      SUBROUTINE MAIN
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, N
      INTEGER GETARG, OPEN
      LOGICAL*1 ARG (40)
      CALL QUERY (32Husage:  ratfor [files] >outfile.)
      CALL INITKW
      CALL LODSYM(ARG)
      N = 1
      I = 1
23000 IF (.NOT.(GETARG (I, ARG, 40) .NE. -1))GOTO 23002
      N = N + 1
      IF (.NOT.(ARG (1) .EQ. 45 .AND. ARG (2) .EQ. 0))GOTO 23003
      INFILE (1) = 1
      GOTO 23004
23003 CONTINUE
      INFILE (1) = OPEN (ARG, 1)
      IF (.NOT.(INFILE (1) .EQ. -3))GOTO 23005
      CALL CANT (ARG)
23005 CONTINUE
23004 CONTINUE
      CALL PARSE
      IF (.NOT.(INFILE (1) .NE. 1))GOTO 23007
      CALL CLOSE (INFILE (1))
23007 CONTINUE
23001 I = I + 1
      GOTO 23000
23002 CONTINUE
      IF (.NOT.(N .EQ. 1))GOTO 23009
      INFILE (1) = 1
      CALL PARSE
23009 CONTINUE
      RETURN
      END
      SUBROUTINE ADDCHR(C, BUF, BP, MAXSIZ)
      INTEGER BP, MAXSIZ
      LOGICAL*1 C, BUF(100)
      IF (.NOT.(BP .GT. MAXSIZ))GOTO 23011
      CALL BADERR(16Hbuffer overflow.)
23011 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
23013 IF (.NOT.(S(I) .NE. 0))GOTO 23015
      CALL ADDCHR(S(I), BUF, BP, MAXSIZ)
23014 I=I+1
      GOTO 23013
23015 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ALLDIG (STR)
      LOGICAL*1 STR (100)
      LOGICAL*1 TYPE
      INTEGER I
      ALLDIG = 0
      IF (.NOT.(STR (1) .EQ. 0))GOTO 23016
      RETURN
23016 CONTINUE
      I = 1
23018 IF (.NOT.(STR (I) .NE. 0))GOTO 23020
      IF (.NOT.(.NOT.(48.LE.STR (I).AND.STR (I).LE.57)))GOTO 23021
      RETURN
23021 CONTINUE
23019 I = I + 1
      GOTO 23018
23020 CONTINUE
      ALLDIG = 1
      RETURN
      END
      SUBROUTINE BADERR (MSG)
      LOGICAL*1 MSG (100)
      CALL SYNERR (MSG)
      CALL ENDST(-3)
      END
      SUBROUTINE BALPAR
      LOGICAL*1 T, TOKEN (100)
      LOGICAL*1 GETTOK, GNBTOK
      INTEGER NLPAR
      IF (.NOT.(GNBTOK (TOKEN, 100) .NE. 40))GOTO 23023
      CALL SYNERR (19Hmissing left paren.)
      RETURN
23023 CONTINUE
      CALL OUTSTR (TOKEN)
      NLPAR = 1
23025 CONTINUE
      T = GETTOK (TOKEN, 100)
      IF (.NOT.(T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ. -1
     *))GOTO 23028
      CALL PBSTR (TOKEN)
      GOTO 23027
23028 CONTINUE
      IF (.NOT.(T .EQ. 10))GOTO 23030
      TOKEN (1) = 0
      GOTO 23031
23030 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23032
      NLPAR = NLPAR + 1
      GOTO 23033
23032 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23034
      NLPAR = NLPAR - 1
23034 CONTINUE
23033 CONTINUE
23031 CONTINUE
      CALL OUTSTR (TOKEN)
23026 IF (.NOT.(NLPAR .LE. 0))GOTO 23025
23027 CONTINUE
      IF (.NOT.(NLPAR .NE. 0))GOTO 23036
      CALL SYNERR (33Hmissing parenthesis in condition.)
23036 CONTINUE
      RETURN
      END
      SUBROUTINE BRKNXT (SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL (100), LEXTYP (100), SP, TOKEN
      INTEGER I, N
      INTEGER ALLDIG, CTOI
      LOGICAL*1 T, PTOKEN (100)
      LOGICAL*1 GNBTOK
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      N = 0
      T = GNBTOK (PTOKEN, 100)
      IF (.NOT.(ALLDIG (PTOKEN) .EQ. 1))GOTO 23038
      I = 1
      N = CTOI (PTOKEN, I) - 1
      GOTO 23039
23038 CONTINUE
      IF (.NOT.(T .NE. 59))GOTO 23040
      CALL PBSTR (PTOKEN)
23040 CONTINUE
23039 CONTINUE
      I = SP
23042 IF (.NOT.(I .GT. 0))GOTO 23044
      IF (.NOT.(LEXTYP (I) .EQ. -15 .OR. LEXTYP (I) .EQ. -10 .OR. LEXTYP
     * (I) .EQ. -16 .OR. LEXTYP (I) .EQ. -17))GOTO 23045
      IF (.NOT.(N .GT. 0))GOTO 23047
      N = N - 1
      GOTO 23043
23047 CONTINUE
      IF (.NOT.(TOKEN .EQ. -8))GOTO 23049
      CALL OUTGO (LABVAL (I) + 1)
      GOTO 23050
23049 CONTINUE
      CALL OUTGO (LABVAL (I))
23050 CONTINUE
23048 CONTINUE
      XFER = 1
      RETURN
23045 CONTINUE
23043 I = I - 1
      GOTO 23042
23044 CONTINUE
      IF (.NOT.(TOKEN .EQ. -8))GOTO 23051
      CALL SYNERR (14Hillegal break.)
      GOTO 23052
23051 CONTINUE
      CALL SYNERR (13Hillegal next.)
23052 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CNDGET(TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN(100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER VALUE
      LOGICAL*1 PTOK(3)
      INTEGER LOOKUP
      LOGICAL*1 GTOK
      IF (.NOT.(CSP .GE. 10))GOTO 23053
      CALL BADERR(31HConditionals nested too deeply.)
23053 CONTINUE
      CSP = CSP + 1
      CNDSTK (CSP) = CURCND
      CALL SKPBLK
      IF (.NOT.(GTOK(TOKEN, TOKSIZ) .NE. 40))GOTO 23055
      CALL BADERR(27Hmissing '(' in conditional.)
23055 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GTOK(TOKEN, TOKSIZ) .NE. -9))GOTO 23057
      CALL BADERR(26Hinvalid conditional token.)
23057 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GTOK(PTOK, 3) .NE. 41))GOTO 23059
      CALL BADERR(27Hmissing ')' in conditional.)
23059 CONTINUE
      IF (.NOT.(LOOKUP(TOKEN, VALUE, DEFTBL) .EQ. 1))GOTO 23061
      CNDGET = 1
      GOTO 23062
23061 CONTINUE
      CNDGET = -1
23062 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION CNDLU (TOKEN)
      LOGICAL*1 TOKEN(100)
      INTEGER INDEX, EQUAL
      INTEGER I, J
      LOGICAL*1 TEMP (9)
      LOGICAL*1 LETTS(5)
      LOGICAL*1 CNDTBL(35)
      DATA LETTS(1)/101/,LETTS(2)/69/,LETTS(3)/105/,LETTS(4)/73/,LETTS(5
     *)/0/
      DATA CNDTBL(1)/105/,CNDTBL(2)/102/,CNDTBL(3)/100/,CNDTBL(4)/101/,C
     *NDTBL(5)/102/,CNDTBL(6)/47/,CNDTBL(7)/32/,CNDTBL(8)/105/,CNDTBL(9)
     */102/,CNDTBL(10)/110/,CNDTBL(11)/111/,CNDTBL(12)/116/,CNDTBL(13)/1
     *00/,CNDTBL(14)/101/,CNDTBL(15)/102/,CNDTBL(16)/47/,CNDTBL(17)/32/,
     *CNDTBL(18)/101/,CNDTBL(19)/108/,CNDTBL(20)/115/,CNDTBL(21)/101/,CN
     *DTBL(22)/100/,CNDTBL(23)/101/,CNDTBL(24)/102/,CNDTBL(25)/47/,CNDTB
     *L(26)/32/,CNDTBL(27)/101/,CNDTBL(28)/110/,CNDTBL(29)/100/,CNDTBL(3
     *0)/100/,CNDTBL(31)/101/,CNDTBL(32)/102/,CNDTBL(33)/47/,CNDTBL(34)/
     *32/,CNDTBL(35)/0/
      DATA CNDTBL(7)/-15/,CNDTBL(17)/-16/,CNDTBL(26)/-17/, CNDTBL(34)/-1
     *8/
      CNDLU = -19
      IF (.NOT.(INDEX (LETTS, TOKEN (1)) .GT. 0))GOTO 23063
      I=1
23065 IF (.NOT.(CNDTBL(I) .NE. 0))GOTO 23067
      J=1
23068 IF (.NOT.(CNDTBL(I) .NE. 47))GOTO 23070
      TEMP(J) = CNDTBL(I)
23069 I=I+1
      J=J+1
      GOTO 23068
23070 CONTINUE
      TEMP(J) = 0
      I = I + 1
      J = EQUAL(TOKEN, TEMP)
      IF (.NOT.(J .EQ. 0))GOTO 23071
      CALL UPPER(TEMP)
      J = EQUAL(TOKEN, TEMP)
