      SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD)
      LOGICAL*1 GTOK, NGETCH
      INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ
      LOGICAL*1 C, DEFN(200), TOKEN(100), T, PTOKEN(100)
      CALL SKPBLK(FD)
      C = GTOK(PTOKEN, 100, FD)
      IF(.NOT.(C .EQ. 40))GOTO 23000
      T = 40
      GOTO 23001
23000 CONTINUE
      T = 32
      CALL PBSTR(PTOKEN)
23001 CONTINUE
      CALL SKPBLK(FD)
      IF(.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. -9))GOTO 23002
      CALL BADERR(22Hnon-alphanumeric name.)
23002 CONTINUE
      CALL SKPBLK(FD)
      C = GTOK(PTOKEN, 100, FD)
      IF(.NOT.(T .EQ. 32))GOTO 23004
      CALL PBSTR(PTOKEN)
      I = 1
23006 CONTINUE
      C = NGETCH(C, FD)
      IF(.NOT.(I .GT. DEFSIZ))GOTO 23009
      CALL BADERR(20Hdefinition too long.)
23009 CONTINUE
      DEFN(I) = C
      I = I + 1
23007 IF(.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. -1))GOTO 23006
23008 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23011
      CALL PUTBAK(C)
23011 CONTINUE
      GOTO 23005
23004 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23013
      IF(.NOT.(C .NE. 44))GOTO 23015
      CALL BADERR(24Hmissing comma in define.)
23015 CONTINUE
      NLPAR = 0
      I = 1
23017 IF(.NOT.(NLPAR .GE. 0))GOTO 23019
      IF(.NOT.(I .GT. DEFSIZ))GOTO 23020
      CALL BADERR(20Hdefinition too long.)
      GOTO 23021
23020 CONTINUE
      IF(.NOT.(NGETCH(DEFN(I), FD) .EQ. -1))GOTO 23022
      CALL BADERR(20Hmissing right paren.)
      GOTO 23023
23022 CONTINUE
      IF(.NOT.(DEFN(I) .EQ. 40))GOTO 23024
      NLPAR = NLPAR + 1
      GOTO 23025
23024 CONTINUE
      IF(.NOT.(DEFN(I) .EQ. 41))GOTO 23026
      NLPAR = NLPAR - 1
23026 CONTINUE
23025 CONTINUE
23023 CONTINUE
23021 CONTINUE
23018 I = I + 1
      GOTO 23017
23019 CONTINUE
      GOTO 23014
23013 CONTINUE
      CALL BADERR(19Hgetdef is confused.)
23014 CONTINUE
23005 CONTINUE
      DEFN(I-1) = 0
      RETURN
      END
      SUBROUTINE INSTAL(NAME, DEFN)
      LOGICAL*1 NAME(100), DEFN(200)
      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
      LOGICAL*1 TABLE
      NLEN = LENGTH(NAME) + 1
      DLEN = LENGTH(DEFN) + 1
      IF(.NOT.(LASTT + NLEN + DLEN .GT. 6250 .OR. LASTP .GE. 625))GOTO 2
     *3028
      CALL PUTLIN(NAME, 3)
      CALL REMARK(24H : too many definitions.)
      GOTO 23029
23028 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
23029 CONTINUE
      RETURN
      END
      INTEGER FUNCTION LOOKUP(NAME, DEFN)
      LOGICAL*1 NAME(100), DEFN(200)
      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
      LOGICAL*1 TABLE
      C = HSHFCN(NAME, 37)
      LOOKUP = 0
      I=HSHPTR(C)
23030 IF(.NOT.(I .GT. 0))GOTO 23032
      J = TABPTR(2, I)
      K=1
23033 IF(.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 0))GOTO 23035
      J = J + 1
23034 K=K+1
      GOTO 23033
23035 CONTINUE
      IF(.NOT.(NAME(K) .EQ. TABLE(J)))GOTO 23036
      CALL SCOPY(TABLE, J+1, DEFN, 1)
      LOOKUP = 1
      GOTO 23032
23036 CONTINUE
23031 I=TABPTR(1,I)
      GOTO 23030
23032 CONTINUE
      RETURN
      END
      INTEGER FUNCTION HSHFCN(STRNG, N)
      LOGICAL*1 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
      LOGICAL*1 TABLE
      LASTP = 0
      LASTT = 0
      I=1
23038 IF(.NOT.(I.LE.37))GOTO 23040
      HSHPTR(I) = 0
23039 I=I+1
      GOTO 23038
23040 CONTINUE
      RETURN
      END
      SUBROUTINE DOCODE(LAB)
      INTEGER LABGEN
      INTEGER LAB
      LOGICAL*1 GNBTOK
      LOGICAL*1 LEXSTR(100)
      COMMON /CGOTO/ XFER
      INTEGER XFER
      LOGICAL*1 SDO(3)
      DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/0/
      XFER = 0
      CALL OUTTAB
      CALL OUTSTR(SDO)
      CALL OUTCH(32)
      LAB = LABGEN(2)
      IF(.NOT.(GNBTOK(LEXSTR, 100) .EQ. 2))GOTO 23041
      CALL OUTSTR(LEXSTR)
      GOTO 23042
23041 CONTINUE
      CALL PBSTR(LEXSTR)
      CALL OUTNUM(LAB)
23042 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)
      LOGICAL*1 MSG(100)
      CALL SYNERR(MSG)
      CALL R4EXIT(0)
      END
      SUBROUTINE SYNERR(MSG)
      LOGICAL*1 LC(10), MSG(100)
      INTEGER ITOC
      INTEGER I, JUNK
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      LOGICAL*1 IN(5)
      LOGICAL*1 ERRMSG(15)
      DATA IN(1)/32/,IN(2)/105/,IN(3)/110/,IN(4)/32/,IN(5)/0/
      DATA ERRMSG(1)/101/,ERRMSG(2)/114/,ERRMSG(3)/114/,ERRMSG(4)/111/,E
     *RRMSG(5)/114/,ERRMSG(6)/32/,ERRMSG(7)/97/,ERRMSG(8)/116/,ERRMSG(9)
     */32/,ERRMSG(10)/108/,ERRMSG(11)/105/,ERRMSG(12)/110/,ERRMSG(13)/10
     *1/,ERRMSG(14)/32/,ERRMSG(15)/0/
      CALL PUTLIN(ERRMSG, 3)
      IF(.NOT.(LEVEL .GE. 1))GOTO 23043
      I = LEVEL
      GOTO 23044
23043 CONTINUE
      I = 1
23044 CONTINUE
      JUNK = ITOC (LINECT(I), LC, 10)
      CALL PUTLIN(LC, 3)
      I = FNAMP-1
23045 IF(.NOT.(I.GT.1))GOTO 23047
      IF(.NOT.(FNAMES(I-1) .EQ. 0))GOTO 23048
      CALL PUTLIN(IN, 3)
      CALL PUTLIN(FNAMES(I), 3)
      GOTO 23047
23048 CONTINUE
23046 I=I-1
      GOTO 23045
23047 CONTINUE
      CALL PUTCH(58, 3)
      CALL PUTCH(32, 3)
      CALL REMARK (MSG)
      RETURN
      END
      SUBROUTINE FORCOD(LAB)
      LOGICAL*1 GETTOK, GNBTOK
      LOGICAL*1 T, TOKEN(100)
      INTEGER LENGTH, LABGEN
      INTEGER I, J, LAB, NLPAR
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      LOGICAL*1 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)/0/
      LAB = LABGEN(3)
      CALL OUTCON(0)
      IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23050
      CALL SYNERR(19Hmissing left paren.)
      RETURN
23050 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 59))GOTO 23052
      CALL PBSTR(TOKEN)
      CALL OUTTAB
      CALL EATUP
      CALL OUTDON
23052 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 100) .EQ. 59))GOTO 23054
      CALL OUTCON(LAB)
      GOTO 23055
23054 CONTINUE
      CALL PBSTR(TOKEN)
      CALL OUTNUM(LAB)
      CALL OUTTAB
      CALL OUTSTR(IFNOT)
      CALL OUTCH(40)
      NLPAR = 0
23056 IF(.NOT.(NLPAR .GE. 0))GOTO 23057
      T = GETTOK(TOKEN, 100)
      IF(.NOT.(T .EQ. 59))GOTO 23058
      GOTO 23057
23058 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23060
      NLPAR = NLPAR + 1
      GOTO 23061
23060 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23062
      NLPAR = NLPAR - 1
23062 CONTINUE
23061 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23064
      CALL PBSTR(TOKEN)
      RETURN
23064 CONTINUE
      IF(.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23066
      CALL OUTSTR(TOKEN)
23066 CONTINUE
      GOTO 23056
23057 CONTINUE
      CALL OUTCH(41)
      CALL OUTCH(41)
      CALL OUTGO(LAB+2)
      IF(.NOT.(NLPAR .LT. 0))GOTO 23068
      CALL SYNERR(19Hinvalid for clause.)
23068 CONTINUE
23055 CONTINUE
      FORDEP = FORDEP + 1
      J = 1
      I = 1
23070 IF(.NOT.(I .LT. FORDEP))GOTO 23072
      J = J + LENGTH(FORSTK(J)) + 1
23071 I = I + 1
      GOTO 23070
23072 CONTINUE
      FORSTK(J) = 0
      NLPAR = 0
      T = GNBTOK(TOKEN, 100)
      CALL PBSTR(TOKEN)
23073 IF(.NOT.(NLPAR .GE. 0))GOTO 23074
      T = GETTOK(TOKEN, 100)
      IF(.NOT.(T .EQ. 40))GOTO 23075
      NLPAR = NLPAR + 1
      GOTO 23076
23075 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23077
      NLPAR = NLPAR - 1
23077 CONTINUE
23076 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23079
      CALL PBSTR(TOKEN)
      GOTO 23074
23079 CONTINUE
      IF(.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))GOTO 23081
      IF(.NOT.(J + LENGTH(TOKEN) .GE. 200))GOTO 23083
      CALL BADERR(20Hfor clause too long.)
