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$
                                                                                                                        