23071 CONTINUE
      IF (.NOT.(J .EQ. 1))GOTO 23073
      CNDLU = CNDTBL(I)
      GOTO 23067
23073 CONTINUE
23066 I=I+1
      GOTO 23065
23067 CONTINUE
23063 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION DEFTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T, C, DEFN (250), MDEFN (250)
      LOGICAL*1 GCTOK
      INTEGER AP, ARGSTK (100), CALLST (50), NLB, PLEV (50), IFL
      INTEGER LUDEF, PUSH, IFPARM
      LOGICAL*1 BALP(3)
      DATA BALP(1)/40/,BALP(2)/41/,BALP(3)/0/
      CP = 0
      AP = 1
      EP = 1
      T = GCTOK (TOKEN, TOKSIZ)
23075 IF (.NOT.(T .NE. -1))GOTO 23077
      IF (.NOT.(T .EQ. -9))GOTO 23078
      IF (.NOT.(LUDEF (TOKEN, DEFN, DEFTBL) .EQ. 0))GOTO 23080
      IF (.NOT.(CP .EQ. 0))GOTO 23082
      GOTO 23077
23082 CONTINUE
      CALL PUTTOK (TOKEN)
23083 CONTINUE
      GOTO 23081
23080 CONTINUE
      IF (.NOT.(DEFN (1) .EQ. -4))GOTO 23084
      CALL GETDEF (TOKEN, TOKSIZ, DEFN, 250)
      CALL ENTDEF (TOKEN, DEFN, DEFTBL)
      GOTO 23085
23084 CONTINUE
      CP = CP + 1
      IF (.NOT.(CP .GT. 50))GOTO 23086
      CALL BADERR (20Hcall stack overflow.)
23086 CONTINUE
      CALLST (CP) = AP
      AP = PUSH (EP, ARGSTK, AP)
      CALL PUTTOK (DEFN)
      CALL PUTCHR (0)
      AP = PUSH (EP, ARGSTK, AP)
      CALL PUTTOK (TOKEN)
      CALL PUTCHR (0)
      AP = PUSH (EP, ARGSTK, AP)
      T = GCTOK (TOKEN, TOKSIZ)
      IF (.NOT.(T .EQ. 32))GOTO 23088
      T = GCTOK (TOKEN, TOKSIZ)
      CALL PBSTR (TOKEN)
      IF (.NOT.(T .NE. 40))GOTO 23090
      CALL PUTBAK (32)
23090 CONTINUE
      GOTO 23089
23088 CONTINUE
      CALL PBSTR (TOKEN)
23089 CONTINUE
      IF (.NOT.(T .NE. 40))GOTO 23092
      CALL PBSTR (BALP)
      GOTO 23093
23092 CONTINUE
      IF (.NOT.(IFPARM (DEFN) .EQ. 0))GOTO 23094
      CALL PBSTR (BALP)
23094 CONTINUE
23093 CONTINUE
      PLEV (CP) = 0
23085 CONTINUE
23081 CONTINUE
      GOTO 23079
23078 CONTINUE
      IF (.NOT.(T .EQ. -10))GOTO 23096
      NLB = 1
23098 CONTINUE
      T = GCTOK (TOKEN, TOKSIZ)
      IF (.NOT.(T .EQ. -10))GOTO 23101
      NLB = NLB + 1
      GOTO 23102
23101 CONTINUE
      IF (.NOT.(T .EQ. -11))GOTO 23103
      NLB = NLB - 1
      IF (.NOT.(NLB .EQ. 0))GOTO 23105
      GOTO 23100
23105 CONTINUE
      GOTO 23104
23103 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23107
      CALL BADERR (14HEOF in string.)
23107 CONTINUE
23104 CONTINUE
23102 CONTINUE
      CALL PUTTOK (TOKEN)
23099 GOTO 23098
23100 CONTINUE
      GOTO 23097
23096 CONTINUE
      IF (.NOT.(CP .EQ. 0))GOTO 23109
      GOTO 23077
23109 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23111
      IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23113
      CALL PUTTOK (TOKEN)
23113 CONTINUE
      PLEV (CP) = PLEV (CP) + 1
      GOTO 23112
23111 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23115
      PLEV (CP) = PLEV (CP) - 1
      IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23117
      CALL PUTTOK (TOKEN)
      GOTO 23118
23117 CONTINUE
      CALL PUTCHR (0)
      CALL EVALR (ARGSTK, CALLST (CP), AP - 1)
      AP = CALLST (CP)
      EP = ARGSTK (AP)
      CP = CP - 1
23118 CONTINUE
      GOTO 23116
23115 CONTINUE
      IF (.NOT.(T .EQ. 44 .AND. PLEV (CP) .EQ. 1))GOTO 23119
      CALL PUTCHR (0)
      AP = PUSH (EP, ARGSTK, AP)
      GOTO 23120
23119 CONTINUE
      CALL PUTTOK (TOKEN)
23120 CONTINUE
23116 CONTINUE
23112 CONTINUE
23110 CONTINUE
23097 CONTINUE
23079 CONTINUE
23076 T = GCTOK (TOKEN, TOKSIZ)
      GOTO 23075
23077 CONTINUE
      DEFTOK = T
      IF (.NOT.(T .EQ. -9))GOTO 23121
      CALL FOLD (TOKEN)
