SPL,L,O,M,T NAME ISA05(5) !92413-16024 760329 ! ! ! SOURCE: 92413-18024 REV A ! RELOC: 92413-16024 REV A ! RETURN DIRECTLY TO MAIN ! ! LET SWPRT BE LABEL,EXTERNAL ISA05:GOTO SWPRT ! ! ! ! ! ! 'CONST' GENERATES CONSTANTS FOR USE WITH DEVICE SUBROUTINES ! ! THE FORMAT OF THE REQUIRED INPUT IS AS FOLLOWS; ! ! ENTRY POINT NAME,I1,I2,I3,,,IN ! ! WHERE: ENTRY POINT NAME = A NAME WITH 1 TO 5 ! CHARACTERS AND IT MUST ! BEGIN WITH A ALPHA CHARACTER ! OR A PERIOD. ! I1,I2,ETC = DECIMAL OR OCTAL CONSTANT. ! OCTAL CONSTANTS MUST HAVE ! "B" AS THE LAST CHARACTER. ! ! ! DECLARATIONS ! LET CONST BE SUBROUTINE,GLOBAL LET PUTWK BE SUBROUTINE,DIRECT LET ASCBF(6) BE INTEGER LET OLDCS BE INTEGER LET LOUT BE SUBROUTINE,EXTERNAL,DIRECT LET EPOIN BE INTEGER(21) INITIALIZE EPOIN TO 40,\ "ENTER INSTRUMENT CONFIGURATION CONSTANTS" LET NCONS BE INTEGER(18) !TABLE NAME RECORD INITIALIZE NCONS TO 17,10400K,20000K,0,"..CON",\ 100001K,0,0,6,7(0) LET IOCT BE PSEUDO,DIRECT LET FLD BE PSEUDO,DIRECT LET WSAA BE PSEUDO,DIRECT,EXTERNAL LET CSAS BE PSEUDO,DIRECT LET BLNK BE PSEUDO,DIRECT LET IDEC BE PSEUDO,DIRECT LET INWS BE PSEUDO,DIRECT,EXTERNAL LET IABS BE FUNCTION LET INCS BE PSEUDO,DIRECT,EXTERNAL LET CSAC BE PSEUDO,DIRECT,EXTERNAL LET STPRG,GT0UT BE SUBROUTINE,DIRECT,EXTERNAL LET MATCS BE SUBROUTINE,DIRECT LET OUTRL BE SUBROUTINE,EXTERNAL LET NAM BE INTEGER,EXTERNAL !STRING INPUT ADDRESS LET READ BE SUBROUTINE,EXTERNAL,DIRECT LET WRITE BE SUBROUTINE,EXTERNAL,DIRECT LET ERR1 BE INTEGER(13) INITIALIZE ERR1 TO 17,"ILLEGAL FIRST CHARACTER" LET ERR2 BE INTEGER(8) INITIALIZE ERR2 TO 13,"INVALID INPUT" LET ERR3 BE INTEGER(9) INITIALIZE ERR3 TO 15,"DUPLICATE ENTRY" ! ! CONST:SUBROUTINE(NAMC,ENT,EXT,DBL) GLOBAL DBL,ENT,EXT,NAMC,K,TENT_0 CALL WRITE(EPOIN) !PRINT PROMPT MESSAGE NEXTL:CALL READ?[GOTO OUTPT] !INPUT DATA L,I,FLAG_0 CHAR_INCS(NAM,1) !CHECK FIRST CHARACTER IF CHAR < "A" AND\ CHAR > "Z" AND\ CHAR # "." THEN\ [WRITE(ERR2);GOTO NEXTL] ! WHILE [I_I+1] DO THRU GTNAM CHAR_INCS(NAM,I)?[WRITE(ERR2);GOTO NEXTL] ! GTNAM:IF CHAR # "," THEN\ !CREATE STRING WITH NAME IN IT CSAC(TENT)_CHAR,ELSE GOTO GTNUM ! GTNUM:BLNK(TENT)_6-I !PAD WITH BLANKS MATCS(TENT,ENT,0,5,COUNT) !DUPLICATE ENTRY IF COUNT THEN[WRITE(ERR3);STPRG(TENT);GOTO NEXTL] CSAS(ENT)_TENT TENT_0 CSAC(ENT)_0 CSAC(ENT)_K>-8 !ENTRY OFFSET CSAC(ENT)_K L_I+1 GTNU3:IF (INCS(NAM,[I_I+1])?[FLAG_1;IF(I AND 1K) THEN\ I_I-1;GOTO GTNU2] = ",") THEN\ !COMMA? GOTO GTNU2,ELSE\ GOTO GTNU3 GTNU2:IF INCS(NAM,I-1)="B" THEN\ !OCTAL? VAL_IOCT(NAM,L),ELSE\ !DECIMAL? VAL_IDEC(NAM,L) L_I+1 CSAC(DBL)_0 CSAC(DBL)_0 CSAC(DBL)_VAL-<8 CSAC(DBL)_VAL !APPEND CONSTANT K_K+1 !INCREMENT ENTRY OFFSET GTNU1:IF FLAG THEN GOTO NEXTL,ELSE\ GOTO GTNU3 OUTPT:WSAA(NAMC)_@NCONS !NAME RECORD RETURN !RETURN TO INST CONFIG. ROUTINE END ! IOCT: PSEUDO(S1,OCNT)DIRECT J_OCNT IF IOCTF THEN GOTO IOCT9 IOCTV,J1_0 IOCT1:J2_INCS(S1,J)?[RETURN] IF J2=40K THEN [IF J1 THEN RETURN, ELSE GOTO IOCT5] J1_1 IF J2<60K THEN RETURN IF J2>67K THEN RETURN IOCTV_(IOCTV-<3)+(J2 AND 7K) IOCT5:J_J+1 GOTO IOCT1 ! IOCT9:WHILE J>6 DO[CSAC(S1)_40K;J_J-1] IF J=6 THEN[CSAC(S1)_((IOCTV-<1)AND 1)+60K;J_5] WHILE J DO [CSAC(S1)_FLD([J1_((5-J)*3)+1],J1+2,IOCTV)+60K;J_J-1] RETURN END ! FLD: PSEUDO(X,Y,Z) DIRECT ! ! DATA SOURCE: RETURNS FIELD OF Z,SPECIFIED BY X AND Y,RIGHT ! JUSTIFIED. ! DATA ACCEPTOR: INSERTS RIGHT JUSTIFIED BITS IN FIELD OF Z ! SPECIFIED BY X AND Y. ! ! BITS ARE SPECIFIED FROM LEFT (SIGN BIT = 0) TO RIGHT (LSB = 15) ! G_Y-X+1 MASK_100000K WHILE[G_G-1]DO MASK_MASK>-1 G_X+1 WHILE[G_G-1]DO MASK_MASK->1 G_16-Y IF FLDF THEN GOTO L4 J_Z AND MASK WHILE[G_G-1]DO J_J->1 FLDV_J RETURN L4: CMASK_NOT MASK J_FLDV WHILE[G_G-1]DO J_J-<1 Z_(Z AND CMASK) OR (J AND MASK) RETURN END !MATCS ! ! !SEARCHES STRING ST2 FOR MATCH TO STRING ST1. IF TYPE =0 THEN ITS A !CHARACTER STRING ELSE ITS A WORD STRING. NUM _ WORDS OR CHARS IN !STRING. IF NO MATCH IS FOUND COUNT IS SET =0 ELSE ITS SET TO !POSITION OF MATCH IN STRING ST2. ! MATCS: SUBROUTINE(ST1,ST2,TYPE,NUM,KOUNT)DIRECT A,E_1 IF TYPE THEN GO TO M2 M1: FOR D_E TO 500 DO[IF INCS(ST1,A)=INCS(ST2,D)?[KOUNT_0;RETURN]\ THEN GOTO M5] M5: FOR M_A TO NUM DO[IFNOT INCS(ST1,M)=INCS(ST2,D+M-1)\ ?[KOUNT_0;RETURN]THEN [E_D+1;GOTO M1]] GOTO M3 M2: FOR D_E TO 500 DO[IF INWS(ST1,A)=INWS(ST2,D)?[KOUNT_0;RETURN]\ THEN GO TO M7] M7: FOR M_A TO NUM DO[IFNOT INWS(ST1,M)=INWS(ST2,D+M-1)\ ?[KOUNT_0;RETURN]THEN [E_D+1;GOTO M2]] M3: KOUNT_D RETURN END ! ! CSAS: PSEUDO (CSP) DIRECT IFNOT CSASF THEN[WRITE(ERR1);CALL GT0UT],ELSE W_0 CSAS1: W_W+1 CSAC(CSP)_INCS(CSASV,W)?[STPRG(CSASV);RETURN] GOTO CSAS1 END IABS: FUNCTION(INT) IABSV_[IF INT<0 THEN -INT,ELSE INT] RETURN END ! ! ! ! IDEC: PSEUDO (S2,DCNT)DIRECT IF IDECF THEN GOTO IDEC2 J0_DCNT J1,J2,IDECV_0 IDEC1:J3_INCS(S2,J0)?[GOTO IDEC9] IF J3<60K THEN GOTO IDEC7 IF J3>71K THEN GOTO IDEC9 J1_1 IDECV_(IDECV*10)+(J3 AND 17K) IDEC6:J0_J0+1 GOTO IDEC1 IDEC7:IF J1 THEN GOTO IDEC9 IF J3=40K THEN GOTO IDEC6 IF J3=55K THEN[J2_1; GOTO IDEC6] IDEC9:IF J2 THEN IDECV_ -IDECV RETURN ! IDEC2:J0_IABS(IDECV) J1_0 J2_10000 ASCBF(1)_40K FOR I0_2 TO 6 DO THRU IDEC3 J3_J0/J2 J0_J0-(J2*J3) J2_J2/10 IF J1 THEN GOTO IDEC4 IF J3 THEN J1_1,ELSE[IF I0 # 6 THEN[J3_40K;GOTO IDEC3]] IF IDECV<0 THEN ASCBF(I0-1)_55K IDEC4: J3_J3+60K IDEC3:ASCBF(I0)_J3 J0_DCNT WHILE J0>6 DO[CSAC(S2)_40K;J0_J0-1] I0_1 IDEC5:IF(J0+I0)>6 THEN CSAC(S2)_ASCBF(I0),\ ELSE[IF ASCBF(I0)#40K THEN[\ FOR I0_1 TO J0 DO[CSAC(S2)_44K];GOTO IDEC9]] IF[I0_I0+1]=7 THEN GOTO IDEC9,ELSE GOTO IDEC5 END ! ! ! BLNK: PSEUDO(BARG)DIRECT IF BLNKF THEN GOTO BLNK5 BLNKV_1 UNTIL INCS(BARG)?[GOTO BLNK1]-40K DO BLNKV_BLNKV+1 BLNK1:BLNKV_BLNKV-1 RETURN BLNK5:J_BLNKV+1 WHILE[J_J-1]DO CSAC(BARG)_40K RETURN END ! ! ! ! ! END ISA05 END$ END ISA05 END$