23083 CONTINUE
      CALL SCOPY(TOKEN, 1, FORSTK, J)
      J = J + LENGTH(TOKEN)
23081 CONTINUE
      GOTO 23073
23074 CONTINUE
      LAB = LAB + 1
      RETURN
      END
      SUBROUTINE FORS(LAB)
      INTEGER LENGTH
      INTEGER I, J, LAB
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTNUM(LAB)
      J = 1
      I = 1
23085 IF(.NOT.(I .LT. FORDEP))GOTO 23087
      J = J + LENGTH(FORSTK(J)) + 1
23086 I = I + 1
      GOTO 23085
23087 CONTINUE
      IF(.NOT.(LENGTH(FORSTK(J)) .GT. 0))GOTO 23088
      CALL OUTTAB
      CALL OUTSTR(FORSTK(J))
      CALL OUTDON
23088 CONTINUE
      CALL OUTGO(LAB-1)
      CALL OUTCON(LAB+1)
      FORDEP = FORDEP - 1
      RETURN
      END
      SUBROUTINE BALPAR
      LOGICAL*1 GETTOK, GNBTOK
      LOGICAL*1 T, TOKEN(100)
      INTEGER NLPAR
      IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23090
      CALL SYNERR(19Hmissing left paren.)
      RETURN
23090 CONTINUE
      CALL OUTSTR(TOKEN)
      NLPAR = 1
23092 CONTINUE
      T = GETTOK(TOKEN, 100)
      IF(.NOT.(T.EQ.59 .OR. T.EQ.123 .OR. T.EQ.125 .OR. T.EQ.-1))GOTO 23
     *095
      CALL PBSTR(TOKEN)
      GOTO 23094
23095 CONTINUE
      IF(.NOT.(T .EQ. 10))GOTO 23097
      TOKEN(1) = 0
      GOTO 23098
23097 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23099
      NLPAR = NLPAR + 1
      GOTO 23100
23099 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23101
      NLPAR = NLPAR - 1
23101 CONTINUE
23100 CONTINUE
23098 CONTINUE
      CALL OUTSTR(TOKEN)
23093 IF(.NOT.(NLPAR .LE. 0))GOTO 23092
23094 CONTINUE
      IF(.NOT.(NLPAR .NE. 0))GOTO 23103
      CALL SYNERR(33Hmissing parenthesis in condition.)
23103 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
      LOGICAL*1 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)/0/
      CALL OUTTAB
      CALL OUTSTR(IFNOT)
      CALL BALPAR
      CALL OUTCH(41)
      CALL OUTGO(LAB)
      RETURN
      END
      LOGICAL*1 FUNCTION GETTOK(TOKEN, TOKSIZ)
      INTEGER EQUAL, OPEN, LENGTH
      INTEGER I, TOKSIZ, F, LEN
      LOGICAL*1 T
      LOGICAL*1 DEFTOK, NGETCH
      LOGICAL*1 GETCH
      LOGICAL*1 NAME(40), TOKEN(100)
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CFNAME/ FCNAME(40)
      LOGICAL*1 FCNAME
      LOGICAL*1 FNCN(9)
      LOGICAL*1 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)/0/
      DATA INCL(1)/105/,INCL(2)/110/,INCL(3)/99/,INCL(4)/108/,INCL(5)/11
     *7/,INCL(6)/100/,INCL(7)/101/,INCL(8)/0/
23105 IF(.NOT.(LEVEL .GT. 0))GOTO 23107
      F = INFILE(LEVEL)
      GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
23108 IF(.NOT.(GETTOK .NE. -1))GOTO 23110
      IF(.NOT.(EQUAL(TOKEN, FNCN) .EQ. 1))GOTO 23111
      CALL SKPBLK(INFILE(LEVEL))
      T = DEFTOK(FCNAME, 40, F)
      CALL PBSTR(FCNAME)
      IF(.NOT.(T .NE. -9))GOTO 23113
      CALL SYNERR(22Hmissing function name.)
23113 CONTINUE
      CALL PUTBAK(32)
      RETURN
23111 CONTINUE
      IF(.NOT.(EQUAL(TOKEN, INCL) .EQ. 0))GOTO 23115
      RETURN
23115 CONTINUE
23112 CONTINUE
      CALL SKPBLK(INFILE(LEVEL))
      T = DEFTOK(NAME, 40, INFILE(LEVEL))
      IF(.NOT.(T .EQ. 39 .OR. T .EQ. 34))GOTO 23117
      LEN = LENGTH(NAME) - 1
      I=1
23119 IF(.NOT.(I .LT. LEN))GOTO 23121
      NAME(I) = NAME(I+1)
23120 I=I+1
      GOTO 23119
23121 CONTINUE
      NAME(I) = 0
23117 CONTINUE
      I = LENGTH(NAME) + 1
      IF(.NOT.(LEVEL .GE. 3))GOTO 23122
      CALL SYNERR(27Hincludes nested too deeply.)
      GOTO 23123