23121 CONTINUE
      RETURN
      END
      SUBROUTINE DOARTH (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER K, L
      INTEGER CTOI
      LOGICAL*1 OP
      K = ARGSTK (I + 2)
      L = ARGSTK (I + 4)
      OP = EVALST (ARGSTK (I + 3))
      IF (.NOT.(OP .EQ. 43))GOTO 23123
      CALL PBNUM (CTOI (EVALST, K) + CTOI (EVALST, L))
      GOTO 23124
23123 CONTINUE
      IF (.NOT.(OP .EQ. 45))GOTO 23125
      CALL PBNUM (CTOI (EVALST, K) - CTOI (EVALST, L))
      GOTO 23126
23125 CONTINUE
      IF (.NOT.(OP .EQ. 42 ))GOTO 23127
      CALL PBNUM (CTOI (EVALST, K) * CTOI (EVALST, L))
      GOTO 23128
23127 CONTINUE
      IF (.NOT.(OP .EQ. 47 ))GOTO 23129
      CALL PBNUM (CTOI (EVALST, K) / CTOI (EVALST, L))
      GOTO 23130
23129 CONTINUE
      CALL REMARK (11Harith error)
23130 CONTINUE
23128 CONTINUE
23126 CONTINUE
23124 CONTINUE
      RETURN
      END
      SUBROUTINE DOCODE (LAB)
      INTEGER LAB
      INTEGER LABGEN
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GNBTOK
      LOGICAL*1 LEXSTR (100)
      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 23131
      CALL OUTSTR (LEXSTR)
      GOTO 23132
23131 CONTINUE
      CALL PBSTR (LEXSTR)
      CALL OUTNUM (LAB)
23132 CONTINUE
      CALL OUTCH (32)
      CALL EATUP
      CALL OUTDON
      RETURN
      END
      SUBROUTINE DOIF (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER A2, A3, A4, A5
      INTEGER EQUAL
      IF (.NOT.(J - I .LT. 5))GOTO 23133
      RETURN
23133 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 23135
      CALL PBSTR (EVALST (A4))
      GOTO 23136
23135 CONTINUE
      CALL PBSTR (EVALST (A5))
23136 CONTINUE
      RETURN
      END
      SUBROUTINE DOINCR (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER K
      INTEGER CTOI
      K = ARGSTK (I + 2)
      CALL PBNUM (CTOI (EVALST, K) + 1)
      RETURN
      END
      SUBROUTINE DOMAC (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER A2, A3
      IF (.NOT.(J - I .GT. 2))GOTO 23137
      A2 = ARGSTK (I + 2)
      A3 = ARGSTK (I + 3)
      CALL ENTDEF (EVALST (A2), EVALST (A3), DEFTBL)
23137 CONTINUE
      RETURN
      END
      SUBROUTINE DOSTAT (LAB)
      INTEGER LAB
      CALL OUTCON (LAB)
      CALL OUTCON (LAB + 1)
      RETURN
      END
      SUBROUTINE DOSUB (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER AP, FC, K, NC
      INTEGER CTOI, LENGTH
      IF (.NOT.(J - I .LT. 3))GOTO 23139
      RETURN
23139 CONTINUE
      IF (.NOT.(J - I .LT. 4))GOTO 23141
      NC = 100
      GOTO 23142
23141 CONTINUE
      K = ARGSTK (I + 4)
      NC = CTOI (EVALST, K)
23142 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
     * 23143
      K = FC + MIN0(NC, LENGTH (EVALST (FC))) - 1
23145 IF (.NOT.(K .GE. FC))GOTO 23147
      CALL PUTBAK (EVALST (K))
23146 K = K - 1
      GOTO 23145
23147 CONTINUE
23143 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION DOTHER(TOKEN)
      LOGICAL*1 TOKEN(100), T
      LOGICAL*1 GETTOK
      CALL OUTTAB
23148 CONTINUE
      T = GETTOK(TOKEN, 100)
      IF (.NOT.(T .EQ. 59 .OR. T .EQ. 125))GOTO 23151
      GOTO 23150
23151 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23153
      CALL SYNERR(15Hunexpected EOF.)
      CALL PBSTR(TOKEN)
      GOTO 23150
23153 CONTINUE
      IF (.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23155
      CALL OUTSTR(TOKEN)
23155 CONTINUE
23149 GOTO 23148
23150 CONTINUE
      CALL OUTDON
      DOTHER=(T)
      RETURN
      END
      SUBROUTINE EATUP
      LOGICAL*1 PTOKEN (100), T, TOKEN (100)
      LOGICAL*1 GETTOK
      INTEGER NLPAR
      NLPAR = 0
23157 CONTINUE
      T = GETTOK (TOKEN, 100)
      IF (.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23160
      GOTO 23159
23160 CONTINUE
      IF (.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23162
      CALL PBSTR (TOKEN)
      GOTO 23159
23162 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23164
      CALL SYNERR (15Hunexpected EOF.)
      CALL PBSTR (TOKEN)
      GOTO 23159
23164 CONTINUE
      IF (.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 .
     *OR. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T
     * .EQ. 126 .OR. T .EQ. 33 .OR. T .EQ. 94 .OR. T .EQ. 61 .OR. T .EQ.
     * 95))GOTO 23166
23168 IF (.NOT.(GETTOK (PTOKEN, 100) .EQ. 10))GOTO 23169
      GOTO 23168
23169 CONTINUE
      CALL PBSTR (PTOKEN)
      IF (.NOT.(T .EQ. 95))GOTO 23170
      TOKEN (1) = 0
23170 CONTINUE
23166 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23172
      NLPAR = NLPAR + 1
      GOTO 23173
23172 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23174
      NLPAR = NLPAR - 1
23174 CONTINUE
23173 CONTINUE
      CALL OUTSTR (TOKEN)
23158 IF (.NOT.(NLPAR .LT. 0))GOTO 23157
23159 CONTINUE
      IF (.NOT.(NLPAR .NE. 0))GOTO 23176
      CALL SYNERR (23Hunbalanced parentheses.)
23176 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ELENTH(BUF)
      LOGICAL*1 BUF(100), C
      LOGICAL*1 ESC
      INTEGER I, N
      N = 0
      I=1
23178 IF (.NOT.(BUF(I) .NE. 0))GOTO 23180
      C = ESC(BUF, I)
      N = N + 1
23179 I=I+1
      GOTO 23178
23180 CONTINUE
      ELENTH = N
      RETURN
      END
      SUBROUTINE ELSEIF (LAB)
      INTEGER LAB
      CALL OUTGO (LAB+1)
      CALL OUTCON (LAB)
      RETURN
      END
      SUBROUTINE ENTDKW
      LOGICAL*1 DEFT (2), INCT (2), SUBT (2), IFT (2), ART (2), MACT (2)
      LOGICAL*1 DEFNAM(7)
      LOGICAL*1 MACNAM(8)
      LOGICAL*1 INCNAM(5)
      LOGICAL*1 SUBNAM(7)
      LOGICAL*1 IFNAM(7)
      LOGICAL*1 ARNAM(6)
      DATA DEFNAM(1)/100/,DEFNAM(2)/101/,DEFNAM(3)/102/,DEFNAM(4)/105/,D
     *EFNAM(5)/110/,DEFNAM(6)/101/,DEFNAM(7)/0/
      DATA MACNAM(1)/109/,MACNAM(2)/100/,MACNAM(3)/101/,MACNAM(4)/102/,M
     *ACNAM(5)/105/,MACNAM(6)/110/,MACNAM(7)/101/,MACNAM(8)/0/
      DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/,IN
     *CNAM(5)/0/
      DATA SUBNAM(1)/115/,SUBNAM(2)/117/,SUBNAM(3)/98/,SUBNAM(4)/115/,SU
     *BNAM(5)/116/,SUBNAM(6)/114/,SUBNAM(7)/0/
      DATA IFNAM(1)/105/,IFNAM(2)/102/,IFNAM(3)/101/,IFNAM(4)/108/,IFNAM
     *(5)/115/,IFNAM(6)/101/,IFNAM(7)/0/
      DATA ARNAM(1)/97/,ARNAM(2)/114/,ARNAM(3)/105/,ARNAM(4)/116/,ARNAM(
     *5)/104/,ARNAM(6)/0/
      DATA DEFT (1), DEFT (2) /-4, 0/
      DATA MACT (1), MACT (2) /-10, 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/
      CALL ULSTAL (DEFNAM, DEFT)
      CALL ULSTAL (MACNAM, MACT)
      CALL ULSTAL (INCNAM, INCT)
      CALL ULSTAL (SUBNAM, SUBT)
      CALL ULSTAL (IFNAM, IFT)
      CALL ULSTAL (ARNAM, ART)
      RETURN
      END
      SUBROUTINE ENTRKW
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER JUNK
      INTEGER ENTER
      LOGICAL*1 SIF(3)
      LOGICAL*1 SELSE(5)
      LOGICAL*1 SWHILE(6)
      LOGICAL*1 SDO(3)
      LOGICAL*1 SBREAK(6)
      LOGICAL*1 SNEXT(5)
      LOGICAL*1 SFOR(4)
      LOGICAL*1 SREPT(7)
      LOGICAL*1 SUNTIL(6)
      LOGICAL*1 SRET(7)
      LOGICAL*1 SSTR(7)
      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/
      JUNK = ENTER (SIF, -19, RKWTBL)
      JUNK = ENTER (SELSE, -11, RKWTBL)
      JUNK = ENTER (SWHILE, -15, RKWTBL)
      JUNK = ENTER (SDO, -10, RKWTBL)
      JUNK = ENTER (SBREAK, -8, RKWTBL)
      JUNK = ENTER (SNEXT, -13, RKWTBL)
      JUNK = ENTER (SFOR, -16, RKWTBL)
      JUNK = ENTER (SREPT, -17, RKWTBL)
      JUNK = ENTER (SUNTIL, -18, RKWTBL)
      JUNK = ENTER (SRET, -20, RKWTBL)
      JUNK = ENTER (SSTR, -23, RKWTBL)
      RETURN
      END
      SUBROUTINE EVALR (ARGSTK, I, J)
      INTEGER ARGSTK (100), I, J
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER ARGNO, K, M, N, T, TD
      INTEGER INDEX, LENGTH
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT
     *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D
     *IGITS(10)/57/,DIGITS(11)/0/
      T = ARGSTK (I)
      TD = EVALST (T)
      IF (.NOT.(TD .EQ. -10))GOTO 23181
      CALL DOMAC (ARGSTK, I, J)
      GOTO 23182
23181 CONTINUE
      IF (.NOT.(TD .EQ. -12))GOTO 23183
      CALL DOINCR (ARGSTK, I, J)
      GOTO 23184
23183 CONTINUE
      IF (.NOT.(TD .EQ. -13))GOTO 23185
      CALL DOSUB (ARGSTK, I, J)
      GOTO 23186
23185 CONTINUE
      IF (.NOT.(TD .EQ. -11))GOTO 23187
      CALL DOIF (ARGSTK, I, J)
      GOTO 23188
23187 CONTINUE
      IF (.NOT.(TD .EQ. -14))GOTO 23189
      CALL DOARTH (ARGSTK, I, J)
      GOTO 23190
23189 CONTINUE
      K = T + LENGTH (EVALST (T)) - 1
23191 IF (.NOT.(K .GT. T))GOTO 23193
      IF (.NOT.(EVALST (K - 1) .NE. 36))GOTO 23194
      CALL PUTBAK (EVALST (K))
      GOTO 23195
23194 CONTINUE
      ARGNO = INDEX (DIGITS, EVALST (K)) - 1
      IF (.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J - I))GOTO 23196
      N = I + ARGNO + 1
      M = ARGSTK (N)
      CALL PBSTR (EVALST (M))
23196 CONTINUE
      K = K - 1
23195 CONTINUE
23192 K = K - 1
      GOTO 23191
23193 CONTINUE
      IF (.NOT.(K .EQ. T))GOTO 23198
      CALL PUTBAK (EVALST (K))
23198 CONTINUE
23190 CONTINUE
23188 CONTINUE
23186 CONTINUE
23184 CONTINUE
23182 CONTINUE
      RETURN
      END
      SUBROUTINE FCLAUS
      LOGICAL*1 GNBTOK, DOTHER
      LOGICAL*1 TOKEN(100), T
      INTEGER BRACE
      IF (.NOT.(GNBTOK(TOKEN, 100) .EQ. 123))GOTO 23200
      BRACE = 1
      GOTO 23201
23200 CONTINUE
      CALL PBSTR(TOKEN)
      BRACE = 0
23201 CONTINUE
      T = DOTHER(TOKEN)
      IF (.NOT.(BRACE .EQ. 1))GOTO 23202
23204 IF (.NOT.(T .NE. 125 .AND. T .NE. -1))GOTO 23205
      T = GNBTOK(TOKEN, 100)
      CALL PBSTR(TOKEN)
      T = DOTHER(TOKEN)
      GOTO 23204
23205 CONTINUE
      IF (.NOT.(GNBTOK(TOKEN, 100) .NE. 59))GOTO 23206
      CALL SYNERR(19Hinvalid for clause.)
23206 CONTINUE
23202 CONTINUE
      RETURN
      END
      SUBROUTINE FINIT
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      OUTP = 0
      LEVEL = 1
      LINECT (1) = 1
      SBP = 1
      FNAMP = 2
      FNAMES (1) = 0
      BP = 0
      FORDEP = 0
      FCNAME (1) = 0
      CSP = 0
      CURCND = 1
      RETURN
      END
      SUBROUTINE FORCOD (LAB)
      INTEGER LAB
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T, TOKEN (100)
      LOGICAL*1 GETTOK, GNBTOK
      INTEGER I, J, NLPAR, LEN
      INTEGER LENGTH, LABGEN
      LOGICAL*1 IFNOT(10)
      LOGICAL*1 SEMI(2)
      DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/32/,IFNOT(4)/40/,IFNOT(5
     *)/46/,IFNOT(6)/110/,IFNOT(7)/111/,IFNOT(8)/116/,IFNOT(9)/46/,IFNOT
     *(10)/0/
      DATA SEMI(1)/59/,SEMI(2)/0/
      LAB = LABGEN (3)
      CALL OUTCON (0)
      IF (.NOT.(GNBTOK (TOKEN, 100) .NE. 40))GOTO 23208
      CALL SYNERR (19Hmissing left paren.)
      RETURN
23208 CONTINUE
      IF (.NOT.(GNBTOK (TOKEN, 100) .NE. 59))GOTO 23210
      CALL PBSTR (TOKEN)
      CALL FCLAUS
23210 CONTINUE
      IF (.NOT.(GNBTOK (TOKEN, 100) .EQ. 59))GOTO 23212
      CALL OUTCON (LAB)
      GOTO 23213
23212 CONTINUE
      CALL PBSTR (TOKEN)
      CALL OUTNUM (LAB)
      CALL OUTTAB
      CALL OUTSTR (IFNOT)
      CALL OUTCH (40)
      NLPAR = 0
23214 IF (.NOT.(NLPAR .GE. 0))GOTO 23215
      T = GETTOK (TOKEN, 100)
      IF (.NOT.(T .EQ. 59))GOTO 23216
      GOTO 23215
23216 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23218
      NLPAR = NLPAR + 1
      GOTO 23219
23218 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23220
      NLPAR = NLPAR - 1
23220 CONTINUE
23219 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23222
      CALL PBSTR (TOKEN)
      RETURN
23222 CONTINUE
      IF (.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23224
      CALL OUTSTR (TOKEN)
23224 CONTINUE
      GOTO 23214
23215 CONTINUE
      CALL OUTCH (41)
      CALL OUTCH (41)
      CALL OUTGO (LAB+2)
      IF (.NOT.(NLPAR .LT. 0))GOTO 23226
      CALL SYNERR (19Hinvalid for clause.)
23226 CONTINUE
23213 CONTINUE
      FORDEP = FORDEP + 1
      LEN = 0
      J = 1
      I = 1
23228 IF (.NOT.(I .LT. FORDEP))GOTO 23230
      J = J + LENGTH (FORSTK (J)) + 1
23229 I = I + 1
      GOTO 23228
23230 CONTINUE
      FORSTK (J) = 0
      NLPAR = 0
      T = GNBTOK (TOKEN, 100)
      CALL PBSTR (TOKEN)
23231 IF (.NOT.(NLPAR .GE. 0))GOTO 23232
      T = GETTOK (TOKEN, 100)
      IF (.NOT.(T .EQ. 40))GOTO 23233
      NLPAR = NLPAR + 1
      GOTO 23234
23233 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23235
      NLPAR = NLPAR - 1
23235 CONTINUE
23234 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23237
      CALL PBSTR (TOKEN)
      GOTO 23232
23237 CONTINUE
      IF (.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))GOTO 23239
      IF (.NOT.(J + LENGTH (TOKEN) .GE. 300))GOTO 23241
      CALL BADERR (20Hfor clause too long.)
23241 CONTINUE
      CALL SCOPY (TOKEN, 1, FORSTK, J)
      J = J + LENGTH (TOKEN)
      LEN = LEN + LENGTH (TOKEN)
      GOTO 23240
23239 CONTINUE
      IF (.NOT.(NLPAR .EQ. -1 .AND. LEN .GT. 0))GOTO 23243
      IF (.NOT.(J .LT. 300))GOTO 23245
      CALL SCOPY(SEMI, 1, FORSTK, J)
      GOTO 23246
23245 CONTINUE
      CALL BADERR(20Hfor clause too long.)
23246 CONTINUE
23243 CONTINUE
23240 CONTINUE
      GOTO 23231
23232 CONTINUE
      LAB = LAB + 1
      RETURN
      END
      SUBROUTINE FORS (LAB)
      INTEGER LAB
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, J
      INTEGER LENGTH
      XFER = 0
      CALL OUTNUM (LAB)
      J = 1
      I = 1
23247 IF (.NOT.(I .LT. FORDEP))GOTO 23249
      J = J + LENGTH (FORSTK (J)) + 1
23248 I = I + 1
      GOTO 23247
23249 CONTINUE
      IF (.NOT.(LENGTH (FORSTK (J)) .GT. 0))GOTO 23250
      CALL PBSTR (FORSTK (J))
      CALL FCLAUS
23250 CONTINUE
      CALL OUTGO (LAB - 1)
      CALL OUTCON (LAB + 1)
      FORDEP = FORDEP - 1
      RETURN
      END
      LOGICAL*1 FUNCTION GCTOK(TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN(100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GTOK, CNDLU
      LOGICAL*1 C
      INTEGER CNDGET
      INTEGER NEWCND
      GCTOK=GTOK(TOKEN,TOKSIZ)
23252 IF (.NOT.(GCTOK .NE. -1))GOTO 23254
      C = CNDLU (TOKEN)
      IF (.NOT.(C .EQ. -19))GOTO 23255
      IF (.NOT.(CURCND .EQ. 1))GOTO 23257
      GOTO 23254
23257 CONTINUE
      GOTO 23256
23255 CONTINUE
      IF (.NOT.(C .EQ. -18))GOTO 23259
      IF (.NOT.(CSP .LE. 0))GOTO 23261
      CALL BADERR(27HIllegal enddef encountered.)
23261 CONTINUE
      CURCND = CNDSTK(CSP)
      CSP = CSP - 1
      GOTO 23260
23259 CONTINUE
      IF (.NOT.(C .EQ. -15))GOTO 23263
      NEWCND = CNDGET (TOKEN, TOKSIZ)
      GOTO 23264
23263 CONTINUE
      IF (.NOT.(C .EQ. -16))GOTO 23265
      NEWCND = - CNDGET (TOKEN, TOKSIZ)
      GOTO 23266
23265 CONTINUE
      NEWCND = - CURCND
23266 CONTINUE
23264 CONTINUE
      CURCND = MIN0(NEWCND, CNDSTK (CSP) )
23260 CONTINUE
23256 CONTINUE
23253 GCTOK=GTOK(TOKEN,TOKSIZ)
      GOTO 23252
23254 CONTINUE
      RETURN
      END
      SUBROUTINE GETDEF (TOKEN, TOKSIZ, DEFN, DEFSIZ)
      LOGICAL*1 TOKEN (100), DEFN (250)
      INTEGER TOKSIZ, DEFSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C, T, PTOKEN (100)
      LOGICAL*1 GCTOK, NGETCH
      INTEGER I, NLPAR
      CALL SKPBLK
      C = GCTOK (PTOKEN, 100)
      IF (.NOT.(C .EQ. 40))GOTO 23267
      T = 40
      GOTO 23268
23267 CONTINUE
      T = 32
      CALL PBSTR (PTOKEN)
23268 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GCTOK (TOKEN, TOKSIZ) .NE. -9))GOTO 23269
      CALL BADERR (22Hnon-alphanumeric name.)
23269 CONTINUE
      CALL SKPBLK
      C = GCTOK (PTOKEN, 100)
      IF (.NOT.(T .EQ. 32))GOTO 23271
      CALL PBSTR (PTOKEN)
      I = 1
23273 CONTINUE
      C = NGETCH (C)
      IF (.NOT.(I .GT. DEFSIZ))GOTO 23276
      CALL BADERR (20Hdefinition too long.)
23276 CONTINUE
      DEFN (I) = C
      I = I + 1
23274 IF (.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. -1))GOTO 23273
23275 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23278
      CALL PUTBAK (C)
23278 CONTINUE
      GOTO 23272
23271 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23280
      IF (.NOT.(C .NE. 44))GOTO 23282
      CALL BADERR (24Hmissing comma in define.)
23282 CONTINUE
      NLPAR = 0
      I = 1
23284 IF (.NOT.(NLPAR .GE. 0))GOTO 23286
      IF (.NOT.(I .GT. DEFSIZ))GOTO 23287
      CALL BADERR (20Hdefinition too long.)
      GOTO 23288
23287 CONTINUE
      IF (.NOT.(NGETCH (DEFN (I)) .EQ. -1))GOTO 23289
      CALL BADERR (20Hmissing right paren.)
      GOTO 23290
23289 CONTINUE
      IF (.NOT.(DEFN (I) .EQ. 40))GOTO 23291
      NLPAR = NLPAR + 1
      GOTO 23292
23291 CONTINUE
      IF (.NOT.(DEFN (I) .EQ. 41))GOTO 23293
      NLPAR = NLPAR - 1
23293 CONTINUE
23292 CONTINUE
23290 CONTINUE
23288 CONTINUE
23285 I = I + 1
      GOTO 23284
23286 CONTINUE
      GOTO 23281
23280 CONTINUE
      CALL BADERR (19Hgetdef is confused.)
23281 CONTINUE
23272 CONTINUE
      DEFN (I - 1) = 0
      RETURN
      END
      LOGICAL*1 FUNCTION GETTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, LEN
      INTEGER EQUAL, OPEN, LENGTH
      LOGICAL*1 NAME (40), T
      LOGICAL*1 DEFTOK
      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/
23295 IF (.NOT.(LEVEL .GT. 0))GOTO 23297
      GETTOK = DEFTOK (TOKEN, TOKSIZ)
23298 IF (.NOT.(GETTOK .NE. -1))GOTO 23300
      IF (.NOT.(EQUAL (TOKEN, FNCN) .EQ. 1))GOTO 23301
      CALL SKPBLK
      T = DEFTOK (FCNAME, 40)
      CALL PBSTR (FCNAME)
      IF (.NOT.(T .NE. -9))GOTO 23303
      CALL SYNERR (22Hmissing function name.)
23303 CONTINUE
      CALL PUTBAK (32)
      RETURN
23301 CONTINUE
      IF (.NOT.(EQUAL (TOKEN, INCL) .EQ. 0))GOTO 23305
      RETURN
23305 CONTINUE
23302 CONTINUE
      CALL SKPBLK
      T = DEFTOK (NAME, 40)
      IF (.NOT.(T .EQ. 39 .OR. T .EQ. 34))GOTO 23307
      LEN = LENGTH (NAME) - 1
      I = 1
23309 IF (.NOT.(I .LT. LEN))GOTO 23311
      NAME (I) = NAME (I + 1)
23310 I = I + 1
      GOTO 23309
23311 CONTINUE
      NAME (I) = 0
23307 CONTINUE
      I = LENGTH (NAME) + 1
      IF (.NOT.(LEVEL .GE. 4))GOTO 23312
      CALL SYNERR (27Hincludes nested too deeply.)
      GOTO 23313
23312 CONTINUE
      INFILE (LEVEL + 1) = OPEN (NAME, 1)
      LINECT (LEVEL + 1) = 1
      IF (.NOT.(INFILE (LEVEL + 1) .EQ. -3))GOTO 23314
      CALL SYNERR (19Hcan't open include.)
      GOTO 23315
23314 CONTINUE
      LEVEL = LEVEL + 1
      IF (.NOT.(FNAMP + I .LE.  160))GOTO 23316
      CALL SCOPY (NAME, 1, FNAMES, FNAMP)
      FNAMP = FNAMP + I
23316 CONTINUE
23315 CONTINUE
23313 CONTINUE
23299 GETTOK = DEFTOK (TOKEN, TOKSIZ)
      GOTO 23298
23300 CONTINUE
      IF (.NOT.(LEVEL .GT. 1))GOTO 23318
      CALL CLOSE (INFILE (LEVEL))
      FNAMP = FNAMP - 1
23320 IF (.NOT.(FNAMP .GT. 1))GOTO 23322
      IF (.NOT.(FNAMES (FNAMP - 1) .EQ. 0))GOTO 23323
      GOTO 23322
23323 CONTINUE
23321 FNAMP = FNAMP - 1
      GOTO 23320
23322 CONTINUE
23318 CONTINUE
23296 LEVEL = LEVEL - 1
      GOTO 23295
23297 CONTINUE
      TOKEN (1) = -1
      TOKEN (2) = 0
      GETTOK = -1
      RETURN
      END
      LOGICAL*1 FUNCTION GNBTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GETTOK
23325 CONTINUE
      CALL SKPBLK
      GNBTOK = GETTOK (TOKEN, TOKSIZ)
23326 IF (.NOT.(GNBTOK .NE. 32))GOTO 23325
23327 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION GTOK (LEXSTR, TOKSIZ)
      LOGICAL*1 LEXSTR (100)
      INTEGER TOKSIZ
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C
      LOGICAL*1 NGETCH, TYPE, CLOWER
      INTEGER I, B, N, D
      INTEGER ITOC, INDEX
      LOGICAL*1 DIGITS(37)
      DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT
     *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D
     *IGITS(10)/57/,DIGITS(11)/97/,DIGITS(12)/98/,DIGITS(13)/99/,DIGITS(
     *14)/100/,DIGITS(15)/101/,DIGITS(16)/102/,DIGITS(17)/103/,DIGITS(18
     *)/104/,DIGITS(19)/105/,DIGITS(20)/106/,DIGITS(21)/107/,DIGITS(22)/
     *108/,DIGITS(23)/109/,DIGITS(24)/110/,DIGITS(25)/111/,DIGITS(26)/11
     *2/,DIGITS(27)/113/,DIGITS(28)/114/,DIGITS(29)/115/,DIGITS(30)/116/
     *,DIGITS(31)/117/,DIGITS(32)/118/,DIGITS(33)/119/,DIGITS(34)/120/,D
     *IGITS(35)/121/,DIGITS(36)/122/,DIGITS(37)/0/
      C = NGETCH (LEXSTR (1))
      IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23328
      LEXSTR (1) = 32
23330 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23331
      C = NGETCH (C)
      GOTO 23330
23331 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23332
23334 IF (.NOT.(NGETCH (C) .NE. 10))GOTO 23335
      GOTO 23334
23335 CONTINUE
23332 CONTINUE
      IF (.NOT.(C .NE. 10))GOTO 23336
      CALL PUTBAK (C)
      GOTO 23337
23336 CONTINUE
      LEXSTR (1) = 10
23337 CONTINUE
      LEXSTR (2) = 0
      GTOK = LEXSTR (1)
      RETURN
23328 CONTINUE
      I = 1
      IF (.NOT.(((65.LE.C.AND.C.LE.90).OR.(97.LE.C.AND.C.LE.122))))GOTO 
     *23338
      I = 1
23340 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23342
      C = NGETCH (LEXSTR (I + 1))
      IF (.NOT.(.NOT.((65.LE.C.AND.C.LE.90).OR.(97.LE.C.AND.C.LE.122)) .
     *AND. .NOT.(48.LE.C.AND.C.LE.57) .AND. C .NE. 95))GOTO 23343
      GOTO 23342
23343 CONTINUE
23341 I = I + 1
      GOTO 23340
23342 CONTINUE
      CALL PUTBAK (C)
      GTOK = -9
      GOTO 23339
23338 CONTINUE
      IF (.NOT.((48.LE.C.AND.C.LE.57)))GOTO 23345
      B = C - 48
      I = 1
23347 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23349
      C = NGETCH (LEXSTR (I + 1))
      IF (.NOT.(.NOT.(48.LE.C.AND.C.LE.57)))GOTO 23350
      GOTO 23349
23350 CONTINUE
      B = 10 * B + C - 48
23348 I = I + 1
      GOTO 23347
23349 CONTINUE
      IF (.NOT.(C .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO 23352
      N = 0
23354 CONTINUE
      D = INDEX (DIGITS, CLOWER (NGETCH (C))) - 1
      IF (.NOT.(D .LT. 0))GOTO 23357
      GOTO 23356
23357 CONTINUE
      N = B * N + D
23355 GOTO 23354
23356 CONTINUE
      CALL PUTBAK (C)
      I = ITOC (N, LEXSTR, TOKSIZ)
      GOTO 23353
23352 CONTINUE
      CALL PUTBAK (C)
23353 CONTINUE
      GTOK = 2
      GOTO 23346
23345 CONTINUE
      IF (.NOT.(C .EQ. 91))GOTO 23359
      LEXSTR (1) = 123
      GTOK = 123
      GOTO 23360
23359 CONTINUE
      IF (.NOT.(C .EQ. 93))GOTO 23361
      LEXSTR (1) = 125
      GTOK = 125
      GOTO 23362
23361 CONTINUE
      IF (.NOT.(C .EQ. 36))GOTO 23363
      IF (.NOT.(NGETCH (LEXSTR (2)) .EQ. 40))GOTO 23365
      I = 2
      GTOK = -10
      GOTO 23366
23365 CONTINUE
      IF (.NOT.(LEXSTR (2) .EQ. 41))GOTO 23367
      I = 2
      GTOK = -11
      GOTO 23368
23367 CONTINUE
      CALL PUTBAK (LEXSTR (2))
      GTOK = 36
23368 CONTINUE
23366 CONTINUE
      GOTO 23364
23363 CONTINUE
      IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23369
      GTOK = C
      I = 2
23371 IF (.NOT.(NGETCH (LEXSTR (I)) .NE. LEXSTR (1)))GOTO 23373
      IF (.NOT.(LEXSTR (I) .EQ. 95))GOTO 23374
      IF (.NOT.(NGETCH (C) .EQ. 10))GOTO 23376
23378 IF (.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23379
      C = NGETCH (C)
      GOTO 23378
23379 CONTINUE
      LEXSTR (I) = C
      GOTO 23377
23376 CONTINUE
      CALL PUTBAK (C)
23377 CONTINUE
23374 CONTINUE
      IF (.NOT.(LEXSTR (I) .EQ. 10 .OR. I .GE. TOKSIZ - 1))GOTO 23380
      CALL SYNERR (14Hmissing quote.)
      LEXSTR (I) = LEXSTR (1)
      CALL PUTBAK (10)
      GOTO 23373
23380 CONTINUE
23372 I = I + 1
      GOTO 23371
23373 CONTINUE
      GOTO 23370
23369 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23382
23384 IF (.NOT.(NGETCH (LEXSTR (1)) .NE. 10))GOTO 23385
      GOTO 23384
23385 CONTINUE
      GTOK = 10
      GOTO 23383
23382 CONTINUE
      IF (.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 33 .OR. C .EQ. 33 .
     *OR. C .EQ. 126 .OR. C .EQ. 94 .OR. C .EQ. 61 .OR. C .EQ. 38 .OR. C
     * .EQ. 124))GOTO 23386
      CALL RELATE (LEXSTR, I)
      GTOK = C
      GOTO 23387
23386 CONTINUE
      GTOK = C
23387 CONTINUE
23383 CONTINUE
23370 CONTINUE
23364 CONTINUE
23362 CONTINUE
23360 CONTINUE
23346 CONTINUE
23339 CONTINUE
      IF (.NOT.(I .GE. TOKSIZ - 1))GOTO 23388
      CALL SYNERR (15Htoken too long.)
23388 CONTINUE
      LEXSTR (I + 1) = 0
      RETURN
      END
      SUBROUTINE IFCODE (LAB)
      INTEGER LAB
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER LABGEN
      XFER = 0
      LAB = LABGEN (2)
      CALL IFGO (LAB)
      RETURN
      END
      SUBROUTINE IFGO (LAB)
      INTEGER LAB
      LOGICAL*1 IFNOT(10)
      DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/32/,IFNOT(4)/40/,IFNOT(5
     *)/46/,IFNOT(6)/110/,IFNOT(7)/111/,IFNOT(8)/116/,IFNOT(9)/46/,IFNOT
     *(10)/0/
      CALL OUTTAB
      CALL OUTSTR (IFNOT)
      CALL BALPAR
      CALL OUTCH (41)
      CALL OUTGO (LAB)
      RETURN
      END
      INTEGER FUNCTION IFPARM (STRNG)
      LOGICAL*1 STRNG (100)
      LOGICAL*1 C
      INTEGER I, INDEX, TYPE
      C = STRNG (1)
      IF (.NOT.(C .EQ. -12 .OR. C .EQ. -13 .OR. C .EQ. -11 .OR. C .EQ. -
     *14 .OR. C .EQ. -10))GOTO 23390
      IFPARM = 1
      GOTO 23391
23390 CONTINUE
      IFPARM = 0
      I = 1
23392 IF (.NOT.(INDEX (STRNG (I), 36) .GT. 0))GOTO 23394
      I = I + INDEX (STRNG (I), 36)
      IF (.NOT.(TYPE (STRNG (I)) .EQ. 2))GOTO 23395
      IF (.NOT.(TYPE (STRNG (I + 1)) .NE. 2))GOTO 23397
      IFPARM = 1
      GOTO 23394
23397 CONTINUE
23395 CONTINUE
23393 GOTO 23392
23394 CONTINUE
23391 CONTINUE
      RETURN
      END
      SUBROUTINE INITKW
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER MKTABL
      CALL DSINIT (5000)
      DEFTBL = MKTABL (1)
      CALL ENTDKW
      RKWTBL = MKTABL (1)
      CALL ENTRKW
      LABEL = 23000
      RETURN
      END
      SUBROUTINE LABELC (LEXSTR)
      LOGICAL*1 LEXSTR (100)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER LENGTH
      XFER = 0
      IF (.NOT.(LENGTH (LEXSTR) .EQ. 5))GOTO 23399
      IF (.NOT.(LEXSTR (1) .EQ. 50 .AND. LEXSTR (2) .EQ. 51))GOTO 23401
      CALL SYNERR (33Hwarning: possible label conflict.)
23401 CONTINUE
23399 CONTINUE
      CALL OUTSTR (LEXSTR)
      CALL OUTTAB
      RETURN
      END
      INTEGER FUNCTION LABGEN (N)
      INTEGER N
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LABGEN = LABEL
      LABEL = LABEL + N
      RETURN
      END
      INTEGER FUNCTION LEX (LEXSTR)
      LOGICAL*1 LEXSTR (100)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GNBTOK
      INTEGER LOOKUP
      LEX = GNBTOK (LEXSTR, 100)
23403 IF (.NOT.(LEX .EQ. 10))GOTO 23405
23404 LEX = GNBTOK (LEXSTR, 100)
      GOTO 23403
23405 CONTINUE
      IF (.NOT.(LEX .EQ. -1 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LEX 
     *.EQ. 125))GOTO 23406
      RETURN
23406 CONTINUE
      IF (.NOT.(LEX .EQ. 2))GOTO 23408
      LEX = -9
      GOTO 23409
23408 CONTINUE
      IF (.NOT.(LEX .EQ. 37))GOTO 23410
      LEX = -27
      GOTO 23411
23410 CONTINUE
      IF (.NOT.(LOOKUP (LEXSTR, LEX, RKWTBL) .EQ. 1))GOTO 23412
      GOTO 23413
23412 CONTINUE
      LEX = -14
23413 CONTINUE
23411 CONTINUE
23409 CONTINUE
      RETURN
      END
      SUBROUTINE LITRAL
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 NGETCH
      IF (.NOT.(OUTP .GT. 0))GOTO 23414
      CALL OUTDON
23414 CONTINUE
      OUTP = 1
23416 IF (.NOT.(NGETCH (OUTBUF (OUTP)) .NE. 10))GOTO 23418
23417 OUTP = OUTP + 1
      GOTO 23416
23418 CONTINUE
      OUTP = OUTP - 1
      CALL OUTDON
      RETURN
      END
      SUBROUTINE LODSYM(FBUF)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER OPEN, LOCCOM
      LOGICAL*1 FBUF(40), PATH(120)
      LOGICAL*1 DEFNS(8)
      LOGICAL*1 SUFFIX(3)
      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/
      DATA SUFFIX(1)/0/,SUFFIX(2)/10/,SUFFIX(3)/0/
      IF (.NOT.(DEFNS(1) .NE. 0))GOTO 23419
      CALL IMPATH(PATH)
      IF (.NOT.(LOCCOM(DEFNS, PATH, SUFFIX, FBUF) .EQ. 12))GOTO 23421
      INFILE(1) = OPEN(FBUF, 1)
      IF (.NOT.(INFILE(1) .EQ. -3))GOTO 23423
      CALL REMARK(38Hcannot open standard definitions file.)
      GOTO 23424
23423 CONTINUE
      CALL PARSE
      CALL CLOSE(INFILE(1))
23424 CONTINUE
      GOTO 23422
23421 CONTINUE
      CALL REMARK(40Hcannot locate standard definitions file.)
23422 CONTINUE
23419 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION NGETCH (C)
      LOGICAL*1 C
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GETCH
      IF (.NOT.(BP .GT. 0))GOTO 23425
      C = BUF(BP)
      BP = BP - 1
      GOTO 23426
23425 CONTINUE
      C = GETCH(C, INFILE (LEVEL) )
      IF (.NOT.(C .EQ. 10))GOTO 23427
      LINECT (LEVEL) = LINECT (LEVEL) + 1
23427 CONTINUE
23426 CONTINUE
      NGETCH=(C)
      RETURN
      END
      SUBROUTINE OTHERC (LEXSTR)
      LOGICAL*1 LEXSTR (100)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      XFER = 0
      CALL OUTTAB
      CALL OUTSTR (LEXSTR)
      CALL EATUP
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTCH (C)
      LOGICAL*1 C
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I
      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 /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      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 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
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      OUTBUF (OUTP + 1) = 10
      OUTBUF (OUTP + 2) = 0
      CALL PUTLIN (OUTBUF, 2)
      OUTP = 0
      RETURN
      END
      SUBROUTINE OUTGO (N)
      INTEGER N
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 SGOTO(6)
      DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO
     *(5)/32/,SGOTO(6)/0/
      IF (.NOT.(XFER .EQ. 1))GOTO 23438
      RETURN
23438 CONTINUE
      CALL OUTTAB
      CALL OUTSTR (SGOTO)
      CALL OUTNUM (N)
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTNUM (N)
      INTEGER N
      LOGICAL*1 CHARS (20)
      INTEGER I, M
      M = IABS (N)
      I = 0
23440 CONTINUE
      I = I + 1
      CHARS (I) = MOD (M, 10) + 48
      M = M / 10
23441 IF (.NOT.(M .EQ. 0 .OR. I .GE. 20))GOTO 23440
23442 CONTINUE
      IF (.NOT.(N .LT. 0))GOTO 23443
      CALL OUTCH (45)
23443 CONTINUE
23445 IF (.NOT.(I .GT. 0))GOTO 23447
      CALL OUTCH (CHARS (I))
23446 I = I - 1
      GOTO 23445
23447 CONTINUE
      RETURN
      END
      SUBROUTINE OUTSTR (STR)
      LOGICAL*1 STR (100)
      LOGICAL*1 C
      LOGICAL*1 CUPPER
      INTEGER I, J
      I = 1
23448 IF (.NOT.(STR (I) .NE. 0))GOTO 23450
      C = STR (I)
      IF (.NOT.(C .NE. 39 .AND. C .NE. 34))GOTO 23451
      CALL OUTCH (CUPPER (C))
      GOTO 23452
23451 CONTINUE
      I = I + 1
      J = I
23453 IF (.NOT.(STR (J) .NE. C))GOTO 23455
23454 J = J + 1
      GOTO 23453
23455 CONTINUE
      CALL OUTNUM (J - I)
      CALL OUTCH (72)
23456 IF (.NOT.(I .LT. J))GOTO 23458
      CALL OUTCH (STR (I))
23457 I = I + 1
      GOTO 23456
23458 CONTINUE
23452 CONTINUE
23449 I = I + 1
      GOTO 23448
23450 CONTINUE
      RETURN
      END
      SUBROUTINE OUTTAB
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
23459 IF (.NOT.(OUTP .LT. 6))GOTO 23460
      CALL OUTCH (32)
      GOTO 23459
23460 CONTINUE
      RETURN
      END
      SUBROUTINE PARSE
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 LEXSTR (100)
      INTEGER LAB, LABVAL (100), LEXTYP (100), SP, TOKEN, I
      INTEGER LEX
      CALL FINIT
      SP = 1
      LEXTYP (1) = -1
      TOKEN = LEX (LEXSTR)
23461 IF (.NOT.(TOKEN .NE. -1))GOTO 23463
      IF (.NOT.(TOKEN .EQ. -19))GOTO 23464
      CALL IFCODE (LAB)
      GOTO 23465
23464 CONTINUE
      IF (.NOT.(TOKEN .EQ. -10))GOTO 23466
      CALL DOCODE (LAB)
      GOTO 23467
23466 CONTINUE
      IF (.NOT.(TOKEN .EQ. -15))GOTO 23468
      CALL WHILEC (LAB)
      GOTO 23469
23468 CONTINUE
      IF (.NOT.(TOKEN .EQ. -16))GOTO 23470
      CALL FORCOD (LAB)
      GOTO 23471
23470 CONTINUE
      IF (.NOT.(TOKEN .EQ. -17))GOTO 23472
      CALL REPCOD (LAB)
      GOTO 23473
23472 CONTINUE
      IF (.NOT.(TOKEN .EQ. -9))GOTO 23474
      CALL LABELC (LEXSTR)
      GOTO 23475
23474 CONTINUE
      IF (.NOT.(TOKEN .EQ. -11))GOTO 23476
      IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23478
      CALL ELSEIF (LABVAL (SP))
      GOTO 23479
23478 CONTINUE
      CALL SYNERR (13Hillegal else.)
23479 CONTINUE
      GOTO 23477
23476 CONTINUE
      IF (.NOT.(TOKEN .EQ. -27))GOTO 23480
      CALL LITRAL
23480 CONTINUE
23477 CONTINUE
23475 CONTINUE
23473 CONTINUE
23471 CONTINUE
23469 CONTINUE
23467 CONTINUE
23465 CONTINUE
      IF (.NOT.(TOKEN .EQ. -19 .OR. TOKEN .EQ. -11 .OR. TOKEN .EQ. -15 .
     *OR. TOKEN .EQ. -16 .OR. TOKEN .EQ. -17  .OR. TOKEN .EQ. -10 .OR. T
     *OKEN .EQ. -9 .OR. TOKEN .EQ. 123))GOTO 23482
      SP = SP + 1
      IF (.NOT.(SP .GT. 100))GOTO 23484
      CALL BADERR (25Hstack overflow in parser.)
23484 CONTINUE
      LEXTYP (SP) = TOKEN
      LABVAL (SP) = LAB
      GOTO 23483
23482 CONTINUE
      IF (.NOT.(TOKEN .NE. -25 .AND. TOKEN .NE. -26))GOTO 23486
      IF (.NOT.(TOKEN .EQ. 125))GOTO 23488
      IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23490
      SP = SP - 1
      GOTO 23491
23490 CONTINUE
      CALL SYNERR (20Hillegal right brace.)
23491 CONTINUE
      GOTO 23489
23488 CONTINUE
      IF (.NOT.(TOKEN .EQ. -14))GOTO 23492
      CALL OTHERC (LEXSTR)
      GOTO 23493
23492 CONTINUE
      IF (.NOT.(TOKEN .EQ. -8 .OR. TOKEN .EQ. -13))GOTO 23494
      CALL BRKNXT (SP, LEXTYP, LABVAL, TOKEN)
      GOTO 23495
23494 CONTINUE
      IF (.NOT.(TOKEN .EQ. -20))GOTO 23496
      CALL RETCOD
      GOTO 23497
23496 CONTINUE
      IF (.NOT.(TOKEN .EQ. -23))GOTO 23498
      CALL STRDCL
23498 CONTINUE
23497 CONTINUE
23495 CONTINUE
23493 CONTINUE
23489 CONTINUE
      TOKEN = LEX (LEXSTR)
      CALL PBSTR (LEXSTR)
      CALL UNSTAK (SP, LEXTYP, LABVAL, TOKEN)
23486 CONTINUE
23483 CONTINUE
23462 TOKEN = LEX (LEXSTR)
      GOTO 23461
23463 CONTINUE
      IF (.NOT.(SP .NE. 1))GOTO 23500
      CALL SYNERR (15Hunexpected EOF.)
23500 CONTINUE
      IF (.NOT.(CSP .GT. 0))GOTO 23502
      CALL SYNERR(43Hconditional processing still active at EOF.)
23502 CONTINUE
      RETURN
      END
      SUBROUTINE PBNUM (N)
      INTEGER N
      INTEGER M, NUM
      INTEGER MOD, IABS
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT
     *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D
     *IGITS(10)/57/,DIGITS(11)/0/
      NUM = IABS(N)
23504 CONTINUE
      M = MOD (NUM, 10)
      CALL PUTBAK (DIGITS (M + 1))
      NUM = NUM / 10
23505 IF (.NOT.(NUM .EQ. 0))GOTO 23504
23506 CONTINUE
      IF (.NOT.(N .LT. 0))GOTO 23507
      CALL PUTBAK(45)
23507 CONTINUE
      RETURN
      END
      SUBROUTINE PBSTR (IN)
      LOGICAL*1 IN (100)
      INTEGER I
      INTEGER LENGTH
      I = LENGTH (IN)
23509 IF (.NOT.(I .GT. 0))GOTO 23511
      CALL PUTBAK (IN (I))
23510 I = I - 1
      GOTO 23509
23511 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PUSH (EP, ARGSTK, AP)
      INTEGER AP, ARGSTK (100), EP
      IF (.NOT.(AP .GT. 100))GOTO 23512
      CALL BADERR (19Harg stack overflow.)
23512 CONTINUE
      ARGSTK (AP) = EP
      PUSH = AP + 1
      RETURN
      END
      SUBROUTINE PUTBAK (C)
      LOGICAL*1 C
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      IF (.NOT.(BP .GE. 500))GOTO 23514
      CALL BADERR (32Htoo many characters pushed back.)
      GOTO 23515
23514 CONTINUE
      BP = BP + 1
      BUF (BP) = C
23515 CONTINUE
      RETURN
      END
      SUBROUTINE PUTCHR (C)
      LOGICAL*1 C
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      IF (.NOT.(EP .GT. 500))GOTO 23516
      CALL BADERR (26Hevaluation stack overflow.)
23516 CONTINUE
      EVALST (EP) = C
      EP = EP + 1
      RETURN
      END
      SUBROUTINE PUTTOK (STR)
      LOGICAL*1 STR (100)
      INTEGER I
      I = 1
23518 IF (.NOT.(STR (I) .NE. 0))GOTO 23520
      CALL PUTCHR (STR (I))
23519 I = I + 1
      GOTO 23518
23520 CONTINUE
      RETURN
      END
      SUBROUTINE RELATE (TOKEN, LAST)
      LOGICAL*1 TOKEN (100)
      INTEGER LAST
      LOGICAL*1 NGETCH
      INTEGER LENGTH
      IF (.NOT.(NGETCH (TOKEN (2)) .NE. 61))GOTO 23521
      CALL PUTBAK (TOKEN (2))
      TOKEN (3) = 116
      GOTO 23522
23521 CONTINUE
      TOKEN (3) = 101
23522 CONTINUE
      TOKEN (4) = 46
      TOKEN (5) = 0
      TOKEN (6) = 0
      IF (.NOT.(TOKEN (1) .EQ. 62))GOTO 23523
      TOKEN (2) = 103
      GOTO 23524
23523 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 60))GOTO 23525
      TOKEN (2) = 108
      GOTO 23526
23525 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 33 .OR. TOKEN (1) .EQ. 33 .OR. TOKEN (1) 
     *.EQ. 94 .OR. TOKEN (1) .EQ. 126))GOTO 23527
      IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23529
      TOKEN (3) = 111
      TOKEN (4) = 116
      TOKEN (5) = 46
23529 CONTINUE
      TOKEN (2) = 110
      GOTO 23528
23527 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 61))GOTO 23531
      IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23533
      TOKEN (2) = 0
      LAST = 1
      RETURN
23533 CONTINUE
      TOKEN (2) = 101
      TOKEN (3) = 113
      GOTO 23532
23531 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 38))GOTO 23535
      TOKEN (2) = 97
      TOKEN (3) = 110
      TOKEN (4) = 100
      TOKEN (5) = 46
      GOTO 23536
