SUBROUTINE MAIN INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER I, N INTEGER GETARG, OPEN LOGICAL*1 ARG (36) LOGICAL*1 ST001Z(39) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST001Z(1)/117/,ST001Z(2)/115/,ST001Z(3)/97/,ST001Z(4)/103/,ST *001Z(5)/101/,ST001Z(6)/58/,ST001Z(7)/32/,ST001Z(8)/32/,ST001Z(9)/1 *14/,ST001Z(10)/97/,ST001Z(11)/116/,ST001Z(12)/112/,ST001Z(13)/49/, *ST001Z(14)/32/,ST001Z(15)/91/,ST001Z(16)/45/,ST001Z(17)/110/,ST001 *Z(18)/93/,ST001Z(19)/32/,ST001Z(20)/91/,ST001Z(21)/102/,ST001Z(22) */105/,ST001Z(23)/108/,ST001Z(24)/101/,ST001Z(25)/93/,ST001Z(26)/32 */,ST001Z(27)/46/,ST001Z(28)/46/,ST001Z(29)/46/,ST001Z(30)/32/,ST00 *1Z(31)/62/,ST001Z(32)/111/,ST001Z(33)/117/,ST001Z(34)/116/,ST001Z( *35)/102/,ST001Z(36)/105/,ST001Z(37)/108/,ST001Z(38)/101/,ST001Z(39 *)/0/ CALL QUERY (ST001Z) CALL INITKW CALL RATARG IF (.NOT.(DOSYM .EQ. 1))GOTO 23000 CALL LODSYM(ARG) 23000 CONTINUE N = 1 I = 1 23002 IF (.NOT.(GETARG (I, ARG, 36) .NE. -1))GOTO 23004 IF (.NOT.(ARG (1) .EQ. 45))GOTO 23005 IF (.NOT.(ARG(2) .EQ. 0))GOTO 23007 INFILE (1) = 1 GOTO 23008 23007 CONTINUE GOTO 23003 23008 CONTINUE GOTO 23006 23005 CONTINUE INFILE (1) = OPEN (ARG, 1) IF (.NOT.(INFILE (1) .EQ. -3))GOTO 23009 CALL CANT (ARG) 23009 CONTINUE 23006 CONTINUE N = N + 1 CALL PARSE IF (.NOT.(INFILE (1) .NE. 1))GOTO 23011 CALL CLOSE (INFILE (1)) 23011 CONTINUE 23003 I = I + 1 GOTO 23002 23004 CONTINUE IF (.NOT.(N .EQ. 1))GOTO 23013 INFILE (1) = 1 CALL PARSE 23013 CONTINUE RETURN END SUBROUTINE INSCHR(C, BUF, BP, MAXSIZ) INTEGER BP, MAXSIZ LOGICAL*1 C, BUF(100) LOGICAL*1 ST002Z(16) DATA ST002Z(1)/98/,ST002Z(2)/117/,ST002Z(3)/102/,ST002Z(4)/102/,ST *002Z(5)/101/,ST002Z(6)/114/,ST002Z(7)/32/,ST002Z(8)/111/,ST002Z(9) */118/,ST002Z(10)/101/,ST002Z(11)/114/,ST002Z(12)/102/,ST002Z(13)/1 *08/,ST002Z(14)/111/,ST002Z(15)/119/,ST002Z(16)/0/ IF (.NOT.(BP .GT. MAXSIZ))GOTO 23015 CALL BADERR(ST002Z) 23015 CONTINUE BUF(BP) = C BP = BP + 1 RETURN END SUBROUTINE INSSTR(S, BUF, BP, MAXSIZ) LOGICAL*1 S(100), BUF(100) INTEGER BP, MAXSIZ INTEGER I I = 1 23017 IF (.NOT.(S(I) .NE. 0))GOTO 23019 CALL INSCHR(S(I), BUF, BP, MAXSIZ) 23018 I=I+1 GOTO 23017 23019 CONTINUE RETURN END SUBROUTINE BADERR (MSG) LOGICAL*1 MSG (100) CALL SYNERR (MSG) CALL ENDST(-3) END SUBROUTINE BALPAR LOGICAL*1 T, TOKEN (120) LOGICAL*1 GETTOK, GNBTOK INTEGER NLPAR LOGICAL*1 ST003Z(19) LOGICAL*1 ST004Z(33) DATA ST003Z(1)/109/,ST003Z(2)/105/,ST003Z(3)/115/,ST003Z(4)/115/,S *T003Z(5)/105/,ST003Z(6)/110/,ST003Z(7)/103/,ST003Z(8)/32/,ST003Z(9 *)/108/,ST003Z(10)/101/,ST003Z(11)/102/,ST003Z(12)/116/,ST003Z(13)/ *32/,ST003Z(14)/112/,ST003Z(15)/97/,ST003Z(16)/114/,ST003Z(17)/101/ *,ST003Z(18)/110/,ST003Z(19)/0/ DATA ST004Z(1)/109/,ST004Z(2)/105/,ST004Z(3)/115/,ST004Z(4)/115/,S *T004Z(5)/105/,ST004Z(6)/110/,ST004Z(7)/103/,ST004Z(8)/32/,ST004Z(9 *)/112/,ST004Z(10)/97/,ST004Z(11)/114/,ST004Z(12)/101/,ST004Z(13)/1 *10/,ST004Z(14)/116/,ST004Z(15)/104/,ST004Z(16)/101/,ST004Z(17)/115 */,ST004Z(18)/105/,ST004Z(19)/115/,ST004Z(20)/32/,ST004Z(21)/105/,S *T004Z(22)/110/,ST004Z(23)/32/,ST004Z(24)/99/,ST004Z(25)/111/,ST004 *Z(26)/110/,ST004Z(27)/100/,ST004Z(28)/105/,ST004Z(29)/116/,ST004Z( *30)/105/,ST004Z(31)/111/,ST004Z(32)/110/,ST004Z(33)/0/ IF (.NOT.(GNBTOK (TOKEN, 120) .NE. 40))GOTO 23020 CALL SYNERR (ST003Z) RETURN 23020 CONTINUE CALL OUTSTR (TOKEN) NLPAR = 1 23022 CONTINUE T = GETTOK (TOKEN, 120) IF (.NOT.(T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ. -1 *))GOTO 23025 CALL PBSTR (TOKEN) GOTO 23024 23025 CONTINUE IF (.NOT.(T .EQ. 10))GOTO 23027 TOKEN (1) = 0 GOTO 23028 23027 CONTINUE IF (.NOT.(T .EQ. 40))GOTO 23029 NLPAR = NLPAR + 1 GOTO 23030 23029 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23031 NLPAR = NLPAR - 1 23031 CONTINUE 23030 CONTINUE 23028 CONTINUE CALL OUTSTR (TOKEN) 23023 IF (.NOT.(NLPAR .LE. 0))GOTO 23022 23024 CONTINUE IF (.NOT.(NLPAR .NE. 0))GOTO 23033 CALL SYNERR (ST004Z) 23033 CONTINUE RETURN END SUBROUTINE BRKNXT (SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL (100), LEXTYP (100), SP, TOKEN INTEGER I, N LOGICAL*1 T INTEGER ALLDIG, CTOI LOGICAL*1 GNBTOK INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 ST005Z(14) LOGICAL*1 ST006Z(13) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST005Z(1)/105/,ST005Z(2)/108/,ST005Z(3)/108/,ST005Z(4)/101/,S *T005Z(5)/103/,ST005Z(6)/97/,ST005Z(7)/108/,ST005Z(8)/32/,ST005Z(9) */98/,ST005Z(10)/114/,ST005Z(11)/101/,ST005Z(12)/97/,ST005Z(13)/107 */,ST005Z(14)/0/ DATA ST006Z(1)/105/,ST006Z(2)/108/,ST006Z(3)/108/,ST006Z(4)/101/,S *T006Z(5)/103/,ST006Z(6)/97/,ST006Z(7)/108/,ST006Z(8)/32/,ST006Z(9) */110/,ST006Z(10)/101/,ST006Z(11)/120/,ST006Z(12)/116/,ST006Z(13)/0 */ N = 0 T = GNBTOK (SCRTOK, 120) IF (.NOT.(ALLDIG (SCRTOK) .EQ. 1))GOTO 23035 I = 1 N = CTOI (SCRTOK, I) - 1 GOTO 23036 23035 CONTINUE IF (.NOT.(T .NE. 59))GOTO 23037 CALL PBSTR (SCRTOK) 23037 CONTINUE 23036 CONTINUE I = SP 23039 IF (.NOT.(I .GT. 0))GOTO 23041 IF (.NOT.(LEXTYP (I) .EQ. -15 .OR. LEXTYP (I) .EQ. -10 .OR. LEXTYP * (I) .EQ. -16 .OR. LEXTYP (I) .EQ. -17))GOTO 23042 IF (.NOT.(N .GT. 0))GOTO 23044 N = N - 1 GOTO 23040 23044 CONTINUE IF (.NOT.(TOKEN .EQ. -8))GOTO 23046 CALL OUTGO (LABVAL (I) + 1) GOTO 23047 23046 CONTINUE CALL OUTGO (LABVAL (I)) 23047 CONTINUE 23045 CONTINUE XFER = 1 RETURN 23042 CONTINUE 23040 I = I - 1 GOTO 23039 23041 CONTINUE IF (.NOT.(TOKEN .EQ. -8))GOTO 23048 CALL SYNERR (ST005Z) GOTO 23049 23048 CONTINUE CALL SYNERR (ST006Z) 23049 CONTINUE RETURN END SUBROUTINE CASCOD (LAB, TOKEN) INTEGER LAB, TOKEN INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER T, L, LB, UB, I, J, JUNK INTEGER CASLAB, LABGEN LOGICAL*1 GNBTOK LOGICAL*1 ST007Z(24) LOGICAL*1 ST008Z(28) LOGICAL*1 ST009Z(22) LOGICAL*1 ST00AZ(21) LOGICAL*1 ST00BZ(21) LOGICAL*1 ST00CZ(20) LOGICAL*1 ST00DZ(38) LOGICAL*1 ST00EZ(15) LOGICAL*1 ST00FZ(39) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST007Z(1)/105/,ST007Z(2)/108/,ST007Z(3)/108/,ST007Z(4)/101/,S *T007Z(5)/103/,ST007Z(6)/97/,ST007Z(7)/108/,ST007Z(8)/32/,ST007Z(9) */99/,ST007Z(10)/97/,ST007Z(11)/115/,ST007Z(12)/101/,ST007Z(13)/32/ *,ST007Z(14)/111/,ST007Z(15)/114/,ST007Z(16)/32/,ST007Z(17)/100/,ST *007Z(18)/101/,ST007Z(19)/102/,ST007Z(20)/97/,ST007Z(21)/117/,ST007 *Z(22)/108/,ST007Z(23)/116/,ST007Z(24)/0/ DATA ST008Z(1)/105/,ST008Z(2)/108/,ST008Z(3)/108/,ST008Z(4)/101/,S *T008Z(5)/103/,ST008Z(6)/97/,ST008Z(7)/108/,ST008Z(8)/32/,ST008Z(9) */114/,ST008Z(10)/97/,ST008Z(11)/110/,ST008Z(12)/103/,ST008Z(13)/10 *1/,ST008Z(14)/32/,ST008Z(15)/105/,ST008Z(16)/110/,ST008Z(17)/32/,S *T008Z(18)/99/,ST008Z(19)/97/,ST008Z(20)/115/,ST008Z(21)/101/,ST008 *Z(22)/32/,ST008Z(23)/108/,ST008Z(24)/97/,ST008Z(25)/98/,ST008Z(26) */101/,ST008Z(27)/108/,ST008Z(28)/0/ DATA ST009Z(1)/115/,ST009Z(2)/119/,ST009Z(3)/105/,ST009Z(4)/116/,S *T009Z(5)/99/,ST009Z(6)/104/,ST009Z(7)/32/,ST009Z(8)/116/,ST009Z(9) */97/,ST009Z(10)/98/,ST009Z(11)/108/,ST009Z(12)/101/,ST009Z(13)/32/ *,ST009Z(14)/111/,ST009Z(15)/118/,ST009Z(16)/101/,ST009Z(17)/114/,S *T009Z(18)/102/,ST009Z(19)/108/,ST009Z(20)/111/,ST009Z(21)/119/,ST0 *09Z(22)/0/ DATA ST00AZ(1)/100/,ST00AZ(2)/117/,ST00AZ(3)/112/,ST00AZ(4)/108/,S *T00AZ(5)/105/,ST00AZ(6)/99/,ST00AZ(7)/97/,ST00AZ(8)/116/,ST00AZ(9) */101/,ST00AZ(10)/32/,ST00AZ(11)/99/,ST00AZ(12)/97/,ST00AZ(13)/115/ *,ST00AZ(14)/101/,ST00AZ(15)/32/,ST00AZ(16)/108/,ST00AZ(17)/97/,ST0 *0AZ(18)/98/,ST00AZ(19)/101/,ST00AZ(20)/108/,ST00AZ(21)/0/ DATA ST00BZ(1)/100/,ST00BZ(2)/117/,ST00BZ(3)/112/,ST00BZ(4)/108/,S *T00BZ(5)/105/,ST00BZ(6)/99/,ST00BZ(7)/97/,ST00BZ(8)/116/,ST00BZ(9) */101/,ST00BZ(10)/32/,ST00BZ(11)/99/,ST00BZ(12)/97/,ST00BZ(13)/115/ *,ST00BZ(14)/101/,ST00BZ(15)/32/,ST00BZ(16)/108/,ST00BZ(17)/97/,ST0 *0BZ(18)/98/,ST00BZ(19)/101/,ST00BZ(20)/108/,ST00BZ(21)/0/ DATA ST00CZ(1)/105/,ST00CZ(2)/108/,ST00CZ(3)/108/,ST00CZ(4)/101/,S *T00CZ(5)/103/,ST00CZ(6)/97/,ST00CZ(7)/108/,ST00CZ(8)/32/,ST00CZ(9) */99/,ST00CZ(10)/97/,ST00CZ(11)/115/,ST00CZ(12)/101/,ST00CZ(13)/32/ *,ST00CZ(14)/115/,ST00CZ(15)/121/,ST00CZ(16)/110/,ST00CZ(17)/116/,S *T00CZ(18)/97/,ST00CZ(19)/120/,ST00CZ(20)/0/ DATA ST00DZ(1)/109/,ST00DZ(2)/117/,ST00DZ(3)/108/,ST00DZ(4)/116/,S *T00DZ(5)/105/,ST00DZ(6)/112/,ST00DZ(7)/108/,ST00DZ(8)/101/,ST00DZ( *9)/32/,ST00DZ(10)/100/,ST00DZ(11)/101/,ST00DZ(12)/102/,ST00DZ(13)/ *97/,ST00DZ(14)/117/,ST00DZ(15)/108/,ST00DZ(16)/116/,ST00DZ(17)/115 */,ST00DZ(18)/32/,ST00DZ(19)/105/,ST00DZ(20)/110/,ST00DZ(21)/32/,ST *00DZ(22)/115/,ST00DZ(23)/119/,ST00DZ(24)/105/,ST00DZ(25)/116/,ST00 *DZ(26)/99/,ST00DZ(27)/104/,ST00DZ(28)/32/,ST00DZ(29)/115/,ST00DZ(3 *0)/116/,ST00DZ(31)/97/,ST00DZ(32)/116/,ST00DZ(33)/101/,ST00DZ(34)/ *109/,ST00DZ(35)/101/,ST00DZ(36)/110/,ST00DZ(37)/116/,ST00DZ(38)/0/ DATA ST00EZ(1)/117/,ST00EZ(2)/110/,ST00EZ(3)/101/,ST00EZ(4)/120/,S *T00EZ(5)/112/,ST00EZ(6)/101/,ST00EZ(7)/99/,ST00EZ(8)/116/,ST00EZ(9 *)/101/,ST00EZ(10)/100/,ST00EZ(11)/32/,ST00EZ(12)/69/,ST00EZ(13)/79 */,ST00EZ(14)/70/,ST00EZ(15)/0/ DATA ST00FZ(1)/109/,ST00FZ(2)/105/,ST00FZ(3)/115/,ST00FZ(4)/115/,S *T00FZ(5)/105/,ST00FZ(6)/110/,ST00FZ(7)/103/,ST00FZ(8)/32/,ST00FZ(9 *)/99/,ST00FZ(10)/111/,ST00FZ(11)/108/,ST00FZ(12)/111/,ST00FZ(13)/1 *10/,ST00FZ(14)/32/,ST00FZ(15)/105/,ST00FZ(16)/110/,ST00FZ(17)/32/, *ST00FZ(18)/99/,ST00FZ(19)/97/,ST00FZ(20)/115/,ST00FZ(21)/101/,ST00 *FZ(22)/32/,ST00FZ(23)/111/,ST00FZ(24)/114/,ST00FZ(25)/32/,ST00FZ(2 *6)/100/,ST00FZ(27)/101/,ST00FZ(28)/102/,ST00FZ(29)/97/,ST00FZ(30)/ *117/,ST00FZ(31)/108/,ST00FZ(32)/116/,ST00FZ(33)/32/,ST00FZ(34)/108 */,ST00FZ(35)/97/,ST00FZ(36)/98/,ST00FZ(37)/101/,ST00FZ(38)/108/,ST *00FZ(39)/0/ IF (.NOT.(SWTOP .LE. 0))GOTO 23050 CALL SYNERR (ST007Z) RETURN 23050 CONTINUE CALL OUTGO (LAB + 1) XFER = 1 L = LABGEN (1) IF (.NOT.(TOKEN .EQ. -25))GOTO 23052 23054 IF (.NOT.(CASLAB (LB, T) .NE. -1))GOTO 23055 UB = LB IF (.NOT.(T .EQ. 45))GOTO 23056 JUNK = CASLAB (UB, T) 23056 CONTINUE IF (.NOT.(LB .GT. UB))GOTO 23058 CALL SYNERR (ST008Z) UB = LB 23058 CONTINUE IF (.NOT.(SWLAST + 3 .GT. 300))GOTO 23060 CALL BADERR (ST009Z) 23060 CONTINUE I = SWTOP + 3 23062 IF (.NOT.(I .LT. SWLAST))GOTO 23064 IF (.NOT.(LB .LE. SWSTAK (I)))GOTO 23065 GOTO 23064 23065 CONTINUE IF (.NOT.(LB .LE. SWSTAK (I+1)))GOTO 23067 CALL SYNERR (ST00AZ) 23067 CONTINUE 23066 CONTINUE 23063 I = I + 3 GOTO 23062 23064 CONTINUE IF (.NOT.(I .LT. SWLAST .AND. UB .GE. SWSTAK (I)))GOTO 23069 CALL SYNERR (ST00BZ) 23069 CONTINUE J = SWLAST 23071 IF (.NOT.(J .GT. I))GOTO 23073 SWSTAK (J+2) = SWSTAK (J-1) 23072 J = J - 1 GOTO 23071 23073 CONTINUE SWSTAK (I) = LB SWSTAK (I + 1) = UB SWSTAK (I + 2) = L SWSTAK (SWTOP + 1) = SWSTAK (SWTOP + 1) + 1 SWLAST = SWLAST + 3 IF (.NOT.(T .EQ. 58))GOTO 23074 GOTO 23055 23074 CONTINUE IF (.NOT.(T .NE. 44))GOTO 23076 CALL SYNERR (ST00CZ) 23076 CONTINUE 23075 CONTINUE GOTO 23054 23055 CONTINUE GOTO 23053 23052 CONTINUE T = GNBTOK (SCRTOK, 120) IF (.NOT.(SWSTAK (SWTOP + 2) .NE. 0))GOTO 23078 CALL BADERR (ST00DZ) GOTO 23079 23078 CONTINUE SWSTAK (SWTOP + 2) = L 23079 CONTINUE 23053 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23080 CALL SYNERR (ST00EZ) GOTO 23081 23080 CONTINUE IF (.NOT.(T .NE. 58))GOTO 23082 CALL BADERR (ST00FZ) 23082 CONTINUE 23081 CONTINUE XFER = 0 CALL OUTCON (L) RETURN END INTEGER FUNCTION CASLAB (N, T) INTEGER N, T LOGICAL*1 TOK (120) INTEGER I, S LOGICAL*1 GNBTOK INTEGER CTOI LOGICAL*1 ST00GZ(19) DATA ST00GZ(1)/105/,ST00GZ(2)/110/,ST00GZ(3)/118/,ST00GZ(4)/97/,ST *00GZ(5)/108/,ST00GZ(6)/105/,ST00GZ(7)/100/,ST00GZ(8)/32/,ST00GZ(9) */99/,ST00GZ(10)/97/,ST00GZ(11)/115/,ST00GZ(12)/101/,ST00GZ(13)/32/ *,ST00GZ(14)/108/,ST00GZ(15)/97/,ST00GZ(16)/98/,ST00GZ(17)/101/,ST0 *0GZ(18)/108/,ST00GZ(19)/0/ T = GNBTOK (TOK, 120) 23084 IF (.NOT.(T .EQ. 10))GOTO 23085 T = GNBTOK (TOK, 120) GOTO 23084 23085 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23086 CASLAB=(T) RETURN 23086 CONTINUE IF (.NOT.(T .EQ. 45))GOTO 23088 S = -1 GOTO 23089 23088 CONTINUE S = +1 23089 CONTINUE IF (.NOT.(T .EQ. 45 .OR. T .EQ. 43))GOTO 23090 T = GNBTOK (TOK, 120) 23090 CONTINUE IF (.NOT.(T .NE. 2))GOTO 23092 CALL SYNERR (ST00GZ) N = 0 GOTO 23093 23092 CONTINUE I = 1 N = S * CTOI (TOK, I) 23093 CONTINUE T = GNBTOK (TOK, 120) 23094 IF (.NOT.(T .EQ. 10))GOTO 23095 T = GNBTOK (TOK, 120) GOTO 23094 23095 CONTINUE RETURN END LOGICAL*1 FUNCTION DEFTOK (TOKEN, TOKSIZ) LOGICAL*1 TOKEN (120) INTEGER TOKSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 T, C, DEFN (250) INTEGER AP, ARGSTK (100), CALLST (50), NLB, PLEV (50), IFL INTEGER LUDEF, PUSH, IFPARM, ENTER LOGICAL*1 GCTOK LOGICAL*1 BALP(3) LOGICAL*1 ST00HZ(20) LOGICAL*1 ST00IZ(14) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA BALP(1)/40/,BALP(2)/41/,BALP(3)/0/ DATA ST00HZ(1)/99/,ST00HZ(2)/97/,ST00HZ(3)/108/,ST00HZ(4)/108/,ST0 *0HZ(5)/32/,ST00HZ(6)/115/,ST00HZ(7)/116/,ST00HZ(8)/97/,ST00HZ(9)/9 *9/,ST00HZ(10)/107/,ST00HZ(11)/32/,ST00HZ(12)/111/,ST00HZ(13)/118/, *ST00HZ(14)/101/,ST00HZ(15)/114/,ST00HZ(16)/102/,ST00HZ(17)/108/,ST *00HZ(18)/111/,ST00HZ(19)/119/,ST00HZ(20)/0/ DATA ST00IZ(1)/69/,ST00IZ(2)/79/,ST00IZ(3)/70/,ST00IZ(4)/32/,ST00I *Z(5)/105/,ST00IZ(6)/110/,ST00IZ(7)/32/,ST00IZ(8)/115/,ST00IZ(9)/11 *6/,ST00IZ(10)/114/,ST00IZ(11)/105/,ST00IZ(12)/110/,ST00IZ(13)/103/ *,ST00IZ(14)/0/ CP = 0 AP = 1 EP = 1 23096 CONTINUE T = GCTOK (TOKEN, TOKSIZ) IF (.NOT.(T .EQ. -1))GOTO 23099 GOTO 23098 23099 CONTINUE IF (.NOT.(T .EQ. -9))GOTO 23101 IF (.NOT.(LUDEF (TOKEN, DEFN, DEFTBL) .EQ. 0))GOTO 23103 IF (.NOT.(CP .EQ. 0))GOTO 23105 GOTO 23098 23105 CONTINUE CALL PUTTOK (TOKEN) 23106 CONTINUE GOTO 23104 23103 CONTINUE IF (.NOT.(DEFN (1) .EQ. -4))GOTO 23107 CALL GETDEF (TOKEN, TOKSIZ, DEFN, 250) CALL ENTDEF (TOKEN, DEFN, DEFTBL) GOTO 23108 23107 CONTINUE IF (.NOT.(DEFN (1) .EQ. -21))GOTO 23109 CALL GETUND (TOKEN) CALL RMDEF (TOKEN, DEFTBL) GOTO 23110 23109 CONTINUE CP = CP + 1 IF (.NOT.(CP .GT. 50))GOTO 23111 CALL BADERR (ST00HZ) 23111 CONTINUE CALLST (CP) = AP AP = PUSH (EP, ARGSTK, AP) CALL PUTTOK (DEFN) CALL PUTCHR (0) AP = PUSH (EP, ARGSTK, AP) CALL PUTTOK (TOKEN) CALL PUTCHR (0) AP = PUSH (EP, ARGSTK, AP) T = GCTOK (TOKEN, TOKSIZ) IF (.NOT.(T .EQ. 32))GOTO 23113 T = GCTOK (TOKEN, TOKSIZ) CALL PBSTR (TOKEN) IF (.NOT.(T .NE. 40))GOTO 23115 CALL PUTBAK (32) 23115 CONTINUE GOTO 23114 23113 CONTINUE CALL PBSTR (TOKEN) 23114 CONTINUE IF (.NOT.(T .NE. 40))GOTO 23117 CALL PBSTR (BALP) GOTO 23118 23117 CONTINUE IF (.NOT.(IFPARM (DEFN) .EQ. 0))GOTO 23119 CALL PBSTR (BALP) 23119 CONTINUE 23118 CONTINUE PLEV (CP) = 0 23110 CONTINUE 23108 CONTINUE 23104 CONTINUE GOTO 23102 23101 CONTINUE IF (.NOT.(T .EQ. -10))GOTO 23121 NLB = 1 23123 CONTINUE T = GCTOK (TOKEN, TOKSIZ) IF (.NOT.(T .EQ. -10))GOTO 23126 NLB = NLB + 1 GOTO 23127 23126 CONTINUE IF (.NOT.(T .EQ. -11))GOTO 23128 NLB = NLB - 1 IF (.NOT.(NLB .EQ. 0))GOTO 23130 GOTO 23125 23130 CONTINUE GOTO 23129 23128 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23132 CALL BADERR (ST00IZ) 23132 CONTINUE 23129 CONTINUE 23127 CONTINUE CALL PUTTOK (TOKEN) 23124 GOTO 23123 23125 CONTINUE GOTO 23122 23121 CONTINUE IF (.NOT.(CP .EQ. 0))GOTO 23134 GOTO 23098 23134 CONTINUE IF (.NOT.(T .EQ. 40))GOTO 23136 IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23138 CALL PUTTOK (TOKEN) 23138 CONTINUE PLEV (CP) = PLEV (CP) + 1 GOTO 23137 23136 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23140 PLEV (CP) = PLEV (CP) - 1 IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23142 CALL PUTTOK (TOKEN) GOTO 23143 23142 CONTINUE CALL PUTCHR (0) CALL EVALR (ARGSTK, CALLST (CP), AP - 1) AP = CALLST (CP) EP = ARGSTK (AP) CP = CP - 1 23143 CONTINUE GOTO 23141 23140 CONTINUE IF (.NOT.(T .EQ. 44 .AND. PLEV (CP) .EQ. 1))GOTO 23144 CALL PUTCHR (0) AP = PUSH (EP, ARGSTK, AP) GOTO 23145 23144 CONTINUE CALL PUTTOK (TOKEN) 23145 CONTINUE 23141 CONTINUE 23137 CONTINUE 23135 CONTINUE 23122 CONTINUE 23102 CONTINUE 23097 GOTO 23096 23098 CONTINUE DEFTOK = T RETURN END SUBROUTINE DMPDCL(TOKEN) LOGICAL*1 TOKEN(100) INTEGER I, J, N LOGICAL*1 C INTEGER INDEXC LOGICAL*1 ESC INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 CHAR(10) LOGICAL*1 COMSTR(7) LOGICAL*1 DATS(6) LOGICAL*1 EOSS(4) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA CHAR(1)/99/,CHAR(2)/104/,CHAR(3)/97/,CHAR(4)/114/,CHAR(5)/97/ *,CHAR(6)/99/,CHAR(7)/116/,CHAR(8)/101/,CHAR(9)/114/,CHAR(10)/0/ DATA COMSTR(1)/99/,COMSTR(2)/32/,COMSTR(3)/32/,COMSTR(4)/32/,COMST *R(5)/32/,COMSTR(6)/32/,COMSTR(7)/0/ DATA DATS(1)/100/,DATS(2)/97/,DATS(3)/116/,DATS(4)/97/,DATS(5)/32/ *,DATS(6)/0/ DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/0/ IF (.NOT.(SBP .GT. 1))GOTO 23146 I = 1 23148 IF (.NOT.(I .LT. SBP))GOTO 23150 CALL OUTTAB CALL OUTDEF(CHAR, TOKEN) CALL OUTCH(32) C = SBUF(I) J = 1 I = I + 1 23151 IF (.NOT.(SBUF(I) .NE. 0))GOTO 23153 TOKEN(J) = SBUF(I) J = J + 1 23152 I = I + 1 GOTO 23151 23153 CONTINUE TOKEN(J) = 0 I = I + 1 CALL OUTSTR(TOKEN) CALL OUTDON J = INDEXC(TOKEN, 40) IF (.NOT.(J .GT. 0))GOTO 23154 TOKEN(J) = 0 23154 CONTINUE J = 1 23156 CONTINUE IF (.NOT.(SBUF(I) .EQ. 0 .AND. C .EQ. 39))GOTO 23159 GOTO 23158 23159 CONTINUE IF (.NOT.(J .EQ. 1))GOTO 23161 CALL OUTTAB CALL OUTSTR(DATS) GOTO 23162 23161 CONTINUE CALL OUTCH(44) 23162 CONTINUE CALL OUTSTR(TOKEN) IF (.NOT.(C .EQ. 34))GOTO 23163 CALL OUTCH(40) CALL OUTNUM(J) CALL OUTCH(41) 23163 CONTINUE CALL OUTCH(47) IF (.NOT.(SBUF(I) .EQ. 0))GOTO 23165 CALL OUTDEF(EOSS, TOKEN) CALL OUTCH(47) GOTO 23158 23165 CONTINUE N = ESC(SBUF, I) CALL OUTNUM(N) CALL OUTCH(47) 23166 CONTINUE J = J + 1 I = I + 1 23157 GOTO 23156 23158 CONTINUE CALL OUTDON 23149 I = I + 1 GOTO 23148 23150 CONTINUE SBP = 1 23146 CONTINUE RETURN END SUBROUTINE DOARTH (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER K, L, ANS, FIRST, SECOND LOGICAL*1 OP INTEGER CTOI LOGICAL*1 ST00JZ(12) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST00JZ(1)/97/,ST00JZ(2)/114/,ST00JZ(3)/105/,ST00JZ(4)/116/,ST *00JZ(5)/104/,ST00JZ(6)/32/,ST00JZ(7)/101/,ST00JZ(8)/114/,ST00JZ(9) */114/,ST00JZ(10)/111/,ST00JZ(11)/114/,ST00JZ(12)/0/ K = ARGSTK (I + 2) FIRST = CTOI(EVALST, K) L = ARGSTK (I + 4) SECOND = CTOI(EVALST, L) OP = EVALST (ARGSTK (I + 3)) IF (.NOT.(OP .EQ. 43))GOTO 23167 CALL PBNUM (FIRST + SECOND) GOTO 23168 23167 CONTINUE IF (.NOT.(OP .EQ. 45))GOTO 23169 CALL PBNUM (FIRST - SECOND) GOTO 23170 23169 CONTINUE IF (.NOT.(OP .EQ. 42 ))GOTO 23171 IF (.NOT.(EVALST(ARGSTK(I+3) + 1) .EQ. 42))GOTO 23173 ANS = 1 23175 IF (.NOT.(SECOND .GT. 0))GOTO 23177 ANS = ANS * FIRST 23176 SECOND = SECOND - 1 GOTO 23175 23177 CONTINUE CALL PBNUM(ANS) GOTO 23174 23173 CONTINUE CALL PBNUM (FIRST * SECOND) 23174 CONTINUE GOTO 23172 23171 CONTINUE IF (.NOT.(OP .EQ. 47 ))GOTO 23178 CALL PBNUM (FIRST / SECOND) GOTO 23179 23178 CONTINUE CALL SYNERR (ST00JZ) 23179 CONTINUE 23172 CONTINUE 23170 CONTINUE 23168 CONTINUE RETURN END SUBROUTINE DOCODE (LAB) INTEGER LAB INTEGER LABGEN INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 GNBTOK LOGICAL*1 SDO(3) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/0/ XFER = 0 CALL OUTTAB CALL OUTSTR (SDO) CALL OUTCH (32) LAB = LABGEN (2) IF (.NOT.(GNBTOK (SCRTOK, 120) .EQ. 2))GOTO 23180 CALL OUTSTR (SCRTOK) GOTO 23181 23180 CONTINUE CALL PBSTR (SCRTOK) CALL OUTNUM (LAB) 23181 CONTINUE CALL OUTCH (32) CALL EATUP CALL OUTDON RETURN END SUBROUTINE DOIF (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER A2, A3, A4, A5 INTEGER EQUAL COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(J - I .LT. 5))GOTO 23182 RETURN 23182 CONTINUE A2 = ARGSTK (I + 2) A3 = ARGSTK (I + 3) A4 = ARGSTK (I + 4) A5 = ARGSTK (I + 5) IF (.NOT.(EQUAL (EVALST (A2), EVALST (A3)) .EQ. 1))GOTO 23184 CALL PBSTR (EVALST (A4)) GOTO 23185 23184 CONTINUE CALL PBSTR (EVALST (A5)) 23185 CONTINUE RETURN END SUBROUTINE DOINCR (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER K INTEGER CTOI COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) K = ARGSTK (I + 2) CALL PBNUM (CTOI (EVALST, K) + 1) RETURN END SUBROUTINE DOLENT(ARGSTK, I, J) INTEGER ARGSTK(100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER K INTEGER LENGTH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) K = ARGSTK(I + 2) CALL PBNUM(LENGTH(EVALST(K))) RETURN END SUBROUTINE DOMAC (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER A2, A3 LOGICAL*1 ST00KZ(34) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST00KZ(1)/73/,ST00KZ(2)/108/,ST00KZ(3)/108/,ST00KZ(4)/101/,ST *00KZ(5)/103/,ST00KZ(6)/97/,ST00KZ(7)/108/,ST00KZ(8)/32/,ST00KZ(9)/ *102/,ST00KZ(10)/105/,ST00KZ(11)/114/,ST00KZ(12)/115/,ST00KZ(13)/11 *6/,ST00KZ(14)/32/,ST00KZ(15)/97/,ST00KZ(16)/114/,ST00KZ(17)/103/,S *T00KZ(18)/117/,ST00KZ(19)/109/,ST00KZ(20)/101/,ST00KZ(21)/110/,ST0 *0KZ(22)/116/,ST00KZ(23)/32/,ST00KZ(24)/116/,ST00KZ(25)/111/,ST00KZ *(26)/32/,ST00KZ(27)/109/,ST00KZ(28)/100/,ST00KZ(29)/101/,ST00KZ(30 *)/102/,ST00KZ(31)/105/,ST00KZ(32)/110/,ST00KZ(33)/101/,ST00KZ(34)/ *0/ IF (.NOT.(J - I .GT. 2))GOTO 23186 A2 = ARGSTK (I + 2) A3 = ARGSTK (I + 3) IF (.NOT.(.NOT. ((65.LE.EVALST(A2).AND.EVALST(A2).LE.90).OR.(97.LE *.EVALST(A2).AND.EVALST(A2).LE.122))))GOTO 23188 CALL SYNERR(ST00KZ) GOTO 23189 23188 CONTINUE CALL ENTDEF (EVALST (A2), EVALST (A3), DEFTBL) 23189 CONTINUE 23186 CONTINUE RETURN END SUBROUTINE DOSTAT (LAB) INTEGER LAB CALL OUTCON (LAB) CALL OUTCON (LAB + 1) RETURN END SUBROUTINE DOSUB (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER AP, FC, K, NC INTEGER CTOI, LENGTH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(J - I .LT. 3))GOTO 23190 RETURN 23190 CONTINUE IF (.NOT.(J - I .LT. 4))GOTO 23192 NC = 120 GOTO 23193 23192 CONTINUE K = ARGSTK (I + 4) NC = CTOI (EVALST, K) 23193 CONTINUE K = ARGSTK (I + 3) AP = ARGSTK (I + 2) FC = AP + CTOI (EVALST, K) - 1 IF (.NOT.(FC .GE. AP .AND. FC .LT. AP + LENGTH (EVALST (AP))))GOTO * 23194 K = FC + MIN0(NC, LENGTH (EVALST (FC))) - 1 23196 IF (.NOT.(K .GE. FC))GOTO 23198 CALL PUTBAK (EVALST (K)) 23197 K = K - 1 GOTO 23196 23198 CONTINUE 23194 CONTINUE RETURN END LOGICAL*1 FUNCTION DOTHER(TOKEN) LOGICAL*1 TOKEN(120), T INTEGER NLPAR LOGICAL*1 GETTOK LOGICAL*1 ST00LZ(15) DATA ST00LZ(1)/117/,ST00LZ(2)/110/,ST00LZ(3)/101/,ST00LZ(4)/120/,S *T00LZ(5)/112/,ST00LZ(6)/101/,ST00LZ(7)/99/,ST00LZ(8)/116/,ST00LZ(9 *)/101/,ST00LZ(10)/100/,ST00LZ(11)/32/,ST00LZ(12)/69/,ST00LZ(13)/79 */,ST00LZ(14)/70/,ST00LZ(15)/0/ CALL OUTTAB NLPAR = 0 23199 CONTINUE T = GETTOK(TOKEN, 120) IF (.NOT.(T .EQ. 40))GOTO 23202 NLPAR = NLPAR + 1 GOTO 23203 23202 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23204 NLPAR = NLPAR - 1 23204 CONTINUE 23203 CONTINUE IF (.NOT.(T .EQ. 59 .OR. (T .EQ. 44 .AND. NLPAR .EQ. 0)))GOTO 2320 *6 GOTO 23201 23206 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23208 CALL SYNERR(ST00LZ) CALL PBSTR(TOKEN) GOTO 23201 23208 CONTINUE IF (.NOT.(T .NE. 10))GOTO 23210 CALL OUTSTR(TOKEN) 23210 CONTINUE 23200 GOTO 23199 23201 CONTINUE CALL OUTDON DOTHER=(T) RETURN END SUBROUTINE EATUP LOGICAL*1 PTOKEN (120), T, TOKEN (120) INTEGER NLPAR LOGICAL*1 GETTOK LOGICAL*1 ST00MZ(15) LOGICAL*1 ST00NZ(23) DATA ST00MZ(1)/117/,ST00MZ(2)/110/,ST00MZ(3)/101/,ST00MZ(4)/120/,S *T00MZ(5)/112/,ST00MZ(6)/101/,ST00MZ(7)/99/,ST00MZ(8)/116/,ST00MZ(9 *)/101/,ST00MZ(10)/100/,ST00MZ(11)/32/,ST00MZ(12)/69/,ST00MZ(13)/79 */,ST00MZ(14)/70/,ST00MZ(15)/0/ DATA ST00NZ(1)/117/,ST00NZ(2)/110/,ST00NZ(3)/98/,ST00NZ(4)/97/,ST0 *0NZ(5)/108/,ST00NZ(6)/97/,ST00NZ(7)/110/,ST00NZ(8)/99/,ST00NZ(9)/1 *01/,ST00NZ(10)/100/,ST00NZ(11)/32/,ST00NZ(12)/112/,ST00NZ(13)/97/, *ST00NZ(14)/114/,ST00NZ(15)/101/,ST00NZ(16)/110/,ST00NZ(17)/116/,ST *00NZ(18)/104/,ST00NZ(19)/101/,ST00NZ(20)/115/,ST00NZ(21)/101/,ST00 *NZ(22)/115/,ST00NZ(23)/0/ NLPAR = 0 23212 CONTINUE T = GETTOK (TOKEN, 120) IF (.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23215 GOTO 23214 23215 CONTINUE IF (.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23217 CALL PBSTR (TOKEN) GOTO 23214 23217 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23219 CALL SYNERR (ST00MZ) CALL PBSTR (TOKEN) GOTO 23214 23219 CONTINUE IF (.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 . *OR. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T * .EQ. 33 .OR. T .EQ. 126 .OR. T .EQ. 94 .OR. T .EQ. 61))GOTO 23221 23223 IF (.NOT.(GETTOK (PTOKEN, 120) .EQ. 10))GOTO 23224 GOTO 23223 23224 CONTINUE CALL PBSTR (PTOKEN) 23221 CONTINUE IF (.NOT.(T .EQ. 40))GOTO 23225 NLPAR = NLPAR + 1 GOTO 23226 23225 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23227 NLPAR = NLPAR - 1 23227 CONTINUE 23226 CONTINUE CALL OUTSTR (TOKEN) 23213 IF (.NOT.(NLPAR .LT. 0))GOTO 23212 23214 CONTINUE IF (.NOT.(NLPAR .NE. 0))GOTO 23229 CALL SYNERR (ST00NZ) 23229 CONTINUE RETURN END INTEGER FUNCTION ELENTH(BUF) LOGICAL*1 BUF(100), C INTEGER I, N LOGICAL*1 ESC N = 0 I=1 23231 IF (.NOT.(BUF(I) .NE. 0))GOTO 23233 C = ESC(BUF, I) N = N + 1 23232 I=I+1 GOTO 23231 23233 CONTINUE ELENTH = N RETURN END SUBROUTINE ELSEIF (LAB) INTEGER LAB CALL OUTGO (LAB+1) CALL OUTCON (LAB) RETURN END SUBROUTINE ENTDKW LOGICAL*1 DEFNAM(7) LOGICAL*1 MACNAM(8) LOGICAL*1 INCNAM(5) LOGICAL*1 SUBNAM(7) LOGICAL*1 IFNAM(7) LOGICAL*1 ARNAM(6) LOGICAL*1 UNDEFN(9) LOGICAL*1 LINKNM(8) LOGICAL*1 LENTNM(7) DATA DEFNAM(1)/100/,DEFNAM(2)/101/,DEFNAM(3)/102/,DEFNAM(4)/105/,D *EFNAM(5)/110/,DEFNAM(6)/101/,DEFNAM(7)/0/ DATA MACNAM(1)/109/,MACNAM(2)/100/,MACNAM(3)/101/,MACNAM(4)/102/,M *ACNAM(5)/105/,MACNAM(6)/110/,MACNAM(7)/101/,MACNAM(8)/0/ DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/,IN *CNAM(5)/0/ DATA SUBNAM(1)/115/,SUBNAM(2)/117/,SUBNAM(3)/98/,SUBNAM(4)/115/,SU *BNAM(5)/116/,SUBNAM(6)/114/,SUBNAM(7)/0/ DATA IFNAM(1)/105/,IFNAM(2)/102/,IFNAM(3)/101/,IFNAM(4)/108/,IFNAM *(5)/115/,IFNAM(6)/101/,IFNAM(7)/0/ DATA ARNAM(1)/97/,ARNAM(2)/114/,ARNAM(3)/105/,ARNAM(4)/116/,ARNAM( *5)/104/,ARNAM(6)/0/ DATA UNDEFN(1)/117/,UNDEFN(2)/110/,UNDEFN(3)/100/,UNDEFN(4)/101/,U *NDEFN(5)/102/,UNDEFN(6)/105/,UNDEFN(7)/110/,UNDEFN(8)/101/,UNDEFN( *9)/0/ DATA LINKNM(1)/108/,LINKNM(2)/105/,LINKNM(3)/110/,LINKNM(4)/107/,L *INKNM(5)/97/,LINKNM(6)/103/,LINKNM(7)/101/,LINKNM(8)/0/ DATA LENTNM(1)/108/,LENTNM(2)/101/,LENTNM(3)/110/,LENTNM(4)/116/,L *ENTNM(5)/111/,LENTNM(6)/107/,LENTNM(7)/0/ CALL ULSTAL (DEFNAM, -4) CALL ULSTAL (MACNAM, -10) CALL ULSTAL (INCNAM, -12) CALL ULSTAL (SUBNAM, -13) CALL ULSTAL (IFNAM, -11) CALL ULSTAL (ARNAM, -14) CALL ULSTAL (UNDEFN, -21) CALL ULSTAL(LINKNM, -4) CALL ULSTAL(LENTNM, -23) RETURN END SUBROUTINE ENTRKW INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER JUNK INTEGER ENTER LOGICAL*1 SIF(3) LOGICAL*1 SELSE(5) LOGICAL*1 SWHILE(6) LOGICAL*1 SDO(3) LOGICAL*1 SBREAK(6) LOGICAL*1 SNEXT(5) LOGICAL*1 SFOR(4) LOGICAL*1 SREPT(7) LOGICAL*1 SUNTIL(6) LOGICAL*1 SRET(7) LOGICAL*1 SSTR(7) LOGICAL*1 SSWTCH(7) LOGICAL*1 SCASE(5) LOGICAL*1 SDEFLT(8) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/0/ DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE *(5)/0/ DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S *WHILE(5)/101/,SWHILE(6)/0/ DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/0/ DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR *EAK(5)/107/,SBREAK(6)/0/ DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT *(5)/0/ DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/0/ DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT *(5)/97/,SREPT(6)/116/,SREPT(7)/0/ DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S *UNTIL(5)/108/,SUNTIL(6)/0/ DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1 *14/,SRET(6)/110/,SRET(7)/0/ DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1 *10/,SSTR(6)/103/,SSTR(7)/0/ DATA SSWTCH(1)/115/,SSWTCH(2)/119/,SSWTCH(3)/105/,SSWTCH(4)/116/,S *SWTCH(5)/99/,SSWTCH(6)/104/,SSWTCH(7)/0/ DATA SCASE(1)/99/,SCASE(2)/97/,SCASE(3)/115/,SCASE(4)/101/,SCASE(5 *)/0/ DATA SDEFLT(1)/100/,SDEFLT(2)/101/,SDEFLT(3)/102/,SDEFLT(4)/97/,SD *EFLT(5)/117/,SDEFLT(6)/108/,SDEFLT(7)/116/,SDEFLT(8)/0/ JUNK = ENTER (SIF, -19, RKWTBL) JUNK = ENTER (SELSE, -11, RKWTBL) JUNK = ENTER (SWHILE, -15, RKWTBL) JUNK = ENTER (SDO, -10, RKWTBL) JUNK = ENTER (SBREAK, -8, RKWTBL) JUNK = ENTER (SNEXT, -13, RKWTBL) JUNK = ENTER (SFOR, -16, RKWTBL) JUNK = ENTER (SREPT, -17, RKWTBL) JUNK = ENTER (SUNTIL, -18, RKWTBL) JUNK = ENTER (SRET, -20, RKWTBL) JUNK = ENTER (SSTR, -23, RKWTBL) JUNK = ENTER (SSWTCH, -24, RKWTBL) JUNK = ENTER (SCASE, -25, RKWTBL) JUNK = ENTER (SDEFLT, -26, RKWTBL) RETURN END SUBROUTINE EVALR (ARGSTK, I, J) INTEGER ARGSTK (100), I, J INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER ARGNO, K, M, N, T, TD INTEGER INDEXC, LENGTH LOGICAL*1 DIGITS(11) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/0/ T = ARGSTK (I) TD = EVALST (T) IF (.NOT.(TD .EQ. -10))GOTO 23234 CALL DOMAC (ARGSTK, I, J) GOTO 23235 23234 CONTINUE IF (.NOT.(TD .EQ. -12))GOTO 23236 CALL DOINCR (ARGSTK, I, J) GOTO 23237 23236 CONTINUE IF (.NOT.(TD .EQ. -13))GOTO 23238 CALL DOSUB (ARGSTK, I, J) GOTO 23239 23238 CONTINUE IF (.NOT.(TD .EQ. -11))GOTO 23240 CALL DOIF (ARGSTK, I, J) GOTO 23241 23240 CONTINUE IF (.NOT.(TD .EQ. -14))GOTO 23242 CALL DOARTH (ARGSTK, I, J) GOTO 23243 23242 CONTINUE IF (.NOT.(TD .EQ. -23))GOTO 23244 CALL DOLENT (ARGSTK, I, J) GOTO 23245 23244 CONTINUE K = T + LENGTH (EVALST (T)) - 1 23246 IF (.NOT.(K .GT. T))GOTO 23248 IF (.NOT.(EVALST (K - 1) .NE. 36))GOTO 23249 CALL PUTBAK (EVALST (K)) GOTO 23250 23249 CONTINUE ARGNO = INDEXC(DIGITS, EVALST (K)) - 1 IF (.NOT.(ARGNO .GE. 0))GOTO 23251 IF (.NOT.(ARGNO .LT. J - I))GOTO 23253 N = I + ARGNO + 1 M = ARGSTK (N) CALL PBSTR (EVALST (M)) 23253 CONTINUE K = K - 1 GOTO 23252 23251 CONTINUE CALL PUTBAK (EVALST (K)) 23252 CONTINUE 23250 CONTINUE 23247 K = K - 1 GOTO 23246 23248 CONTINUE IF (.NOT.(K .EQ. T))GOTO 23255 CALL PUTBAK (EVALST (K)) 23255 CONTINUE 23245 CONTINUE 23243 CONTINUE 23241 CONTINUE 23239 CONTINUE 23237 CONTINUE 23235 CONTINUE RETURN END SUBROUTINE FCLAUS LOGICAL*1 TOKEN(120), T LOGICAL*1 GNBTOK, DOTHER 23257 CONTINUE T = GNBTOK(TOKEN, 120) CALL PBSTR(TOKEN) T = DOTHER(TOKEN) 23258 IF (.NOT.(T .EQ. 59 .OR. T .EQ. -1))GOTO 23257 23259 CONTINUE RETURN END SUBROUTINE FINIT INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) OUTP = 0 LEVEL = 1 LINECT (1) = 1 SBP = 1 FNAMP = 2 FNAMES (1) = 0 BP = 0 FORDEP = 0 FCNAME (1) = 0 SWTOP = 0 SWLAST = 1 CSP = 0 CURCND = 1 RETURN END SUBROUTINE FORCOD (LAB) INTEGER LAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 T INTEGER I, J, NLPAR, LEN LOGICAL*1 GETTOK, GNBTOK INTEGER LENGTH, LABGEN LOGICAL*1 IFNOT(10) LOGICAL*1 SEMI(2) LOGICAL*1 ST00OZ(19) LOGICAL*1 ST00PZ(19) LOGICAL*1 ST00QZ(20) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/32/,IFNOT(4)/40/,IFNOT(5 *)/46/,IFNOT(6)/110/,IFNOT(7)/111/,IFNOT(8)/116/,IFNOT(9)/46/,IFNOT *(10)/0/ DATA SEMI(1)/59/,SEMI(2)/0/ DATA ST00OZ(1)/109/,ST00OZ(2)/105/,ST00OZ(3)/115/,ST00OZ(4)/115/,S *T00OZ(5)/105/,ST00OZ(6)/110/,ST00OZ(7)/103/,ST00OZ(8)/32/,ST00OZ(9 *)/108/,ST00OZ(10)/101/,ST00OZ(11)/102/,ST00OZ(12)/116/,ST00OZ(13)/ *32/,ST00OZ(14)/112/,ST00OZ(15)/97/,ST00OZ(16)/114/,ST00OZ(17)/101/ *,ST00OZ(18)/110/,ST00OZ(19)/0/ DATA ST00PZ(1)/105/,ST00PZ(2)/110/,ST00PZ(3)/118/,ST00PZ(4)/97/,ST *00PZ(5)/108/,ST00PZ(6)/105/,ST00PZ(7)/100/,ST00PZ(8)/32/,ST00PZ(9) */102/,ST00PZ(10)/111/,ST00PZ(11)/114/,ST00PZ(12)/32/,ST00PZ(13)/99 */,ST00PZ(14)/108/,ST00PZ(15)/97/,ST00PZ(16)/117/,ST00PZ(17)/115/,S *T00PZ(18)/101/,ST00PZ(19)/0/ DATA ST00QZ(1)/102/,ST00QZ(2)/111/,ST00QZ(3)/114/,ST00QZ(4)/32/,ST *00QZ(5)/99/,ST00QZ(6)/108/,ST00QZ(7)/97/,ST00QZ(8)/117/,ST00QZ(9)/ *115/,ST00QZ(10)/101/,ST00QZ(11)/32/,ST00QZ(12)/116/,ST00QZ(13)/111 */,ST00QZ(14)/111/,ST00QZ(15)/32/,ST00QZ(16)/108/,ST00QZ(17)/111/,S *T00QZ(18)/110/,ST00QZ(19)/103/,ST00QZ(20)/0/ LAB = LABGEN (3) CALL OUTCON (0) IF (.NOT.(GNBTOK (SCRTOK, 120) .NE. 40))GOTO 23260 CALL SYNERR (ST00OZ) RETURN 23260 CONTINUE IF (.NOT.(GNBTOK (SCRTOK, 120) .NE. 59))GOTO 23262 CALL PBSTR (SCRTOK) CALL FCLAUS 23262 CONTINUE IF (.NOT.(GNBTOK (SCRTOK, 120) .EQ. 59))GOTO 23264 CALL OUTCON (LAB) GOTO 23265 23264 CONTINUE CALL PBSTR (SCRTOK) CALL OUTNUM (LAB) CALL OUTTAB CALL OUTSTR (IFNOT) CALL OUTCH (40) NLPAR = 0 23266 IF (.NOT.(NLPAR .GE. 0))GOTO 23267 T = GETTOK (SCRTOK, 120) IF (.NOT.(T .EQ. 59))GOTO 23268 GOTO 23267 23268 CONTINUE IF (.NOT.(T .EQ. 40))GOTO 23270 NLPAR = NLPAR + 1 GOTO 23271 23270 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23272 NLPAR = NLPAR - 1 23272 CONTINUE 23271 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23274 CALL PBSTR (SCRTOK) RETURN 23274 CONTINUE IF (.NOT.(T .NE. 10))GOTO 23276 CALL OUTSTR (SCRTOK) 23276 CONTINUE GOTO 23266 23267 CONTINUE CALL OUTCH (41) CALL OUTCH (41) CALL OUTGO (LAB+2) IF (.NOT.(NLPAR .LT. 0))GOTO 23278 CALL SYNERR (ST00PZ) 23278 CONTINUE 23265 CONTINUE FORDEP = FORDEP + 1 LEN = 0 J = 1 I = 1 23280 IF (.NOT.(I .LT. FORDEP))GOTO 23282 J = J + LENGTH (FORSTK (J)) + 1 23281 I = I + 1 GOTO 23280 23282 CONTINUE FORSTK (J) = 0 NLPAR = 0 T = GNBTOK (SCRTOK, 120) CALL PBSTR (SCRTOK) 23283 IF (.NOT.(NLPAR .GE. 0))GOTO 23284 T = GETTOK (SCRTOK, 120) IF (.NOT.(T .EQ. 40))GOTO 23285 NLPAR = NLPAR + 1 GOTO 23286 23285 CONTINUE IF (.NOT.(T .EQ. 41))GOTO 23287 NLPAR = NLPAR - 1 23287 CONTINUE 23286 CONTINUE IF (.NOT.(T .EQ. -1))GOTO 23289 CALL PBSTR (SCRTOK) GOTO 23284 23289 CONTINUE IF (.NOT.(NLPAR .GE. 0 .AND. T .NE. 10))GOTO 23291 IF (.NOT.(J + LENGTH (SCRTOK) .GE. 300))GOTO 23293 CALL BADERR (ST00QZ) 23293 CONTINUE CALL SCOPY (SCRTOK, 1, FORSTK, J) J = J + LENGTH (SCRTOK) LEN = LEN + LENGTH (SCRTOK) 23291 CONTINUE GOTO 23283 23284 CONTINUE LAB = LAB + 1 RETURN END SUBROUTINE FORS (LAB) INTEGER LAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER I, J INTEGER LENGTH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) XFER = 0 CALL OUTNUM (LAB) J = 1 I = 1 23295 IF (.NOT.(I .LT. FORDEP))GOTO 23297 J = J + LENGTH (FORSTK (J)) + 1 23296 I = I + 1 GOTO 23295 23297 CONTINUE IF (.NOT.(LENGTH (FORSTK (J)) .GT. 0))GOTO 23298 CALL PUTBAK (59) CALL PBSTR (FORSTK (J)) CALL FCLAUS 23298 CONTINUE CALL OUTGO (LAB - 1) CALL OUTCON (LAB + 1) FORDEP = FORDEP - 1 RETURN END LOGICAL*1 FUNCTION GCTOK(TOKEN, TOKSIZ) LOGICAL*1 TOKEN(120) INTEGER TOKSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 TEMP(9) INTEGER CTYPE, I, N, J, CNDVAL(4), NEWCND, VALUE LOGICAL*1 GTOK INTEGER EQUAL, LOOKUP LOGICAL*1 LETTS(5) LOGICAL*1 CNDTBL(31) LOGICAL*1 ST00RZ(27) LOGICAL*1 ST00SZ(31) LOGICAL*1 ST00TZ(27) LOGICAL*1 ST010Z(26) LOGICAL*1 ST011Z(27) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA LETTS(1)/101/,LETTS(2)/69/,LETTS(3)/105/,LETTS(4)/73/,LETTS(5 *)/0/ DATA CNDTBL(1)/105/,CNDTBL(2)/102/,CNDTBL(3)/100/,CNDTBL(4)/101/,C *NDTBL(5)/102/,CNDTBL(6)/47/,CNDTBL(7)/105/,CNDTBL(8)/102/,CNDTBL(9 *)/110/,CNDTBL(10)/111/,CNDTBL(11)/116/,CNDTBL(12)/100/,CNDTBL(13)/ *101/,CNDTBL(14)/102/,CNDTBL(15)/47/,CNDTBL(16)/101/,CNDTBL(17)/108 */,CNDTBL(18)/115/,CNDTBL(19)/101/,CNDTBL(20)/100/,CNDTBL(21)/101/, *CNDTBL(22)/102/,CNDTBL(23)/47/,CNDTBL(24)/101/,CNDTBL(25)/110/,CND *TBL(26)/100/,CNDTBL(27)/100/,CNDTBL(28)/101/,CNDTBL(29)/102/,CNDTB *L(30)/47/,CNDTBL(31)/0/ DATA CNDVAL(1)/-15/, CNDVAL(2)/-16/, CNDVAL(3)/-17/, CNDVAL(4)/-18 */ DATA ST00RZ(1)/73/,ST00RZ(2)/108/,ST00RZ(3)/108/,ST00RZ(4)/101/,ST *00RZ(5)/103/,ST00RZ(6)/97/,ST00RZ(7)/108/,ST00RZ(8)/32/,ST00RZ(9)/ *101/,ST00RZ(10)/110/,ST00RZ(11)/100/,ST00RZ(12)/100/,ST00RZ(13)/10 *1/,ST00RZ(14)/102/,ST00RZ(15)/32/,ST00RZ(16)/101/,ST00RZ(17)/110/, *ST00RZ(18)/99/,ST00RZ(19)/111/,ST00RZ(20)/117/,ST00RZ(21)/110/,ST0 *0RZ(22)/116/,ST00RZ(23)/101/,ST00RZ(24)/114/,ST00RZ(25)/101/,ST00R *Z(26)/100/,ST00RZ(27)/0/ DATA ST00SZ(1)/67/,ST00SZ(2)/111/,ST00SZ(3)/110/,ST00SZ(4)/100/,ST *00SZ(5)/105/,ST00SZ(6)/116/,ST00SZ(7)/105/,ST00SZ(8)/111/,ST00SZ(9 *)/110/,ST00SZ(10)/97/,ST00SZ(11)/108/,ST00SZ(12)/115/,ST00SZ(13)/3 *2/,ST00SZ(14)/110/,ST00SZ(15)/101/,ST00SZ(16)/115/,ST00SZ(17)/116/ *,ST00SZ(18)/101/,ST00SZ(19)/100/,ST00SZ(20)/32/,ST00SZ(21)/116/,ST *00SZ(22)/111/,ST00SZ(23)/111/,ST00SZ(24)/32/,ST00SZ(25)/100/,ST00S *Z(26)/101/,ST00SZ(27)/101/,ST00SZ(28)/112/,ST00SZ(29)/108/,ST00SZ( *30)/121/,ST00SZ(31)/0/ DATA ST00TZ(1)/109/,ST00TZ(2)/105/,ST00TZ(3)/115/,ST00TZ(4)/115/,S *T00TZ(5)/105/,ST00TZ(6)/110/,ST00TZ(7)/103/,ST00TZ(8)/32/,ST00TZ(9 *)/96/,ST00TZ(10)/40/,ST00TZ(11)/39/,ST00TZ(12)/32/,ST00TZ(13)/105/ *,ST00TZ(14)/110/,ST00TZ(15)/32/,ST00TZ(16)/99/,ST00TZ(17)/111/,ST0 *0TZ(18)/110/,ST00TZ(19)/100/,ST00TZ(20)/105/,ST00TZ(21)/116/,ST00T *Z(22)/105/,ST00TZ(23)/111/,ST00TZ(24)/110/,ST00TZ(25)/97/,ST00TZ(2 *6)/108/,ST00TZ(27)/0/ DATA ST010Z(1)/105/,ST010Z(2)/110/,ST010Z(3)/118/,ST010Z(4)/97/,ST *010Z(5)/108/,ST010Z(6)/105/,ST010Z(7)/100/,ST010Z(8)/32/,ST010Z(9) */99/,ST010Z(10)/111/,ST010Z(11)/110/,ST010Z(12)/100/,ST010Z(13)/10 *5/,ST010Z(14)/116/,ST010Z(15)/105/,ST010Z(16)/111/,ST010Z(17)/110/ *,ST010Z(18)/97/,ST010Z(19)/108/,ST010Z(20)/32/,ST010Z(21)/116/,ST0 *10Z(22)/111/,ST010Z(23)/107/,ST010Z(24)/101/,ST010Z(25)/110/,ST010 *Z(26)/0/ DATA ST011Z(1)/109/,ST011Z(2)/105/,ST011Z(3)/115/,ST011Z(4)/115/,S *T011Z(5)/105/,ST011Z(6)/110/,ST011Z(7)/103/,ST011Z(8)/32/,ST011Z(9 *)/96/,ST011Z(10)/41/,ST011Z(11)/39/,ST011Z(12)/32/,ST011Z(13)/105/ *,ST011Z(14)/110/,ST011Z(15)/32/,ST011Z(16)/99/,ST011Z(17)/111/,ST0 *11Z(18)/110/,ST011Z(19)/100/,ST011Z(20)/105/,ST011Z(21)/116/,ST011 *Z(22)/105/,ST011Z(23)/111/,ST011Z(24)/110/,ST011Z(25)/97/,ST011Z(2 *6)/108/,ST011Z(27)/0/ 23300 CONTINUE GCTOK = GTOK (TOKEN, TOKSIZ) IF (.NOT.(GCTOK .EQ. -1))GOTO 23303 GOTO 23302 23303 CONTINUE CTYPE = -19 I = 1 23305 IF (.NOT.(LETTS(I) .NE. 0))GOTO 23307 IF (.NOT.(LETTS(I) .EQ. TOKEN(1)))GOTO 23308 GOTO 23307 23308 CONTINUE 23306 I = I + 1 GOTO 23305 23307 CONTINUE IF (.NOT.(LETTS(I) .NE. 0))GOTO 23310 N = 1 I = 1 23312 IF (.NOT.(CNDTBL(I) .NE. 0))GOTO 23314 J = 1 23315 IF (.NOT.(CNDTBL(I) .NE. 47))GOTO 23317 TEMP(J) = CNDTBL(I) I = I + 1 23316 J = J + 1 GOTO 23315 23317 CONTINUE TEMP(J) = 0 J = EQUAL(TOKEN, TEMP) IF (.NOT.(J .EQ. 0))GOTO 23318 CALL UPPER(TEMP) J = EQUAL(TOKEN, TEMP) 23318 CONTINUE IF (.NOT.(J .EQ. 1))GOTO 23320 CTYPE = CNDVAL(N) GOTO 23314 23320 CONTINUE N = N + 1 23313 I = I + 1 GOTO 23312 23314 CONTINUE 23310 CONTINUE IF (.NOT.(CTYPE .EQ. -19))GOTO 23322 IF (.NOT.(CURCND .EQ. 1))GOTO 23324 GOTO 23302 23324 CONTINUE GOTO 23323 23322 CONTINUE IF (.NOT.(CTYPE .EQ. -18))GOTO 23326 IF (.NOT.(CSP .LE. 0))GOTO 23328 CALL BADERR(ST00RZ) 23328 CONTINUE CURCND = CNDSTK(CSP) CSP = CSP - 1 GOTO 23327 23326 CONTINUE IF (.NOT.(CTYPE .EQ. -17))GOTO 23330 NEWCND = - CURCND GOTO 23331 23330 CONTINUE IF (.NOT.(CSP .GE. 10))GOTO 23332 CALL BADERR(ST00SZ) 23332 CONTINUE CSP = CSP + 1 CNDSTK(CSP) = CURCND CALL SKPBLK IF (.NOT.(GTOK(TEMP, 9) .NE. 40))GOTO 23334 CALL BADERR(ST00TZ) 23334 CONTINUE CALL SKPBLK IF (.NOT.(GTOK(TOKEN, TOKSIZ) .NE. -9))GOTO 23336 CALL BADERR(ST010Z) 23336 CONTINUE CALL SKPBLK IF (.NOT.(GTOK(TEMP, 9) .NE. 41))GOTO 23338 CALL BADERR(ST011Z) 23338 CONTINUE IF (.NOT.(LOOKUP(TOKEN, VALUE, DEFTBL) .EQ. 1))GOTO 23340 NEWCND = 1 GOTO 23341 23340 CONTINUE NEWCND = - 1 23341 CONTINUE IF (.NOT.(CTYPE .EQ. -16))GOTO 23342 NEWCND = - NEWCND 23342 CONTINUE 23331 CONTINUE CURCND = MIN0(NEWCND, CNDSTK (CSP) ) 23327 CONTINUE 23323 CONTINUE 23301 GOTO 23300 23302 CONTINUE RETURN END INTEGER FUNCTION GENNAM(ROOT, COUNTR, BUF) LOGICAL*1 ROOT(100), BUF(7), TEMP(4) INTEGER COUNTR, X, I, D, J LOGICAL*1 DIGITS(31) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/97/,DIGITS(12)/98/,DIGITS(13)/99/,DIGITS( *14)/100/,DIGITS(15)/101/,DIGITS(16)/102/,DIGITS(17)/103/,DIGITS(18 *)/104/,DIGITS(19)/105/,DIGITS(20)/106/,DIGITS(21)/107/,DIGITS(22)/ *108/,DIGITS(23)/109/,DIGITS(24)/110/,DIGITS(25)/111/,DIGITS(26)/11 *2/,DIGITS(27)/113/,DIGITS(28)/114/,DIGITS(29)/115/,DIGITS(30)/116/ *,DIGITS(31)/0/ X = COUNTR COUNTR = COUNTR + 1 IF (.NOT.(COUNTR .GT. 27000))GOTO 23344 COUNTR = 1 23344 CONTINUE I = 1 23346 IF (.NOT.(X .GT. 0))GOTO 23348 D = MOD(X, 30) + 1 TEMP(I) = DIGITS(D) X = X / 30 23347 I = I + 1 GOTO 23346 23348 CONTINUE TEMP(I) = 0 J = 1 CALL INSSTR(ROOT, BUF, J, 6) X = 4 - I 23349 IF (.NOT.(X .GT. 0))GOTO 23351 CALL INSCHR(48, BUF, J, 6) 23350 X = X - 1 GOTO 23349 23351 CONTINUE I = I - 1 23352 IF (.NOT.(I .GT. 0))GOTO 23354 CALL INSCHR(TEMP(I), BUF, J, 6) 23353 I = I - 1 GOTO 23352 23354 CONTINUE CALL INSCHR(122, BUF, J, 6) BUF(J) = 0 GENNAM=(J-1) RETURN END SUBROUTINE GETDEF (TOKEN, TOKSIZ, DEFN, DEFSIZ) LOGICAL*1 TOKEN (120), DEFN (250) INTEGER TOKSIZ, DEFSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 C, T, PTOKEN (120) INTEGER I, NLPAR LOGICAL*1 GCTOK, NGETCH LOGICAL*1 ST012Z(22) LOGICAL*1 ST013Z(20) LOGICAL*1 ST014Z(24) LOGICAL*1 ST015Z(20) LOGICAL*1 ST016Z(20) LOGICAL*1 ST017Z(19) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST012Z(1)/110/,ST012Z(2)/111/,ST012Z(3)/110/,ST012Z(4)/45/,ST *012Z(5)/97/,ST012Z(6)/108/,ST012Z(7)/112/,ST012Z(8)/104/,ST012Z(9) */97/,ST012Z(10)/110/,ST012Z(11)/117/,ST012Z(12)/109/,ST012Z(13)/10 *1/,ST012Z(14)/114/,ST012Z(15)/105/,ST012Z(16)/99/,ST012Z(17)/32/,S *T012Z(18)/110/,ST012Z(19)/97/,ST012Z(20)/109/,ST012Z(21)/101/,ST01 *2Z(22)/0/ DATA ST013Z(1)/100/,ST013Z(2)/101/,ST013Z(3)/102/,ST013Z(4)/105/,S *T013Z(5)/110/,ST013Z(6)/105/,ST013Z(7)/116/,ST013Z(8)/105/,ST013Z( *9)/111/,ST013Z(10)/110/,ST013Z(11)/32/,ST013Z(12)/116/,ST013Z(13)/ *111/,ST013Z(14)/111/,ST013Z(15)/32/,ST013Z(16)/108/,ST013Z(17)/111 */,ST013Z(18)/110/,ST013Z(19)/103/,ST013Z(20)/0/ DATA ST014Z(1)/109/,ST014Z(2)/105/,ST014Z(3)/115/,ST014Z(4)/115/,S *T014Z(5)/105/,ST014Z(6)/110/,ST014Z(7)/103/,ST014Z(8)/32/,ST014Z(9 *)/99/,ST014Z(10)/111/,ST014Z(11)/109/,ST014Z(12)/109/,ST014Z(13)/9 *7/,ST014Z(14)/32/,ST014Z(15)/105/,ST014Z(16)/110/,ST014Z(17)/32/,S *T014Z(18)/100/,ST014Z(19)/101/,ST014Z(20)/102/,ST014Z(21)/105/,ST0 *14Z(22)/110/,ST014Z(23)/101/,ST014Z(24)/0/ DATA ST015Z(1)/100/,ST015Z(2)/101/,ST015Z(3)/102/,ST015Z(4)/105/,S *T015Z(5)/110/,ST015Z(6)/105/,ST015Z(7)/116/,ST015Z(8)/105/,ST015Z( *9)/111/,ST015Z(10)/110/,ST015Z(11)/32/,ST015Z(12)/116/,ST015Z(13)/ *111/,ST015Z(14)/111/,ST015Z(15)/32/,ST015Z(16)/108/,ST015Z(17)/111 */,ST015Z(18)/110/,ST015Z(19)/103/,ST015Z(20)/0/ DATA ST016Z(1)/109/,ST016Z(2)/105/,ST016Z(3)/115/,ST016Z(4)/115/,S *T016Z(5)/105/,ST016Z(6)/110/,ST016Z(7)/103/,ST016Z(8)/32/,ST016Z(9 *)/114/,ST016Z(10)/105/,ST016Z(11)/103/,ST016Z(12)/104/,ST016Z(13)/ *116/,ST016Z(14)/32/,ST016Z(15)/112/,ST016Z(16)/97/,ST016Z(17)/114/ *,ST016Z(18)/101/,ST016Z(19)/110/,ST016Z(20)/0/ DATA ST017Z(1)/103/,ST017Z(2)/101/,ST017Z(3)/116/,ST017Z(4)/100/,S *T017Z(5)/101/,ST017Z(6)/102/,ST017Z(7)/32/,ST017Z(8)/105/,ST017Z(9 *)/115/,ST017Z(10)/32/,ST017Z(11)/99/,ST017Z(12)/111/,ST017Z(13)/11 *0/,ST017Z(14)/102/,ST017Z(15)/117/,ST017Z(16)/115/,ST017Z(17)/101/ *,ST017Z(18)/100/,ST017Z(19)/0/ CALL SKPBLK C = GCTOK (PTOKEN, 120) IF (.NOT.(C .EQ. 40))GOTO 23355 T = 40 GOTO 23356 23355 CONTINUE T = 32 CALL PBSTR (PTOKEN) 23356 CONTINUE CALL SKPBLK IF (.NOT.(GCTOK (TOKEN, TOKSIZ) .NE. -9))GOTO 23357 CALL BADERR (ST012Z) 23357 CONTINUE CALL SKPBLK C = GCTOK (PTOKEN, 120) IF (.NOT.(T .EQ. 32))GOTO 23359 CALL PBSTR (PTOKEN) I = 1 23361 CONTINUE C = NGETCH (C) IF (.NOT.(I .GT. DEFSIZ))GOTO 23364 CALL BADERR (ST013Z) 23364 CONTINUE DEFN (I) = C I = I + 1 23362 IF (.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. -1))GOTO 23361 23363 CONTINUE IF (.NOT.(C .EQ. 35))GOTO 23366 CALL PUTBAK (C) 23366 CONTINUE GOTO 23360 23359 CONTINUE IF (.NOT.(T .EQ. 40))GOTO 23368 IF (.NOT.(C .NE. 44))GOTO 23370 CALL BADERR (ST014Z) 23370 CONTINUE NLPAR = 0 I = 1 23372 IF (.NOT.(NLPAR .GE. 0))GOTO 23374 IF (.NOT.(I .GT. DEFSIZ))GOTO 23375 CALL BADERR (ST015Z) GOTO 23376 23375 CONTINUE IF (.NOT.(NGETCH (DEFN (I)) .EQ. -1))GOTO 23377 CALL BADERR (ST016Z) GOTO 23378 23377 CONTINUE IF (.NOT.(DEFN (I) .EQ. 40))GOTO 23379 NLPAR = NLPAR + 1 GOTO 23380 23379 CONTINUE IF (.NOT.(DEFN (I) .EQ. 41))GOTO 23381 NLPAR = NLPAR - 1 23381 CONTINUE 23380 CONTINUE 23378 CONTINUE 23376 CONTINUE 23373 I = I + 1 GOTO 23372 23374 CONTINUE GOTO 23369 23368 CONTINUE CALL BADERR (ST017Z) 23369 CONTINUE 23360 CONTINUE DEFN (I - 1) = 0 RETURN END LOGICAL*1 FUNCTION GETTOK (TOKEN, TOKSIZ) LOGICAL*1 TOKEN (120) INTEGER TOKSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER I, LEN LOGICAL*1 NAME (36), T, TBUF(9) INTEGER EQUAL, OPEN, LENGTH LOGICAL*1 DEFTOK LOGICAL*1 FNCN(9) LOGICAL*1 INCL(8) LOGICAL*1 ST018Z(22) LOGICAL*1 ST019Z(27) LOGICAL*1 ST01AZ(19) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA FNCN(1)/102/,FNCN(2)/117/,FNCN(3)/110/,FNCN(4)/99/,FNCN(5)/11 *6/,FNCN(6)/105/,FNCN(7)/111/,FNCN(8)/110/,FNCN(9)/0/ DATA INCL(1)/105/,INCL(2)/110/,INCL(3)/99/,INCL(4)/108/,INCL(5)/11 *7/,INCL(6)/100/,INCL(7)/101/,INCL(8)/0/ DATA ST018Z(1)/109/,ST018Z(2)/105/,ST018Z(3)/115/,ST018Z(4)/115/,S *T018Z(5)/105/,ST018Z(6)/110/,ST018Z(7)/103/,ST018Z(8)/32/,ST018Z(9 *)/102/,ST018Z(10)/117/,ST018Z(11)/110/,ST018Z(12)/99/,ST018Z(13)/1 *16/,ST018Z(14)/105/,ST018Z(15)/111/,ST018Z(16)/110/,ST018Z(17)/32/ *,ST018Z(18)/110/,ST018Z(19)/97/,ST018Z(20)/109/,ST018Z(21)/101/,ST *018Z(22)/0/ DATA ST019Z(1)/105/,ST019Z(2)/110/,ST019Z(3)/99/,ST019Z(4)/108/,ST *019Z(5)/117/,ST019Z(6)/100/,ST019Z(7)/101/,ST019Z(8)/115/,ST019Z(9 *)/32/,ST019Z(10)/110/,ST019Z(11)/101/,ST019Z(12)/115/,ST019Z(13)/1 *16/,ST019Z(14)/101/,ST019Z(15)/100/,ST019Z(16)/32/,ST019Z(17)/116/ *,ST019Z(18)/111/,ST019Z(19)/111/,ST019Z(20)/32/,ST019Z(21)/100/,ST *019Z(22)/101/,ST019Z(23)/101/,ST019Z(24)/112/,ST019Z(25)/108/,ST01 *9Z(26)/121/,ST019Z(27)/0/ DATA ST01AZ(1)/99/,ST01AZ(2)/97/,ST01AZ(3)/110/,ST01AZ(4)/39/,ST01 *AZ(5)/116/,ST01AZ(6)/32/,ST01AZ(7)/111/,ST01AZ(8)/112/,ST01AZ(9)/1 *01/,ST01AZ(10)/110/,ST01AZ(11)/32/,ST01AZ(12)/105/,ST01AZ(13)/110/ *,ST01AZ(14)/99/,ST01AZ(15)/108/,ST01AZ(16)/117/,ST01AZ(17)/100/,ST *01AZ(18)/101/,ST01AZ(19)/0/ 23383 IF (.NOT.(LEVEL .GT. 0))GOTO 23385 23386 CONTINUE GETTOK = DEFTOK(TOKEN, TOKSIZ) IF (.NOT.(GETTOK .EQ. -1))GOTO 23389 GOTO 23388 23389 CONTINUE IF (.NOT.(GETTOK .NE. -9))GOTO 23391 RETURN 23391 CONTINUE 23390 CONTINUE I = 1 23393 IF (.NOT.(I .LE. 9))GOTO 23395 T = TOKEN(I) TBUF(I) = T IF (.NOT.(T .EQ. 0))GOTO 23396 GOTO 23395 23396 CONTINUE 23394 I = I + 1 GOTO 23393 23395 CONTINUE IF (.NOT.(I .LT. 8 .OR. T .NE. 0))GOTO 23398 RETURN 23398 CONTINUE CALL FOLD(TBUF) IF (.NOT.(EQUAL (TBUF, FNCN) .EQ. 1))GOTO 23400 CALL SKPBLK T = DEFTOK (FCNAME, 36) CALL PBSTR (FCNAME) IF (.NOT.(T .NE. -9))GOTO 23402 CALL SYNERR (ST018Z) 23402 CONTINUE CALL PUTBAK (32) RETURN 23400 CONTINUE IF (.NOT.(EQUAL (TBUF, INCL) .EQ. 0))GOTO 23404 RETURN 23404 CONTINUE 23401 CONTINUE CALL SKPBLK T = DEFTOK (NAME, 36) IF (.NOT.(T .EQ. 34))GOTO 23406 LEN = LENGTH (NAME) - 1 I = 1 23408 IF (.NOT.(I .LT. LEN))GOTO 23410 NAME (I) = NAME (I + 1) 23409 I = I + 1 GOTO 23408 23410 CONTINUE NAME (I) = 0 23406 CONTINUE I = LENGTH (NAME) + 1 IF (.NOT.(LEVEL .GE. 4))GOTO 23411 CALL SYNERR (ST019Z) GOTO 23412 23411 CONTINUE INFILE (LEVEL + 1) = OPEN (NAME, 1) LINECT (LEVEL + 1) = 1 IF (.NOT.(INFILE (LEVEL + 1) .EQ. -3))GOTO 23413 CALL SYNERR (ST01AZ) GOTO 23414 23413 CONTINUE LEVEL = LEVEL + 1 IF (.NOT.(FNAMP + I .LE. 144))GOTO 23415 CALL SCOPY (NAME, 1, FNAMES, FNAMP) FNAMP = FNAMP + I 23415 CONTINUE 23414 CONTINUE 23412 CONTINUE 23387 GOTO 23386 23388 CONTINUE IF (.NOT.(LEVEL .GT. 1))GOTO 23417 CALL CLOSE (INFILE (LEVEL)) FNAMP = FNAMP - 1 23419 IF (.NOT.(FNAMP .GT. 1))GOTO 23421 IF (.NOT.(FNAMES (FNAMP - 1) .EQ. 0))GOTO 23422 GOTO 23421 23422 CONTINUE 23420 FNAMP = FNAMP - 1 GOTO 23419 23421 CONTINUE 23417 CONTINUE 23384 LEVEL = LEVEL - 1 GOTO 23383 23385 CONTINUE TOKEN (1) = -1 TOKEN (2) = 0 GETTOK = -1 RETURN END SUBROUTINE GETUND(TOKEN) LOGICAL*1 TOKEN(120), TEMP(4) LOGICAL*1 GCTOK LOGICAL*1 ST01BZ(24) LOGICAL*1 ST01CZ(22) LOGICAL*1 ST01DZ(24) DATA ST01BZ(1)/109/,ST01BZ(2)/105/,ST01BZ(3)/115/,ST01BZ(4)/115/,S *T01BZ(5)/105/,ST01BZ(6)/110/,ST01BZ(7)/103/,ST01BZ(8)/32/,ST01BZ(9 *)/96/,ST01BZ(10)/40/,ST01BZ(11)/39/,ST01BZ(12)/32/,ST01BZ(13)/105/ *,ST01BZ(14)/110/,ST01BZ(15)/32/,ST01BZ(16)/117/,ST01BZ(17)/110/,ST *01BZ(18)/100/,ST01BZ(19)/101/,ST01BZ(20)/102/,ST01BZ(21)/105/,ST01 *BZ(22)/110/,ST01BZ(23)/101/,ST01BZ(24)/0/ DATA ST01CZ(1)/110/,ST01CZ(2)/111/,ST01CZ(3)/110/,ST01CZ(4)/45/,ST *01CZ(5)/97/,ST01CZ(6)/108/,ST01CZ(7)/112/,ST01CZ(8)/104/,ST01CZ(9) */97/,ST01CZ(10)/110/,ST01CZ(11)/117/,ST01CZ(12)/109/,ST01CZ(13)/10 *1/,ST01CZ(14)/114/,ST01CZ(15)/105/,ST01CZ(16)/99/,ST01CZ(17)/32/,S *T01CZ(18)/110/,ST01CZ(19)/97/,ST01CZ(20)/109/,ST01CZ(21)/101/,ST01 *CZ(22)/0/ DATA ST01DZ(1)/109/,ST01DZ(2)/105/,ST01DZ(3)/115/,ST01DZ(4)/115/,S *T01DZ(5)/105/,ST01DZ(6)/110/,ST01DZ(7)/103/,ST01DZ(8)/32/,ST01DZ(9 *)/96/,ST01DZ(10)/41/,ST01DZ(11)/39/,ST01DZ(12)/32/,ST01DZ(13)/105/ *,ST01DZ(14)/110/,ST01DZ(15)/32/,ST01DZ(16)/117/,ST01DZ(17)/110/,ST *01DZ(18)/100/,ST01DZ(19)/101/,ST01DZ(20)/102/,ST01DZ(21)/105/,ST01 *DZ(22)/110/,ST01DZ(23)/101/,ST01DZ(24)/0/ CALL SKPBLK IF (.NOT.(GCTOK(TOKEN, 120) .NE. 40))GOTO 23424 CALL BADERR(ST01BZ) 23424 CONTINUE CALL SKPBLK IF (.NOT.(GCTOK(TOKEN, 120) .NE. -9))GOTO 23426 CALL BADERR(ST01CZ) 23426 CONTINUE CALL SKPBLK IF (.NOT.(GCTOK(TEMP, 4) .NE. 41))GOTO 23428 CALL BADERR(ST01DZ) 23428 CONTINUE RETURN END LOGICAL*1 FUNCTION GNBTOK (TOKEN, TOKSIZ) LOGICAL*1 TOKEN (120) INTEGER TOKSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 GETTOK COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) 23430 CONTINUE CALL SKPBLK GNBTOK = GETTOK (TOKEN, TOKSIZ) 23431 IF (.NOT.(GNBTOK .NE. 32))GOTO 23430 23432 CONTINUE RETURN END LOGICAL*1 FUNCTION GTOK (LEXSTR, TOKSIZ) LOGICAL*1 LEXSTR (120) INTEGER TOKSIZ INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 C INTEGER I, B, N, D LOGICAL*1 NGETCH, CLOWER, ESC INTEGER ITOC, INDEXC, CTOI LOGICAL*1 DIGITS(37) LOGICAL*1 ALFCHR(2) LOGICAL*1 ST01EZ(14) LOGICAL*1 ST01FZ(40) LOGICAL*1 ST01GZ(22) LOGICAL*1 ST01HZ(15) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/97/,DIGITS(12)/98/,DIGITS(13)/99/,DIGITS( *14)/100/,DIGITS(15)/101/,DIGITS(16)/102/,DIGITS(17)/103/,DIGITS(18 *)/104/,DIGITS(19)/105/,DIGITS(20)/106/,DIGITS(21)/107/,DIGITS(22)/ *108/,DIGITS(23)/109/,DIGITS(24)/110/,DIGITS(25)/111/,DIGITS(26)/11 *2/,DIGITS(27)/113/,DIGITS(28)/114/,DIGITS(29)/115/,DIGITS(30)/116/ *,DIGITS(31)/117/,DIGITS(32)/118/,DIGITS(33)/119/,DIGITS(34)/120/,D *IGITS(35)/121/,DIGITS(36)/122/,DIGITS(37)/0/ DATA ALFCHR(1)/95/,ALFCHR(2)/0/ DATA ST01EZ(1)/109/,ST01EZ(2)/105/,ST01EZ(3)/115/,ST01EZ(4)/115/,S *T01EZ(5)/105/,ST01EZ(6)/110/,ST01EZ(7)/103/,ST01EZ(8)/32/,ST01EZ(9 *)/113/,ST01EZ(10)/117/,ST01EZ(11)/111/,ST01EZ(12)/116/,ST01EZ(13)/ *101/,ST01EZ(14)/0/ DATA ST01FZ(1)/109/,ST01FZ(2)/105/,ST01FZ(3)/115/,ST01FZ(4)/115/,S *T01FZ(5)/105/,ST01FZ(6)/110/,ST01FZ(7)/103/,ST01FZ(8)/32/,ST01FZ(9 *)/97/,ST01FZ(10)/112/,ST01FZ(11)/111/,ST01FZ(12)/115/,ST01FZ(13)/1 *16/,ST01FZ(14)/114/,ST01FZ(15)/111/,ST01FZ(16)/112/,ST01FZ(17)/104 */,ST01FZ(18)/101/,ST01FZ(19)/32/,ST01FZ(20)/105/,ST01FZ(21)/110/,S *T01FZ(22)/32/,ST01FZ(23)/99/,ST01FZ(24)/104/,ST01FZ(25)/97/,ST01FZ *(26)/114/,ST01FZ(27)/97/,ST01FZ(28)/99/,ST01FZ(29)/116/,ST01FZ(30) */101/,ST01FZ(31)/114/,ST01FZ(32)/32/,ST01FZ(33)/108/,ST01FZ(34)/10 *5/,ST01FZ(35)/116/,ST01FZ(36)/101/,ST01FZ(37)/114/,ST01FZ(38)/97/, *ST01FZ(39)/108/,ST01FZ(40)/0/ DATA ST01GZ(1)/109/,ST01GZ(2)/105/,ST01GZ(3)/115/,ST01GZ(4)/115/,S *T01GZ(5)/105/,ST01GZ(6)/110/,ST01GZ(7)/103/,ST01GZ(8)/32/,ST01GZ(9 *)/108/,ST01GZ(10)/105/,ST01GZ(11)/116/,ST01GZ(12)/101/,ST01GZ(13)/ *114/,ST01GZ(14)/97/,ST01GZ(15)/108/,ST01GZ(16)/32/,ST01GZ(17)/113/ *,ST01GZ(18)/117/,ST01GZ(19)/111/,ST01GZ(20)/116/,ST01GZ(21)/101/,S *T01GZ(22)/0/ DATA ST01HZ(1)/116/,ST01HZ(2)/111/,ST01HZ(3)/107/,ST01HZ(4)/101/,S *T01HZ(5)/110/,ST01HZ(6)/32/,ST01HZ(7)/116/,ST01HZ(8)/111/,ST01HZ(9 *)/111/,ST01HZ(10)/32/,ST01HZ(11)/108/,ST01HZ(12)/111/,ST01HZ(13)/1 *10/,ST01HZ(14)/103/,ST01HZ(15)/0/ 23433 CONTINUE C = NGETCH (LEXSTR (1)) IF (.NOT.(C .EQ. 95))GOTO 23436 IF (.NOT.(NGETCH(C) .NE. 10))GOTO 23438 CALL PUTBAK(C) C = 95 GOTO 23435 23438 CONTINUE 23436 CONTINUE 23434 IF (.NOT.(LEXSTR(1) .NE. 95))GOTO 23433 23435 CONTINUE IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23440 LEXSTR (1) = 32 23442 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23443 C = NGETCH (C) GOTO 23442 23443 CONTINUE IF (.NOT.(C .EQ. 35))GOTO 23444 23446 IF (.NOT.(NGETCH (C) .NE. 10))GOTO 23447 GOTO 23446 23447 CONTINUE 23444 CONTINUE IF (.NOT.(C .NE. 10))GOTO 23448 CALL PUTBAK (C) GOTO 23449 23448 CONTINUE LEXSTR (1) = 10 23449 CONTINUE LEXSTR (2) = 0 GTOK = LEXSTR (1) RETURN 23440 CONTINUE I = 1 IF (.NOT.(((65.LE.C.AND.C.LE.90).OR.(97.LE.C.AND.C.LE.122))))GOTO *23450 I = 1 23452 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23454 C = NGETCH (LEXSTR (I + 1)) IF (.NOT.(.NOT.((65.LE.C.AND.C.LE.90).OR.(97.LE.C.AND.C.LE.122)) . *AND. .NOT.(48.LE.C.AND.C.LE.57) .AND. INDEXC(ALFCHR, C) .EQ. 0))GO *TO 23455 GOTO 23454 23455 CONTINUE 23453 I = I + 1 GOTO 23452 23454 CONTINUE CALL PUTBAK (C) GTOK = -9 GOTO 23451 23450 CONTINUE IF (.NOT.((48.LE.C.AND.C.LE.57)))GOTO 23457 I = 1 23459 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23461 C = NGETCH (LEXSTR (I + 1)) IF (.NOT.(.NOT.(48.LE.C.AND.C.LE.57)))GOTO 23462 GOTO 23461 23462 CONTINUE 23460 I = I + 1 GOTO 23459 23461 CONTINUE IF (.NOT.(C .EQ. 37))GOTO 23464 LEXSTR(I + 1) = 0 N = 1 B = CTOI(LEXSTR, N) 23464 CONTINUE IF (.NOT.(C .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO 23466 N = 0 23468 CONTINUE D = INDEXC(DIGITS, CLOWER (NGETCH (C))) - 1 IF (.NOT.(D .LT. 0))GOTO 23471 GOTO 23470 23471 CONTINUE N = B * N + D 23469 GOTO 23468 23470 CONTINUE CALL PUTBAK (C) I = ITOC (N, LEXSTR, TOKSIZ) GOTO 23467 23466 CONTINUE CALL PUTBAK (C) 23467 CONTINUE GTOK = 2 GOTO 23458 23457 CONTINUE IF (.NOT.(C .EQ. 91))GOTO 23473 LEXSTR (1) = 123 GTOK = 123 GOTO 23474 23473 CONTINUE IF (.NOT.(C .EQ. 93))GOTO 23475 LEXSTR (1) = 125 GTOK = 125 GOTO 23476 23475 CONTINUE IF (.NOT.(C .EQ. 36))GOTO 23477 IF (.NOT.(NGETCH (LEXSTR (2)) .EQ. 40))GOTO 23479 I = 2 GTOK = -10 GOTO 23480 23479 CONTINUE IF (.NOT.(LEXSTR (2) .EQ. 41))GOTO 23481 I = 2 GTOK = -11 GOTO 23482 23481 CONTINUE CALL PUTBAK (LEXSTR (2)) GTOK = 36 23482 CONTINUE 23480 CONTINUE GOTO 23478 23477 CONTINUE IF (.NOT.(C .EQ. 34 .OR. C .EQ. 39))GOTO 23483 GTOK = C I = 2 23485 IF (.NOT.(NGETCH(C) .NE. -1))GOTO 23487 LEXSTR(I) = C IF (.NOT.(LEXSTR(I) .EQ. 95))GOTO 23488 IF (.NOT.(NGETCH(C) .EQ. 10))GOTO 23490 23492 IF (.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23493 C = NGETCH(C) GOTO 23492 23493 CONTINUE LEXSTR(I) = C GOTO 23491 23490 CONTINUE CALL PUTBAK(C) 23491 CONTINUE C = LEXSTR(I) 23488 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23494 IF (.NOT.(NGETCH(C) .EQ. -1))GOTO 23496 CALL PUTBAK(C) GOTO 23497 23496 CONTINUE I = I + 1 IF (.NOT.(I .GE. TOKSIZ - 1))GOTO 23498 I = TOKSIZ - 1 23498 CONTINUE LEXSTR(I) = C 23497 CONTINUE C = 64 23494 CONTINUE IF (.NOT.(C .EQ. LEXSTR(1)))GOTO 23500 GOTO 23487 23500 CONTINUE IF (.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ - 1))GOTO 23502 CALL SYNERR (ST01EZ) LEXSTR(I) = LEXSTR(1) CALL PUTBAK(10) GOTO 23487 23502 CONTINUE 23486 I = I + 1 GOTO 23485 23487 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 39))GOTO 23504 N = 2 C = ESC(LEXSTR, N) IF (.NOT.(LEXSTR(N + 1) .NE. 39))GOTO 23506 CALL SYNERR(ST01FZ) 23506 CONTINUE N = C I = ITOC(N, LEXSTR, TOKSIZ) GTOK = 2 23504 CONTINUE GOTO 23484 23483 CONTINUE IF (.NOT.(C .EQ. 37))GOTO 23508 IF (.NOT.(NGETCH(LEXSTR(2)) .NE. 40))GOTO 23510 CALL PUTBAK(LEXSTR(2)) GTOK = 37 GOTO 23511 23510 CONTINUE GTOK = 34 LEXSTR(1) = -12 I = 2 23512 IF (.NOT.(NGETCH(C) .NE. -1))GOTO 23514 LEXSTR(I) = C IF (.NOT.(C .EQ. 95))GOTO 23515 IF (.NOT.(NGETCH(C) .EQ. 10))GOTO 23517 23519 IF (.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23520 C = NGETCH(C) GOTO 23519 23520 CONTINUE LEXSTR(I) = C GOTO 23518 23517 CONTINUE CALL PUTBAK(C) 23518 CONTINUE C = LEXSTR(I) 23515 CONTINUE IF (.NOT.(C .EQ. 37))GOTO 23521 IF (.NOT.(NGETCH(C) .EQ. 41))GOTO 23523 LEXSTR(I) = -12 GOTO 23514 23523 CONTINUE CALL PUTBAK(C) 23524 CONTINUE 23521 CONTINUE IF (.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ - 1))GOTO 23525 CALL SYNERR(ST01GZ) LEXSTR(I) = -12 CALL PUTBAK(10) GOTO 23514 23525 CONTINUE 23513 I = I + 1 GOTO 23512 23514 CONTINUE 23511 CONTINUE GOTO 23509 23508 CONTINUE IF (.NOT.(C .EQ. -12))GOTO 23527 GTOK = 34 I = 2 23529 IF (.NOT.(NGETCH(LEXSTR(I)) .NE. -12))GOTO 23531 23530 I = I + 1 GOTO 23529 23531 CONTINUE GOTO 23528 23527 CONTINUE IF (.NOT.(C .EQ. 35))GOTO 23532 23534 IF (.NOT.(NGETCH (LEXSTR (1)) .NE. 10))GOTO 23535 GOTO 23534 23535 CONTINUE GTOK = 10 GOTO 23533 23532 CONTINUE IF (.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 33 .OR. C .EQ. 38 . *OR. C .EQ. 124 .OR. C .EQ. 61 .OR. C .EQ. 33 .OR. C .EQ. 126 .OR. *C .EQ. 94))GOTO 23536 CALL RELATE (LEXSTR, I) GTOK = C GOTO 23537 23536 CONTINUE GTOK = C 23537 CONTINUE 23533 CONTINUE 23528 CONTINUE 23509 CONTINUE 23484 CONTINUE 23478 CONTINUE 23476 CONTINUE 23474 CONTINUE 23458 CONTINUE 23451 CONTINUE IF (.NOT.(I .GE. TOKSIZ - 1))GOTO 23538 CALL SYNERR (ST01HZ) 23538 CONTINUE LEXSTR (I + 1) = 0 RETURN END SUBROUTINE IFCODE (LAB) INTEGER LAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER LABGEN COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) XFER = 0 LAB = LABGEN (2) CALL IFGO (LAB) RETURN END SUBROUTINE IFGO (LAB) INTEGER LAB LOGICAL*1 IFNOT(10) DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/32/,IFNOT(4)/40/,IFNOT(5 *)/46/,IFNOT(6)/110/,IFNOT(7)/111/,IFNOT(8)/116/,IFNOT(9)/46/,IFNOT *(10)/0/ CALL OUTTAB CALL OUTSTR (IFNOT) CALL BALPAR CALL OUTCH (41) CALL OUTGO (LAB) RETURN END INTEGER FUNCTION IFPARM (STRNG) LOGICAL*1 STRNG (100) LOGICAL*1 C INTEGER I INTEGER INDEXC LOGICAL*1 TYPE C = STRNG (1) IF (.NOT.(C .EQ. -12 .OR. C .EQ. -13 .OR. C .EQ. -11 .OR. C .EQ. - *14 .OR. C .EQ. -10 .OR. C .EQ. -23))GOTO 23540 IFPARM = 1 GOTO 23541 23540 CONTINUE IFPARM = 0 I = 1 23542 IF (.NOT.(INDEXC(STRNG (I), 36) .GT. 0))GOTO 23544 I = I + INDEXC(STRNG (I), 36) IF (.NOT.(TYPE (STRNG (I)) .EQ. 2))GOTO 23545 IF (.NOT.(TYPE (STRNG (I + 1)) .NE. 2))GOTO 23547 IFPARM = 1 GOTO 23544 23547 CONTINUE 23545 CONTINUE 23543 GOTO 23542 23544 CONTINUE 23541 CONTINUE RETURN END SUBROUTINE INITKW INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER MKTABL COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) CALL DSINIT (4250) DEFTBL = MKTABL (1) CALL ENTDKW RKWTBL = MKTABL (1) CALL ENTRKW LABEL = 23000 STRCNT = 1 RETURN END SUBROUTINE INSDCL(NAME, VALUE, C) LOGICAL*1 NAME(100), VALUE(100), C LOGICAL*1 TEMP(10) INTEGER STRIP, DOSIZE, LEN, JUNK, FIRST, LAST, I INTEGER INDEXC, ELENTH, ITOC, LENGTH INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(VALUE(1) .EQ. C))GOTO 23549 STRIP = 1 GOTO 23550 23549 CONTINUE STRIP = 0 23550 CONTINUE DOSIZE = 1 IF (.NOT.(INDEXC(NAME, 40) .GT. 0 .OR. C .EQ. 39))GOTO 23551 DOSIZE = 0 23551 CONTINUE CALL INSCHR(C, SBUF, SBP, 600) CALL INSSTR(NAME, SBUF, SBP, 600) IF (.NOT.(DOSIZE .EQ. 1))GOTO 23553 LEN = ELENTH(VALUE) IF (.NOT.(STRIP .EQ. 1))GOTO 23555 LEN = LEN - 2 23555 CONTINUE IF (.NOT.(C .EQ. 34))GOTO 23557 LEN = LEN + 1 23557 CONTINUE CALL INSCHR(40, SBUF, SBP, 600) JUNK = ITOC(LEN, TEMP, 10) CALL INSSTR(TEMP, SBUF, SBP, 600) CALL INSCHR(41, SBUF, SBP, 600) 23553 CONTINUE CALL INSCHR(0, SBUF, SBP, 600) FIRST = 1 LAST = LENGTH(VALUE) IF (.NOT.(STRIP .EQ. 1))GOTO 23559 FIRST = FIRST + 1 LAST = LAST -1 23559 CONTINUE I = FIRST 23561 IF (.NOT.(I .LE. LAST))GOTO 23563 CALL INSCHR(VALUE(I), SBUF, SBP, 600) 23562 I = I + 1 GOTO 23561 23563 CONTINUE CALL INSCHR(0, SBUF, SBP, 600) RETURN END SUBROUTINE LABELC (LEXSTR) LOGICAL*1 LEXSTR (100) INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER LENGTH LOGICAL*1 ST01IZ(33) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST01IZ(1)/119/,ST01IZ(2)/97/,ST01IZ(3)/114/,ST01IZ(4)/110/,ST *01IZ(5)/105/,ST01IZ(6)/110/,ST01IZ(7)/103/,ST01IZ(8)/58/,ST01IZ(9) */32/,ST01IZ(10)/112/,ST01IZ(11)/111/,ST01IZ(12)/115/,ST01IZ(13)/11 *5/,ST01IZ(14)/105/,ST01IZ(15)/98/,ST01IZ(16)/108/,ST01IZ(17)/101/, *ST01IZ(18)/32/,ST01IZ(19)/108/,ST01IZ(20)/97/,ST01IZ(21)/98/,ST01I *Z(22)/101/,ST01IZ(23)/108/,ST01IZ(24)/32/,ST01IZ(25)/99/,ST01IZ(26 *)/111/,ST01IZ(27)/110/,ST01IZ(28)/102/,ST01IZ(29)/108/,ST01IZ(30)/ *105/,ST01IZ(31)/99/,ST01IZ(32)/116/,ST01IZ(33)/0/ XFER = 0 IF (.NOT.(LENGTH (LEXSTR) .EQ. 5))GOTO 23564 IF (.NOT.(LEXSTR (1) .EQ. 50 .AND. LEXSTR (2) .EQ. 51))GOTO 23566 CALL SYNERR (ST01IZ) 23566 CONTINUE 23564 CONTINUE CALL OUTSTR (LEXSTR) CALL OUTTAB RETURN END INTEGER FUNCTION LABGEN (N) INTEGER N INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) LABGEN = LABEL LABEL = LABEL + N RETURN END INTEGER FUNCTION LEX (LEXSTR) LOGICAL*1 LEXSTR (120) INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 GNBTOK INTEGER LOOKUP COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) 23568 CONTINUE LEX = GNBTOK (LEXSTR, 120) IF (.NOT.(LEX .NE. 10))GOTO 23571 GOTO 23570 23571 CONTINUE 23569 GOTO 23568 23570 CONTINUE IF (.NOT.(LEX .EQ. -1 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LEX *.EQ. 125))GOTO 23573 RETURN 23573 CONTINUE IF (.NOT.(LEX .EQ. 2))GOTO 23575 LEX = -9 GOTO 23576 23575 CONTINUE IF (.NOT.(LEX .EQ. 37))GOTO 23577 LEX = -27 GOTO 23578 23577 CONTINUE CALL SCOPY(LEXSTR, 1, SCRTOK, 1) CALL FOLD(SCRTOK) IF (.NOT.(LOOKUP (SCRTOK, LEX, RKWTBL) .EQ. 0))GOTO 23579 LEX = -14 23579 CONTINUE 23578 CONTINUE 23576 CONTINUE RETURN END SUBROUTINE LITRAL INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 NGETCH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(OUTP .GT. 0))GOTO 23581 CALL OUTDON 23581 CONTINUE OUTP = 1 23583 IF (.NOT.(NGETCH (OUTBUF (OUTP)) .NE. 10))GOTO 23585 23584 OUTP = OUTP + 1 GOTO 23583 23585 CONTINUE OUTP = OUTP - 1 CALL OUTDON RETURN END SUBROUTINE LODSYM(FBUF) INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 FBUF(36) INTEGER OPEN LOGICAL*1 ST01JZ(38) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST01JZ(1)/99/,ST01JZ(2)/97/,ST01JZ(3)/110/,ST01JZ(4)/110/,ST0 *1JZ(5)/111/,ST01JZ(6)/116/,ST01JZ(7)/32/,ST01JZ(8)/111/,ST01JZ(9)/ *112/,ST01JZ(10)/101/,ST01JZ(11)/110/,ST01JZ(12)/32/,ST01JZ(13)/115 */,ST01JZ(14)/116/,ST01JZ(15)/97/,ST01JZ(16)/110/,ST01JZ(17)/100/,S *T01JZ(18)/97/,ST01JZ(19)/114/,ST01JZ(20)/100/,ST01JZ(21)/32/,ST01J *Z(22)/100/,ST01JZ(23)/101/,ST01JZ(24)/102/,ST01JZ(25)/105/,ST01JZ( *26)/110/,ST01JZ(27)/105/,ST01JZ(28)/116/,ST01JZ(29)/105/,ST01JZ(30 *)/111/,ST01JZ(31)/110/,ST01JZ(32)/115/,ST01JZ(33)/32/,ST01JZ(34)/1 *02/,ST01JZ(35)/105/,ST01JZ(36)/108/,ST01JZ(37)/101/,ST01JZ(38)/0/ CALL LOCSYM(FBUF) IF (.NOT.(FBUF(1) .NE. 0))GOTO 23586 INFILE(1) = OPEN(FBUF, 1) IF (.NOT.(INFILE(1) .EQ. -3))GOTO 23588 CALL REMARK(ST01JZ) GOTO 23589 23588 CONTINUE CALL PARSE CALL CLOSE(INFILE(1)) 23589 CONTINUE 23586 CONTINUE RETURN END LOGICAL*1 FUNCTION NGETCH (C) LOGICAL*1 C INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 GETCH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(BP .GT. 0))GOTO 23590 C = BUF(BP) BP = BP - 1 GOTO 23591 23590 CONTINUE C = GETCH(C, INFILE (LEVEL) ) IF (.NOT.(C .EQ. 10))GOTO 23592 LINECT (LEVEL) = LINECT (LEVEL) + 1 23592 CONTINUE 23591 CONTINUE NGETCH=(C) RETURN END SUBROUTINE OTHERC (LEXSTR) LOGICAL*1 LEXSTR (100) INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) XFER = 0 CALL OUTTAB CALL OUTSTR (LEXSTR) CALL EATUP CALL OUTDON RETURN END SUBROUTINE OUTCH (C) LOGICAL*1 C INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER I COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) IF (.NOT.(OUTP .GE. 72))GOTO 23594 CALL OUTDON I = 1 23596 IF (.NOT.(I .LT. 6))GOTO 23598 OUTBUF (I) = 32 23597 I = I + 1 GOTO 23596 23598 CONTINUE OUTBUF (6) = 42 OUTP = 6 23594 CONTINUE OUTP = OUTP + 1 OUTBUF (OUTP) = C RETURN END SUBROUTINE OUTCON (N) INTEGER N INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 CONTIN(9) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA CONTIN(1)/99/,CONTIN(2)/111/,CONTIN(3)/110/,CONTIN(4)/116/,CO *NTIN(5)/105/,CONTIN(6)/110/,CONTIN(7)/117/,CONTIN(8)/101/,CONTIN(9 *)/0/ XFER = 0 IF (.NOT.(N .LE. 0 .AND. OUTP .EQ. 0))GOTO 23599 RETURN 23599 CONTINUE IF (.NOT.(N .GT. 0))GOTO 23601 CALL OUTNUM (N) 23601 CONTINUE CALL OUTTAB CALL OUTSTR (CONTIN) CALL OUTDON RETURN END SUBROUTINE OUTDEF(STR, TOK) LOGICAL*1 STR(100), TOK(120), T LOGICAL*1 GNBTOK CALL PUTBAK(47) CALL PBSTR(STR) 23603 CONTINUE T = GNBTOK(TOK, 120) IF (.NOT.(T .EQ. 47))GOTO 23606 GOTO 23605 23606 CONTINUE CALL OUTSTR(TOK) 23604 GOTO 23603 23605 CONTINUE RETURN END SUBROUTINE OUTDON INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) OUTBUF (OUTP + 1) = 10 OUTBUF (OUTP + 2) = 0 CALL PUTLIN (OUTBUF, 2) OUTP = 0 RETURN END SUBROUTINE OUTGO (N) INTEGER N INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 SGOTO(6) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO *(5)/32/,SGOTO(6)/0/ IF (.NOT.(XFER .EQ. 1))GOTO 23608 RETURN 23608 CONTINUE CALL OUTTAB CALL OUTSTR (SGOTO) CALL OUTNUM (N) CALL OUTDON RETURN END SUBROUTINE OUTNUM (N) INTEGER N LOGICAL*1 CHARS (20) INTEGER I, M M = IABS (N) I = 0 23610 CONTINUE I = I + 1 CHARS (I) = MOD (M, 10) + 48 M = M / 10 23611 IF (.NOT.(M .EQ. 0 .OR. I .GE. 20))GOTO 23610 23612 CONTINUE IF (.NOT.(N .LT. 0))GOTO 23613 CALL OUTCH (45) 23613 CONTINUE 23615 IF (.NOT.(I .GT. 0))GOTO 23617 CALL OUTCH (CHARS (I)) 23616 I = I - 1 GOTO 23615 23617 CONTINUE RETURN END SUBROUTINE OUTSTR (STR) LOGICAL*1 STR (100) LOGICAL*1 VARBUF(7) INTEGER I, N INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER QSTFIX INTEGER GENNAM LOGICAL*1 STROOT(3) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA STROOT(1)/115/,STROOT(2)/116/,STROOT(3)/0/ IF (.NOT.(STR(1) .EQ. -12))GOTO 23618 I = 2 23620 IF (.NOT.(STR(I) .NE. -12))GOTO 23622 CALL OUTCH(STR(I)) 23621 I = I + 1 GOTO 23620 23622 CONTINUE GOTO 23619 23618 CONTINUE IF (.NOT.(STR(1) .NE. 34))GOTO 23623 CALL STROUT(STR, 1) GOTO 23624 23623 CONTINUE N = QSTFIX(STR) I = GENNAM(STROOT, STRCNT, VARBUF) CALL INSDCL(VARBUF, STR, 34) CALL STROUT(VARBUF, 1) 23624 CONTINUE 23619 CONTINUE RETURN END SUBROUTINE OUTTAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) 23625 IF (.NOT.(OUTP .LT. 6))GOTO 23626 CALL OUTCH (32) GOTO 23625 23626 CONTINUE RETURN END SUBROUTINE PARSE INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 LEXSTR (120) INTEGER LAB, LABVAL (100), LEXTYP (100), SP, TOKEN, I INTEGER LEX LOGICAL*1 ST01KZ(24) LOGICAL*1 ST01LZ(13) LOGICAL*1 ST01MZ(25) LOGICAL*1 ST01NZ(20) LOGICAL*1 ST01OZ(15) LOGICAL*1 ST01PZ(43) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST01KZ(1)/105/,ST01KZ(2)/108/,ST01KZ(3)/108/,ST01KZ(4)/101/,S *T01KZ(5)/103/,ST01KZ(6)/97/,ST01KZ(7)/108/,ST01KZ(8)/32/,ST01KZ(9) */99/,ST01KZ(10)/97/,ST01KZ(11)/115/,ST01KZ(12)/101/,ST01KZ(13)/32/ *,ST01KZ(14)/111/,ST01KZ(15)/114/,ST01KZ(16)/32/,ST01KZ(17)/100/,ST *01KZ(18)/101/,ST01KZ(19)/102/,ST01KZ(20)/97/,ST01KZ(21)/117/,ST01K *Z(22)/108/,ST01KZ(23)/116/,ST01KZ(24)/0/ DATA ST01LZ(1)/105/,ST01LZ(2)/108/,ST01LZ(3)/108/,ST01LZ(4)/101/,S *T01LZ(5)/103/,ST01LZ(6)/97/,ST01LZ(7)/108/,ST01LZ(8)/32/,ST01LZ(9) */101/,ST01LZ(10)/108/,ST01LZ(11)/115/,ST01LZ(12)/101/,ST01LZ(13)/0 */ DATA ST01MZ(1)/115/,ST01MZ(2)/116/,ST01MZ(3)/97/,ST01MZ(4)/99/,ST0 *1MZ(5)/107/,ST01MZ(6)/32/,ST01MZ(7)/111/,ST01MZ(8)/118/,ST01MZ(9)/ *101/,ST01MZ(10)/114/,ST01MZ(11)/102/,ST01MZ(12)/108/,ST01MZ(13)/11 *1/,ST01MZ(14)/119/,ST01MZ(15)/32/,ST01MZ(16)/105/,ST01MZ(17)/110/, *ST01MZ(18)/32/,ST01MZ(19)/112/,ST01MZ(20)/97/,ST01MZ(21)/114/,ST01 *MZ(22)/115/,ST01MZ(23)/101/,ST01MZ(24)/114/,ST01MZ(25)/0/ DATA ST01NZ(1)/105/,ST01NZ(2)/108/,ST01NZ(3)/108/,ST01NZ(4)/101/,S *T01NZ(5)/103/,ST01NZ(6)/97/,ST01NZ(7)/108/,ST01NZ(8)/32/,ST01NZ(9) */114/,ST01NZ(10)/105/,ST01NZ(11)/103/,ST01NZ(12)/104/,ST01NZ(13)/1 *16/,ST01NZ(14)/32/,ST01NZ(15)/98/,ST01NZ(16)/114/,ST01NZ(17)/97/,S *T01NZ(18)/99/,ST01NZ(19)/101/,ST01NZ(20)/0/ DATA ST01OZ(1)/117/,ST01OZ(2)/110/,ST01OZ(3)/101/,ST01OZ(4)/120/,S *T01OZ(5)/112/,ST01OZ(6)/101/,ST01OZ(7)/99/,ST01OZ(8)/116/,ST01OZ(9 *)/101/,ST01OZ(10)/100/,ST01OZ(11)/32/,ST01OZ(12)/69/,ST01OZ(13)/79 */,ST01OZ(14)/70/,ST01OZ(15)/0/ DATA ST01PZ(1)/99/,ST01PZ(2)/111/,ST01PZ(3)/110/,ST01PZ(4)/100/,ST *01PZ(5)/105/,ST01PZ(6)/116/,ST01PZ(7)/105/,ST01PZ(8)/111/,ST01PZ(9 *)/110/,ST01PZ(10)/97/,ST01PZ(11)/108/,ST01PZ(12)/32/,ST01PZ(13)/11 *2/,ST01PZ(14)/114/,ST01PZ(15)/111/,ST01PZ(16)/99/,ST01PZ(17)/101/, *ST01PZ(18)/115/,ST01PZ(19)/115/,ST01PZ(20)/105/,ST01PZ(21)/110/,ST *01PZ(22)/103/,ST01PZ(23)/32/,ST01PZ(24)/115/,ST01PZ(25)/116/,ST01P *Z(26)/105/,ST01PZ(27)/108/,ST01PZ(28)/108/,ST01PZ(29)/32/,ST01PZ(3 *0)/97/,ST01PZ(31)/99/,ST01PZ(32)/116/,ST01PZ(33)/105/,ST01PZ(34)/1 *18/,ST01PZ(35)/101/,ST01PZ(36)/32/,ST01PZ(37)/97/,ST01PZ(38)/116/, *ST01PZ(39)/32/,ST01PZ(40)/69/,ST01PZ(41)/79/,ST01PZ(42)/70/,ST01PZ *(43)/0/ CALL FINIT SP = 1 LEXTYP (1) = -1 23627 CONTINUE IF (.NOT.(SBP .GT. 1))GOTO 23630 CALL DMPDCL(LEXSTR) 23630 CONTINUE TOKEN = LEX (LEXSTR) IF (.NOT.(TOKEN .EQ. -1))GOTO 23632 GOTO 23629 23632 CONTINUE IF (.NOT.(TOKEN .EQ. -19))GOTO 23634 CALL IFCODE (LAB) GOTO 23635 23634 CONTINUE IF (.NOT.(TOKEN .EQ. -10))GOTO 23636 CALL DOCODE (LAB) GOTO 23637 23636 CONTINUE IF (.NOT.(TOKEN .EQ. -15))GOTO 23638 CALL WHILEC (LAB) GOTO 23639 23638 CONTINUE IF (.NOT.(TOKEN .EQ. -16))GOTO 23640 CALL FORCOD (LAB) GOTO 23641 23640 CONTINUE IF (.NOT.(TOKEN .EQ. -17))GOTO 23642 CALL REPCOD (LAB) GOTO 23643 23642 CONTINUE IF (.NOT.(TOKEN .EQ. -24))GOTO 23644 CALL SWCODE (LAB) GOTO 23645 23644 CONTINUE IF (.NOT.(TOKEN .EQ. -25 .OR. TOKEN .EQ. -26))GOTO 23646 I = SP 23648 IF (.NOT.(I .GT. 0))GOTO 23650 IF (.NOT.(LEXTYP (I) .EQ. -24))GOTO 23651 GOTO 23650 23651 CONTINUE 23649 I = I - 1 GOTO 23648 23650 CONTINUE IF (.NOT.(I .EQ. 0))GOTO 23653 CALL SYNERR (ST01KZ) GOTO 23654 23653 CONTINUE CALL CASCOD (LABVAL (I), TOKEN) 23654 CONTINUE GOTO 23647 23646 CONTINUE IF (.NOT.(TOKEN .EQ. -9))GOTO 23655 CALL LABELC (LEXSTR) GOTO 23656 23655 CONTINUE IF (.NOT.(TOKEN .EQ. -11))GOTO 23657 IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23659 CALL ELSEIF (LABVAL (SP)) GOTO 23660 23659 CONTINUE CALL SYNERR (ST01LZ) 23660 CONTINUE GOTO 23658 23657 CONTINUE IF (.NOT.(TOKEN .EQ. -27))GOTO 23661 CALL LITRAL 23661 CONTINUE 23658 CONTINUE 23656 CONTINUE 23647 CONTINUE 23645 CONTINUE 23643 CONTINUE 23641 CONTINUE 23639 CONTINUE 23637 CONTINUE 23635 CONTINUE IF (.NOT.(TOKEN .EQ. -19 .OR. TOKEN .EQ. -11 .OR. TOKEN .EQ. -15 . *OR. TOKEN .EQ. -16 .OR. TOKEN .EQ. -17 .OR. TOKEN .EQ. -24 .OR. *TOKEN .EQ. -10 .OR. TOKEN .EQ. -9 .OR. TOKEN .EQ. 123))GOTO 23663 SP = SP + 1 IF (.NOT.(SP .GT. 100))GOTO 23665 CALL BADERR (ST01MZ) 23665 CONTINUE LEXTYP (SP) = TOKEN LABVAL (SP) = LAB GOTO 23664 23663 CONTINUE IF (.NOT.(TOKEN .NE. -25 .AND. TOKEN .NE. -26))GOTO 23667 IF (.NOT.(TOKEN .EQ. 125))GOTO 23669 IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23671 SP = SP - 1 GOTO 23672 23671 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -24))GOTO 23673 CALL SWEND (LABVAL (SP)) SP = SP - 1 GOTO 23674 23673 CONTINUE CALL SYNERR (ST01NZ) 23674 CONTINUE 23672 CONTINUE GOTO 23670 23669 CONTINUE IF (.NOT.(TOKEN .EQ. -14))GOTO 23675 CALL OTHERC (LEXSTR) GOTO 23676 23675 CONTINUE IF (.NOT.(TOKEN .EQ. -8 .OR. TOKEN .EQ. -13))GOTO 23677 CALL BRKNXT (SP, LEXTYP, LABVAL, TOKEN) GOTO 23678 23677 CONTINUE IF (.NOT.(TOKEN .EQ. -20))GOTO 23679 CALL RETCOD GOTO 23680 23679 CONTINUE IF (.NOT.(TOKEN .EQ. -23))GOTO 23681 CALL STRDCL 23681 CONTINUE 23680 CONTINUE 23678 CONTINUE 23676 CONTINUE 23670 CONTINUE TOKEN = LEX (LEXSTR) CALL PBSTR (LEXSTR) CALL UNSTAK (SP, LEXTYP, LABVAL, TOKEN) 23667 CONTINUE 23664 CONTINUE 23628 GOTO 23627 23629 CONTINUE IF (.NOT.(SP .NE. 1))GOTO 23683 CALL SYNERR (ST01OZ) 23683 CONTINUE IF (.NOT.(CSP .GT. 0))GOTO 23685 CALL SYNERR(ST01PZ) 23685 CONTINUE RETURN END SUBROUTINE PBNUM (N) INTEGER N INTEGER M, NUM LOGICAL*1 DIGITS(11) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/0/ NUM = IABS(N) 23687 CONTINUE M = MOD (NUM, 10) CALL PUTBAK (DIGITS (M + 1)) NUM = NUM / 10 23688 IF (.NOT.(NUM .EQ. 0))GOTO 23687 23689 CONTINUE IF (.NOT.(N .LT. 0))GOTO 23690 CALL PUTBAK(45) 23690 CONTINUE RETURN END SUBROUTINE PBSTR (IN) LOGICAL*1 IN (100) INTEGER I INTEGER LENGTH I = LENGTH (IN) 23692 IF (.NOT.(I .GT. 0))GOTO 23694 CALL PUTBAK (IN (I)) 23693 I = I - 1 GOTO 23692 23694 CONTINUE RETURN END INTEGER FUNCTION PUSH (EP, ARGSTK, AP) INTEGER AP, ARGSTK (100), EP LOGICAL*1 ST01QZ(19) DATA ST01QZ(1)/97/,ST01QZ(2)/114/,ST01QZ(3)/103/,ST01QZ(4)/32/,ST0 *1QZ(5)/115/,ST01QZ(6)/116/,ST01QZ(7)/97/,ST01QZ(8)/99/,ST01QZ(9)/1 *07/,ST01QZ(10)/32/,ST01QZ(11)/111/,ST01QZ(12)/118/,ST01QZ(13)/101/ *,ST01QZ(14)/114/,ST01QZ(15)/102/,ST01QZ(16)/108/,ST01QZ(17)/111/,S *T01QZ(18)/119/,ST01QZ(19)/0/ IF (.NOT.(AP .GT. 100))GOTO 23695 CALL BADERR (ST01QZ) 23695 CONTINUE ARGSTK (AP) = EP PUSH = AP + 1 RETURN END SUBROUTINE PUTBAK (C) LOGICAL*1 C INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 ST01RZ(32) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST01RZ(1)/116/,ST01RZ(2)/111/,ST01RZ(3)/111/,ST01RZ(4)/32/,ST *01RZ(5)/109/,ST01RZ(6)/97/,ST01RZ(7)/110/,ST01RZ(8)/121/,ST01RZ(9) */32/,ST01RZ(10)/99/,ST01RZ(11)/104/,ST01RZ(12)/97/,ST01RZ(13)/114/ *,ST01RZ(14)/97/,ST01RZ(15)/99/,ST01RZ(16)/116/,ST01RZ(17)/101/,ST0 *1RZ(18)/114/,ST01RZ(19)/115/,ST01RZ(20)/32/,ST01RZ(21)/112/,ST01RZ *(22)/117/,ST01RZ(23)/115/,ST01RZ(24)/104/,ST01RZ(25)/101/,ST01RZ(2 *6)/100/,ST01RZ(27)/32/,ST01RZ(28)/98/,ST01RZ(29)/97/,ST01RZ(30)/99 */,ST01RZ(31)/107/,ST01RZ(32)/0/ IF (.NOT.(BP .GE. 500))GOTO 23697 CALL BADERR (ST01RZ) GOTO 23698 23697 CONTINUE BP = BP + 1 BUF (BP) = C 23698 CONTINUE RETURN END SUBROUTINE PUTCHR (C) LOGICAL*1 C INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 ST01SZ(26) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ST01SZ(1)/101/,ST01SZ(2)/118/,ST01SZ(3)/97/,ST01SZ(4)/108/,ST *01SZ(5)/117/,ST01SZ(6)/97/,ST01SZ(7)/116/,ST01SZ(8)/105/,ST01SZ(9) */111/,ST01SZ(10)/110/,ST01SZ(11)/32/,ST01SZ(12)/115/,ST01SZ(13)/11 *6/,ST01SZ(14)/97/,ST01SZ(15)/99/,ST01SZ(16)/107/,ST01SZ(17)/32/,ST *01SZ(18)/111/,ST01SZ(19)/118/,ST01SZ(20)/101/,ST01SZ(21)/114/,ST01 *SZ(22)/102/,ST01SZ(23)/108/,ST01SZ(24)/111/,ST01SZ(25)/119/,ST01SZ *(26)/0/ IF (.NOT.(EP .GT. 500))GOTO 23699 CALL BADERR (ST01SZ) 23699 CONTINUE EVALST (EP) = C EP = EP + 1 RETURN END SUBROUTINE PUTTOK (STR) LOGICAL*1 STR (120) INTEGER I I = 1 23701 IF (.NOT.(STR (I) .NE. 0))GOTO 23703 CALL PUTCHR (STR (I)) 23702 I = I + 1 GOTO 23701 23703 CONTINUE RETURN END INTEGER FUNCTION QSTFIX(STR) LOGICAL*1 STR(100) INTEGER LAST, N, I INTEGER LENGTH LAST = LENGTH(STR) N = 1 I = 2 23704 IF (.NOT.(I .LT. LAST))GOTO 23706 IF (.NOT.(STR(I) .EQ. 64))GOTO 23707 IF (.NOT.(STR(I+1) .EQ. 34))GOTO 23709 I = I + 1 23709 CONTINUE 23707 CONTINUE STR(N) = STR(I) N = N + 1 23705 I = I + 1 GOTO 23704 23706 CONTINUE STR(N) = 0 QSTFIX=(N-1) RETURN END SUBROUTINE RATARG INTEGER I INTEGER GETARG INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DOSYM = 1 I = 1 23711 IF (.NOT.(GETARG(I, SCRTOK, 120) .NE. -1))GOTO 23713 IF (.NOT.(SCRTOK(1) .EQ. 45 .AND. SCRTOK(2) .NE. 0))GOTO 23714 IF (.NOT.(SCRTOK(2) .EQ. 110 .OR. SCRTOK(2) .EQ. 78))GOTO 23716 DOSYM = 0 23716 CONTINUE 23714 CONTINUE 23712 I = I + 1 GOTO 23711 23713 CONTINUE RETURN END SUBROUTINE RELATE (TOKEN, LAST) LOGICAL*1 TOKEN (100) INTEGER LAST LOGICAL*1 NGETCH INTEGER LENGTH IF (.NOT.(NGETCH (TOKEN (2)) .NE. 61))GOTO 23718 CALL PUTBAK (TOKEN (2)) TOKEN (3) = 116 GOTO 23719 23718 CONTINUE TOKEN (3) = 101 23719 CONTINUE TOKEN (4) = 46 TOKEN (5) = 0 TOKEN (6) = 0 IF (.NOT.(TOKEN (1) .EQ. 62))GOTO 23720 TOKEN (2) = 103 GOTO 23721 23720 CONTINUE IF (.NOT.(TOKEN (1) .EQ. 60))GOTO 23722 TOKEN (2) = 108 GOTO 23723 23722 CONTINUE IF (.NOT.(TOKEN (1) .EQ. 33 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .E *Q. 126 .OR. TOKEN(1) .EQ. 94))GOTO 23724 IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23726 TOKEN (3) = 111 TOKEN (4) = 116 TOKEN (5) = 46 23726 CONTINUE TOKEN (2) = 110 GOTO 23725 23724 CONTINUE IF (.NOT.(TOKEN (1) .EQ. 61))GOTO 23728 IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23730 TOKEN (2) = 0 LAST = 1 RETURN 23730 CONTINUE TOKEN (2) = 101 TOKEN (3) = 113 GOTO 23729 23728 CONTINUE IF (.NOT.(TOKEN (1) .EQ. 38))GOTO 23732 TOKEN (2) = 97 TOKEN (3) = 110 TOKEN (4) = 100 TOKEN (5) = 46 GOTO 23733 23732 CONTINUE IF (.NOT.(TOKEN (1) .EQ. 124))GOTO 23734 TOKEN (2) = 111 TOKEN (3) = 114 GOTO 23735 23734 CONTINUE TOKEN (2) = 0 23735 CONTINUE 23733 CONTINUE 23729 CONTINUE 23725 CONTINUE 23723 CONTINUE 23721 CONTINUE TOKEN (1) = 46 LAST = LENGTH (TOKEN) RETURN END SUBROUTINE REPCOD (LAB) INTEGER LAB INTEGER LABGEN CALL OUTCON (0) LAB = LABGEN (3) CALL OUTCON (LAB) LAB = LAB + 1 RETURN END SUBROUTINE RETCOD INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 T LOGICAL*1 GNBTOK LOGICAL*1 SRET(7) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1 *14/,SRET(6)/110/,SRET(7)/0/ T = GNBTOK (SCRTOK, 120) IF (.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23736 CALL PBSTR (SCRTOK) CALL OUTTAB CALL SCOPY (FCNAME, 1, SCRTOK, 1) CALL OUTSTR (SCRTOK) CALL OUTCH (61) CALL EATUP CALL OUTDON GOTO 23737 23736 CONTINUE IF (.NOT.(T .EQ. 125))GOTO 23738 CALL PBSTR (SCRTOK) 23738 CONTINUE 23737 CONTINUE CALL OUTTAB CALL OUTSTR (SRET) CALL OUTDON XFER = 1 RETURN END SUBROUTINE SKPBLK INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 C LOGICAL*1 NGETCH COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) 23740 CONTINUE C = NGETCH (C) 23741 IF (.NOT.(C .NE. 32 .AND. C .NE. 9))GOTO 23740 23742 CONTINUE CALL PUTBAK (C) RETURN END SUBROUTINE STRDCL INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 T, DCHAR (120) INTEGER I, J, K, N, LEN LOGICAL*1 GNBTOK, ESC INTEGER LENGTH, CTOI, LEX, ELENTH LOGICAL*1 CHAR(10) LOGICAL*1 DAT(6) LOGICAL*1 EOSS(4) LOGICAL*1 ST01TZ(21) LOGICAL*1 ST020Z(20) LOGICAL*1 ST021Z(20) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA CHAR(1)/99/,CHAR(2)/104/,CHAR(3)/97/,CHAR(4)/114/,CHAR(5)/97/ *,CHAR(6)/99/,CHAR(7)/116/,CHAR(8)/101/,CHAR(9)/114/,CHAR(10)/0/ DATA DAT(1)/100/,DAT(2)/97/,DAT(3)/116/,DAT(4)/97/,DAT(5)/32/,DAT( *6)/0/ DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/0/ DATA ST01TZ(1)/109/,ST01TZ(2)/105/,ST01TZ(3)/115/,ST01TZ(4)/115/,S *T01TZ(5)/105/,ST01TZ(6)/110/,ST01TZ(7)/103/,ST01TZ(8)/32/,ST01TZ(9 *)/115/,ST01TZ(10)/116/,ST01TZ(11)/114/,ST01TZ(12)/105/,ST01TZ(13)/ *110/,ST01TZ(14)/103/,ST01TZ(15)/32/,ST01TZ(16)/116/,ST01TZ(17)/111 */,ST01TZ(18)/107/,ST01TZ(19)/101/,ST01TZ(20)/110/,ST01TZ(21)/0/ DATA ST020Z(1)/105/,ST020Z(2)/110/,ST020Z(3)/118/,ST020Z(4)/97/,ST *020Z(5)/108/,ST020Z(6)/105/,ST020Z(7)/100/,ST020Z(8)/32/,ST020Z(9) */115/,ST020Z(10)/116/,ST020Z(11)/114/,ST020Z(12)/105/,ST020Z(13)/1 *10/,ST020Z(14)/103/,ST020Z(15)/32/,ST020Z(16)/115/,ST020Z(17)/105/ *,ST020Z(18)/122/,ST020Z(19)/101/,ST020Z(20)/0/ DATA ST021Z(1)/109/,ST021Z(2)/105/,ST021Z(3)/115/,ST021Z(4)/115/,S *T021Z(5)/105/,ST021Z(6)/110/,ST021Z(7)/103/,ST021Z(8)/32/,ST021Z(9 *)/114/,ST021Z(10)/105/,ST021Z(11)/103/,ST021Z(12)/104/,ST021Z(13)/ *116/,ST021Z(14)/32/,ST021Z(15)/112/,ST021Z(16)/97/,ST021Z(17)/114/ *,ST021Z(18)/101/,ST021Z(19)/110/,ST021Z(20)/0/ T = GNBTOK (SCRTOK, 120) IF (.NOT.(T .NE. -9))GOTO 23743 CALL SYNERR (ST01TZ) 23743 CONTINUE IF (.NOT.(GNBTOK(DCHAR, 120) .EQ. 40))GOTO 23745 CALL CONCAT(SCRTOK, DCHAR, SCRTOK) IF (.NOT.(GNBTOK(DCHAR, 120) .NE. 2))GOTO 23747 CALL SYNERR(ST020Z) 23747 CONTINUE CALL CONCAT(SCRTOK, DCHAR, SCRTOK) IF (.NOT.(GNBTOK(DCHAR, 120) .NE. 41))GOTO 23749 CALL SYNERR(ST021Z) 23749 CONTINUE CALL CONCAT(SCRTOK, DCHAR, SCRTOK) T = GNBTOK(DCHAR, 120) 23745 CONTINUE CALL INSDCL(SCRTOK, DCHAR, 34) RETURN END SUBROUTINE STROUT(STR, IFUP) LOGICAL*1 STR(100), C INTEGER IFUP, I LOGICAL*1 CUPPER I = 1 23751 IF (.NOT.(STR(I) .NE. 0))GOTO 23753 C = STR(I) IF (.NOT.(IFUP .EQ. 1))GOTO 23754 C = CUPPER(C) 23754 CONTINUE CALL OUTCH(C) 23752 I = I + 1 GOTO 23751 23753 CONTINUE RETURN END SUBROUTINE SWCODE (LAB) INTEGER LAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER LABGEN, GNBTOK LOGICAL*1 INTSTR(8) LOGICAL*1 ST022Z(22) LOGICAL*1 ST023Z(39) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA INTSTR(1)/105/,INTSTR(2)/110/,INTSTR(3)/116/,INTSTR(4)/101/,I *NTSTR(5)/103/,INTSTR(6)/101/,INTSTR(7)/114/,INTSTR(8)/0/ DATA ST022Z(1)/115/,ST022Z(2)/119/,ST022Z(3)/105/,ST022Z(4)/116/,S *T022Z(5)/99/,ST022Z(6)/104/,ST022Z(7)/32/,ST022Z(8)/116/,ST022Z(9) */97/,ST022Z(10)/98/,ST022Z(11)/108/,ST022Z(12)/101/,ST022Z(13)/32/ *,ST022Z(14)/111/,ST022Z(15)/118/,ST022Z(16)/101/,ST022Z(17)/114/,S *T022Z(18)/102/,ST022Z(19)/108/,ST022Z(20)/111/,ST022Z(21)/119/,ST0 *22Z(22)/0/ DATA ST023Z(1)/109/,ST023Z(2)/105/,ST023Z(3)/115/,ST023Z(4)/115/,S *T023Z(5)/105/,ST023Z(6)/110/,ST023Z(7)/103/,ST023Z(8)/32/,ST023Z(9 *)/108/,ST023Z(10)/101/,ST023Z(11)/102/,ST023Z(12)/116/,ST023Z(13)/ *32/,ST023Z(14)/98/,ST023Z(15)/114/,ST023Z(16)/97/,ST023Z(17)/99/,S *T023Z(18)/101/,ST023Z(19)/32/,ST023Z(20)/105/,ST023Z(21)/110/,ST02 *3Z(22)/32/,ST023Z(23)/115/,ST023Z(24)/119/,ST023Z(25)/105/,ST023Z( *26)/116/,ST023Z(27)/99/,ST023Z(28)/104/,ST023Z(29)/32/,ST023Z(30)/ *115/,ST023Z(31)/116/,ST023Z(32)/97/,ST023Z(33)/116/,ST023Z(34)/101 */,ST023Z(35)/109/,ST023Z(36)/101/,ST023Z(37)/110/,ST023Z(38)/116/, *ST023Z(39)/0/ LAB = LABGEN (2) IF (.NOT.(SWLAST + 3 .GT. 300))GOTO 23756 CALL BADERR (ST022Z) 23756 CONTINUE SWSTAK (SWLAST) = SWTOP SWSTAK (SWLAST + 1) = 0 SWSTAK (SWLAST + 2) = 0 SWTOP = SWLAST SWLAST = SWLAST + 3 XFER = 0 CALL OUTTAB CALL SWVAR (LAB) CALL OUTCH (61) CALL BALPAR CALL OUTDON CALL OUTTAB CALL OUTSTR (INTSTR) CALL OUTCH (32) CALL SWVAR (LAB) CALL OUTDON CALL OUTGO (LAB) XFER = 1 23758 IF (.NOT.(GNBTOK (SCRTOK, 120) .EQ. 10))GOTO 23759 GOTO 23758 23759 CONTINUE IF (.NOT.(SCRTOK (1) .NE. 123))GOTO 23760 CALL SYNERR (ST023Z) CALL PBSTR (SCRTOK) 23760 CONTINUE RETURN END SUBROUTINE SWEND (LAB) INTEGER LAB INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) INTEGER LB, UB, N, I, J LOGICAL*1 SIF(5) LOGICAL*1 SLT(10) LOGICAL*1 SGT(5) LOGICAL*1 SGOTO(7) LOGICAL*1 SEQ(5) LOGICAL*1 SGE(5) LOGICAL*1 SLE(5) LOGICAL*1 SAND(6) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/32/,SIF(4)/40/,SIF(5)/0/ DATA SLT(1)/46/,SLT(2)/108/,SLT(3)/116/,SLT(4)/46/,SLT(5)/49/,SLT( *6)/46/,SLT(7)/111/,SLT(8)/114/,SLT(9)/46/,SLT(10)/0/ DATA SGT(1)/46/,SGT(2)/103/,SGT(3)/116/,SGT(4)/46/,SGT(5)/0/ DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO *(5)/32/,SGOTO(6)/40/,SGOTO(7)/0/ DATA SEQ(1)/46/,SEQ(2)/101/,SEQ(3)/113/,SEQ(4)/46/,SEQ(5)/0/ DATA SGE(1)/46/,SGE(2)/103/,SGE(3)/101/,SGE(4)/46/,SGE(5)/0/ DATA SLE(1)/46/,SLE(2)/108/,SLE(3)/101/,SLE(4)/46/,SLE(5)/0/ DATA SAND(1)/46/,SAND(2)/97/,SAND(3)/110/,SAND(4)/100/,SAND(5)/46/ *,SAND(6)/0/ LB = SWSTAK (SWTOP + 3) UB = SWSTAK (SWLAST - 2) N = SWSTAK (SWTOP + 1) CALL OUTGO (LAB + 1) IF (.NOT.(SWSTAK (SWTOP + 2) .EQ. 0))GOTO 23762 SWSTAK (SWTOP + 2) = LAB + 1 23762 CONTINUE XFER = 0 CALL OUTCON (LAB) IF (.NOT.(N .GE. 3 .AND. UB - LB + 1 .LT. 2 * N))GOTO 23764 IF (.NOT.(LB .NE. 1))GOTO 23766 CALL OUTTAB CALL SWVAR (LAB) CALL OUTCH (61) CALL SWVAR (LAB) IF (.NOT.(LB .LT. 1))GOTO 23768 CALL OUTCH (43) 23768 CONTINUE CALL OUTNUM (-LB + 1) CALL OUTDON 23766 CONTINUE CALL OUTTAB CALL OUTSTR (SIF) CALL SWVAR (LAB) CALL OUTSTR (SLT) CALL SWVAR (LAB) CALL OUTSTR (SGT) CALL OUTNUM (UB - LB + 1) CALL OUTCH (41) CALL OUTGO (SWSTAK (SWTOP + 2)) CALL OUTTAB CALL OUTSTR (SGOTO) J = LB I = SWTOP + 3 23770 IF (.NOT.(I .LT. SWLAST))GOTO 23772 23773 IF (.NOT.(J .LT. SWSTAK (I)))GOTO 23775 CALL OUTNUM (SWSTAK (SWTOP + 2)) CALL OUTCH (44) 23774 J = J + 1 GOTO 23773 23775 CONTINUE J = SWSTAK (I + 1) - SWSTAK (I) 23776 IF (.NOT.(J .GE. 0))GOTO 23778 CALL OUTNUM (SWSTAK (I + 2)) 23777 J = J - 1 GOTO 23776 23778 CONTINUE J = SWSTAK (I + 1) + 1 IF (.NOT.(I .LT. SWLAST - 3))GOTO 23779 CALL OUTCH (44) 23779 CONTINUE 23771 I = I + 3 GOTO 23770 23772 CONTINUE CALL OUTCH (41) CALL OUTCH (44) CALL SWVAR (LAB) CALL OUTDON GOTO 23765 23764 CONTINUE IF (.NOT.(N .GT. 0))GOTO 23781 I = SWTOP + 3 23783 IF (.NOT.(I .LT. SWLAST))GOTO 23785 CALL OUTTAB CALL OUTSTR (SIF) CALL SWVAR (LAB) IF (.NOT.(SWSTAK (I) .EQ. SWSTAK (I+1)))GOTO 23786 CALL OUTSTR (SEQ) CALL OUTNUM (SWSTAK (I)) GOTO 23787 23786 CONTINUE CALL OUTSTR (SGE) CALL OUTNUM (SWSTAK (I)) CALL OUTSTR (SAND) CALL SWVAR (LAB) CALL OUTSTR (SLE) CALL OUTNUM (SWSTAK (I + 1)) 23787 CONTINUE CALL OUTCH (41) CALL OUTGO (SWSTAK (I + 2)) 23784 I = I + 3 GOTO 23783 23785 CONTINUE IF (.NOT.(LAB + 1 .NE. SWSTAK (SWTOP + 2)))GOTO 23788 CALL OUTGO (SWSTAK (SWTOP + 2)) 23788 CONTINUE 23781 CONTINUE 23765 CONTINUE CALL OUTCON (LAB + 1) SWLAST = SWTOP SWTOP = SWSTAK (SWTOP) RETURN END SUBROUTINE SWVAR (LAB) INTEGER LAB CALL OUTCH (73) CALL OUTNUM (LAB) RETURN END SUBROUTINE SYNERR (MSG) LOGICAL*1 MSG (100) INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 LC (20) INTEGER I, JUNK INTEGER ITOC LOGICAL*1 IN(5) LOGICAL*1 ERRMSG(15) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA IN(1)/32/,IN(2)/105/,IN(3)/110/,IN(4)/32/,IN(5)/0/ DATA ERRMSG(1)/101/,ERRMSG(2)/114/,ERRMSG(3)/114/,ERRMSG(4)/111/,E *RRMSG(5)/114/,ERRMSG(6)/32/,ERRMSG(7)/97/,ERRMSG(8)/116/,ERRMSG(9) */32/,ERRMSG(10)/108/,ERRMSG(11)/105/,ERRMSG(12)/110/,ERRMSG(13)/10 *1/,ERRMSG(14)/32/,ERRMSG(15)/0/ IF (.NOT.(CURCND .NE. 1))GOTO 23790 RETURN 23790 CONTINUE CALL PUTLIN (ERRMSG, 3) IF (.NOT.(LEVEL .GE. 1))GOTO 23792 I = LEVEL GOTO 23793 23792 CONTINUE I = 1 23793 CONTINUE JUNK = ITOC (LINECT (I), LC, 20) CALL PUTLIN (LC, 3) I = FNAMP - 1 23794 IF (.NOT.(I .GT. 1))GOTO 23796 IF (.NOT.(FNAMES (I - 1) .EQ. 0))GOTO 23797 CALL PUTLIN (IN, 3) CALL PUTLIN (FNAMES (I), 3) GOTO 23796 23797 CONTINUE 23795 I = I - 1 GOTO 23794 23796 CONTINUE CALL PUTCH (58, 3) CALL PUTCH (32, 3) CALL REMARK (MSG) RETURN END SUBROUTINE ULSTAL (NAME, VAL) LOGICAL*1 NAME (100), DEFN (2), VAL INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DEFN (1) = VAL DEFN (2) = 0 CALL ENTDEF (NAME, DEFN, DEFTBL) CALL UPPER (NAME) CALL ENTDEF (NAME, DEFN, DEFTBL) RETURN END SUBROUTINE UNSTAK (SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL (100), LEXTYP (100), SP, TOKEN 23799 IF (.NOT.(SP .GT. 1))GOTO 23801 IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23802 GOTO 23801 23802 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -24))GOTO 23804 GOTO 23801 23804 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -19 .AND. TOKEN .EQ. -11))GOTO 23806 GOTO 23801 23806 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23808 CALL OUTCON (LABVAL (SP)) GOTO 23809 23808 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -11))GOTO 23810 IF (.NOT.(SP .GT. 2))GOTO 23812 SP = SP - 1 23812 CONTINUE CALL OUTCON (LABVAL (SP) + 1) GOTO 23811 23810 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -10))GOTO 23814 CALL DOSTAT (LABVAL (SP)) GOTO 23815 23814 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -15))GOTO 23816 CALL WHILES (LABVAL (SP)) GOTO 23817 23816 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -16))GOTO 23818 CALL FORS (LABVAL (SP)) GOTO 23819 23818 CONTINUE IF (.NOT.(LEXTYP (SP) .EQ. -17))GOTO 23820 CALL UNTILS (LABVAL (SP), TOKEN) 23820 CONTINUE 23819 CONTINUE 23817 CONTINUE 23815 CONTINUE 23811 CONTINUE 23809 CONTINUE 23800 SP = SP - 1 GOTO 23799 23801 CONTINUE RETURN END SUBROUTINE UNTILS (LAB, TOKEN) INTEGER LAB, TOKEN INTEGER BP LOGICAL*1 BUF LOGICAL*1 FCNAME INTEGER FORDEP LOGICAL*1 FORSTK INTEGER XFER INTEGER LABEL INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP LOGICAL*1 FNAMES INTEGER CP INTEGER EP LOGICAL*1 EVALST INTEGER DEFTBL INTEGER OUTP LOGICAL*1 OUTBUF INTEGER SBP LOGICAL*1 SBUF INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK INTEGER RKWTBL INTEGER CSP INTEGER CURCND INTEGER CNDSTK LOGICAL*1 SCRTOK INTEGER DOSYM INTEGER STRCNT INTEGER MEM( 4250) LOGICAL*1 CMEM(8500) LOGICAL*1 PTOKEN (120) INTEGER JUNK INTEGER LEX COMMON /CDEFIO/ BP, BUF (500) COMMON /CFNAME/ FCNAME (36) COMMON /CFOR/ FORDEP, FORSTK (300) COMMON /CGOTO/ XFER COMMON /CLABEL/ LABEL COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 144) COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL COMMON /COUTLN/ OUTP, OUTBUF (74) COMMON /CSBUF/ SBP, SBUF (600) COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK (300) COMMON /CKWORD/ RKWTBL COMMON /CONDPP/ CSP, CURCND, CNDSTK(10) COMMON / CSCTOK / SCRTOK(120) COMMON / CFLAGS / DOSYM COMMON / CPASS1 / STRCNT COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) XFER = 0 CALL OUTNUM (LAB) IF (.NOT.(TOKEN .EQ. -18))GOTO 23822 JUNK = LEX (PTOKEN) CALL IFGO (LAB - 1) GOTO 23823 23822 CONTINUE CALL OUTGO (LAB - 1) 23823 CONTINUE CALL OUTCON (LAB + 1) RETURN END SUBROUTINE WHILEC (LAB) INTEGER LAB INTEGER LABGEN CALL OUTCON (0) LAB = LABGEN (2) CALL OUTNUM (LAB) CALL IFGO (LAB + 1) RETURN END SUBROUTINE WHILES (LAB) INTEGER LAB CALL OUTGO (LAB) CALL OUTCON (LAB + 1) RETURN END SUBROUTINE LOCSYM(FILE) LOGICAL*1 FILE(36) INTEGER LOCCOM LOGICAL*1 PATH(18) LOGICAL*1 SUFFIX(3) LOGICAL*1 DEFNS(7) LOGICAL*1 ST024Z(40) DATA PATH(1)/0/,PATH(2)/126/,PATH(3)/47/,PATH(4)/0/,PATH(5)/126/,P *ATH(6)/117/,PATH(7)/115/,PATH(8)/114/,PATH(9)/47/,PATH(10)/0/,PATH *(11)/126/,PATH(12)/98/,PATH(13)/105/,PATH(14)/110/,PATH(15)/47/,PA *TH(16)/0/,PATH(17)/10/,PATH(18)/0/ DATA SUFFIX(1)/0/,SUFFIX(2)/10/,SUFFIX(3)/0/ DATA DEFNS(1)/114/,DEFNS(2)/97/,DEFNS(3)/116/,DEFNS(4)/100/,DEFNS( *5)/101/,DEFNS(6)/102/,DEFNS(7)/0/ DATA ST024Z(1)/67/,ST024Z(2)/97/,ST024Z(3)/110/,ST024Z(4)/110/,ST0 *24Z(5)/111/,ST024Z(6)/116/,ST024Z(7)/32/,ST024Z(8)/108/,ST024Z(9)/ *111/,ST024Z(10)/99/,ST024Z(11)/97/,ST024Z(12)/116/,ST024Z(13)/101/ *,ST024Z(14)/32/,ST024Z(15)/115/,ST024Z(16)/116/,ST024Z(17)/97/,ST0 *24Z(18)/110/,ST024Z(19)/100/,ST024Z(20)/97/,ST024Z(21)/114/,ST024Z *(22)/100/,ST024Z(23)/32/,ST024Z(24)/100/,ST024Z(25)/101/,ST024Z(26 *)/102/,ST024Z(27)/105/,ST024Z(28)/110/,ST024Z(29)/105/,ST024Z(30)/ *116/,ST024Z(31)/105/,ST024Z(32)/111/,ST024Z(33)/110/,ST024Z(34)/11 *5/,ST024Z(35)/32/,ST024Z(36)/102/,ST024Z(37)/105/,ST024Z(38)/108/, *ST024Z(39)/101/,ST024Z(40)/0/ CALL SCOPY(DEFNS, 1, FILE, 1) IF (.NOT.(DEFNS(1) .NE. 0))GOTO 23824 IF (.NOT.(LOCCOM(DEFNS, PATH, SUFFIX, FILE) .NE. 12))GOTO 23826 FILE(1) = 0 CALL SYNERR(ST024Z) 23826 CONTINUE 23824 CONTINUE RETURN END