23122 CONTINUE
      INFILE(LEVEL+1) = OPEN(NAME, 1)
      LINECT(LEVEL+1) = 1
      IF(.NOT.(INFILE(LEVEL+1) .EQ. -3))GOTO 23124
      CALL SYNERR(19Hcan't open include.)
      GOTO 23125
23124 CONTINUE
      LEVEL = LEVEL + 1
      IF(.NOT.(FNAMP + I .LE. 120))GOTO 23126
      CALL SCOPY(NAME, 1, FNAMES, FNAMP)
      FNAMP = FNAMP + I
23126 CONTINUE
      F = INFILE(LEVEL)
23125 CONTINUE
23123 CONTINUE
23109  GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
      GOTO 23108
23110 CONTINUE
      IF(.NOT.(LEVEL .GT. 1))GOTO 23128
      CALL CLOSE(INFILE(LEVEL))
      FNAMP = FNAMP - 1
23130 IF(.NOT.(FNAMP .GT. 1))GOTO 23132
      IF(.NOT.(FNAMES(FNAMP-1) .EQ. 0))GOTO 23133
      GOTO 23132
23133 CONTINUE
23131 FNAMP = FNAMP - 1
      GOTO 23130
23132 CONTINUE
23128 CONTINUE
23106 LEVEL = LEVEL - 1
      GOTO 23105
23107 CONTINUE
      TOKEN(1) = -1
      TOKEN(2) = 0
      GETTOK = -1
      RETURN
      END
      LOGICAL*1 FUNCTION GNBTOK(TOKEN, TOKSIZ)
      INTEGER TOKSIZ
      LOGICAL*1 TOKEN(100), GETTOK
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      CALL SKPBLK(INFILE(LEVEL))
      GNBTOK = GETTOK(TOKEN, TOKSIZ)
      RETURN
      END
      LOGICAL*1 FUNCTION GTOK(LEXSTR, TOKSIZ, FD)
      LOGICAL*1 NGETCH, TYPE
      INTEGER FD, I, B, N, TOKSIZ, ITOC
      LOGICAL*1 C, LEXSTR(100)
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      C = NGETCH(LEXSTR(1), FD)
      IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23135
      LEXSTR(1) = 32
23137 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23138
      C = NGETCH(C, FD)
      GOTO 23137
23138 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23139
23141 IF(.NOT.(NGETCH(C, FD) .NE. 10))GOTO 23142
      GOTO 23141
23142 CONTINUE
23139 CONTINUE
      IF(.NOT.(C .NE. 10))GOTO 23143
      CALL PUTBAK(C)
      GOTO 23144
23143 CONTINUE
      LEXSTR(1) = 10
23144 CONTINUE
      LEXSTR(2) = 0
      GTOK = LEXSTR(1)
      RETURN
23135 CONTINUE
      I = 1
      GTOK = TYPE(C)
      IF(.NOT.(GTOK .EQ. 1))GOTO 23145
      I = 1
23147 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23149
      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 23150
      GOTO 23149
23150 CONTINUE
23148 I = I + 1
      GOTO 23147
23149 CONTINUE
      CALL PUTBAK(LEXSTR(I+1))
      GTOK = -9
      GOTO 23146
23145 CONTINUE
      IF(.NOT.(GTOK .EQ. 2))GOTO 23152
      B = C - 48
      I = 1
23154 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23156
      IF(.NOT.(TYPE(NGETCH(LEXSTR(I+1), FD)) .NE. 2))GOTO 23157
      GOTO 23156
23157 CONTINUE
      B = 10*B + LEXSTR(I+1) - 48
23155 I = I + 1
      GOTO 23154
23156 CONTINUE
      IF(.NOT.(LEXSTR(I+1) .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO 
     *23159
      N = 0
23161 CONTINUE
      C = NGETCH(LEXSTR(1), FD)
      IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23164
      C = C - 97 + 57 + 1
      GOTO 23165
23164 CONTINUE
      IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23166
      C = C - 65 + 57 + 1
23166 CONTINUE
23165 CONTINUE
      IF(.NOT.(C .LT. 48 .OR. C .GE. 48 + B))GOTO 23168
      GOTO 23163
23168 CONTINUE
23162 N = B*N + C - 48
      GOTO 23161
23163 CONTINUE
      CALL PUTBAK(LEXSTR(1))
      I = ITOC(N, LEXSTR, TOKSIZ)
      GOTO 23160
23159 CONTINUE
      CALL PUTBAK(LEXSTR(I+1))
23160 CONTINUE
      GTOK = 2
      GOTO 23153
23152 CONTINUE
      IF(.NOT.(C .EQ. 91))GOTO 23170
      LEXSTR(1) = 123
      GTOK = 123
      GOTO 23171
23170 CONTINUE
      IF(.NOT.(C .EQ. 93))GOTO 23172
      LEXSTR(1) = 125
      GTOK = 125
      GOTO 23173
23172 CONTINUE
      IF(.NOT.(C .EQ. 36))GOTO 23174
      IF(.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40))GOTO 23176
      LEXSTR(1) = -10
      GTOK = -10
      GOTO 23177
23176 CONTINUE
      IF(.NOT.(LEXSTR(2) .EQ. 41))GOTO 23178
      LEXSTR(1) = -11
      GTOK = -11
      GOTO 23179
23178 CONTINUE
      CALL PUTBAK(LEXSTR(2))
23179 CONTINUE
23177 CONTINUE
      GOTO 23175
23174 CONTINUE
      IF(.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23180
      I = 2
23182 IF(.NOT.(NGETCH(LEXSTR(I), FD) .NE. LEXSTR(1)))GOTO 23184
      IF(.NOT.(LEXSTR(I) .EQ. 95))GOTO 23185
      IF(.NOT.(NGETCH(C, FD) .EQ. 10))GOTO 23187
23189 IF(.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23190
      C = NGETCH(C, FD)
      GOTO 23189
23190 CONTINUE
      LEXSTR(I) = C
      GOTO 23188
23187 CONTINUE
      CALL PUTBAK(C)
23188 CONTINUE
23185 CONTINUE
      IF(.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ-1))GOTO 23191
      CALL SYNERR(14Hmissing quote.)
      LEXSTR(I) = LEXSTR(1)
      CALL PUTBAK(10)
      GOTO 23184
23191 CONTINUE
23183 I = I + 1
      GOTO 23182
23184 CONTINUE
      GOTO 23181
23180 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23193
23195 IF(.NOT.(NGETCH(LEXSTR(1), FD) .NE. 10))GOTO 23196
      GOTO 23195
23196 CONTINUE
      GTOK = 10
      GOTO 23194
23193 CONTINUE
      IF(.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ.  33 .OR. C .EQ. 33 .
     *OR. C .EQ. 94 .OR. C .EQ. 61 .OR. C .EQ. 38 .OR. C .EQ. 124))GOTO 
     *23197
      CALL RELATE(LEXSTR, I, FD)
23197 CONTINUE
23194 CONTINUE
23181 CONTINUE
23175 CONTINUE
23173 CONTINUE
23171 CONTINUE
23153 CONTINUE
23146 CONTINUE
      IF(.NOT.(I .GE. TOKSIZ-1))GOTO 23199
      CALL SYNERR(15Htoken too long.)
23199 CONTINUE
      LEXSTR(I+1) = 0
      IF(.NOT.(LEXSTR(1) .EQ. 10))GOTO 23201
      LINECT(LEVEL) = LINECT(LEVEL) + 1
23201 CONTINUE
      RETURN
      END
      INTEGER FUNCTION LEX(LEXSTR)
      LOGICAL*1 GNBTOK, DEFTOK
      LOGICAL*1 LEXSTR(100)
      INTEGER EQUAL
      LOGICAL*1 SIF(3)
      LOGICAL*1 SELSE(5)
      LOGICAL*1 SWHILE(6)
      LOGICAL*1 SDO(3)
      LOGICAL*1 SBREAK(6)
      LOGICAL*1 SNEXT(5)
      LOGICAL*1 SFOR(4)
      LOGICAL*1 SREPT(7)
      LOGICAL*1 SUNTIL(6)
      LOGICAL*1 SRET(7)
      LOGICAL*1 SSTR(7)
      LOGICAL*1 SSWTCH(7)
      LOGICAL*1 SCASE(5)
      LOGICAL*1 SDEFLT(8)
      DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/0/
      DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE
     *(5)/0/
      DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S
     *WHILE(5)/101/,SWHILE(6)/0/
      DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/0/
      DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR
     *EAK(5)/107/,SBREAK(6)/0/
      DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT
     *(5)/0/
      DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/0/
      DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT
     *(5)/97/,SREPT(6)/116/,SREPT(7)/0/
      DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S
     *UNTIL(5)/108/,SUNTIL(6)/0/
      DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
     *14/,SRET(6)/110/,SRET(7)/0/
      DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1
     *10/,SSTR(6)/103/,SSTR(7)/0/
      DATA SSWTCH(1)/115/,SSWTCH(2)/119/,SSWTCH(3)/105/,SSWTCH(4)/116/,S
     *SWTCH(5)/99/,SSWTCH(6)/104/,SSWTCH(7)/0/
      DATA SCASE(1)/99/,SCASE(2)/97/,SCASE(3)/115/,SCASE(4)/101/,SCASE(5
     *)/0/
      DATA SDEFLT(1)/100/,SDEFLT(2)/101/,SDEFLT(3)/102/,SDEFLT(4)/97/,SD
     *EFLT(5)/117/,SDEFLT(6)/108/,SDEFLT(7)/116/,SDEFLT(8)/0/
      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. -1 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LEX .
     *EQ. 125))GOTO 23206
      RETURN
23206 CONTINUE
      IF(.NOT.(LEX .EQ. 2))GOTO 23208
      LEX = -9
      GOTO 23209
23208 CONTINUE
      IF(.NOT.(LEX .EQ. 37))GOTO 23210
      LEX = -27
      GOTO 23211
23210 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1))GOTO 23212
      LEX = -19
      GOTO 23213
23212 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1))GOTO 23214
      LEX = -11
      GOTO 23215
23214 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1))GOTO 23216
      LEX = -15
      GOTO 23217
23216 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1))GOTO 23218
      LEX = -10
      GOTO 23219
23218 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1))GOTO 23220
      LEX = -8
      GOTO 23221
23220 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1))GOTO 23222
      LEX = -13
      GOTO 23223
23222 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1))GOTO 23224
      LEX = -16
      GOTO 23225
23224 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1))GOTO 23226
      LEX = -17
      GOTO 23227
23226 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1))GOTO 23228
      LEX = -18
      GOTO 23229
23228 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SRET) .EQ. 1))GOTO 23230
      LEX = -20
      GOTO 23231
23230 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SSTR) .EQ. 1))GOTO 23232
      LEX = -23
      GOTO 23233
23232 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SSWTCH) .EQ. 1))GOTO 23234
      LEX = -24
      GOTO 23235
23234 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SCASE) .EQ. 1))GOTO 23236
      LEX = -25
      GOTO 23237
23236 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SDEFLT) .EQ. 1))GOTO 23238
      LEX = -26
      GOTO 23239
23238 CONTINUE
      LEX = -14
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
      LOGICAL*1 FUNCTION NGETCH(C, FD)
      LOGICAL*1 GETCH
      LOGICAL*1 C
      INTEGER FD
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      LOGICAL*1 BUF
      IF(.NOT.(BP .GT. 0))GOTO 23240
      C = BUF(BP)
      BP = BP - 1
      GOTO 23241
23240 CONTINUE
      C = GETCH(C, FD)
23241 CONTINUE
      NGETCH = C
      RETURN
      END
      SUBROUTINE PBSTR(IN)
      LOGICAL*1 IN(100)
      INTEGER LENGTH
      INTEGER I
      I = LENGTH(IN)
23242 IF(.NOT.(I .GT. 0))GOTO 23244
      CALL PUTBAK(IN(I))
23243 I = I - 1
      GOTO 23242
23244 CONTINUE
      RETURN
      END
      SUBROUTINE PUTBAK(C)
      LOGICAL*1 C
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      LOGICAL*1 BUF
      BP = BP + 1
      IF(.NOT.(BP .GT. 300))GOTO 23245
      CALL BADERR(32Htoo many characters pushed back.)
23245 CONTINUE
      BUF(BP) = C
      RETURN
      END
      SUBROUTINE RELATE(TOKEN, LAST, FD)
      LOGICAL*1 NGETCH
      LOGICAL*1 TOKEN(100)
      INTEGER LENGTH
      INTEGER FD, LAST
      IF(.NOT.(NGETCH(TOKEN(2), FD) .NE. 61))GOTO 23247
      CALL PUTBAK(TOKEN(2))
      TOKEN(3) = 116
      GOTO 23248
23247 CONTINUE
      TOKEN(3) = 101
23248 CONTINUE
      TOKEN(4) = 46
      TOKEN(5) = 0
      TOKEN(6) = 0
      IF(.NOT.(TOKEN(1) .EQ. 62))GOTO 23249
      TOKEN(2) = 103
      GOTO 23250
23249 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 60))GOTO 23251
      TOKEN(2) = 108
      GOTO 23252
23251 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ.  33 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ
     *. 94))GOTO 23253
      IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23255
      TOKEN(3) = 111
      TOKEN(4) = 116
      TOKEN(5) = 46
23255 CONTINUE
      TOKEN(2) = 110
      GOTO 23254
23253 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 61))GOTO 23257
      IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23259
      TOKEN(2) = 0
      LAST = 1
      RETURN
23259 CONTINUE
      TOKEN(2) = 101
      TOKEN(3) = 113
      GOTO 23258
23257 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 38))GOTO 23261
      TOKEN(2) = 97
      TOKEN(3) = 110
      TOKEN(4) = 100
      TOKEN(5) = 46
      GOTO 23262
23261 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 124))GOTO 23263
      TOKEN(2) = 111
      TOKEN(3) = 114
      GOTO 23264
23263 CONTINUE
      TOKEN(2) = 0