23535 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 124))GOTO 23537
      TOKEN (2) = 111
      TOKEN (3) = 114
      GOTO 23538
23537 CONTINUE
      TOKEN (2) = 0
23538 CONTINUE
23536 CONTINUE
23532 CONTINUE
23528 CONTINUE
23526 CONTINUE
23524 CONTINUE
      TOKEN (1) = 46
      LAST = LENGTH (TOKEN)
      RETURN
      END
      SUBROUTINE REPCOD (LAB)
      INTEGER LAB
      INTEGER LABGEN
      CALL OUTCON (0)
      LAB = LABGEN (3)
      CALL OUTCON (LAB)
      LAB = LAB + 1
      RETURN
      END
      SUBROUTINE RETCOD
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 TOKEN (100), T
      LOGICAL*1 GNBTOK
      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 23539
      CALL PBSTR (TOKEN)
      CALL OUTTAB
      CALL SCOPY (FCNAME, 1, TOKEN, 1)
      CALL OUTSTR (TOKEN)
      CALL OUTCH (61)
      CALL EATUP
      CALL OUTDON
      GOTO 23540
23539 CONTINUE
      IF (.NOT.(T .EQ. 125))GOTO 23541
      CALL PBSTR (TOKEN)
23541 CONTINUE
23540 CONTINUE
      CALL OUTTAB
      CALL OUTSTR (SRET)
      CALL OUTDON
      XFER = 1
      RETURN
      END
      SUBROUTINE SKPBLK
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C
      LOGICAL*1 NGETCH
      C = NGETCH (C)
