
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 OUTDON
      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