23264 CONTINUE
23262 CONTINUE
23258 CONTINUE
23254 CONTINUE
23252 CONTINUE
23250 CONTINUE
      TOKEN(1) = 46
      LAST = LENGTH(TOKEN)
      RETURN
      END
      SUBROUTINE MAIN
      INTEGER GETARG, OPEN
      LOGICAL*1 BUF(40)
      INTEGER I
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      LOGICAL*1 DEFNS(8)
      DATA DEFNS(1)/115/,DEFNS(2)/121/,DEFNS(3)/109/,DEFNS(4)/98/,DEFNS(
     *5)/111/,DEFNS(6)/108/,DEFNS(7)/115/,DEFNS(8)/0/
      CALL INITKW
      IF(.NOT.(DEFNS(1) .NE. 0))GOTO 23265
      CALL GETDIR(1, 6, BUF)
      CALL CONCAT(BUF, DEFNS, BUF)
      INFILE(1) = OPEN(BUF, 1)
      IF(.NOT.(INFILE(1) .EQ. -3))GOTO 23267
      CALL REMARK (37Hcan't open standard definitions file.)
      GOTO 23268
23267 CONTINUE
      CALL PARSE
      CALL CLOSE (INFILE(1))
23268 CONTINUE
23265 CONTINUE
      I=1
23269 IF(.NOT.(GETARG(I, BUF, 40) .NE. -1))GOTO 23271
      IF(.NOT.(BUF(1) .EQ. 63 .AND. BUF(2) .EQ. 0))GOTO 23272
      CALL ERROR (33Husage:  rat4 [file ...] >outfile.)
      GOTO 23273
23272 CONTINUE
      IF(.NOT.(BUF(1) .EQ. 45 .AND. BUF(2) .EQ. 0))GOTO 23274
      INFILE(1) = 1
      GOTO 23275
23274 CONTINUE
      INFILE(1) = OPEN(BUF, 1)
      IF(.NOT.(INFILE(1) .EQ. -3))GOTO 23276
      CALL CANT(BUF)
23276 CONTINUE
23275 CONTINUE
23273 CONTINUE
      CALL PARSE
      IF(.NOT.(INFILE(1) .NE. 1))GOTO 23278
      CALL CLOSE(INFILE(1))
23278 CONTINUE
23270 I=I+1
      GOTO 23269
23271 CONTINUE
      IF(.NOT.(I .EQ. 1))GOTO 23280
      INFILE(1) = 1
      CALL PARSE
23280 CONTINUE
      RETURN
      END
      SUBROUTINE EATUP
      LOGICAL*1 GETTOK
      LOGICAL*1 PTOKEN(100), T, TOKEN(100)
      INTEGER NLPAR
      NLPAR = 0
23282 CONTINUE
      T = GETTOK(TOKEN, 100)
      IF(.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23285
      GOTO 23284
23285 CONTINUE
      IF(.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23287
      CALL PBSTR(TOKEN)
      GOTO 23284
23287 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23289
      CALL SYNERR(15Hunexpected EOF.)
      CALL PBSTR(TOKEN)
      GOTO 23284
23289 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. 61 .OR. T .EQ. 95 ))GOTO 23291
23293 IF(.NOT.(GETTOK(PTOKEN, 100) .EQ. 10))GOTO 23294
      GOTO 23293
23294 CONTINUE
      CALL PBSTR(PTOKEN)
      IF(.NOT.(T .EQ. 95))GOTO 23295
      TOKEN(1) = 0
23295 CONTINUE
23291 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23297
      NLPAR = NLPAR + 1
      GOTO 23298
23297 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23299
      NLPAR = NLPAR - 1
23299 CONTINUE
23298 CONTINUE
      CALL OUTSTR(TOKEN)
23283 IF(.NOT.(NLPAR .LT. 0))GOTO 23282
23284 CONTINUE
      IF(.NOT.(NLPAR .NE. 0))GOTO 23301
      CALL SYNERR(23Hunbalanced parentheses.)
23301 CONTINUE
      RETURN
      END
      SUBROUTINE LABELC(LEXSTR)
      LOGICAL*1 LEXSTR(100)
      INTEGER LENGTH
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      IF(.NOT.(LENGTH(LEXSTR) .EQ. 5))GOTO 23303
      IF(.NOT.(LEXSTR(1) .EQ. 50 .AND. LEXSTR(2) .EQ. 51))GOTO 23305
      CALL SYNERR(33Hwarning: possible label conflict.)
23305 CONTINUE
23303 CONTINUE
      CALL OUTSTR(LEXSTR)
      CALL OUTTAB
      RETURN
      END
      SUBROUTINE OTHERC(LEXSTR)
      LOGICAL*1 LEXSTR(100)
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTTAB
      CALL OUTSTR(LEXSTR)
      CALL EATUP
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTCH(C)
      LOGICAL*1 C
      INTEGER I
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      IF(.NOT.(OUTP .GE. 72))GOTO 23307
      CALL OUTDON
      I = 1
23309 IF(.NOT.(I .LT. 6))GOTO 23311
      OUTBUF(I) = 32
23310 I = I + 1
      GOTO 23309
23311 CONTINUE
      OUTBUF(6) = 42
      OUTP = 6
23307 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
      LOGICAL*1 OUTBUF
      LOGICAL*1 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
     *)/0/
      XFER = 0
      IF(.NOT.(N .LE. 0 .AND. OUTP .EQ. 0))GOTO 23312
      RETURN
23312 CONTINUE
      IF(.NOT.(N .GT. 0))GOTO 23314
      CALL OUTNUM(N)
23314 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(CONTIN)
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTDON
      INTEGER ALLBLK
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      OUTBUF(OUTP+1) = 10
      OUTBUF(OUTP+2) = 0
      IF(.NOT.(ALLBLK(OUTBUF) .EQ. 0))GOTO 23316
      CALL PUTLIN(OUTBUF, 2)
23316 CONTINUE
      OUTP = 0
      RETURN
      END
      SUBROUTINE OUTGO(N)
      INTEGER N
      COMMON /CGOTO/ XFER
      INTEGER XFER
      LOGICAL*1 GOTO(6)
      DATA GOTO(1)/103/,GOTO(2)/111/,GOTO(3)/116/,GOTO(4)/111/,GOTO(5)/3
     *2/,GOTO(6)/0/
      IF(.NOT.(XFER .EQ. 1))GOTO 23318
      RETURN
23318 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(GOTO)
      CALL OUTNUM(N)
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTNUM(N)
      LOGICAL*1 CHARS(10)
      INTEGER I, M
      M = IABS(N)
      I = 0
23320 CONTINUE
      I = I + 1
      CHARS(I) = MOD(M, 10) + 48
      M = M / 10
23321 IF(.NOT.(M .EQ. 0 .OR. I .GE. 10))GOTO 23320
23322 CONTINUE
      IF(.NOT.(N .LT. 0))GOTO 23323
      CALL OUTCH(45)
23323 CONTINUE
23325 IF(.NOT.(I .GT. 0))GOTO 23327
      CALL OUTCH(CHARS(I))
23326 I = I - 1
      GOTO 23325
23327 CONTINUE
      RETURN
      END
      SUBROUTINE OUTSTR(STR)
      LOGICAL*1 C, STR(100)
      INTEGER I, J
      I = 1
23328 IF(.NOT.(STR(I) .NE. 0))GOTO 23330
      C = STR(I)
      IF(.NOT.(C .NE. 39 .AND. C .NE. 34))GOTO 23331
      IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23333
      C = C - 97 + 65
23333 CONTINUE
      CALL OUTCH(C)
      GOTO 23332
23331 CONTINUE
      I = I + 1
      J = I
23335 IF(.NOT.(STR(J) .NE. C))GOTO 23337
23336 J = J + 1
      GOTO 23335
23337 CONTINUE
      CALL OUTNUM(J-I)
      CALL OUTCH(72)
23338 IF(.NOT.(I .LT. J))GOTO 23340
      CALL OUTCH(STR(I))
23339 I = I + 1
      GOTO 23338
23340 CONTINUE
23332 CONTINUE
23329 I = I + 1
      GOTO 23328
23330 CONTINUE
      RETURN
      END
      SUBROUTINE OUTTAB
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
23341 IF(.NOT.(OUTP .LT. 6))GOTO 23342
      CALL OUTCH(32)
      GOTO 23341
23342 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ALLBLK(BUF)
      LOGICAL*1 BUF(100)
      INTEGER I
      ALLBLK = 1
      I=1
23343 IF(.NOT.(BUF(I) .NE. 10 .AND. BUF(I) .NE. 0))GOTO 23345
      IF(.NOT.(BUF(I) .NE. 32))GOTO 23346
      ALLBLK = 0
      GOTO 23345
23346 CONTINUE
23344 I=I+1
      GOTO 23343
23345 CONTINUE
      RETURN
      END
      SUBROUTINE INITKW
      LOGICAL*1 DEFT(2), INCT(2), SUBT(2), IFT(2), ART(2), IFDFT(2), IFN
     *DT(2)
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      LOGICAL*1 DEFNAM(7)
      LOGICAL*1 INCNAM(5)
      LOGICAL*1 SUBNAM(7)
      LOGICAL*1 IFNAM(7)
      LOGICAL*1 ARNAM(6)
      LOGICAL*1 IFDFNM(6)
      LOGICAL*1 IFNDNM(9)
      DATA DEFNAM(1)/100/,DEFNAM(2)/101/,DEFNAM(3)/102/,DEFNAM(4)/105/,D
     *EFNAM(5)/110/,DEFNAM(6)/101/,DEFNAM(7)/0/
      DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/,IN
     *CNAM(5)/0/
      DATA SUBNAM(1)/115/,SUBNAM(2)/117/,SUBNAM(3)/98/,SUBNAM(4)/115/,SU
     *BNAM(5)/116/,SUBNAM(6)/114/,SUBNAM(7)/0/
      DATA IFNAM(1)/105/,IFNAM(2)/102/,IFNAM(3)/101/,IFNAM(4)/108/,IFNAM
     *(5)/115/,IFNAM(6)/101/,IFNAM(7)/0/
      DATA ARNAM(1)/97/,ARNAM(2)/114/,ARNAM(3)/105/,ARNAM(4)/116/,ARNAM(
     *5)/104/,ARNAM(6)/0/
      DATA IFDFNM(1)/105/,IFDFNM(2)/102/,IFDFNM(3)/100/,IFDFNM(4)/101/,I
     *FDFNM(5)/102/,IFDFNM(6)/0/
      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)/0/
      DATA DEFT(1), DEFT(2) /-4, 0/
      DATA INCT(1), INCT(2) /-12, 0/
      DATA SUBT(1), SUBT(2) /-13, 0/
      DATA IFT(1), IFT(2) /-11, 0/
      DATA ART(1), ART(2) /-14, 0/
      DATA IFDFT(1), IFDFT(2) /-15, 0/
      DATA IFNDT(1), IFNDT(2) /-16, 0/
      CALL TBINIT
      CALL ULSTAL(DEFNAM, DEFT)
      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
      RETURN
      END
      SUBROUTINE INIT
      INTEGER I
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250
     *)
      INTEGER LASTP
      INTEGER LASTT
      INTEGER HSHPTR
      INTEGER TABPTR
      LOGICAL*1 TABLE
      COMMON /CFNAME/ FCNAME(40)
      LOGICAL*1 FCNAME
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      LOGICAL*1 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) = 0
      BP = 0
      FORDEP = 0
      FCNAME(1) = 0
      SWTOP = 0
      SWLAST = 1
      RETURN
      END
      SUBROUTINE PARSE
      LOGICAL*1 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
      LOGICAL*1 FORSTK
      COMMON /CFNAME/ FCNAME(40)
      LOGICAL*1 FCNAME
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250
     *)
      INTEGER LASTP
      INTEGER LASTT
      INTEGER HSHPTR
      INTEGER TABPTR
      LOGICAL*1 TABLE
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      CALL INIT
      SP = 1
      LEXTYP(1) = -1
      TOKEN = LEX(LEXSTR)