23543 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23545
23544 C = NGETCH (C)
      GOTO 23543
23545 CONTINUE
      CALL PUTBAK (C)
      RETURN
      END
      SUBROUTINE STRDCL
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T, TOKEN (100), DCHAR (100)
      LOGICAL*1 GNBTOK, ESC
      INTEGER I, J, K, N, LEN
      INTEGER LENGTH, CTOI, LEX, ELENTH
      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 23546
      CALL SYNERR (21Hmissing string token.)
23546 CONTINUE
      CALL OUTTAB
      CALL PBSTR (CHAR)
23548 CONTINUE
      T = GNBTOK (DCHAR, 100)
      IF (.NOT.(T .EQ. 47))GOTO 23551
      GOTO 23550
23551 CONTINUE
      CALL OUTSTR (DCHAR)
23549 GOTO 23548
23550 CONTINUE
      CALL OUTCH (32)
      CALL OUTSTR (TOKEN)
      CALL ADDSTR (TOKEN, SBUF, SBP, 600)
      CALL ADDCHR (0, SBUF, SBP, 600)
      IF (.NOT.(GNBTOK (TOKEN, 100) .NE. 40))GOTO 23553
      LEN = ELENTH (TOKEN) + 1
      IF (.NOT.(TOKEN (1) .EQ. 39 .OR. TOKEN (1) .EQ. 34))GOTO 23555
      LEN = LEN - 2
