C RATFOR BOOTSTRAP (IN FORTRAN) C CALL INITST CALL RAT4 CALL ENDST END SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN INTEGER I, N, ALLDIG, CTOI INTEGER T, PTOKEN(100), GNBTOK COMMON /CGOTO/ XFER INTEGER XFER N = 0 T = GNBTOK(PTOKEN, 100) IF(.NOT.(ALLDIG(PTOKEN) .EQ. 1))GOTO 23000 I = 1 N = CTOI(PTOKEN, I) - 1 GOTO 23001 23000 CONTINUE IF(.NOT.(T .NE. 59))GOTO 23002 CALL PBSTR(PTOKEN) 23002 CONTINUE 23001 CONTINUE I = SP 23004 IF(.NOT.(I .GT. 0))GOTO 23006 IF(.NOT.(LEXTYP(I) .EQ. 10263 .OR. LEXTYP(I) .EQ. 10266 .OR. LEXTY *P(I) .EQ. 10268 .OR. LEXTYP(I) .EQ. 10269))GOTO 23007 IF(.NOT.(N .GT. 0))GOTO 23009 N = N - 1 GOTO 23005 23009 CONTINUE IF(.NOT.(TOKEN .EQ. 10264))GOTO 23011 CALL OUTGO(LABVAL(I)+1) GOTO 23012 23011 CONTINUE CALL OUTGO(LABVAL(I)) 23012 CONTINUE 23010 CONTINUE XFER = 1 RETURN 23007 CONTINUE 23005 I = I - 1 GOTO 23004 23006 CONTINUE IF(.NOT.(TOKEN .EQ. 10264))GOTO 23013 CALL SYNERR(14HILLEGAL BREAK.) GOTO 23014 23013 CONTINUE CALL SYNERR(13HILLEGAL NEXT.) 23014 CONTINUE RETURN END SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD) INTEGER GTOK, NGETCH INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ INTEGER C, DEFN(2500), TOKEN(100), T, PTOKEN(100) CALL SKPBLK(FD) C = GTOK(PTOKEN, 100, FD) IF(.NOT.(C .EQ. 40))GOTO 23015 T = 40 GOTO 23016 23015 CONTINUE T = 32 CALL PBSTR(PTOKEN) 23016 CONTINUE CALL SKPBLK(FD) IF(.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. 10100))GOTO 23017 CALL BADERR(22HNON-ALPHANUMERIC NAME.) 23017 CONTINUE CALL SKPBLK(FD) C = GTOK(PTOKEN, 100, FD) IF(.NOT.(T .EQ. 32))GOTO 23019 CALL PBSTR(PTOKEN) I = 1 23021 CONTINUE C = NGETCH(C, FD) IF(.NOT.(I .GT. DEFSIZ))GOTO 23024 CALL BADERR(20HDEFINITION TOO LONG.) 23024 CONTINUE DEFN(I) = C I = I + 1 23022 IF(.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. 10003))GOTO 23021 23023 CONTINUE IF(.NOT.(C .EQ. 35))GOTO 23026 CALL PUTBAK(C) 23026 CONTINUE GOTO 23020 23019 CONTINUE IF(.NOT.(T .EQ. 40))GOTO 23028 IF(.NOT.(C .NE. 44))GOTO 23030 CALL BADERR(24HMISSING COMMA IN DEFINE.) 23030 CONTINUE NLPAR = 0 I = 1 23032 IF(.NOT.(NLPAR .GE. 0))GOTO 23034 IF(.NOT.(I .GT. DEFSIZ))GOTO 23035 CALL BADERR(20HDEFINITION TOO LONG.) GOTO 23036 23035 CONTINUE IF(.NOT.(NGETCH(DEFN(I), FD) .EQ. 10003))GOTO 23037 CALL BADERR(20HMISSING RIGHT PAREN.) GOTO 23038 23037 CONTINUE IF(.NOT.(DEFN(I) .EQ. 40))GOTO 23039 NLPAR = NLPAR + 1 GOTO 23040 23039 CONTINUE IF(.NOT.(DEFN(I) .EQ. 41))GOTO 23041 NLPAR = NLPAR - 1 23041 CONTINUE 23040 CONTINUE 23038 CONTINUE 23036 CONTINUE 23033 I = I + 1 GOTO 23032 23034 CONTINUE GOTO 23029 23028 CONTINUE CALL BADERR(19HGETDEF IS CONFUSED.) 23029 CONTINUE 23020 CONTINUE DEFN(I-1) = 10002 RETURN END SUBROUTINE DOCODE(LAB) INTEGER LABGEN INTEGER LAB INTEGER GNBTOK INTEGER LEXSTR(100) COMMON /CGOTO/ XFER INTEGER XFER INTEGER SDO(3) DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/ XFER = 0 CALL OUTTAB CALL OUTSTR(SDO) CALL OUTCH(32) LAB = LABGEN(2) IF(.NOT.(GNBTOK(LEXSTR, 100) .EQ. 2))GOTO 23043 CALL OUTSTR(LEXSTR) GOTO 23044 23043 CONTINUE CALL PBSTR(LEXSTR) CALL OUTNUM(LAB) 23044 CONTINUE CALL OUTCH(32) CALL EATUP CALL OUTDON RETURN END SUBROUTINE DOSTAT(LAB) INTEGER LAB CALL OUTCON(LAB) CALL OUTCON(LAB+1) RETURN END SUBROUTINE BADERR(MSG) INTEGER MSG(100) CALL SYNERR(MSG) CALL ENDST END SUBROUTINE SYNERR(MSG) INTEGER LC(20), MSG(100) INTEGER ITOC INTEGER I, JUNK COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES INTEGER IN(5) INTEGER ERRMSG(15) DATA IN(1)/32/,IN(2)/105/,IN(3)/110/,IN(4)/32/,IN(5)/10002/ 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)/10002/ CALL PUTLIN(ERRMSG, 3) IF(.NOT.(LEVEL .GE. 1))GOTO 23045 I = LEVEL GOTO 23046 23045 CONTINUE I = 1 23046 CONTINUE JUNK = ITOC (LINECT(I), LC, 20) CALL PUTLIN(LC, 3) I = FNAMP-1 23047 IF(.NOT.(I.GT.1))GOTO 23049 IF(.NOT.(FNAMES(I-1) .EQ. 10002))GOTO 23050 CALL PUTLIN(IN, 3) CALL PUTLIN(FNAMES(I), 3) GOTO 23049 23050 CONTINUE 23048 I=I-1 GOTO 23047 23049 CONTINUE CALL PUTCH(58, 3) CALL PUTCH(32, 3) CALL REMARK (MSG) RETURN END SUBROUTINE FORCOD(LAB) INTEGER GETTOK, GNBTOK INTEGER T, TOKEN(100) INTEGER LENGTH, LABGEN INTEGER I, J, LAB, NLPAR COMMON /CFOR/ FORDEP, FORSTK(200) INTEGER FORDEP INTEGER FORSTK INTEGER IFNOT(9) DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5 *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/ LAB = LABGEN(3) CALL OUTCON(0) IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23052 CALL SYNERR(19HMISSING LEFT PAREN.) RETURN 23052 CONTINUE IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 59))GOTO 23054 CALL PBSTR(TOKEN) CALL OUTTAB CALL EATUP CALL OUTDON 23054 CONTINUE IF(.NOT.(GNBTOK(TOKEN, 100) .EQ. 59))GOTO 23056 CALL OUTCON(LAB) GOTO 23057 23056 CONTINUE CALL PBSTR(TOKEN) CALL OUTNUM(LAB) CALL OUTTAB CALL OUTSTR(IFNOT) CALL OUTCH(40) NLPAR = 0 23058 IF(.NOT.(NLPAR .GE. 0))GOTO 23059 T = GETTOK(TOKEN, 100) IF(.NOT.(T .EQ. 59))GOTO 23060 GOTO 23059 23060 CONTINUE IF(.NOT.(T .EQ. 40))GOTO 23062 NLPAR = NLPAR + 1 GOTO 23063 23062 CONTINUE IF(.NOT.(T .EQ. 41))GOTO 23064 NLPAR = NLPAR - 1 23064 CONTINUE 23063 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23066 CALL PBSTR(TOKEN) RETURN 23066 CONTINUE IF(.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23068 CALL OUTSTR(TOKEN) 23068 CONTINUE GOTO 23058 23059 CONTINUE CALL OUTCH(41) CALL OUTCH(41) CALL OUTGO(LAB+2) IF(.NOT.(NLPAR .LT. 0))GOTO 23070 CALL SYNERR(19HINVALID FOR CLAUSE.) 23070 CONTINUE 23057 CONTINUE FORDEP = FORDEP + 1 J = 1 I = 1 23072 IF(.NOT.(I .LT. FORDEP))GOTO 23074 J = J + LENGTH(FORSTK(J)) + 1 23073 I = I + 1 GOTO 23072 23074 CONTINUE FORSTK(J) = 10002 NLPAR = 0 T = GNBTOK(TOKEN, 100) CALL PBSTR(TOKEN) 23075 IF(.NOT.(NLPAR .GE. 0))GOTO 23076 T = GETTOK(TOKEN, 100) IF(.NOT.(T .EQ. 40))GOTO 23077 NLPAR = NLPAR + 1 GOTO 23078 23077 CONTINUE IF(.NOT.(T .EQ. 41))GOTO 23079 NLPAR = NLPAR - 1 23079 CONTINUE 23078 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23081 CALL PBSTR(TOKEN) GOTO 23076 23081 CONTINUE IF(.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))GOTO 23083 IF(.NOT.(J + LENGTH(TOKEN) .GE. 200))GOTO 23085 CALL BADERR(20HFOR CLAUSE TOO LONG.) 23085 CONTINUE CALL SCOPY(TOKEN, 1, FORSTK, J) J = J + LENGTH(TOKEN) 23083 CONTINUE GOTO 23075 23076 CONTINUE LAB = LAB + 1 RETURN END SUBROUTINE FORS(LAB) INTEGER LENGTH INTEGER I, J, LAB COMMON /CFOR/ FORDEP, FORSTK(200) INTEGER FORDEP INTEGER FORSTK COMMON /CGOTO/ XFER INTEGER XFER XFER = 0 CALL OUTNUM(LAB) J = 1 I = 1 23087 IF(.NOT.(I .LT. FORDEP))GOTO 23089 J = J + LENGTH(FORSTK(J)) + 1 23088 I = I + 1 GOTO 23087 23089 CONTINUE IF(.NOT.(LENGTH(FORSTK(J)) .GT. 0))GOTO 23090 CALL OUTTAB CALL OUTSTR(FORSTK(J)) CALL OUTDON 23090 CONTINUE CALL OUTGO(LAB-1) CALL OUTCON(LAB+1) FORDEP = FORDEP - 1 RETURN END SUBROUTINE BALPAR INTEGER GETTOK, GNBTOK INTEGER T, TOKEN(100) INTEGER NLPAR IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23092 CALL SYNERR(19HMISSING LEFT PAREN.) RETURN 23092 CONTINUE CALL OUTSTR(TOKEN) NLPAR = 1 23094 CONTINUE T = GETTOK(TOKEN, 100) IF(.NOT.(T.EQ.59 .OR. T.EQ.123 .OR. T.EQ.125 .OR. T.EQ.10003))GOTO * 23097 CALL PBSTR(TOKEN) GOTO 23096 23097 CONTINUE IF(.NOT.(T .EQ. 10))GOTO 23099 TOKEN(1) = 10002 GOTO 23100 23099 CONTINUE IF(.NOT.(T .EQ. 40))GOTO 23101 NLPAR = NLPAR + 1 GOTO 23102 23101 CONTINUE IF(.NOT.(T .EQ. 41))GOTO 23103 NLPAR = NLPAR - 1 23103 CONTINUE 23102 CONTINUE 23100 CONTINUE CALL OUTSTR(TOKEN) 23095 IF(.NOT.(NLPAR .LE. 0))GOTO 23094 23096 CONTINUE IF(.NOT.(NLPAR .NE. 0))GOTO 23105 CALL SYNERR(33HMISSING PARENTHESIS IN CONDITION.) 23105 CONTINUE RETURN END SUBROUTINE ELSEIF(LAB) INTEGER LAB CALL OUTGO(LAB+1) CALL OUTCON(LAB) RETURN END SUBROUTINE IFCODE(LAB) INTEGER LABGEN INTEGER LAB COMMON /CGOTO/ XFER INTEGER XFER XFER = 0 LAB = LABGEN(2) CALL IFGO(LAB) RETURN END SUBROUTINE IFGO(LAB) INTEGER LAB INTEGER IFNOT(9) DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5 *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/ CALL OUTTAB CALL OUTSTR(IFNOT) CALL BALPAR CALL OUTCH(41) CALL OUTGO(LAB) RETURN END INTEGER FUNCTION GETTOK(TOKEN, TOKSIZ) INTEGER EQUAL, OPEN, LENGTH INTEGER I, TOKSIZ, F, LEN INTEGER T INTEGER DEFTOK, NGETCH INTEGER GETCH INTEGER NAME(30), TOKEN(100) COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES COMMON /CFNAME/ FCNAME(30) INTEGER FCNAME INTEGER FNCN(9) INTEGER INCL(8) 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)/10002/ 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)/10002/ 23107 IF(.NOT.(LEVEL .GT. 0))GOTO 23109 F = INFILE(LEVEL) GETTOK = DEFTOK(TOKEN, TOKSIZ, F) 23110 IF(.NOT.(GETTOK .NE. 10003))GOTO 23112 IF(.NOT.(EQUAL(TOKEN, FNCN) .EQ. 1))GOTO 23113 CALL SKPBLK(INFILE(LEVEL)) T = DEFTOK(FCNAME, 30, F) CALL PBSTR(FCNAME) IF(.NOT.(T .NE. 10100))GOTO 23115 CALL SYNERR(22HMISSING FUNCTION NAME.) 23115 CONTINUE CALL PUTBAK(32) RETURN 23113 CONTINUE IF(.NOT.(EQUAL(TOKEN, INCL) .EQ. 0))GOTO 23117 RETURN 23117 CONTINUE 23114 CONTINUE CALL SKPBLK(INFILE(LEVEL)) T = DEFTOK(NAME, 30, INFILE(LEVEL)) IF(.NOT.(T .EQ. 39 .OR. T .EQ. 34))GOTO 23119 LEN = LENGTH(NAME) - 1 I=1 23121 IF(.NOT.(I .LT. LEN))GOTO 23123 NAME(I) = NAME(I+1) 23122 I=I+1 GOTO 23121 23123 CONTINUE NAME(I) = 10002 23119 CONTINUE I = LENGTH(NAME) + 1 IF(.NOT.(LEVEL .GE. 3))GOTO 23124 CALL SYNERR(27HINCLUDES NESTED TOO DEEPLY.) GOTO 23125 23124 CONTINUE INFILE(LEVEL+1) = OPEN(NAME, 1) LINECT(LEVEL+1) = 1 IF(.NOT.(INFILE(LEVEL+1) .EQ. 10001))GOTO 23126 CALL SYNERR(19HCAN'T OPEN INCLUDE.) GOTO 23127 23126 CONTINUE LEVEL = LEVEL + 1 IF(.NOT.(FNAMP + I .LE. 90))GOTO 23128 CALL SCOPY(NAME, 1, FNAMES, FNAMP) FNAMP = FNAMP + I 23128 CONTINUE F = INFILE(LEVEL) 23127 CONTINUE 23125 CONTINUE 23111 GETTOK = DEFTOK(TOKEN, TOKSIZ, F) GOTO 23110 23112 CONTINUE IF(.NOT.(LEVEL .GT. 1))GOTO 23130 CALL CLOSE(INFILE(LEVEL)) FNAMP = FNAMP - 1 23132 IF(.NOT.(FNAMP .GT. 1))GOTO 23134 IF(.NOT.(FNAMES(FNAMP-1) .EQ. 10002))GOTO 23135 GOTO 23134 23135 CONTINUE 23133 FNAMP = FNAMP - 1 GOTO 23132 23134 CONTINUE 23130 CONTINUE 23108 LEVEL = LEVEL - 1 GOTO 23107 23109 CONTINUE TOKEN(1) = 10003 TOKEN(2) = 10002 GETTOK = 10003 RETURN END INTEGER FUNCTION GNBTOK(TOKEN, TOKSIZ) INTEGER TOKSIZ INTEGER TOKEN(100), GETTOK COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES CALL SKPBLK(INFILE(LEVEL)) GNBTOK = GETTOK(TOKEN, TOKSIZ) RETURN END INTEGER FUNCTION GTOK(LEXSTR, TOKSIZ, FD) INTEGER NGETCH, TYPE INTEGER FD, I, B, N, TOKSIZ, ITOC INTEGER C, LEXSTR(100) COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES C = NGETCH(LEXSTR(1), FD) IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23137 LEXSTR(1) = 32 23139 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23140 C = NGETCH(C, FD) GOTO 23139 23140 CONTINUE IF(.NOT.(C .EQ. 35))GOTO 23141 23143 IF(.NOT.(NGETCH(C, FD) .NE. 10))GOTO 23144 GOTO 23143 23144 CONTINUE 23141 CONTINUE IF(.NOT.(C .NE. 10))GOTO 23145 CALL PUTBAK(C) GOTO 23146 23145 CONTINUE LEXSTR(1) = 10 23146 CONTINUE LEXSTR(2) = 10002 GTOK = LEXSTR(1) RETURN 23137 CONTINUE I = 1 GTOK = TYPE(C) IF(.NOT.(GTOK .EQ. 1))GOTO 23147 I = 1 23149 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23151 GTOK = TYPE(NGETCH(LEXSTR(I+1), FD)) IF(.NOT.(GTOK .NE. 1 .AND. GTOK .NE. 2 .AND. GTOK .NE. 95 .AND. GT *OK .NE. 46))GOTO 23152 GOTO 23151 23152 CONTINUE 23150 I = I + 1 GOTO 23149 23151 CONTINUE CALL PUTBAK(LEXSTR(I+1)) GTOK = 10100 GOTO 23148 23147 CONTINUE IF(.NOT.(GTOK .EQ. 2))GOTO 23154 B = C - 48 I = 1 23156 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23158 IF(.NOT.(TYPE(NGETCH(LEXSTR(I+1), FD)) .NE. 2))GOTO 23159 GOTO 23158 23159 CONTINUE B = 10*B + LEXSTR(I+1) - 48 23157 I = I + 1 GOTO 23156 23158 CONTINUE IF(.NOT.(LEXSTR(I+1) .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO *23161 N = 0 23163 CONTINUE C = NGETCH(LEXSTR(1), FD) IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23166 C = C - 97 + 57 + 1 GOTO 23167 23166 CONTINUE IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23168 C = C - 65 + 57 + 1 23168 CONTINUE 23167 CONTINUE IF(.NOT.(C .LT. 48 .OR. C .GE. 48 + B))GOTO 23170 GOTO 23165 23170 CONTINUE 23164 N = B*N + C - 48 GOTO 23163 23165 CONTINUE CALL PUTBAK(LEXSTR(1)) I = ITOC(N, LEXSTR, TOKSIZ) GOTO 23162 23161 CONTINUE CALL PUTBAK(LEXSTR(I+1)) 23162 CONTINUE GTOK = 2 GOTO 23155 23154 CONTINUE IF(.NOT.(C .EQ. 91))GOTO 23172 LEXSTR(1) = 123 GTOK = 123 GOTO 23173 23172 CONTINUE IF(.NOT.(C .EQ. 93))GOTO 23174 LEXSTR(1) = 125 GTOK = 125 GOTO 23175 23174 CONTINUE IF(.NOT.(C .EQ. 36))GOTO 23176 IF(.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40))GOTO 23178 I = 2 GTOK = 10279 GOTO 23179 23178 CONTINUE IF(.NOT.(LEXSTR(2) .EQ. 41))GOTO 23180 I = 2 GTOK = 10280 GOTO 23181 23180 CONTINUE CALL PUTBAK(LEXSTR(2)) 23181 CONTINUE 23179 CONTINUE GOTO 23177 23176 CONTINUE IF(.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23182 I = 2 23184 IF(.NOT.(NGETCH(LEXSTR(I), FD) .NE. LEXSTR(1)))GOTO 23186 IF(.NOT.(LEXSTR(I) .EQ. 95))GOTO 23187 IF(.NOT.(NGETCH(C, FD) .EQ. 10))GOTO 23189 23191 IF(.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23192 C = NGETCH(C, FD) GOTO 23191 23192 CONTINUE LEXSTR(I) = C GOTO 23190 23189 CONTINUE CALL PUTBAK(C) 23190 CONTINUE 23187 CONTINUE IF(.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ-1))GOTO 23193 CALL SYNERR(14HMISSING QUOTE.) LEXSTR(I) = LEXSTR(1) CALL PUTBAK(10) GOTO 23186 23193 CONTINUE 23185 I = I + 1 GOTO 23184 23186 CONTINUE GOTO 23183 23182 CONTINUE IF(.NOT.(C .EQ. 35))GOTO 23195 23197 IF(.NOT.(NGETCH(LEXSTR(1), FD) .NE. 10))GOTO 23198 GOTO 23197 23198 CONTINUE GTOK = 10 GOTO 23196 23195 CONTINUE IF(.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 33 .OR. C .EQ. 33 .O *R. C .EQ. 126 .OR. C .EQ. 94 .OR. C .EQ. 61 .OR. C .EQ. 38 .OR. C *.EQ. 124))GOTO 23199 CALL RELATE(LEXSTR, I, FD) 23199 CONTINUE 23196 CONTINUE 23183 CONTINUE 23177 CONTINUE 23175 CONTINUE 23173 CONTINUE 23155 CONTINUE 23148 CONTINUE IF(.NOT.(I .GE. TOKSIZ-1))GOTO 23201 CALL SYNERR(15HTOKEN TOO LONG.) 23201 CONTINUE LEXSTR(I+1) = 10002 RETURN END INTEGER FUNCTION LEX(LEXSTR) INTEGER GNBTOK, DEFTOK INTEGER LEXSTR(100) INTEGER EQUAL INTEGER SIF(3) INTEGER SELSE(5) INTEGER SWHILE(6) INTEGER SDO(3) INTEGER SBREAK(6) INTEGER SNEXT(5) INTEGER SFOR(4) INTEGER SREPT(7) INTEGER SUNTIL(6) INTEGER SRET(7) INTEGER SSTR(7) INTEGER SSWTCH(7) INTEGER SCASE(5) INTEGER SDEFLT(8) DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/10002/ DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE *(5)/10002/ DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S *WHILE(5)/101/,SWHILE(6)/10002/ DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/ DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR *EAK(5)/107/,SBREAK(6)/10002/ DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT *(5)/10002/ DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/10002/ DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT *(5)/97/,SREPT(6)/116/,SREPT(7)/10002/ DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S *UNTIL(5)/108/,SUNTIL(6)/10002/ DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1 *14/,SRET(6)/110/,SRET(7)/10002/ DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1 *10/,SSTR(6)/103/,SSTR(7)/10002/ DATA SSWTCH(1)/115/,SSWTCH(2)/119/,SSWTCH(3)/105/,SSWTCH(4)/116/,S *SWTCH(5)/99/,SSWTCH(6)/104/,SSWTCH(7)/10002/ DATA SCASE(1)/99/,SCASE(2)/97/,SCASE(3)/115/,SCASE(4)/101/,SCASE(5 *)/10002/ 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)/10002/ LEX = GNBTOK(LEXSTR, 100) 23203 IF(.NOT.(LEX .EQ. 10))GOTO 23205 23204 LEX = GNBTOK(LEXSTR, 100) GOTO 23203 23205 CONTINUE IF(.NOT.(LEX .EQ. 10003 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LE *X .EQ. 125))GOTO 23206 RETURN 23206 CONTINUE IF(.NOT.(LEX .EQ. 2))GOTO 23208 LEX = 10260 GOTO 23209 23208 CONTINUE IF(.NOT.(LEX .EQ. 37))GOTO 23210 LEX = 10278 GOTO 23211 23210 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1))GOTO 23212 LEX = 10261 GOTO 23213 23212 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1))GOTO 23214 LEX = 10262 GOTO 23215 23214 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1))GOTO 23216 LEX = 10263 GOTO 23217 23216 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1))GOTO 23218 LEX = 10266 GOTO 23219 23218 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1))GOTO 23220 LEX = 10264 GOTO 23221 23220 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1))GOTO 23222 LEX = 10265 GOTO 23223 23222 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1))GOTO 23224 LEX = 10268 GOTO 23225 23224 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1))GOTO 23226 LEX = 10269 GOTO 23227 23226 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1))GOTO 23228 LEX = 10270 GOTO 23229 23228 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SRET) .EQ. 1))GOTO 23230 LEX = 10271 GOTO 23231 23230 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SSTR) .EQ. 1))GOTO 23232 LEX = 10274 GOTO 23233 23232 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SSWTCH) .EQ. 1))GOTO 23234 LEX = 10275 GOTO 23235 23234 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SCASE) .EQ. 1))GOTO 23236 LEX = 10276 GOTO 23237 23236 CONTINUE IF(.NOT.(EQUAL(LEXSTR, SDEFLT) .EQ. 1))GOTO 23238 LEX = 10277 GOTO 23239 23238 CONTINUE LEX = 10267 23239 CONTINUE 23237 CONTINUE 23235 CONTINUE 23233 CONTINUE 23231 CONTINUE 23229 CONTINUE 23227 CONTINUE 23225 CONTINUE 23223 CONTINUE 23221 CONTINUE 23219 CONTINUE 23217 CONTINUE 23215 CONTINUE 23213 CONTINUE 23211 CONTINUE 23209 CONTINUE RETURN END INTEGER FUNCTION NGETCH(C, FD) INTEGER GETCH INTEGER C INTEGER FD COMMON /CDEFIO/ BP, BUF(300) INTEGER BP INTEGER BUF COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES IF(.NOT.(BP .GT. 0))GOTO 23240 C = BUF(BP) BP = BP - 1 GOTO 23241 23240 CONTINUE C = GETCH(C, FD) IF(.NOT.(RATLST .EQ. 1))GOTO 23242 CALL PUTCH(C, 3) 23242 CONTINUE 23241 CONTINUE NGETCH = C IF(.NOT.(C .EQ. 10))GOTO 23244 LINECT(LEVEL) = LINECT(LEVEL) + 1 23244 CONTINUE RETURN END SUBROUTINE PBSTR(IN) INTEGER IN(100) INTEGER LENGTH INTEGER I I = LENGTH(IN) 23246 IF(.NOT.(I .GT. 0))GOTO 23248 CALL PUTBAK(IN(I)) 23247 I = I - 1 GOTO 23246 23248 CONTINUE RETURN END SUBROUTINE PUTBAK(C) INTEGER C COMMON /CDEFIO/ BP, BUF(300) INTEGER BP INTEGER BUF COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES BP = BP + 1 IF(.NOT.(BP .GT. 300))GOTO 23249 CALL BADERR(32HTOO MANY CHARACTERS PUSHED BACK.) 23249 CONTINUE BUF(BP) = C IF(.NOT.(C .EQ. 10))GOTO 23251 LINECT(LEVEL) = LINECT(LEVEL) - 1 23251 CONTINUE RETURN END SUBROUTINE RELATE(TOKEN, LAST, FD) INTEGER NGETCH INTEGER TOKEN(100) INTEGER LENGTH INTEGER FD, LAST IF(.NOT.(NGETCH(TOKEN(2), FD) .NE. 61))GOTO 23253 CALL PUTBAK(TOKEN(2)) TOKEN(3) = 116 GOTO 23254 23253 CONTINUE TOKEN(3) = 101 23254 CONTINUE TOKEN(4) = 46 TOKEN(5) = 10002 TOKEN(6) = 10002 IF(.NOT.(TOKEN(1) .EQ. 62))GOTO 23255 TOKEN(2) = 103 GOTO 23256 23255 CONTINUE IF(.NOT.(TOKEN(1) .EQ. 60))GOTO 23257 TOKEN(2) = 108 GOTO 23258 23257 CONTINUE IF(.NOT.(TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ. * 94 .OR. TOKEN(1) .EQ. 126))GOTO 23259 IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23261 TOKEN(3) = 111 TOKEN(4) = 116 TOKEN(5) = 46 23261 CONTINUE TOKEN(2) = 110 GOTO 23260 23259 CONTINUE IF(.NOT.(TOKEN(1) .EQ. 61))GOTO 23263 IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23265 TOKEN(2) = 10002 LAST = 1 RETURN 23265 CONTINUE TOKEN(2) = 101 TOKEN(3) = 113 GOTO 23264 23263 CONTINUE IF(.NOT.(TOKEN(1) .EQ. 38))GOTO 23267 TOKEN(2) = 97 TOKEN(3) = 110 TOKEN(4) = 100 TOKEN(5) = 46 GOTO 23268 23267 CONTINUE IF(.NOT.(TOKEN(1) .EQ. 124))GOTO 23269 TOKEN(2) = 111 TOKEN(3) = 114 GOTO 23270 23269 CONTINUE TOKEN(2) = 10002 23270 CONTINUE 23268 CONTINUE 23264 CONTINUE 23260 CONTINUE 23258 CONTINUE 23256 CONTINUE TOKEN(1) = 46 LAST = LENGTH(TOKEN) RETURN END SUBROUTINE LITRAL INTEGER NGETCH COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES IF(.NOT.(OUTP .GT. 0))GOTO 23271 CALL OUTDON 23271 CONTINUE OUTP = 1 23273 IF(.NOT.(NGETCH(OUTBUF(OUTP), INFILE(LEVEL)) .NE. 10))GOTO 23275 23274 OUTP = OUTP + 1 GOTO 23273 23275 CONTINUE OUTP = OUTP - 1 CALL OUTDON RETURN END INTEGER FUNCTION DEFTOK(TOKEN, TOKSIZ, FD) INTEGER TOKEN(100) INTEGER TOKSIZ, FD INTEGER GTOK INTEGER LOOKUP, PUSH, IFPARM INTEGER T, C, DEFN(2500), BALP(3), MDEFN(2500) INTEGER AP, ARGSTK(100), CALLST(50), NLB, PLEV(50), IFL COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST DATA BALP/40, 41, 10002/ CP = 0 AP = 1 EP = 1 T=GTOK(TOKEN,TOKSIZ,FD) 23276 IF(.NOT.(T .NE. 10003))GOTO 23278 IF(.NOT.(T .EQ. 10100))GOTO 23279 IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23281 IF(.NOT.(CP .EQ. 0))GOTO 23283 GOTO 23278 23283 CONTINUE CALL PUTTOK(TOKEN) 23284 CONTINUE GOTO 23282 23281 CONTINUE IF(.NOT.(DEFN(1) .EQ. 10010))GOTO 23285 CALL GETDEF(TOKEN, TOKSIZ, DEFN, 2500, FD) CALL INSTAL(TOKEN, DEFN) GOTO 23286 23285 CONTINUE IF(.NOT.(DEFN(1) .EQ. 215 .OR. DEFN(1) .EQ. 216))GOTO 23287 C = DEFN(1) CALL GETDEF(TOKEN, TOKSIZ, DEFN, 2500, FD) IFL = LOOKUP(TOKEN, MDEFN) IF(.NOT.((IFL .EQ. 1 .AND. C .EQ. 215) .OR. (IFL .EQ. 0 .AND. C .E *Q. 216)))GOTO 23289 CALL PBSTR(DEFN) 23289 CONTINUE GOTO 23288 23287 CONTINUE CP = CP + 1 IF(.NOT.(CP .GT. 50))GOTO 23291 CALL BADERR(20HCALL STACK OVERFLOW.) 23291 CONTINUE CALLST(CP) = AP AP = PUSH(EP, ARGSTK, AP) CALL PUTTOK(DEFN) CALL PUTCHR(10002) AP = PUSH(EP, ARGSTK, AP) CALL PUTTOK(TOKEN) CALL PUTCHR(10002) AP = PUSH(EP, ARGSTK, AP) T = GTOK(TOKEN, TOKSIZ, FD) CALL PBSTR(TOKEN) IF(.NOT.(T .NE. 40))GOTO 23293 CALL PBSTR(BALP) GOTO 23294 23293 CONTINUE IF(.NOT.(IFPARM(DEFN) .EQ. 0))GOTO 23295 CALL PBSTR(BALP) 23295 CONTINUE 23294 CONTINUE PLEV(CP) = 0 23288 CONTINUE 23286 CONTINUE 23282 CONTINUE GOTO 23280 23279 CONTINUE IF(.NOT.(T .EQ. 10279))GOTO 23297 NLB = 1 23299 CONTINUE T = GTOK(TOKEN, TOKSIZ, FD) IF(.NOT.(T .EQ. 10279))GOTO 23302 NLB = NLB + 1 GOTO 23303 23302 CONTINUE IF(.NOT.(T .EQ. 10280))GOTO 23304 NLB = NLB - 1 IF(.NOT.(NLB .EQ. 0))GOTO 23306 GOTO 23301 23306 CONTINUE GOTO 23305 23304 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23308 CALL BADERR(14HEOF IN STRING.) 23308 CONTINUE 23305 CONTINUE 23303 CONTINUE CALL PUTTOK(TOKEN) 23300 GOTO 23299 23301 CONTINUE GOTO 23298 23297 CONTINUE IF(.NOT.(CP .EQ. 0))GOTO 23310 GOTO 23278 23310 CONTINUE IF(.NOT.(T .EQ. 40))GOTO 23312 IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23314 CALL PUTTOK(TOKEN) 23314 CONTINUE PLEV(CP) = PLEV(CP) + 1 GOTO 23313 23312 CONTINUE IF(.NOT.(T .EQ. 41))GOTO 23316 PLEV(CP) = PLEV(CP) - 1 IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23318 CALL PUTTOK(TOKEN) GOTO 23319 23318 CONTINUE CALL PUTCHR(10002) CALL EVALR(ARGSTK, CALLST(CP), AP-1) AP = CALLST(CP) EP = ARGSTK(AP) CP = CP - 1 23319 CONTINUE GOTO 23317 23316 CONTINUE IF(.NOT.(T .EQ. 44 .AND. PLEV(CP) .EQ. 1))GOTO 23320 CALL PUTCHR(10002) AP = PUSH(EP, ARGSTK, AP) GOTO 23321 23320 CONTINUE CALL PUTTOK(TOKEN) 23321 CONTINUE 23317 CONTINUE 23313 CONTINUE 23311 CONTINUE 23298 CONTINUE 23280 CONTINUE 23277 T=GTOK(TOKEN,TOKSIZ,FD) GOTO 23276 23278 CONTINUE DEFTOK = T IF(.NOT.(T .EQ. 10100))GOTO 23322 CALL FOLD(TOKEN) 23322 CONTINUE   RETURN END SUBROUTINE DOARTH(ARGSTK,I,J) INTEGER CTOI INTEGER ARGSTK(100), I, J, K, L INTEGER OP COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST K = ARGSTK(I+2) L = ARGSTK(I+4) OP = EVALST(ARGSTK(I+3)) IF(.NOT.(OP .EQ. 43))GOTO 23324 CALL PBNUM(CTOI(EVALST,K)+CTOI(EVALST,L)) GOTO 23325 23324 CONTINUE IF(.NOT.(OP .EQ. 45))GOTO 23326 CALL PBNUM(CTOI(EVALST,K)-CTOI(EVALST,L)) GOTO 23327 23326 CONTINUE IF(.NOT.(OP .EQ. 42 ))GOTO 23328 CALL PBNUM(CTOI(EVALST,K)*CTOI(EVALST,L)) GOTO 23329 23328 CONTINUE IF(.NOT.(OP .EQ. 47 ))GOTO 23330 CALL PBNUM(CTOI(EVALST,K)/CTOI(EVALST,L)) GOTO 23331 23330 CONTINUE CALL REMARK(11HARITH ERROR) 23331 CONTINUE 23329 CONTINUE 23327 CONTINUE 23325 CONTINUE RETURN END SUBROUTINE DOIF(ARGSTK, I, J) INTEGER EQUAL INTEGER A2, A3, A4, A5, ARGSTK(100), I, J COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST IF(.NOT.(J - I .LT. 5))GOTO 23332 RETURN 23332 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 23334 CALL PBSTR(EVALST(A4)) GOTO 23335 23334 CONTINUE CALL PBSTR(EVALST(A5)) 23335 CONTINUE RETURN END SUBROUTINE DOINCR(ARGSTK, I, J) INTEGER CTOI INTEGER ARGSTK(100), I, J, K COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST K = ARGSTK(I+2) CALL PBNUM(CTOI(EVALST, K)+1) RETURN END SUBROUTINE DOSUB(ARGSTK, I, J) INTEGER CTOI, LENGTH INTEGER AP, ARGSTK(100), FC, I, J, K, NC COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST IF(.NOT.(J - I .LT. 3))GOTO 23336 RETURN 23336 CONTINUE IF(.NOT.(J - I .LT. 4))GOTO 23338 NC = 100 GOTO 23339 23338 CONTINUE K = ARGSTK(I+4) NC = CTOI(EVALST, K) 23339 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 23 *340 K = FC + MIN0(NC, LENGTH(EVALST(FC))) - 1 23342 IF(.NOT.(K .GE. FC))GOTO 23344 CALL PUTBAK(EVALST(K)) 23343 K = K - 1 GOTO 23342 23344 CONTINUE 23340 CONTINUE RETURN END SUBROUTINE EVALR(ARGSTK, I, J) INTEGER INDEX, LENGTH INTEGER ARGNO, ARGSTK(100), I, J, K, M, N, T, TD COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST INTEGER DIGITS(11) DATA DIGITS(1) /48/ DATA DIGITS(2) /49/ DATA DIGITS(3) /50/ DATA DIGITS(4) /51/ DATA DIGITS(5) /52/ DATA DIGITS(6) /53/ DATA DIGITS(7) /54/ DATA DIGITS(8) /55/ DATA DIGITS(9) /56/ DATA DIGITS(10) /57/ DATA DIGITS(11) /10002/ T = ARGSTK(I) TD = EVALST(T) IF(.NOT.(TD .EQ. 210))GOTO 23345 CALL DOMAC(ARGSTK, I, J) GOTO 23346 23345 CONTINUE IF(.NOT.(TD .EQ. 212))GOTO 23347 CALL DOINCR(ARGSTK, I, J) GOTO 23348 23347 CONTINUE IF(.NOT.(TD .EQ. 213))GOTO 23349 CALL DOSUB(ARGSTK, I, J) GOTO 23350 23349 CONTINUE IF(.NOT.(TD .EQ. 211))GOTO 23351 CALL DOIF(ARGSTK, I, J) GOTO 23352 23351 CONTINUE IF(.NOT.(TD .EQ. 214))GOTO 23353 CALL DOARTH(ARGSTK, I, J) GOTO 23354 23353 CONTINUE K = T+LENGTH(EVALST(T))-1 23355 IF(.NOT.(K .GT. T))GOTO 23357 IF(.NOT.(EVALST(K-1) .NE. 36))GOTO 23358 CALL PUTBAK(EVALST(K)) GOTO 23359 23358 CONTINUE ARGNO = INDEX(DIGITS, EVALST(K)) - 1 IF(.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J-I))GOTO 23360 N = I + ARGNO + 1 M = ARGSTK(N) CALL PBSTR(EVALST(M)) 23360 CONTINUE K = K - 1 23359 CONTINUE 23356 K = K - 1 GOTO 23355 23357 CONTINUE IF(.NOT.(K .EQ. T))GOTO 23362 CALL PUTBAK(EVALST(K)) 23362 CONTINUE 23354 CONTINUE 23352 CONTINUE 23350 CONTINUE 23348 CONTINUE 23346 CONTINUE RETURN END INTEGER FUNCTION IFPARM(STRNG) INTEGER STRNG(100), C INTEGER I, INDEX, TYPE C = STRNG(1) IF(.NOT.(C .EQ. 212 .OR. C .EQ. 213 .OR. C .EQ. 211 .OR. C .EQ. 21 *4 .OR. C .EQ. 210))GOTO 23364 IFPARM = 1 GOTO 23365 23364 CONTINUE IFPARM = 0 I=1 23366 IF(.NOT.(INDEX(STRNG(I), 36) .GT. 0))GOTO 23368 I = I + INDEX(STRNG(I), 36) IF(.NOT.(TYPE(STRNG(I)) .EQ. 2))GOTO 23369 IF(.NOT.(TYPE(STRNG(I+1)) .NE. 2))GOTO 23371 IFPARM = 1 GOTO 23368 23371 CONTINUE 23369 CONTINUE 23367 GOTO 23366 23368 CONTINUE 23365 CONTINUE RETURN END SUBROUTINE PBNUM(N) INTEGER MOD INTEGER M, N, NUM INTEGER DIGITS(11) DATA DIGITS(1) /48/ DATA DIGITS(2) /49/ DATA DIGITS(3) /50/ DATA DIGITS(4) /51/ DATA DIGITS(5) /52/ DATA DIGITS(6) /53/ DATA DIGITS(7) /54/ DATA DIGITS(8) /55/ DATA DIGITS(9) /56/ DATA DIGITS(10) /57/ DATA DIGITS(11) /10002/ NUM = N 23373 CONTINUE M = MOD(NUM, 10) CALL PUTBAK(DIGITS(M+1)) NUM = NUM / 10 23374 IF(.NOT.(NUM .EQ. 0))GOTO 23373 23375 CONTINUE RETURN END INTEGER FUNCTION PUSH(EP, ARGSTK, AP) INTEGER AP, ARGSTK(100), EP IF(.NOT.(AP .GT. 100))GOTO 23376 CALL BADERR(19HARG STACK OVERFLOW.) 23376 CONTINUE ARGSTK(AP) = EP PUSH = AP + 1 RETURN END SUBROUTINE PUTCHR(C) INTEGER C COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST IF(.NOT.(EP .GT. 500))GOTO 23378 CALL BADERR(26HEVALUATION STACK OVERFLOW.) 23378 CONTINUE EVALST(EP) = C EP = EP + 1 RETURN END SUBROUTINE PUTTOK(STR) INTEGER STR(100) INTEGER I I = 1 23380 IF(.NOT.(STR(I) .NE. 10002))GOTO 23382 CALL PUTCHR(STR(I)) 23381 I = I + 1 GOTO 23380 23382 CONTINUE RETURN END SUBROUTINE DOMAC(ARGSTK, I, J) INTEGER A2, A3, ARGSTK(100), I, J COMMON /CMACRO/ CP, EP, EVALST(500) INTEGER CP INTEGER EP INTEGER EVALST IF(.NOT.(J - I .GT. 2))GOTO 23383 A2 = ARGSTK(I+2) A3 = ARGSTK(I+3) CALL INSTAL(EVALST(A2), EVALST(A3)) 23383 CONTINUE RETURN END SUBROUTINE RAT4 INTEGER GETARG, OPEN INTEGER BUF(30) INTEGER I, N COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES INTEGER DEFNS(1) DATA DEFNS(1)/10002/ CALL INITKW IF(.NOT.(DEFNS(1) .NE. 10002))GOTO 23385 CALL SCOPY(DEFNS, 1, BUF, 1) INFILE(1) = OPEN(BUF, 1) IF(.NOT.(INFILE(1) .EQ. 10001))GOTO 23387 CALL REMARK (37HCAN'T OPEN STANDARD DEFINITIONS FILE.) GOTO 23388 23387 CONTINUE CALL PARSE CALL CLOSE (INFILE(1)) 23388 CONTINUE 23385 CONTINUE N = 1 I=1 23389 IF(.NOT.(GETARG(I, BUF, 30) .NE. 10003))GOTO 23391 N = N + 1 IF(.NOT.(BUF(1) .EQ. 63 .AND. BUF(2) .EQ. 10002))GOTO 23392 CALL ERROR (38HUSAGE: RAT4 [-L] [FILE ...] >OUTFILE.) GOTO 23393 23392 CONTINUE IF(.NOT.(BUF(1) .EQ. 45 .AND. BUF(2) .EQ. 10002))GOTO 23394 INFILE(1) = 1 GOTO 23395 23394 CONTINUE IF(.NOT.(BUF(1) .EQ. 45 .AND. (BUF(2) .EQ. 108 .OR. BUF(2) .EQ. 76 *)))GOTO 23396 RATLST = 1 N = N - 1 GOTO 23397 23396 CONTINUE INFILE(1) = OPEN(BUF, 1) IF(.NOT.(INFILE(1) .EQ. 10001))GOTO 23398 CALL CANT(BUF) 23398 CONTINUE 23397 CONTINUE 23395 CONTINUE 23393 CONTINUE CALL PARSE IF(.NOT.(INFILE(1) .NE. 1))GOTO 23400 CALL CLOSE(INFILE(1)) 23400 CONTINUE 23390 I=I+1 GOTO 23389 23391 CONTINUE IF(.NOT.(N .EQ. 1))GOTO 23402 INFILE(1) = 1 CALL PARSE 23402 CONTINUE RETURN END SUBROUTINE EATUP INTEGER GETTOK INTEGER PTOKEN(100), T, TOKEN(100) INTEGER NLPAR NLPAR = 0 23404 CONTINUE T = GETTOK(TOKEN, 100) IF(.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23407 GOTO 23406 23407 CONTINUE IF(.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23409 CALL PBSTR(TOKEN) GOTO 23406 23409 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23411 CALL SYNERR(15HUNEXPECTED EOF.) CALL PBSTR(TOKEN) GOTO 23406 23411 CONTINUE IF(.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 .O *R. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T *.EQ. 126 .OR. T .EQ. 33 .OR. T .EQ. 94 .OR. T .EQ. 61 .OR. T .EQ. *95))GOTO 23413 23415 IF(.NOT.(GETTOK(PTOKEN, 100) .EQ. 10))GOTO 23416 GOTO 23415 23416 CONTINUE CALL PBSTR(PTOKEN) IF(.NOT.(T .EQ. 95))GOTO 23417 TOKEN(1) = 10002 23417 CONTINUE 23413 CONTINUE IF(.NOT.(T .EQ. 40))GOTO 23419 NLPAR = NLPAR + 1 GOTO 23420 23419 CONTINUE IF(.NOT.(T .EQ. 41))GOTO 23421 NLPAR = NLPAR - 1 23421 CONTINUE 23420 CONTINUE CALL OUTSTR(TOKEN) 23405 IF(.NOT.(NLPAR .LT. 0))GOTO 23404 23406 CONTINUE IF(.NOT.(NLPAR .NE. 0))GOTO 23423 CALL SYNERR(23HUNBALANCED PARENTHESES.) 23423 CONTINUE RETURN END SUBROUTINE LABELC(LEXSTR) INTEGER LEXSTR(100) INTEGER LENGTH COMMON /CGOTO/ XFER INTEGER XFER XFER = 0 IF(.NOT.(LENGTH(LEXSTR) .EQ. 5))GOTO 23425 IF(.NOT.(LEXSTR(1) .EQ. 50 .AND. LEXSTR(2) .EQ. 51))GOTO 23427 CALL SYNERR(33HWARNING: POSSIBLE LABEL CONFLICT.) 23427 CONTINUE 23425 CONTINUE CALL OUTSTR(LEXSTR) CALL OUTTAB RETURN END SUBROUTINE OTHERC(LEXSTR) INTEGER LEXSTR(100) COMMON /CGOTO/ XFER INTEGER XFER XFER = 0 CALL OUTTAB CALL OUTSTR(LEXSTR) CALL EATUP CALL OUTDON RETURN END SUBROUTINE OUTCH(C) INTEGER C INTEGER I COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF IF(.NOT.(OUTP .GE. 72))GOTO 23429 CALL OUTDON I = 1 23431 IF(.NOT.(I .LT. 6))GOTO 23433 OUTBUF(I) = 32 23432 I = I + 1 GOTO 23431 23433 CONTINUE OUTBUF(6) = 42 OUTP = 6 23429 CONTINUE OUTP = OUTP + 1 OUTBUF(OUTP) = C RETURN END SUBROUTINE OUTCON(N) INTEGER N COMMON /CGOTO/ XFER INTEGER XFER COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF INTEGER CONTIN(9) 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 *)/10002/ XFER = 0 IF(.NOT.(N .LE. 0 .AND. OUTP .EQ. 0))GOTO 23434 RETURN 23434 CONTINUE IF(.NOT.(N .GT. 0))GOTO 23436 CALL OUTNUM(N) 23436 CONTINUE CALL OUTTAB CALL OUTSTR(CONTIN) CALL OUTDON RETURN END SUBROUTINE OUTDON INTEGER ALLBLK COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF OUTBUF(OUTP+1) = 10 OUTBUF(OUTP+2) = 10002 IF(.NOT.(ALLBLK(OUTBUF) .EQ. 0))GOTO 23438 CALL PUTLIN(OUTBUF, 2) 23438 CONTINUE OUTP = 0 RETURN END SUBROUTINE OUTGO(N) INTEGER N COMMON /CGOTO/ XFER INTEGER XFER INTEGER GOTO(6) DATA GOTO(1)/103/,GOTO(2)/111/,GOTO(3)/116/,GOTO(4)/111/,GOTO(5)/3 *2/,GOTO(6)/10002/ IF(.NOT.(XFER .EQ. 1))GOTO 23440 RETURN 23440 CONTINUE CALL OUTTAB CALL OUTSTR(GOTO) CALL OUTNUM(N) CALL OUTDON RETURN END SUBROUTINE OUTNUM(N) INTEGER CHARS(20) INTEGER I, M M = IABS(N) I = 0 23442 CONTINUE I = I + 1 CHARS(I) = MOD(M, 10) + 48 M = M / 10 23443 IF(.NOT.(M .EQ. 0 .OR. I .GE. 20))GOTO 23442 23444 CONTINUE IF(.NOT.(N .LT. 0))GOTO 23445 CALL OUTCH(45) 23445 CONTINUE 23447 IF(.NOT.(I .GT. 0))GOTO 23449 CALL OUTCH(CHARS(I)) 23448 I = I - 1 GOTO 23447 23449 CONTINUE RETURN END SUBROUTINE OUTSTR(STR) INTEGER C, STR(100) INTEGER I, J I = 1 23450 IF(.NOT.(STR(I) .NE. 10002))GOTO 23452 C = STR(I) IF(.NOT.(C .NE. 39 .AND. C .NE. 34))GOTO 23453 IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23455 C = C - 97 + 65 23455 CONTINUE CALL OUTCH(C) GOTO 23454 23453 CONTINUE I = I + 1 J = I 23457 IF(.NOT.(STR(J) .NE. C))GOTO 23459 23458 J = J + 1 GOTO 23457 23459 CONTINUE CALL OUTNUM(J-I) CALL OUTCH(72) 23460 IF(.NOT.(I .LT. J))GOTO 23462 CALL OUTCH(STR(I)) 23461 I = I + 1 GOTO 23460 23462 CONTINUE 23454 CONTINUE 23451 I = I + 1 GOTO 23450 23452 CONTINUE RETURN END SUBROUTINE OUTTAB COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF 23463 IF(.NOT.(OUTP .LT. 6))GOTO 23464 CALL OUTCH(32) GOTO 23463 23464 CONTINUE RETURN END INTEGER FUNCTION ALLBLK(BUF) INTEGER BUF(100) INTEGER I ALLBLK = 1 I=1 23465 IF(.NOT.(BUF(I) .NE. 10 .AND. BUF(I) .NE. 10002))GOTO 23467 IF(.NOT.(BUF(I) .NE. 32))GOTO 23468 ALLBLK = 0 GOTO 23467 23468 CONTINUE 23466 I=I+1 GOTO 23465 23467 CONTINUE RETURN END SUBROUTINE INITKW INTEGER DEFT(2), INCT(2), SUBT(2), IFT(2), ART(2), IFDFT(2), IFNDT *(2), MACT(2) COMMON /CLABEL/ LABEL INTEGER LABEL COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES INTEGER DEFNAM(7) INTEGER MACNAM(8) INTEGER INCNAM(5) INTEGER SUBNAM(7) INTEGER IFNAM(7) INTEGER ARNAM(6) INTEGER IFDFNM(6) INTEGER IFNDNM(9) DATA DEFNAM(1)/100/,DEFNAM(2)/101/,DEFNAM(3)/102/,DEFNAM(4)/105/,D *EFNAM(5)/110/,DEFNAM(6)/101/,DEFNAM(7)/10002/ 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)/10002/ DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/,IN *CNAM(5)/10002/ DATA SUBNAM(1)/115/,SUBNAM(2)/117/,SUBNAM(3)/98/,SUBNAM(4)/115/,SU *BNAM(5)/116/,SUBNAM(6)/114/,SUBNAM(7)/10002/ DATA IFNAM(1)/105/,IFNAM(2)/102/,IFNAM(3)/101/,IFNAM(4)/108/,IFNAM *(5)/115/,IFNAM(6)/101/,IFNAM(7)/10002/ DATA ARNAM(1)/97/,ARNAM(2)/114/,ARNAM(3)/105/,ARNAM(4)/116/,ARNAM( *5)/104/,ARNAM(6)/10002/ DATA IFDFNM(1)/105/,IFDFNM(2)/102/,IFDFNM(3)/100/,IFDFNM(4)/101/,I *FDFNM(5)/102/,IFDFNM(6)/10002/ DATA IFNDNM(1)/105/,IFNDNM(2)/102/,IFNDNM(3)/110/,IFNDNM(4)/111/,I *FNDNM(5)/116/,IFNDNM(6)/100/,IFNDNM(7)/101/,IFNDNM(8)/102/,IFNDNM( *9)/10002/ DATA DEFT(1), DEFT(2) /10010, 10002/ DATA MACT(1), MACT(2) /210, 10002/ DATA INCT(1), INCT(2) /212, 10002/ DATA SUBT(1), SUBT(2) /213, 10002/ DATA IFT(1), IFT(2) /211, 10002/ DATA ART(1), ART(2) /214, 10002/ DATA IFDFT(1), IFDFT(2) /215, 10002/ DATA IFNDT(1), IFNDT(2) /216, 10002/ CALL TBINIT CALL ULSTAL(DEFNAM, DEFT) CALL ULSTAL(MACNAM, MACT) CALL ULSTAL(INCNAM, INCT) CALL ULSTAL(SUBNAM, SUBT) CALL ULSTAL(IFNAM, IFT) CALL ULSTAL(ARNAM, ART) CALL ULSTAL(IFDFNM, IFDFT) CALL ULSTAL(IFNDNM, IFNDT) LABEL = 23000 RATLST = 0 RETURN END SUBROUTINE INIT INTEGER I COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES COMMON /CDEFIO/ BP, BUF(300) INTEGER BP INTEGER BUF COMMON /CFOR/ FORDEP, FORSTK(200) INTEGER FORDEP INTEGER FORSTK COMMON /CFNAME/ FCNAME(30) INTEGER FCNAME COMMON /CLABEL/ LABEL INTEGER LABEL COMMON /CSBUF/ SBP, SBUF(500) INTEGER SBP INTEGER SBUF COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000) INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK OUTP = 0 LEVEL = 1 LINECT(1) = 1 SBP = 1 FNAMP = 2 FNAMES(1) = 10002 BP = 0 FORDEP = 0 FCNAME(1) = 10002 SWTOP = 0 SWLAST = 1 RETURN END SUBROUTINE PARSE INTEGER LEXSTR(100) INTEGER LEX INTEGER LAB, LABVAL(100), LEXTYP(100), SP, TOKEN, I COMMON /CGOTO/ XFER INTEGER XFER COMMON /CFOR/ FORDEP, FORSTK(200) INTEGER FORDEP INTEGER FORSTK COMMON /CFNAME/ FCNAME(30) INTEGER FCNAME COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES( * 90) INTEGER RATLST INTEGER LEVEL INTEGER LINECT INTEGER INFILE INTEGER FNAMP INTEGER FNAMES COMMON /CSBUF/ SBP, SBUF(500) INTEGER SBP INTEGER SBUF COMMON /CLABEL/ LABEL INTEGER LABEL COMMON /CDEFIO/ BP, BUF(300) INTEGER BP INTEGER BUF COMMON /COUTLN/ OUTP, OUTBUF(74) INTEGER OUTP INTEGER OUTBUF CALL INIT SP = 1 LEXTYP(1) = 10003 TOKEN = LEX(LEXSTR) 23470 IF(.NOT.(TOKEN .NE. 10003))GOTO 23472 IF(.NOT.(TOKEN .EQ. 10261))GOTO 23473 CALL IFCODE(LAB) GOTO 23474 23473 CONTINUE IF(.NOT.(TOKEN .EQ. 10266))GOTO 23475 CALL DOCODE(LAB) GOTO 23476 23475 CONTINUE IF(.NOT.(TOKEN .EQ. 10263))GOTO 23477 CALL WHILEC(LAB) GOTO 23478 23477 CONTINUE IF(.NOT.(TOKEN .EQ. 10268))GOTO 23479 CALL FORCOD(LAB) GOTO 23480 23479 CONTINUE IF(.NOT.(TOKEN .EQ. 10269))GOTO 23481 CALL REPCOD(LAB) GOTO 23482 23481 CONTINUE IF(.NOT.(TOKEN .EQ. 10275))GOTO 23483 CALL SWCODE(LAB) GOTO 23484 23483 CONTINUE IF(.NOT.(TOKEN .EQ. 10276 .OR. TOKEN .EQ. 10277))GOTO 23485 I = SP 23487 IF(.NOT.(I .GT. 0))GOTO 23489 IF(.NOT.(LEXTYP(I) .EQ. 10275))GOTO 23490 GOTO 23489 23490 CONTINUE 23488 I = I - 1 GOTO 23487 23489 CONTINUE IF(.NOT.(I .EQ. 0))GOTO 23492 CALL SYNERR(24HILLEGAL CASE OR DEFAULT.) GOTO 23493 23492 CONTINUE CALL CASCOD(LABVAL(I), TOKEN) 23493 CONTINUE GOTO 23486 23485 CONTINUE IF(.NOT.(TOKEN .EQ. 10260))GOTO 23494 CALL LABELC(LEXSTR) GOTO 23495 23494 CONTINUE IF(.NOT.(TOKEN .EQ. 10262))GOTO 23496 IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23498 CALL ELSEIF(LABVAL(SP)) GOTO 23499 23498 CONTINUE CALL SYNERR(13HILLEGAL ELSE.) 23499 CONTINUE GOTO 23497 23496 CONTINUE IF(.NOT.(TOKEN .EQ. 10278))GOTO 23500 CALL LITRAL 23500 CONTINUE 23497 CONTINUE 23495 CONTINUE 23486 CONTINUE 23484 CONTINUE 23482 CONTINUE 23480 CONTINUE 23478 CONTINUE 23476 CONTINUE 23474 CONTINUE IF(.NOT.(TOKEN .EQ. 10261 .OR. TOKEN .EQ. 10262 .OR. TOKEN .EQ. 10 *263 .OR. TOKEN .EQ. 10268 .OR. TOKEN .EQ. 10269 .OR. TOKEN .EQ. 10 *275 .OR. TOKEN .EQ. 10266 .OR. TOKEN .EQ. 10260 .OR. TOKEN .EQ. 12 *3))GOTO 23502 SP = SP + 1 IF(.NOT.(SP .GT. 100))GOTO 23504 CALL BADERR(25HSTACK OVERFLOW IN PARSER.) 23504 CONTINUE LEXTYP(SP) = TOKEN LABVAL(SP) = LAB GOTO 23503 23502 CONTINUE IF(.NOT.(TOKEN .NE. 10276 .AND. TOKEN .NE. 10277))GOTO 23506 IF(.NOT.(TOKEN .EQ. 125))GOTO 23508 IF(.NOT.(LEXTYP(SP) .EQ. 123))GOTO 23510 SP = SP - 1 GOTO 23511 23510 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10275))GOTO 23512 CALL SWEND(LABVAL(SP)) SP = SP - 1 GOTO 23513 23512 CONTINUE CALL SYNERR(20HILLEGAL RIGHT BRACE.) 23513 CONTINUE 23511 CONTINUE GOTO 23509 23508 CONTINUE IF(.NOT.(TOKEN .EQ. 10267))GOTO 23514 CALL OTHERC(LEXSTR) GOTO 23515 23514 CONTINUE IF(.NOT.(TOKEN .EQ. 10264 .OR. TOKEN .EQ. 10265))GOTO 23516 CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN) GOTO 23517 23516 CONTINUE IF(.NOT.(TOKEN .EQ. 10271))GOTO 23518 CALL RETCOD GOTO 23519 23518 CONTINUE IF(.NOT.(TOKEN .EQ. 10274))GOTO 23520 CALL STRDCL 23520 CONTINUE 23519 CONTINUE 23517 CONTINUE 23515 CONTINUE 23509 CONTINUE TOKEN = LEX(LEXSTR) CALL PBSTR(LEXSTR) CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN) 23506 CONTINUE 23503 CONTINUE 23471 TOKEN = LEX(LEXSTR) GOTO 23470 23472 CONTINUE IF(.NOT.(SP .NE. 1))GOTO 23522 CALL SYNERR(15HUNEXPECTED EOF.) 23522 CONTINUE RETURN END SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN 23524 IF(.NOT.(SP .GT. 1))GOTO 23526 IF(.NOT.(LEXTYP(SP) .EQ. 123 .OR. LEXTYP(SP) .EQ. 10275))GOTO 2352 *7 GOTO 23526 23527 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10261 .AND. TOKEN .EQ. 10262))GOTO 23529 GOTO 23526 23529 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23531 CALL OUTCON(LABVAL(SP)) GOTO 23532 23531 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10262))GOTO 23533 IF(.NOT.(SP .GT. 2))GOTO 23535 SP = SP - 1 23535 CONTINUE CALL OUTCON(LABVAL(SP)+1) GOTO 23534 23533 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10266))GOTO 23537 CALL DOSTAT(LABVAL(SP)) GOTO 23538 23537 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10263))GOTO 23539 CALL WHILES(LABVAL(SP)) GOTO 23540 23539 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10268))GOTO 23541 CALL FORS(LABVAL(SP)) GOTO 23542 23541 CONTINUE IF(.NOT.(LEXTYP(SP) .EQ. 10269))GOTO 23543 CALL UNTILS(LABVAL(SP), TOKEN) 23543 CONTINUE 23542 CONTINUE 23540 CONTINUE 23538 CONTINUE 23534 CONTINUE 23532 CONTINUE 23525 SP = SP - 1 GOTO 23524 23526 CONTINUE RETURN END SUBROUTINE ULSTAL(NAME, DEFN) INTEGER NAME(100), DEFN(100) CALL INSTAL(NAME, DEFN) CALL UPPER(NAME) CALL INSTAL(NAME, DEFN) RETURN END SUBROUTINE REPCOD(LAB) INTEGER LABGEN INTEGER LAB CALL OUTCON(0) LAB = LABGEN(3) CALL OUTCON(LAB) LAB = LAB + 1 RETURN END SUBROUTINE UNTILS(LAB, TOKEN) INTEGER PTOKEN(100) INTEGER LEX INTEGER JUNK, LAB, TOKEN COMMON /CGOTO/ XFER INTEGER XFER XFER = 0 CALL OUTNUM(LAB) IF(.NOT.(TOKEN .EQ. 10270))GOTO 23545 JUNK = LEX(PTOKEN) CALL IFGO(LAB-1) GOTO 23546 23545 CONTINUE CALL OUTGO(LAB-1) 23546 CONTINUE CALL OUTCON(LAB+1) RETURN END SUBROUTINE RETCOD INTEGER TOKEN(100), GNBTOK, T COMMON /CFNAME/ FCNAME(30) INTEGER FCNAME COMMON /CGOTO/ XFER INTEGER XFER INTEGER SRET(7) DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1 *14/,SRET(6)/110/,SRET(7)/10002/ T = GNBTOK(TOKEN, 100) IF(.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23547 CALL PBSTR(TOKEN) CALL OUTTAB CALL OUTSTR(FCNAME) CALL OUTCH(61) CALL EATUP CALL OUTDON GOTO 23548 23547 CONTINUE IF(.NOT.(T .EQ. 125))GOTO 23549 CALL PBSTR(TOKEN) 23549 CONTINUE 23548 CONTINUE CALL OUTTAB CALL OUTSTR(SRET) CALL OUTDON XFER = 1 RETURN END SUBROUTINE STRDCL INTEGER T, TOKEN(100), GNBTOK INTEGER I, J, K, N, LEN INTEGER LENGTH, CTOI, LEX INTEGER DCHAR(100) COMMON /CSBUF/ SBP, SBUF(500) INTEGER SBP INTEGER SBUF INTEGER CHAR(11) INTEGER DAT(6) INTEGER EOSS(5) 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)/47/,C *HAR(11)/10002/ DATA DAT(1)/100/,DAT(2)/97/,DAT(3)/116/,DAT(4)/97/,DAT(5)/32/,DAT( *6)/10002/ DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/47/,EOSS(5)/10002 */ T = GNBTOK(TOKEN, 100) IF(.NOT.(T .NE. 10100))GOTO 23551 CALL SYNERR(21HMISSING STRING TOKEN.) 23551 CONTINUE CALL OUTTAB CALL PBSTR(CHAR) 23553 CONTINUE T = GNBTOK(DCHAR, 100) IF(.NOT.(T .EQ. 47))GOTO 23556 GOTO 23555 23556 CONTINUE CALL OUTSTR (DCHAR) 23554 GOTO 23553 23555 CONTINUE CALL OUTCH(32) CALL OUTSTR(TOKEN) CALL ADDSTR(TOKEN, SBUF, SBP, 500) CALL ADDCHR(10002, SBUF, SBP, 500) IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23558 LEN = LENGTH(TOKEN) + 1 IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23560 LEN = LEN - 2 23560 CONTINUE GOTO 23559 23558 CONTINUE T = GNBTOK(TOKEN, 100) I = 1 LEN = CTOI(TOKEN, I) IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23562 CALL SYNERR(20HINVALID STRING SIZE.) 23562 CONTINUE IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 41))GOTO 23564 CALL SYNERR(20HMISSING RIGHT PAREN.) GOTO 23565 23564 CONTINUE T = GNBTOK(TOKEN, 100) 23565 CONTINUE 23559 CONTINUE CALL OUTCH(40) CALL OUTNUM(LEN) CALL OUTCH(41) CALL OUTDON IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23566 LEN = LENGTH(TOKEN) TOKEN(LEN) = 10002 CALL ADDSTR(TOKEN(2), SBUF, SBP, 500) GOTO 23567 23566 CONTINUE CALL ADDSTR(TOKEN, SBUF, SBP, 500) 23567 CONTINUE CALL ADDCHR(10002, SBUF, SBP, 500) T = LEX(TOKEN) CALL PBSTR(TOKEN) IF(.NOT.(T .NE. 10274))GOTO 23568 I = 1 23570 IF(.NOT.(I .LT. SBP))GOTO 23572 CALL OUTTAB CALL OUTSTR(DAT) K = 1 J = I + LENGTH(SBUF(I)) + 1 23573 CONTINUE IF(.NOT.(K .GT. 1))GOTO 23576 CALL OUTCH(44) 23576 CONTINUE CALL OUTSTR(SBUF(I)) CALL OUTCH(40) CALL OUTNUM(K) CALL OUTCH(41) CALL OUTCH(47) IF(.NOT.(SBUF(J) .EQ. 10002))GOTO 23578 GOTO 23575 23578 CONTINUE N = SBUF(J) CALL OUTNUM (N) CALL OUTCH(47) K = K + 1 23574 J = J + 1 GOTO 23573 23575 CONTINUE CALL PBSTR(EOSS) 23580 CONTINUE T = GNBTOK(TOKEN, 100) CALL OUTSTR(TOKEN) 23581 IF(.NOT.(T .EQ. 47))GOTO 23580 23582 CONTINUE CALL OUTDON 23571 I = J + 1 GOTO 23570 23572 CONTINUE SBP = 1 23568 CONTINUE RETURN END SUBROUTINE ADDCHR(C, BUF, BP, MAXSIZ) INTEGER BP, MAXSIZ INTEGER C, BUF(100) IF(.NOT.(BP .GT. MAXSIZ))GOTO 23583 CALL BADERR(16HBUFFER OVERFLOW.) 23583 CONTINUE BUF(BP) = C BP = BP + 1 RETURN END INTEGER FUNCTION ALLDIG(STR) INTEGER TYPE INTEGER STR(100) INTEGER I ALLDIG = 0 IF(.NOT.(STR(1) .EQ. 10002))GOTO 23585 RETURN 23585 CONTINUE I = 1 23587 IF(.NOT.(STR(I) .NE. 10002))GOTO 23589 IF(.NOT.(TYPE(STR(I)) .NE. 2))GOTO 23590 RETURN 23590 CONTINUE 23588 I = I + 1 GOTO 23587 23589 CONTINUE ALLDIG = 1 RETURN END INTEGER FUNCTION LABGEN(N) INTEGER N COMMON /CLABEL/ LABEL INTEGER LABEL LABGEN = LABEL LABEL = LABEL + N RETURN END SUBROUTINE SKPBLK(FD) INTEGER FD INTEGER C, NGETCH C = NGETCH(C, FD) 23592 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23594 23593 C = NGETCH(C, FD) GOTO 23592 23594 CONTINUE CALL PUTBAK(C) RETURN END SUBROUTINE CASCOD(LAB, TOKEN) INTEGER LAB, TOKEN INTEGER T, L, LB, UB, I, J, JUNK INTEGER TOK(100) INTEGER CASLAB, LABGEN, GNBTOK COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000) INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK COMMON /CGOTO/ XFER INTEGER XFER IF(.NOT.(SWTOP .LE. 0))GOTO 23595 CALL SYNERR(24HILLEGAL CASE OR DEFAULT.) RETURN 23595 CONTINUE CALL OUTGO(LAB+1) XFER = 1 L = LABGEN(1) IF(.NOT.(TOKEN .EQ. 10276))GOTO 23597 23599 IF(.NOT.(CASLAB(LB, T) .NE. 10003))GOTO 23600 UB = LB IF(.NOT.(T .EQ. 45))GOTO 23601 JUNK = CASLAB(UB, T) 23601 CONTINUE IF(.NOT.(LB .GT. UB))GOTO 23603 CALL SYNERR(28HILLEGAL RANGE IN CASE LABEL.) UB = LB 23603 CONTINUE IF(.NOT.(SWLAST + 3 .GT. 1000))GOTO 23605 CALL BADERR(22HSWITCH TABLE OVERFLOW.) 23605 CONTINUE I = SWTOP + 3 23607 IF(.NOT.(I .LT. SWLAST))GOTO 23609 IF(.NOT.(LB .LE. SWSTAK(I)))GOTO 23610 GOTO 23609 23610 CONTINUE IF(.NOT.(LB .LE. SWSTAK(I+1)))GOTO 23612 CALL SYNERR(21HDUPLICATE CASE LABEL.) 23612 CONTINUE 23611 CONTINUE 23608 I = I + 3 GOTO 23607 23609 CONTINUE IF(.NOT.(I .LT. SWLAST .AND. UB .GE. SWSTAK(I)))GOTO 23614 CALL SYNERR(21HDUPLICATE CASE LABEL.) 23614 CONTINUE J = SWLAST 23616 IF(.NOT.(J .GT. I))GOTO 23618 SWSTAK(J+2) = SWSTAK(J-1) 23617 J = J - 1 GOTO 23616 23618 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 23619 GOTO 23600 23619 CONTINUE IF(.NOT.(T .NE. 44))GOTO 23621 CALL SYNERR(20HILLEGAL CASE SYNTAX.) 23621 CONTINUE 23620 CONTINUE GOTO 23599 23600 CONTINUE GOTO 23598 23597 CONTINUE T = GNBTOK(TOK, 100) IF(.NOT.(SWSTAK(SWTOP+2) .NE. 0))GOTO 23623 CALL ERROR(38HMULTIPLE DEFAULTS IN SWITCH STATEMENT.) GOTO 23624 23623 CONTINUE SWSTAK(SWTOP+2) = L 23624 CONTINUE 23598 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23625 CALL SYNERR(15HUNEXPECTED EOF.) GOTO 23626 23625 CONTINUE IF(.NOT.(T .NE. 58))GOTO 23627 CALL ERROR(39HMISSING COLON IN CASE OR DEFAULT LABEL.) 23627 CONTINUE 23626 CONTINUE XFER = 0 CALL OUTCON(L) RETURN END INTEGER FUNCTION CASLAB(N, T) INTEGER N, T INTEGER TOK(100) INTEGER I, S INTEGER GNBTOK, CTOI T = GNBTOK(TOK, 100) 23629 IF(.NOT.(T .EQ. 10))GOTO 23630 T = GNBTOK(TOK, 100) GOTO 23629 23630 CONTINUE IF(.NOT.(T .EQ. 10003))GOTO 23631 CASLAB=(T) RETURN 23631 CONTINUE IF(.NOT.(T .EQ. 45))GOTO 23633 S = -1 GOTO 23634 23633 CONTINUE S = +1 23634 CONTINUE IF(.NOT.(T .EQ. 45 .OR. T .EQ. 43))GOTO 23635 T = GNBTOK(TOK, 100) 23635 CONTINUE IF(.NOT.(T .NE. 2))GOTO 23637 CALL SYNERR(19HINVALID CASE LABEL.) N = 0 GOTO 23638 23637 CONTINUE I = 1 N = S*CTOI(TOK, I) 23638 CONTINUE T = GNBTOK(TOK, 100) 23639 IF(.NOT.(T .EQ. 10))GOTO 23640 T = GNBTOK(TOK, 100) GOTO 23639 23640 CONTINUE RETURN END SUBROUTINE SWCODE(LAB) INTEGER LAB INTEGER TOK(100) INTEGER LABGEN, GNBTOK COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000) INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK COMMON /CGOTO/ XFER INTEGER XFER LAB = LABGEN(2) IF(.NOT.(SWLAST + 3 .GT. 1000))GOTO 23641 CALL BADERR(22HSWITCH TABLE OVERFLOW.) 23641 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 ĻUTDON CALL OUTGO(LAB) XFER = 1 23643 IF(.NOT.(GNBTOK(TOK, 100) .EQ. 10))GOTO 23644 GOTO 23643 23644 CONTINUE IF(.NOT.(TOK(1) .NE. 123))GOTO 23645 CALL SYNERR(39HMISSING LEFT BRACE IN SWITCH STATEMENT.) CALL PBSTR(TOK) 23645 CONTINUE RETURN END SUBROUTINE SWEND(LAB) INTEGER LAB INTEGER LB, UB, N, I, J COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000) INTEGER SWTOP INTEGER SWLAST INTEGER SWSTAK COMMON /CGOTO/ XFER INTEGER XFER INTEGER SIF(4) INTEGER SLT(10) INTEGER SGT(5) INTEGER SGOTO(6) INTEGER SEQ(5) INTEGER SGE(5) INTEGER SLE(5) INTEGER SAND(6) DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/40/,SIF(4)/10002/ 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)/10002/ DATA SGT(1)/46/,SGT(2)/103/,SGT(3)/116/,SGT(4)/46/,SGT(5)/10002/ DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO *(5)/40/,SGOTO(6)/10002/ DATA SEQ(1)/46/,SEQ(2)/101/,SEQ(3)/113/,SEQ(4)/46/,SEQ(5)/10002/ DATA SGE(1)/46/,SGE(2)/103/,SGE(3)/101/,SGE(4)/46/,SGE(5)/10002/ DATA SLE(1)/46/,SLE(2)/108/,SLE(3)/101/,SLE(4)/46/,SLE(5)/10002/ DATA SAND(1)/46/,SAND(2)/97/,SAND(3)/110/,SAND(4)/100/,SAND(5)/46/ *,SAND(6)/10002/ LB = SWSTAK(SWTOP+3) UB = SWSTAK(SWLAST-2) N = SWSTAK(SWTOP+1) CALL OUTGO(LAB+1) IF(.NOT.(SWSTAK(SWTOP+2) .EQ. 0))GOTO 23647 SWSTAK(SWTOP+2) = LAB + 1 23647 CONTINUE XFER = 0 CALL OUTCON(LAB) IF(.NOT.(N .GE. 3 .AND. UB - LB + 1 .LT. 2*N))GOTO 23649 IF(.NOT.(LB .NE. 1))GOTO 23651 CALL OUTTAB CALL SWVAR(LAB) CALL OUTCH(61) CALL SWVAR(LAB) IF(.NOT.(LB .LT. 1))GOTO 23653 CALL OUTCH(43) 23653 CONTINUE CALL OUTNUM(-LB + 1) CALL OUTDON 23651 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 23655 IF(.NOT.(I .LT. SWLAST))GOTO 23657 23658 IF(.NOT.(J .LT. SWSTAK(I)))GOTO 23660 CALL OUTNUM(SWSTAK(SWTOP+2)) CALL OUTCH(44) 23659 J = J + 1 GOTO 23658 23660 CONTINUE J = SWSTAK(I+1) - SWSTAK(I) 23661 IF(.NOT.(J .GE. 0))GOTO 23663 CALL OUTNUM(SWSTAK(I+2)) 23662 J = J - 1 GOTO 23661 23663 CONTINUE J = SWSTAK(I+1) + 1 IF(.NOT.(I .LT. SWLAST - 3))GOTO 23664 CALL OUTCH(44) 23664 CONTINUE 23656 I = I + 3 GOTO 23655 23657 CONTINUE CALL OUTCH(41) CALL OUTCH(44) CALL SWVAR(LAB) CALL OUTDON GOTO 23650 23649 CONTINUE IF(.NOT.(N .GT. 0))GOTO 23666 I = SWTOP + 3 23668 IF(.NOT.(I .LT. SWLAST))GOTO 23670 CALL OUTTAB CALL OUTSTR(SIF) CALL SWVAR(LAB) IF(.NOT.(SWSTAK(I) .EQ. SWSTAK(I+1)))GOTO 23671 CALL OUTSTR(SEQ) CALL OUTNUM(SWSTAK(I)) GOTO 23672 23671 CONTINUE CALL OUTSTR(SGE) CALL OUTNUM(SWSTAK(I)) CALL OUTSTR(SAND) CALL SWVAR(LAB) CALL OUTSTR(SLE) CALL OUTNUM(SWSTAK(I+1)) 23672 CONTINUE CALL OUTCH(41) CALL OUTGO(SWSTAK(I+2)) 23669 I = I + 3 GOTO 23668 23670 CONTINUE IF(.NOT.(LAB + 1 .NE. SWSTAK(SWTOP+2)))GOTO 23673 CALL OUTGO(SWSTAK(SWTOP+2)) 23673 CONTINUE 23666 CONTINUE 23650 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 WHILEC(LAB) INTEGER LABGEN INTEGER LAB 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 INTEGER FUNCTION ADDSET (C, STR, J, MAXSIZ) INTEGER J, MAXSIZ INTEGER C, STR(MAXSIZ) IF(.NOT.(J .GT. MAXSIZ))GOTO 23000 ADDSET = 0 GOTO 23001 23000 CONTINUE STR(J) = C J = J + 1 ADDSET = 1 23001 CONTINUE RETURN END INTEGER FUNCTION ADDSTR(S, STR, J, MAXSIZ) INTEGER S(100), STR(100) INTEGER J, MAXSIZ INTEGER I, ADDSET I = 1 23002 IF(.NOT.(S(I) .NE. 10002))GOTO 23004 IF(.NOT.(ADDSET(S(I), STR, J, MAXSIZ) .EQ. 0))GOTO 23005 ADDSTR = 0 RETURN 23005 CONTINUE 23003 I = I + 1 GOTO 23002 23004 CONTINUE ADDSTR = 1 RETURN END SUBROUTINE CANT (FILE) INTEGER FILE (100) INTEGER BUF(15) DATA BUF(1), BUF(2), BUF(3), BUF(4), BUF(5), BUF(6), BUF(7), BUF(8 *), BUF(9), BUF(10), BUF(11), BUF(12), BUF(13), BUF(14), BUF(15) /5 *8, 32, 32, 99, 97, 110, 39, 116, 32, 111, 112, 101, 110, 10, 10002 */ CALL PUTLIN (FILE, 3) CALL PUTLIN (BUF, 3) CALL ENDST END INTEGER FUNCTION CLOWER(C) INTEGER C, K IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23007 K = 97 - 65 CLOWER = C + K GOTO 23008 23007 CONTINUE CLOWER = C 23008 CONTINUE RETURN END SUBROUTINE CONCAT (BUF1, BUF2, OUTSTR) INTEGER BUF1(100), BUF2(100), OUTSTR(100) INTEGER LEN, I, J INTEGER LENGTH CALL SCOPY(BUF1, 1, OUTSTR, 1) LEN = LENGTH(OUTSTR) J = 1 I=LEN+1 23009 IF(.NOT.(BUF2(J) .NE. 10002))GOTO 23011 CALL SCOPY(BUF2, J, OUTSTR, I) J = J + 1 23010 I=I+1 GOTO 23009 23011 CONTINUE OUTSTR(I) = 10002 RETURN END INTEGER FUNCTION CTOI(IN, I) INTEGER IN(100) INTEGER INDEX INTEGER D, I INTEGER DIGITS(11) DATA DIGITS(1) /48/ DATA DIGITS(2) /49/ DATA DIGITS(3) /50/ DATA DIGITS(4) /51/ DATA DIGITS(5) /52/ DATA DIGITS(6) /53/ DATA DIGITS(7) /54/ DATA DIGITS(8) /55/ DATA DIGITS(9) /56/ DATA DIGITS(10) /57/ DATA DIGITS(11) /10002/ 23012 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23013 I = I + 1 GOTO 23012 23013 CONTINUE CTOI = 0 23014 IF(.NOT.(IN(I) .NE. 10002))GOTO 23016 D = INDEX(DIGITS, IN(I)) IF(.NOT.(D .EQ. 0))GOTO 23017 GOTO 23016 23017 CONTINUE CTOI = 10 * CTOI + D - 1 23015 I = I + 1 GOTO 23014 23016 CONTINUE RETURN END INTEGER FUNCTION CUPPER(C) INTEGER C, K IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23019 CUPPER = C + (65 - 97) GOTO 23020 23019 CONTINUE CUPPER = C 23020 CONTINUE RETURN END INTEGER FUNCTION EQUAL (STR1, STR2) INTEGER STR1(100), STR2(100) INTEGER I I=1 23021 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23023 IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23024 EQUAL = 1 RETURN 23024 CONTINUE 23022 I=I+1 GOTO 23021 23023 CONTINUE EQUAL = 0 RETURN END SUBROUTINE ERROR (LINE) INTEGER LINE(100) CALL REMARK (LINE) CALL ENDST END INTEGER FUNCTION ESC (ARRAY, I) INTEGER ARRAY(100) INTEGER I IF(.NOT.(ARRAY(I) .NE. 64))GOTO 23026 ESC = ARRAY(I) GOTO 23027 23026 CONTINUE IF(.NOT.(ARRAY(I+1) .EQ. 10002))GOTO 23028 ESC = 64 GOTO 23029 23028 CONTINUE I = I + 1 IF(.NOT.(ARRAY(I) .EQ. 110 .OR. ARRAY(I) .EQ. 78))GOTO 23030 ESC = 10 GOTO 23031 23030 CONTINUE IF(.NOT.(ARRAY(I) .EQ. 116 .OR. ARRAY(I) .EQ. 84))GOTO 23032 ESC = 9 GOTO 23033 23032 CONTINUE ESC = ARRAY(I) 23033 CONTINUE 23031 CONTINUE 23029 CONTINUE 23027 CONTINUE RETURN END SUBROUTINE FCOPY (IN, OUT) INTEGER C INTEGER GETCH INTEGER IN, OUT 23034 IF(.NOT.(GETCH(C,IN) .NE. 10003))GOTO 23035 CALL PUTCH(C, OUT) GOTO 23034 23035 CONTINUE RETURN END SUBROUTINE FOLD (TOKEN) INTEGER TOKEN(100), CLOWER INTEGER I I=1 23036 IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23038 TOKEN(I) = CLOWER(TOKEN(I)) 23037 I=I+1 GOTO 23036 23038 CONTINUE RETURN END INTEGER FUNCTION GETC(C) INTEGER C INTEGER GETCH GETC = GETCH(C, 1) RETURN END INTEGER FUNCTION GETWRD (IN, I, OUT) INTEGER IN(100), OUT(100) INTEGER I, J 23039 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23040 I = I + 1 GOTO 23039 23040 CONTINUE J = 1 23041 IF(.NOT.(IN(I) .NE. 10002 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 . *AND. IN(I) .NE. 10))GOTO 23042 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23041 23042 CONTINUE OUT(J) = 10002 GETWRD = J - 1 RETURN END INTEGER FUNCTION INDEX(STR, C) INTEGER C, STR(100) INDEX = 1 23043 IF(.NOT.(STR(INDEX) .NE. 10002))GOTO 23045 IF(.NOT.(STR(INDEX) .EQ. C))GOTO 23046 RETURN 23046 CONTINUE 23044 INDEX = INDEX + 1 GOTO 23043 23045 CONTINUE INDEX = 0 RETURN END INTEGER FUNCTION ITOC(INT, STR, SIZE) INTEGER MOD INTEGER D, I, INT, INTVAL, J, K, SIZE INTEGER STR(SIZE) INTEGER DIGITS(11) DATA DIGITS(1) /48/ DATA DIGITS(2) /49/ DATA DIGITS(3) /50/ DATA DIGITS(4) /51/ DATA DIGITS(5) /52/ DATA DIGITS(6) /53/ DATA DIGITS(7) /54/ DATA DIGITS(8) /55/ DATA DIGITS(9) /56/ DATA DIGITS(10) /57/ DATA DIGITS(11) /10002/ INTVAL = IABS(INT) STR(1) = 10002 I = 1 23048 CONTINUE I = I + 1 D = MOD(INTVAL, 10) STR(I) = DIGITS(D+1) INTVAL = INTVAL / 10 23049 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23048 23050 CONTINUE IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23051 I = I + 1 STR(I) = 45 23051 CONTINUE ITOC = I - 1 J = 1 23053 IF(.NOT.(J .LT. I))GOTO 23055 K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 23054 J = J + 1 GOTO 23053 23055 CONTINUE RETURN END INTEGER FUNCTION LENGTH (STR) INTEGER STR(100) LENGTH=0 23056 IF(.NOT.(STR(LENGTH+1) .NE. 10002))GOTO 23058 23057 LENGTH = LENGTH + 1 GOTO 23056 23058 CONTINUE RETURN END SUBROUTINE LOWER (TOKEN) INTEGER TOKEN(100) CALL FOLD(TOKEN) RETURN END SUBROUTINE PUTC (C) INTEGER C CALL PUTCH (C, 2) RETURN END SUBROUTINE PUTDEC(N,W) INTEGER CHARS(120) INTEGER ITOC INTEGER I,N,ND,W ND = ITOC(N,CHARS,20) I = ND+1 23059 IF(.NOT.(I .LE. W))GOTO 23061 CALL PUTC(32) 23060 I = I+1 GOTO 23059 23061 CONTINUE I = 1 23062 IF(.NOT.(I .LE. ND))GOTO 23064 CALL PUTC(CHARS(I)) 23063 I = I+1 GOTO 23062 23064 CONTINUE RETURN END SUBROUTINE PUTINT(N, W, FD) INTEGER CHARS(20) INTEGER ITOC INTEGER N, W, FD, JUNK JUNK = ITOC(N,CHARS,20) CALL PUTSTR(CHARS, W, FD) RETURN END SUBROUTINE PUTSTR(STR, W, FD) INTEGER STR(100) INTEGER W, FD INTEGER LEN, I INTEGER LENGTH LEN = LENGTH(STR) I = LEN+1 23065 IF(.NOT.(I .LE. W))GOTO 23067 CALL PUTCH(32, FD) 23066 I=I+1 GOTO 23065 23067 CONTINUE I = 1 23068 IF(.NOT.(I .LE. LEN))GOTO 23070 CALL PUTCH(STR(I), FD) 23069 I=I+1 GOTO 23068 23070 CONTINUE I = (-W) - LEN 23071 IF(.NOT.(I .GT. 0))GOTO 23073 CALL PUTCH(32, FD) 23072 I = I - 1 GOTO 23071 23073 CONTINUE RETURN END SUBROUTINE SCOPY(FROM, I, TO, J) INTEGER FROM(100), TO(100) INTEGER I, J, K1, K2 K2 = J K1 = I 23074 IF(.NOT.(FROM(K1) .NE. 10002))GOTO 23076 TO(K2) = FROM(K1) K2 = K2 + 1 23075 K1 = K1 + 1 GOTO 23074 23076 CONTINUE TO(K2) = 10002 RETURN END SUBROUTINE SKIPBL(LIN, I) INTEGER LIN(100) INTEGER I 23077 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23078 I = I + 1 GOTO 23077 23078 CONTINUE RETURN END SUBROUTINE STCOPY(IN, I, OUT, J) INTEGER IN(100), OUT(100) INTEGER I, J, K K=I 23079 IF(.NOT.(IN(K) .NE. 10002))GOTO 23081 OUT(J) = IN(K) J = J + 1 23080 K=K+1 GOTO 23079 23081 CONTINUE RETURN END INTEGER FUNCTION STRCMP (STR1, STR2) INTEGER STR1(100), STR2(100) INTEGER I I=1 23082 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23084 IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23085 STRCMP = 0 RETURN 23085 CONTINUE 23083 I=I+1 GOTO 23082 23084 CONTINUE IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23087 STRCMP = -1 GOTO 23088 23087 CONTINUE IF(.NOT.(STR2(I) .EQ. 10002))GOTO 23089 STRCMP = + 1 GOTO 23090 23089 CONTINUE IF(.NOT.(STR1(I) .LT. STR2(I)))GOTO 23091 STRCMP = -1 GOTO 23092 23091 CONTINUE STRCMP = +1 23092 CONTINUE 23090 CONTINUE 23088 CONTINUE RETURN END INTEGER FUNCTION TYPE (C) INTEGER C IF(.NOT.( (C .GE. 97 .AND. C .LE. 122) .OR. ( C .GE. 65 .AND. C .L *E. 90)))GOTO 23093 TYPE = 1 GOTO 23094 23093 CONTINUE IF(.NOT.(C .GE. 48 .AND. C .LE. 57))GOTO 23095 TYPE = 2 GOTO 23096 23095 CONTINUE TYPE = C 23096 CONTINUE 23094 CONTINUE RETURN END SUBROUTINE UPPER (TOKEN) INTEGER TOKEN(100), CUPPER INTEGER I I=1 23097 IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23099 TOKEN(I) = CUPPER(TOKEN(I)) 23098 I=I+1 GOTO 23097 23099 CONTINUE RETURN END SUBROUTINE INSTAL(NAME, DEFN) INTEGER NAME(100), DEFN(100) INTEGER NLEN, DLEN, LENGTH, C, HSHFCN COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250 *) INTEGER LASTP INTEGER LASTT INTEGER HSHPTR INTEGER TABPTR INTEGER TABLE NLEN = LENGTH(NAME) + 1 DLEN = LENGTH(DEFN) + 1 IF(.NOT.(LASTT + NLEN + DLEN .GT. 6250 .OR. LASTP .GE. 625))GOTO 2 *3100 CALL PUTLIN(NAME, 3) CALL REMARK(24H : TOO MANY DEFINITIONS.) GOTO 23101 23100 CONTINUE LASTP = LASTP + 1 TABPTR(2, LASTP) = LASTT + 1 C = HSHFCN(NAME, 37) TABPTR(1, LASTP) = HSHPTR(C) HSHPTR(C) = LASTP CALL SCOPY(NAME, 1, TABLE, LASTT + 1) CALL SCOPY(DEFN, 1, TABLE, LASTT + NLEN + 1) LASTT = LASTT + NLEN + DLEN 23101 CONTINUE RETURN END INTEGER FUNCTION LOOKUP(NAME, DEFN) INTEGER NAME(100), DEFN(100) INTEGER C, HSHFCN, I, J, K COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250 *) INTEGER LASTP INTEGER LASTT INTEGER HSHPTR INTEGER TABPTR INTEGER TABLE C = HSHFCN(NAME, 37) LOOKUP = 0 I=HSHPTR(C) 23102 IF(.NOT.(I .GT. 0))GOTO 23104 J = TABPTR(2, I) K=1 23105 IF(.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 10002))GOTO 2310 *7 J = J + 1 23106 K=K+1 GOTO 23105 23107 CONTINUE IF(.NOT.(NAME(K) .EQ. TABLE(J)))GOTO 23108 CALL SCOPY(TABLE, J+1, DEFN, 1) LOOKUP = 1 GOTO 23104 23108 CONTINUE 23103 I=TABPTR(1,I) GOTO 23102 23104 CONTINUE RETURN END INTEGER FUNCTION HSHFCN(STRNG, N) INTEGER STRNG(100) INTEGER N, I, LENGTH, I1, I2 I = LENGTH(STRNG) I = MAX0(I, 1) I1 = STRNG(1) I2 = STRNG(I) HSHFCN = MOD(I1+I2, N) + 1 RETURN END SUBROUTINE TBINIT COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250 *) INTEGER LASTP INTEGER LASTT INTEGER HSHPTR INTEGER TABPTR INTEGER TABLE INTEGER I LASTP = 0 LASTT = 0 I=1 23110 IF(.NOT.(I.LE.37))GOTO 23112 HSHPTR(I) = 0 23111 I=I+1 GOTO 23110 23112 CONTINUE RETURN END INTEGER FUNCTION OPEN(NAME, ACCESS) INTEGER NAME(100) INTEGER ACCESS OPEN = 10001 RETURN END SUBROUTINE CLOSE(FD) INTEGER FD RETURN END SUBROUTINE INITST RETURN END SUBROUTINE ENDST STOP END INTEGER FUNCTION GETARG(N, BUF, MAXSIZ) INTEGER N, MAXSIZ INTEGER BUF(100) GETARG = 10003 RETURN END SUBROUTINE PUTLIN(LIN, FD) INTEGER LIN(100) INTEGER FD INTEGER I I=1 23113 IF(.NOT.(LIN(I) .NE. 10002))GOTO 23115 CALL PUTCH(LIN(I), FD) 23114 I=I+1 GOTO 23113 23115 CONTINUE RETURN END