23348 IF(.NOT.(TOKEN .NE. -1))GOTO 23350
      IF(.NOT.(TOKEN .EQ. -19))GOTO 23351
      CALL IFCODE(LAB)
      GOTO 23352
23351 CONTINUE
      IF(.NOT.(TOKEN .EQ. -10))GOTO 23353
      CALL DOCODE(LAB)
      GOTO 23354
23353 CONTINUE
      IF(.NOT.(TOKEN .EQ. -15))GOTO 23355
      CALL WHILEC(LAB)
      GOTO 23356
23355 CONTINUE
      IF(.NOT.(TOKEN .EQ. -16))GOTO 23357
      CALL FORCOD(LAB)
      GOTO 23358
23357 CONTINUE
      IF(.NOT.(TOKEN .EQ. -17))GOTO 23359
      CALL REPCOD(LAB)
      GOTO 23360
23359 CONTINUE
      IF(.NOT.(TOKEN .EQ. -24))GOTO 23361
      CALL SWCODE(LAB)
      GOTO 23362
23361 CONTINUE
      IF(.NOT.(TOKEN .EQ. -25 .OR. TOKEN .EQ. -26))GOTO 23363
      I = SP
23365 IF(.NOT.(I .GT. 0))GOTO 23367
      IF(.NOT.(LEXTYP(I) .EQ. -24))GOTO 23368
      GOTO 23367
23368 CONTINUE
23366 I = I - 1
      GOTO 23365
23367 CONTINUE
      IF(.NOT.(I .EQ. 0))GOTO 23370
      CALL SYNERR(24Hillegal case or default.)
      GOTO 23371
23370 CONTINUE
      CALL CASCOD(LABVAL(I), TOKEN)
23371 CONTINUE
      GOTO 23364
23363 CONTINUE
      IF(.NOT.(TOKEN .EQ. -9))GOTO 23372
      CALL LABELC(LEXSTR)
      GOTO 23373
23372 CONTINUE
      IF(.NOT.(TOKEN .EQ. -11))GOTO 23374
      IF(.NOT.(LEXTYP(SP) .EQ. -19))GOTO 23376
      CALL ELSEIF(LABVAL(SP))
      GOTO 23377
23376 CONTINUE
      CALL SYNERR(13Hillegal else.)
23377 CONTINUE
      GOTO 23375
23374 CONTINUE
      IF(.NOT.(TOKEN .EQ. -27))GOTO 23378
      CALL LITRAL
23378 CONTINUE
23375 CONTINUE
23373 CONTINUE
23364 CONTINUE
23362 CONTINUE
23360 CONTINUE
23358 CONTINUE
23356 CONTINUE
23354 CONTINUE
23352 CONTINUE
      IF(.NOT.(TOKEN .EQ. -19 .OR. TOKEN .EQ. -11 .OR. TOKEN .EQ. -15 .O
     *R. TOKEN .EQ. -16 .OR. TOKEN .EQ. -17 .OR. TOKEN .EQ. -24 .OR. TOK
     *EN .EQ. -10 .OR. TOKEN .EQ. -9 .OR. TOKEN .EQ. 123))GOTO 23380
      SP = SP + 1
      IF(.NOT.(SP .GT. 100))GOTO 23382
      CALL BADERR(25Hstack overflow in parser.)
23382 CONTINUE
      LEXTYP(SP) = TOKEN
      LABVAL(SP) = LAB
      GOTO 23381
23380 CONTINUE
      IF(.NOT.(TOKEN .NE. -25 .AND. TOKEN .NE. -26))GOTO 23384
      IF(.NOT.(TOKEN .EQ. 125))GOTO 23386
      IF(.NOT.(LEXTYP(SP) .EQ. 123))GOTO 23388
      SP = SP - 1
      GOTO 23389
23388 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -24))GOTO 23390
      CALL SWEND(LABVAL(SP))
      SP = SP - 1
      GOTO 23391
23390 CONTINUE
      CALL SYNERR(20Hillegal right brace.)
23391 CONTINUE
23389 CONTINUE
      GOTO 23387
23386 CONTINUE
      IF(.NOT.(TOKEN .EQ. -14))GOTO 23392
      CALL OTHERC(LEXSTR)
      GOTO 23393
23392 CONTINUE
      IF(.NOT.(TOKEN .EQ. -8 .OR. TOKEN .EQ. -13))GOTO 23394
      CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
      GOTO 23395
23394 CONTINUE
      IF(.NOT.(TOKEN .EQ. -20))GOTO 23396
      CALL RETCOD
      GOTO 23397
23396 CONTINUE
      IF(.NOT.(TOKEN .EQ. -23))GOTO 23398
      CALL STRDCL
23398 CONTINUE
23397 CONTINUE
23395 CONTINUE
23393 CONTINUE
23387 CONTINUE
      TOKEN = LEX(LEXSTR)
      CALL PBSTR(LEXSTR)
      CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
23384 CONTINUE
23381 CONTINUE
23349 TOKEN = LEX(LEXSTR)
      GOTO 23348
23350 CONTINUE
      IF(.NOT.(SP .NE. 1))GOTO 23400
      CALL SYNERR(15Hunexpected EOF.)
23400 CONTINUE
      RETURN
      END
      SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
23402 IF(.NOT.(SP .GT. 1))GOTO 23404
      IF(.NOT.(LEXTYP(SP) .EQ. 123 .OR. LEXTYP(SP) .EQ. -24))GOTO 23405
      GOTO 23404
23405 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -19 .AND. TOKEN .EQ. -11))GOTO 23407
      GOTO 23404
23407 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -19))GOTO 23409
      CALL OUTCON(LABVAL(SP))
      GOTO 23410
23409 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -11))GOTO 23411
      IF(.NOT.(SP .GT. 2))GOTO 23413
      SP = SP - 1
23413 CONTINUE
      CALL OUTCON(LABVAL(SP)+1)
      GOTO 23412
23411 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -10))GOTO 23415
      CALL DOSTAT(LABVAL(SP))
      GOTO 23416
23415 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -15))GOTO 23417
      CALL WHILES(LABVAL(SP))
      GOTO 23418
23417 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -16))GOTO 23419
      CALL FORS(LABVAL(SP))
      GOTO 23420
23419 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. -17))GOTO 23421
      CALL UNTILS(LABVAL(SP), TOKEN)
23421 CONTINUE
23420 CONTINUE
23418 CONTINUE
23416 CONTINUE
23412 CONTINUE
23410 CONTINUE
23403 SP = SP - 1
      GOTO 23402
23404 CONTINUE
      RETURN
      END
      SUBROUTINE ULSTAL(NAME, DEFN)
      LOGICAL*1 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)
      LOGICAL*1 PTOKEN(100)
      INTEGER LEX
      INTEGER JUNK, LAB, TOKEN
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTNUM(LAB)
      IF(.NOT.(TOKEN .EQ. -18))GOTO 23423
      JUNK = LEX(PTOKEN)
      CALL IFGO(LAB-1)
      GOTO 23424
23423 CONTINUE
      CALL OUTGO(LAB-1)
23424 CONTINUE
      CALL OUTCON(LAB+1)
      RETURN
      END
      SUBROUTINE RETCOD
      LOGICAL*1 TOKEN(100), GNBTOK, T
      COMMON /CFNAME/ FCNAME(40)
      LOGICAL*1 FCNAME
      COMMON /CGOTO/ XFER
      INTEGER XFER
      LOGICAL*1 SRET(7)
      DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
     *14/,SRET(6)/110/,SRET(7)/0/
      T = GNBTOK(TOKEN, 100)
      IF(.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23425
      CALL PBSTR(TOKEN)
      CALL OUTTAB
      CALL OUTSTR(FCNAME)
      CALL OUTCH(61)
      CALL EATUP
      CALL OUTDON
      GOTO 23426
23425 CONTINUE
      IF(.NOT.(T .EQ. 125))GOTO 23427
      CALL PBSTR(TOKEN)
23427 CONTINUE
23426 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(SRET)
      CALL OUTDON
      XFER = 1
      RETURN
      END
      SUBROUTINE STRDCL
      LOGICAL*1 T, TOKEN(100), GNBTOK, ESC
      INTEGER I, J, K, N, LEN
      INTEGER LENGTH, CTOI, LEX, ELENTH
      LOGICAL*1 DCHAR(100)
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      LOGICAL*1 SBUF
      LOGICAL*1 CHAR(11)
      LOGICAL*1 DAT(6)
      LOGICAL*1 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)/0/
      DATA DAT(1)/100/,DAT(2)/97/,DAT(3)/116/,DAT(4)/97/,DAT(5)/32/,DAT(
     *6)/0/
      DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/47/,EOSS(5)/0/
      T = GNBTOK(TOKEN, 100)
      IF(.NOT.(T .NE. -9))GOTO 23429
      CALL SYNERR(21Hmissing string token.)