23555 CONTINUE
      GOTO 23554
23553 CONTINUE
      T = GNBTOK (TOKEN, 100)
      I = 1
      LEN = CTOI (TOKEN, I)
      IF (.NOT.(TOKEN (I) .NE. 0))GOTO 23557
      CALL SYNERR (20Hinvalid string size.)
23557 CONTINUE
      IF (.NOT.(GNBTOK (TOKEN, 100) .NE. 41))GOTO 23559
      CALL SYNERR (20Hmissing right paren.)
      GOTO 23560
23559 CONTINUE
      T = GNBTOK (TOKEN, 100)
23560 CONTINUE
23554 CONTINUE
      CALL OUTCH (40)
      CALL OUTNUM (LEN)
      CALL OUTCH (41)
      CALL OUTDON
      IF (.NOT.(TOKEN (1) .EQ. 39 .OR. TOKEN (1) .EQ. 34))GOTO 23561
      LEN = LENGTH (TOKEN)
      TOKEN (LEN) = 0
      CALL ADDSTR (TOKEN (2), SBUF, SBP, 600)
      GOTO 23562
23561 CONTINUE
      CALL ADDSTR (TOKEN, SBUF, SBP, 600)
23562 CONTINUE
      CALL ADDCHR (0, SBUF, SBP, 600)
      T = LEX (TOKEN)
      CALL PBSTR (TOKEN)
      IF (.NOT.(T .NE. -23))GOTO 23563
      I = 1