23429 CONTINUE
      CALL OUTTAB
      CALL PBSTR(CHAR)
23431 CONTINUE
      T = GNBTOK(DCHAR, 100)
      IF(.NOT.(T .EQ. 47))GOTO 23434
      GOTO 23433
23434 CONTINUE
      CALL OUTSTR (DCHAR)
23432 GOTO 23431
23433 CONTINUE
      CALL OUTCH(32)
      CALL OUTSTR(TOKEN)
      CALL ADDSTR(TOKEN, SBUF, SBP, 500)
      CALL ADDCHR(0, SBUF, SBP, 500)
      IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23436
      LEN = ELENTH(TOKEN) + 1
      IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23438
      LEN = LEN - 2
23438 CONTINUE
      GOTO 23437
23436 CONTINUE
      T = GNBTOK(TOKEN, 100)
      I = 1
      LEN = CTOI(TOKEN, I)
      IF(.NOT.(TOKEN(I) .NE. 0))GOTO 23440
      CALL SYNERR(20Hinvalid string size.)
23440 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 41))GOTO 23442
      CALL SYNERR(20Hmissing right paren.)
      GOTO 23443
23442 CONTINUE
      T = GNBTOK(TOKEN, 100)
23443 CONTINUE
23437 CONTINUE
      CALL OUTCH(40)
      CALL OUTNUM(LEN)
      CALL OUTCH(41)
      CALL OUTDON
      IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23444
      LEN = LENGTH(TOKEN)
      TOKEN(LEN) = 0
      CALL ADDSTR(TOKEN(2), SBUF, SBP, 500)
      GOTO 23445
23444 CONTINUE
      CALL ADDSTR(TOKEN, SBUF, SBP, 500)
23445 CONTINUE
      CALL ADDCHR(0, SBUF, SBP, 500)
      T = LEX(TOKEN)
      CALL PBSTR(TOKEN)
      IF(.NOT.(T .NE. -23))GOTO 23446
      I = 1
23448 IF(.NOT.(I .LT. SBP))GOTO 23450
      CALL OUTTAB
      CALL OUTSTR(DAT)
      K = 1
      J = I + LENGTH(SBUF(I)) + 1
23451 CONTINUE
      IF(.NOT.(K .GT. 1))GOTO 23454
      CALL OUTCH(44)
23454 CONTINUE
      CALL OUTSTR(SBUF(I))
      CALL OUTCH(40)
      CALL OUTNUM(K)
      CALL OUTCH(41)
      CALL OUTCH(47)
      IF(.NOT.(SBUF(J) .EQ. 0))GOTO 23456
      GOTO 23453
23456 CONTINUE
      N = ESC(SBUF, J)
      CALL OUTNUM (N)
      CALL OUTCH(47)
      K = K + 1
23452 J = J + 1
      GOTO 23451
23453 CONTINUE
      CALL PBSTR(EOSS)
23458 CONTINUE
      T = GNBTOK(TOKEN, 100)
      CALL OUTSTR(TOKEN)
23459 IF(.NOT.(T .EQ. 47))GOTO 23458
23460 CONTINUE
      CALL OUTDON
23449 I = J + 1
      GOTO 23448
23450 CONTINUE
      SBP = 1
23446 CONTINUE
      RETURN
      END
      SUBROUTINE ADDCHR(C, BUF, BP, MAXSIZ)
      INTEGER BP, MAXSIZ
      LOGICAL*1 C, BUF(100)
      IF(.NOT.(BP .GT. MAXSIZ))GOTO 23461
      CALL BADERR(16Hbuffer overflow.)
23461 CONTINUE
      BUF(BP) = C
      BP = BP + 1
      RETURN
      END
      SUBROUTINE ADDSTR(S, BUF, BP, MAXSIZ)
      LOGICAL*1 S(100), BUF(100)
      INTEGER BP, MAXSIZ
      INTEGER I
      I = 1
23463 IF(.NOT.(S(I) .NE. 0))GOTO 23465
      CALL ADDCHR(S(I), BUF, BP, MAXSIZ)
23464 I=I+1
      GOTO 23463
23465 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ALLDIG(STR)
      LOGICAL*1 TYPE
      LOGICAL*1 STR(100)
      INTEGER I
      ALLDIG = 0
      IF(.NOT.(STR(1) .EQ. 0))GOTO 23466
      RETURN
23466 CONTINUE
      I = 1
23468 IF(.NOT.(STR(I) .NE. 0))GOTO 23470
      IF(.NOT.(TYPE(STR(I)) .NE. 2))GOTO 23471
      RETURN
23471 CONTINUE
23469 I = I + 1
      GOTO 23468
23470 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
      LOGICAL*1 C, NGETCH
      C = NGETCH(C, FD)
23473 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23475
23474 C = NGETCH(C, FD)
      GOTO 23473
23475 CONTINUE
      CALL PUTBAK(C)
      RETURN
      END
      SUBROUTINE CASCOD(LAB, TOKEN)
      INTEGER LAB, TOKEN
      INTEGER T, L, LB, UB, I, J
      LOGICAL*1 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 23476
      CALL SYNERR(24Hillegal case or default.)
      RETURN
23476 CONTINUE
      CALL OUTGO(LAB+1)
      XFER = 1
      L = LABGEN(1)
      IF(.NOT.(TOKEN .EQ. -25))GOTO 23478
23480 IF(.NOT.(CASLAB(LB, T) .NE. -1))GOTO 23481
      UB = LB
      IF(.NOT.(T .EQ. 45))GOTO 23482
      JUNK = CASLAB(UB, T)
23482 CONTINUE
      IF(.NOT.(LB .GT. UB))GOTO 23484
      CALL SYNERR(28Hillegal range in case label.)
      UB = LB
23484 CONTINUE
      IF(.NOT.(SWLAST + 3 .GT. 1000))GOTO 23486
      CALL BADERR(22Hswitch table overflow.)
23486 CONTINUE
      I = SWTOP + 3
23488 IF(.NOT.(I .LT. SWLAST))GOTO 23490
      IF(.NOT.(LB .LE. SWSTAK(I)))GOTO 23491
      GOTO 23490
23491 CONTINUE
      IF(.NOT.(LB .LE. SWSTAK(I+1)))GOTO 23493
      CALL SYNERR(21Hduplicate case label.)
23493 CONTINUE
23492 CONTINUE
23489 I = I + 3
      GOTO 23488
23490 CONTINUE
      IF(.NOT.(I .LT. SWLAST .AND. UB .GE. SWSTAK(I)))GOTO 23495
      CALL SYNERR(21Hduplicate case label.)
23495 CONTINUE
      J = SWLAST
23497 IF(.NOT.(J .GT. I))GOTO 23499
      SWSTAK(J+2) = SWSTAK(J-1)
23498 J = J - 1
      GOTO 23497
23499 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 23500
      GOTO 23481
23500 CONTINUE
      IF(.NOT.(T .NE. 44))GOTO 23502
      CALL SYNERR(20Hillegal case syntax.)
23502 CONTINUE
23501 CONTINUE
      GOTO 23480
23481 CONTINUE
      GOTO 23479
23478 CONTINUE
      T = GNBTOK(TOK, 100)
      IF(.NOT.(SWSTAK(SWTOP+2) .NE. 0))GOTO 23504
      CALL ERROR(38Hmultiple defaults in switch statement.)
      GOTO 23505
23504 CONTINUE
      SWSTAK(SWTOP+2) = L
23505 CONTINUE
23479 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23506
      CALL SYNERR(15Hunexpected EOF.)
      GOTO 23507
23506 CONTINUE
      IF(.NOT.(T .NE. 58))GOTO 23508
      CALL ERROR(39Hmissing colon in case or default label.)
23508 CONTINUE
23507 CONTINUE
      XFER = 0
      CALL OUTCON(L)
      RETURN
      END
      INTEGER FUNCTION CASLAB(N, T)
      INTEGER N, T
      LOGICAL*1 TOK(100)
      INTEGER I, S
      INTEGER GNBTOK, CTOI
      T = GNBTOK(TOK, 100)
23510 IF(.NOT.(T .EQ. 10))GOTO 23511
      T = GNBTOK(TOK, 100)
      GOTO 23510
23511 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23512
      CASLAB=(T)
      RETURN
23512 CONTINUE
      IF(.NOT.(T .EQ. 45))GOTO 23514
      S = -1
      GOTO 23515
23514 CONTINUE
      S = +1
23515 CONTINUE
      IF(.NOT.(T .EQ. 45 .OR. T .EQ. 43))GOTO 23516
      T = GNBTOK(TOK, 100)
23516 CONTINUE
      IF(.NOT.(T .NE. 2))GOTO 23518
      CALL SYNERR(19Hinvalid case label.)
      N = 0
      GOTO 23519
23518 CONTINUE
      I = 1
      N = S*CTOI(TOK, I)
23519 CONTINUE
      T = GNBTOK(TOK, 100)
23520 IF(.NOT.(T .EQ. 10))GOTO 23521
      T = GNBTOK(TOK, 100)
      GOTO 23520
23521 CONTINUE
      RETURN
      END
      SUBROUTINE SWCODE(LAB)
      INTEGER LAB
      LOGICAL*1 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 23522
      CALL BADERR(22Hswitch table overflow.)
23522 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
23524 IF(.NOT.(GNBTOK(TOK, 100) .EQ. 10))GOTO 23525
      GOTO 23524
23525 CONTINUE
      IF(.NOT.(TOK(1) .NE. 123))GOTO 23526
      CALL SYNERR(39Hmissing left brace in switch statement.)
      CALL PBSTR(TOK)
23526 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
      LOGICAL*1 SIF(4)
      LOGICAL*1 SLT(10)
      LOGICAL*1 SGT(5)
      LOGICAL*1 SGOTO(6)
      LOGICAL*1 SEQ(5)
      LOGICAL*1 SGE(5)
      LOGICAL*1 SLE(5)
      LOGICAL*1 SAND(6)
      DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/40/,SIF(4)/0/
      DATA SLT(1)/46/,SLT(2)/108/,SLT(3)/116/,SLT(4)/46/,SLT(5)/49/,SLT(
     *6)/46/,SLT(7)/111/,SLT(8)/114/,SLT(9)/46/,SLT(10)/0/
      DATA SGT(1)/46/,SGT(2)/103/,SGT(3)/116/,SGT(4)/46/,SGT(5)/0/
      DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO
     *(5)/40/,SGOTO(6)/0/
      DATA SEQ(1)/46/,SEQ(2)/101/,SEQ(3)/113/,SEQ(4)/46/,SEQ(5)/0/
      DATA SGE(1)/46/,SGE(2)/103/,SGE(3)/101/,SGE(4)/46/,SGE(5)/0/
      DATA SLE(1)/46/,SLE(2)/108/,SLE(3)/101/,SLE(4)/46/,SLE(5)/0/
      DATA SAND(1)/46/,SAND(2)/97/,SAND(3)/110/,SAND(4)/100/,SAND(5)/46/
     *,SAND(6)/0/
      LB = SWSTAK(SWTOP+3)
      UB = SWSTAK(SWLAST-2)
      N = SWSTAK(SWTOP+1)
      CALL OUTGO(LAB+1)
      IF(.NOT.(SWSTAK(SWTOP+2) .EQ. 0))GOTO 23528
      SWSTAK(SWTOP+2) = LAB + 1
23528 CONTINUE
      XFER = 0
      CALL OUTCON(LAB)
      IF(.NOT.(N .GE. 3 .AND. UB - LB + 1 .LT. 2*N))GOTO 23530
      IF(.NOT.(LB .NE. 1))GOTO 23532
      CALL OUTTAB
      CALL SWVAR(LAB)
      CALL OUTCH(61)
      CALL SWVAR(LAB)
      IF(.NOT.(LB .LT. 1))GOTO 23534
      CALL OUTCH(43)
23534 CONTINUE
      CALL OUTNUM(-LB + 1)
      CALL OUTDON
23532 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
23536 IF(.NOT.(I .LT. SWLAST))GOTO 23538
23539 IF(.NOT.(J .LT. SWSTAK(I)))GOTO 23541
      CALL OUTNUM(SWSTAK(SWTOP+2))
      CALL OUTCH(44)
23540 J = J + 1
      GOTO 23539
23541 CONTINUE
      J = SWSTAK(I+1) - SWSTAK(I)
23542 IF(.NOT.(J .GE. 0))GOTO 23544
      CALL OUTNUM(SWSTAK(I+2))
23543 J = J - 1
      GOTO 23542
23544 CONTINUE
      J = SWSTAK(I+1) + 1
      IF(.NOT.(I .LT. SWLAST - 3))GOTO 23545
      CALL OUTCH(44)
23545 CONTINUE
23537 I = I + 3
      GOTO 23536
23538 CONTINUE
      CALL OUTCH(41)
      CALL OUTCH(44)
      CALL SWVAR(LAB)
      CALL OUTDON
      GOTO 23531
23530 CONTINUE
      IF(.NOT.(N .GT. 0))GOTO 23547
      I = SWTOP + 3
23549 IF(.NOT.(I .LT. SWLAST))GOTO 23551
      CALL OUTTAB
      CALL OUTSTR(SIF)
      CALL SWVAR(LAB)
      IF(.NOT.(SWSTAK(I) .EQ. SWSTAK(I+1)))GOTO 23552
      CALL OUTSTR(SEQ)
      CALL OUTNUM(SWSTAK(I))
      GOTO 23553
23552 CONTINUE
      CALL OUTSTR(SGE)
      CALL OUTNUM(SWSTAK(I))
      CALL OUTSTR(SAND)
      CALL SWVAR(LAB)
      CALL OUTSTR(SLE)
      CALL OUTNUM(SWSTAK(I+1))
23553 CONTINUE
      CALL OUTCH(41)
      CALL OUTGO(SWSTAK(I+2))
23550 I = I + 3
      GOTO 23549
23551 CONTINUE
      IF(.NOT.(LAB + 1 .NE. SWSTAK(SWTOP+2)))GOTO 23554
      CALL OUTGO(SWSTAK(SWTOP+2))
23554 CONTINUE
23547 CONTINUE
23531 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
      SUBROUTINE LITRAL
      INTEGER GETLIN, INDEX
      INTEGER I
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CLINE/ LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(120)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      IF(.NOT.(OUTP .GT. 0))GOTO 23556
      CALL OUTDON
23556 CONTINUE
      I = GETLIN (OUTBUF, INFILE(LEVEL))
23558 IF(.NOT.( GETLIN (OUTBUF, INFILE(LEVEL)) .NE. -1 ))GOTO 23559
      I = 1
      CALL SKIPBL (OUTBUF, I)
      IF(.NOT.(OUTBUF(I) .EQ. 37))GOTO 23560
      GOTO 23559
23560 CONTINUE
      CALL PUTLIN (OUTBUF, 2)
      LINECT(LEVEL) = LINECT(LEVEL) + 1
      GOTO 23558
23559 CONTINUE
      OUTP = 0
      RETURN
      END
      SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
      INTEGER I, N, ALLDIG, CTOI
      LOGICAL*1 T, PTOKEN(100), GNBTOK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      N = 0
      T = GNBTOK(PTOKEN, 100)
      IF(.NOT.(ALLDIG(PTOKEN) .EQ. 1))GOTO 23562
      I = 1
      N = CTOI(PTOKEN, I) - 1
      GOTO 23563
23562 CONTINUE
      IF(.NOT.(T .NE. 59))GOTO 23564
      CALL PBSTR(PTOKEN)
23564 CONTINUE
23563 CONTINUE
      I = SP
23566 IF(.NOT.(I .GT. 0))GOTO 23568
      IF(.NOT.(LEXTYP(I) .EQ. -15 .OR. LEXTYP(I) .EQ. -10 .OR. LEXTYP(I)
     * .EQ. -16 .OR. LEXTYP(I) .EQ. -17))GOTO 23569
      IF(.NOT.(N .GT. 0))GOTO 23571
      N = N - 1
      GOTO 23567
23571 CONTINUE
      IF(.NOT.(TOKEN .EQ. -8))GOTO 23573
      CALL OUTGO(LABVAL(I)+1)
      GOTO 23574
23573 CONTINUE
      CALL OUTGO(LABVAL(I))
23574 CONTINUE
23572 CONTINUE
      XFER = 1
      RETURN
23569 CONTINUE
23567 I = I - 1
      GOTO 23566
23568 CONTINUE
      IF(.NOT.(TOKEN .EQ. -8))GOTO 23575
      CALL SYNERR(14Hillegal break.)
      GOTO 23576
23575 CONTINUE
      CALL SYNERR(13Hillegal next.)
23576 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION DEFTOK(TOKEN, TOKSIZ, FD)
      LOGICAL*1 TOKEN(100)
      INTEGER TOKSIZ, FD
      LOGICAL*1 GTOK
      INTEGER LOOKUP, PUSH, IFPARM
      LOGICAL*1 T, C, DEFN(200), BALP(3), MDEFN(200)
      INTEGER AP, ARGSTK(100), CALLST(50), NLB, PLEV(50), IFL
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      DATA BALP/40, 41, 0/
      CP = 0
      AP = 1
      EP = 1
      T=GTOK(TOKEN,TOKSIZ,FD)
23577 IF(.NOT.(T .NE. -1))GOTO 23579
      IF(.NOT.(T .EQ. -9))GOTO 23580
      IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23582
      IF(.NOT.(CP .EQ. 0))GOTO 23584
      GOTO 23579
23584 CONTINUE
      CALL PUTTOK(TOKEN)
23585 CONTINUE
      GOTO 23583
23582 CONTINUE
      IF(.NOT.(DEFN(1) .EQ. -4))GOTO 23586
      CALL GETDEF(TOKEN, TOKSIZ, DEFN, 200, FD)
      CALL INSTAL(TOKEN, DEFN)
      GOTO 23587
23586 CONTINUE
      IF(.NOT.(DEFN(1) .EQ. -15 .OR. DEFN(1) .EQ. -16))GOTO 23588
      C = DEFN(1)
      CALL GETDEF(TOKEN, TOKSIZ, DEFN, 200, FD)
      IFL = LOOKUP(TOKEN, MDEFN)
      IF(.NOT.((IFL .EQ. 1 .AND. C .EQ. -15) .OR. (IFL .EQ. 0 .AND. C .E
     *Q. -16)))GOTO 23590
      CALL PBSTR(DEFN)
23590 CONTINUE
      GOTO 23589
23588 CONTINUE
      CP = CP + 1
      IF(.NOT.(CP .GT. 50))GOTO 23592
      CALL BADERR(20Hcall stack overflow.)
23592 CONTINUE
      CALLST(CP) = AP
      AP = PUSH(EP, ARGSTK, AP)
      CALL PUTTOK(DEFN)
      CALL PUTCHR(0)
      AP = PUSH(EP, ARGSTK, AP)
      CALL PUTTOK(TOKEN)
      CALL PUTCHR(0)
      AP = PUSH(EP, ARGSTK, AP)
      T = GTOK(TOKEN, TOKSIZ, FD)
      CALL PBSTR(TOKEN)
      IF(.NOT.(T .NE. 40))GOTO 23594
      CALL PBSTR(BALP)
      GOTO 23595