23565 IF (.NOT.(I .LT. SBP))GOTO 23567
      CALL OUTTAB
      CALL OUTSTR (DAT)
      K = 1
      J = I + LENGTH (SBUF (I)) + 1
23568 CONTINUE
      IF (.NOT.(K .GT. 1))GOTO 23571
      CALL OUTCH (44)
23571 CONTINUE
      CALL OUTSTR (SBUF (I))
      CALL OUTCH (40)
      CALL OUTNUM (K)
      CALL OUTCH (41)
      CALL OUTCH (47)
      IF (.NOT.(SBUF (J) .EQ. 0))GOTO 23573
      GOTO 23570
23573 CONTINUE
      N = ESC (SBUF, J)
      CALL OUTNUM (N)
      CALL OUTCH (47)
      K = K + 1
23569 J = J + 1
      GOTO 23568
23570 CONTINUE
      CALL PBSTR (EOSS)
23575 CONTINUE
      T = GNBTOK (TOKEN, 100)
      CALL OUTSTR (TOKEN)
23576 IF (.NOT.(T .EQ. 47))GOTO 23575
23577 CONTINUE
      CALL OUTDON
23566 I = J + 1
      GOTO 23565
23567 CONTINUE
      SBP = 1
23563 CONTINUE
      RETURN
      END
      SUBROUTINE SYNERR (MSG)
      LOGICAL*1 MSG (100)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 LC (20)
      INTEGER I, JUNK
      INTEGER ITOC
      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 23578
      I = LEVEL
      GOTO 23579
23578 CONTINUE
      I = 1
23579 CONTINUE
      JUNK = ITOC (LINECT (I), LC, 20)
      CALL PUTLIN (LC, 3)
      I = FNAMP - 1
23580 IF (.NOT.(I .GT. 1))GOTO 23582
      IF (.NOT.(FNAMES (I - 1) .EQ. 0))GOTO 23583
      CALL PUTLIN (IN, 3)
      CALL PUTLIN (FNAMES (I), 3)
      GOTO 23582
23583 CONTINUE
23581 I = I - 1
      GOTO 23580
23582 CONTINUE
      CALL PUTCH (58, 3)
      CALL PUTCH (32, 3)
      CALL REMARK (MSG)
      RETURN
      END
      SUBROUTINE ULSTAL (NAME, DEFN)
      LOGICAL*1 NAME (100), DEFN (100)
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      CALL ENTDEF (NAME, DEFN, DEFTBL)
      CALL UPPER (NAME)
      CALL ENTDEF (NAME, DEFN, DEFTBL)
      RETURN
      END
      SUBROUTINE UNSTAK (SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL (100), LEXTYP (100), SP, TOKEN
23585 IF (.NOT.(SP .GT. 1))GOTO 23587
      IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23588
      GOTO 23587
23588 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -19 .AND. TOKEN .EQ. -11))GOTO 23590
      GOTO 23587
23590 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23592
      CALL OUTCON (LABVAL (SP))
      GOTO 23593
23592 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -11))GOTO 23594
      IF (.NOT.(SP .GT. 2))GOTO 23596
      SP = SP - 1
23596 CONTINUE
      CALL OUTCON (LABVAL (SP) + 1)
      GOTO 23595
23594 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -10))GOTO 23598
      CALL DOSTAT (LABVAL (SP))
      GOTO 23599
23598 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -15))GOTO 23600
      CALL WHILES (LABVAL (SP))
      GOTO 23601
23600 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -16))GOTO 23602
      CALL FORS (LABVAL (SP))
      GOTO 23603
23602 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -17))GOTO 23604
      CALL UNTILS (LABVAL (SP), TOKEN)
23604 CONTINUE
23603 CONTINUE
23601 CONTINUE
23599 CONTINUE
23595 CONTINUE
23593 CONTINUE
23586 SP = SP - 1
      GOTO 23585
23587 CONTINUE
      RETURN
      END
      SUBROUTINE UNTILS (LAB, TOKEN)
      INTEGER LAB, TOKEN
      COMMON /CDEFIO/ BP, BUF (500)
      INTEGER BP
      LOGICAL*1 BUF
      COMMON /CFNAME/ FCNAME (40)
      LOGICAL*1 FCNAME
      COMMON /CFOR/ FORDEP, FORSTK (300)
      INTEGER FORDEP
      LOGICAL*1 FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLINE/ LEVEL, LINECT (4), INFILE (4), FNAMP, FNAMES ( 160)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      LOGICAL*1 FNAMES
      COMMON /CMACRO/ CP, EP, EVALST (500), DEFTBL
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      INTEGER DEFTBL
      COMMON /COUTLN/ OUTP, OUTBUF (74)
      INTEGER OUTP
      LOGICAL*1 OUTBUF
      COMMON /CSBUF/ SBP, SBUF (600)
      INTEGER SBP
      LOGICAL*1 SBUF
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 PTOKEN (100)
      INTEGER JUNK
      INTEGER LEX
      XFER = 0
      CALL OUTNUM (LAB)
      IF (.NOT.(TOKEN .EQ. -18))GOTO 23606
      JUNK = LEX (PTOKEN)
      CALL IFGO (LAB - 1)
      GOTO 23607
23606 CONTINUE
      CALL OUTGO (LAB - 1)
23607 CONTINUE
      CALL OUTCON (LAB + 1)
      RETURN
      END
      SUBROUTINE WHILEC (LAB)
      INTEGER LAB
      INTEGER LABGEN
      CALL OUTCON (0)
      LAB = LABGEN (2)
      CALL OUTNUM (LAB)
      CALL IFGO (LAB + 1)
      RETURN
      END
      SUBROUTINE WHILES (LAB)
      INTEGER LAB
      CALL OUTGO (LAB)
      CALL OUTCON (LAB + 1)
      RETURN
      END