23594 CONTINUE
      IF(.NOT.(IFPARM(DEFN) .EQ. 0))GOTO 23596
      CALL PBSTR(BALP)
23596 CONTINUE
23595 CONTINUE
      PLEV(CP) = 0
23589 CONTINUE
23587 CONTINUE
23583 CONTINUE
      GOTO 23581
23580 CONTINUE
      IF(.NOT.(T .EQ. -10))GOTO 23598
      NLB = 1
23600 CONTINUE
      T = GTOK(TOKEN, TOKSIZ, FD)
      IF(.NOT.(T .EQ. -10))GOTO 23603
      NLB = NLB + 1
      GOTO 23604
23603 CONTINUE
      IF(.NOT.(T .EQ. -11))GOTO 23605
      NLB = NLB - 1
      IF(.NOT.(NLB .EQ. 0))GOTO 23607
      GOTO 23602
23607 CONTINUE
      GOTO 23606
23605 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23609
      CALL BADERR(14HEOF in string.)
23609 CONTINUE
23606 CONTINUE
23604 CONTINUE
      CALL PUTTOK(TOKEN)
23601 GOTO 23600
23602 CONTINUE
      GOTO 23599
23598 CONTINUE
      IF(.NOT.(CP .EQ. 0))GOTO 23611
      GOTO 23579
23611 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23613
      IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23615
      CALL PUTTOK(TOKEN)
23615 CONTINUE
      PLEV(CP) = PLEV(CP) + 1
      GOTO 23614
23613 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23617
      PLEV(CP) = PLEV(CP) - 1
      IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23619
      CALL PUTTOK(TOKEN)
      GOTO 23620
23619 CONTINUE
      CALL PUTCHR(0)
      CALL EVALR(ARGSTK, CALLST(CP), AP-1)
      AP = CALLST(CP)
      EP = ARGSTK(AP)
      CP = CP - 1
23620 CONTINUE
      GOTO 23618
23617 CONTINUE
      IF(.NOT.(T .EQ. 44 .AND. PLEV(CP) .EQ. 1))GOTO 23621
      CALL PUTCHR(0)
      AP = PUSH(EP, ARGSTK, AP)
      GOTO 23622
23621 CONTINUE
      CALL PUTTOK(TOKEN)
23622 CONTINUE
23618 CONTINUE
23614 CONTINUE
23612 CONTINUE
23599 CONTINUE
23581 CONTINUE
23578 T=GTOK(TOKEN,TOKSIZ,FD)
      GOTO 23577
23579 CONTINUE
      DEFTOK = T
      IF(.NOT.(T .EQ. -9))GOTO 23623
      CALL FOLD(TOKEN)
23623 CONTINUE
      RETURN
      END
      SUBROUTINE DOARTH(ARGSTK,I,J)
      INTEGER CTOI
      INTEGER ARGSTK(100), I, J, K, L
      LOGICAL*1 OP
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      K = ARGSTK(I+2)
      L = ARGSTK(I+4)
      OP = EVALST(ARGSTK(I+3))
      IF(.NOT.(OP .EQ. 43))GOTO 23625
      CALL PBNUM(CTOI(EVALST,K)+CTOI(EVALST,L))
      GOTO 23626
23625 CONTINUE
      IF(.NOT.(OP .EQ. 45))GOTO 23627
      CALL PBNUM(CTOI(EVALST,K)-CTOI(EVALST,L))
      GOTO 23628
23627 CONTINUE
      IF(.NOT.(OP .EQ. 42 ))GOTO 23629
      CALL PBNUM(CTOI(EVALST,K)*CTOI(EVALST,L))
      GOTO 23630
23629 CONTINUE
      IF(.NOT.(OP .EQ. 47 ))GOTO 23631
      CALL PBNUM(CTOI(EVALST,K)/CTOI(EVALST,L))
      GOTO 23632
23631 CONTINUE
      CALL REMARK(11Harith error)
23632 CONTINUE
23630 CONTINUE
23628 CONTINUE
23626 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
      LOGICAL*1 EVALST
      IF(.NOT.(J - I .LT. 5))GOTO 23633
      RETURN
23633 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 23635
      CALL PBSTR(EVALST(A4))
      GOTO 23636
23635 CONTINUE
      CALL PBSTR(EVALST(A5))
23636 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
      LOGICAL*1 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
      LOGICAL*1 EVALST
      IF(.NOT.(J - I .LT. 3))GOTO 23637
      RETURN
23637 CONTINUE
      IF(.NOT.(J - I .LT. 4))GOTO 23639
      NC = 100
      GOTO 23640
23639 CONTINUE
      K = ARGSTK(I+4)
      NC = CTOI(EVALST, K)
23640 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
     *641
      K = FC + MIN0(NC, LENGTH(EVALST(FC))) - 1
23643 IF(.NOT.(K .GE. FC))GOTO 23645
      CALL PUTBAK(EVALST(K))
23644 K = K - 1
      GOTO 23643
23645 CONTINUE
23641 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
      LOGICAL*1 EVALST
      LOGICAL*1 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) /0/
      T = ARGSTK(I)
      TD = EVALST(T)
      IF(.NOT.(TD .EQ. -12))GOTO 23646
      CALL DOINCR(ARGSTK, I, J)
      GOTO 23647
23646 CONTINUE
      IF(.NOT.(TD .EQ. -13))GOTO 23648
      CALL DOSUB(ARGSTK, I, J)
      GOTO 23649
23648 CONTINUE
      IF(.NOT.(TD .EQ. -11))GOTO 23650
      CALL DOIF(ARGSTK, I, J)
      GOTO 23651
23650 CONTINUE
      IF(.NOT.(TD .EQ. -14))GOTO 23652
      CALL DOARTH(ARGSTK, I, J)
      GOTO 23653
23652 CONTINUE
      K = T+LENGTH(EVALST(T))-1
23654 IF(.NOT.(K .GT. T))GOTO 23656
      IF(.NOT.(EVALST(K-1) .NE. 36))GOTO 23657
      CALL PUTBAK(EVALST(K))
      GOTO 23658
23657 CONTINUE
      ARGNO = INDEX(DIGITS, EVALST(K)) - 1
      IF(.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J-I))GOTO 23659
      N = I + ARGNO + 1
      M = ARGSTK(N)
      CALL PBSTR(EVALST(M))
23659 CONTINUE
      K = K - 1
23658 CONTINUE
23655 K = K - 1
      GOTO 23654
23656 CONTINUE
      IF(.NOT.(K .EQ. T))GOTO 23661
      CALL PUTBAK(EVALST(K))
23661 CONTINUE
23653 CONTINUE
23651 CONTINUE
23649 CONTINUE
23647 CONTINUE
      RETURN
      END
      INTEGER FUNCTION IFPARM(STRNG)
      LOGICAL*1 STRNG(100), C
      INTEGER I, INDEX, TYPE
      C = STRNG(1)
      IF(.NOT.(C .EQ. -12 .OR. C .EQ. -13 .OR. C .EQ. -11 .OR. C .EQ. -1
     *4 .OR. C .EQ. -15))GOTO 23663
      IFPARM = 1
      GOTO 23664
23663 CONTINUE
      IFPARM = 0
      I=1
23665 IF(.NOT.(INDEX(STRNG(I), 36) .GT. 0))GOTO 23667
      I = I + INDEX(STRNG(I), 36)
      IF(.NOT.(TYPE(STRNG(I)) .EQ. 2))GOTO 23668
      IF(.NOT.(TYPE(STRNG(I+1)) .NE. 2))GOTO 23670
      IFPARM = 1
      GOTO 23667
23670 CONTINUE
23668 CONTINUE
23666 GOTO 23665
23667 CONTINUE
23664 CONTINUE
      RETURN
      END
      SUBROUTINE PBNUM(N)
      INTEGER MOD
      INTEGER M, N, NUM
      LOGICAL*1 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) /0/
      NUM = IABS(N)
23672 CONTINUE
      M = MOD(NUM, 10)
      CALL PUTBAK(DIGITS(M+1))
      NUM = NUM / 10
23673 IF(.NOT.(NUM .EQ. 0))GOTO 23672
23674 CONTINUE
      IF(.NOT.(N .LT. 0))GOTO 23675
      CALL PUTBAK(45)
23675 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PUSH(EP, ARGSTK, AP)
      INTEGER AP, ARGSTK(100), EP
      IF(.NOT.(AP .GT. 100))GOTO 23677
      CALL BADERR(19Harg stack overflow.)
23677 CONTINUE
      ARGSTK(AP) = EP
      PUSH = AP + 1
      RETURN
      END
      SUBROUTINE PUTCHR(C)
      LOGICAL*1 C
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      IF(.NOT.(EP .GT. 500))GOTO 23679
      CALL BADERR(26Hevaluation stack overflow.)
23679 CONTINUE
      EVALST(EP) = C
      EP = EP + 1
      RETURN
      END
      SUBROUTINE PUTTOK(STR)
      LOGICAL*1 STR(100)
      INTEGER I
      I = 1
23681 IF(.NOT.(STR(I) .NE. 0))GOTO 23683
      CALL PUTCHR(STR(I))
23682 I = I + 1
      GOTO 23681
23683 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ELENTH(BUF)
      LOGICAL*1 BUF(100), C
      LOGICAL*1 ESC
      INTEGER I, N
      N = 0
      I=1
23684 IF(.NOT.(BUF(I) .NE. 0))GOTO 23686
      C = ESC(BUF, I)
      N = N + 1
23685 I=I+1
      GOTO 23684
23686 CONTINUE
      ELENTH = N
      RETURN
      END
