      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, N
      INTEGER GETARG, OPEN
      LOGICAL*1 ARG (40)
      CALL QUERY (35Husage:  ratfor [file] ... >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 (120)
      LOGICAL*1 GETTOK, GNBTOK
      INTEGER NLPAR
      IF (.NOT.(GNBTOK (TOKEN, 120) .NE. 40))GOTO 23023
      CALL SYNERR (19Hmissing left paren.)
      RETURN
23023 CONTINUE
      CALL OUTSTR (TOKEN)
      NLPAR = 1
23025 CONTINUE
      T = GETTOK (TOKEN, 120)
      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
      LOGICAL*1 T
      INTEGER ALLDIG, CTOI
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      N = 0
      T = GNBTOK (SCRTOK, 120)
      IF (.NOT.(ALLDIG (SCRTOK) .EQ. 1))GOTO 23038
      I = 1
      N = CTOI (SCRTOK, I) - 1
      GOTO 23039
23038 CONTINUE
      IF (.NOT.(T .NE. 59))GOTO 23040
      CALL PBSTR (SCRTOK)
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
      SUBROUTINE CASCOD (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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER T, L, LB, UB, I, J, JUNK
      INTEGER CASLAB, LABGEN
      LOGICAL*1 GNBTOK
      IF (.NOT.(SETOP .LE. 0))GOTO 23053
      CALL SYNERR (24Hillegal case or default.)
      RETURN
23053 CONTINUE
      CALL OUTGO (LAB + 1)
      XFER = 1
      L = LABGEN (1)
      IF (.NOT.(TOKEN .EQ. -25))GOTO 23055
23057 IF (.NOT.(CASLAB (LB, T) .NE. -1))GOTO 23058
      UB = LB
      IF (.NOT.(T .EQ. 45))GOTO 23059
      JUNK = CASLAB (UB, T)
23059 CONTINUE
      IF (.NOT.(LB .GT. UB))GOTO 23061
      CALL SYNERR (28Hillegal range in case label.)
      UB = LB
23061 CONTINUE
      IF (.NOT.(SELAST + 3 .GT. 300))GOTO 23063
      CALL BADERR (22Hselect table overflow.)
23063 CONTINUE
      I = SETOP + 3
23065 IF (.NOT.(I .LT. SELAST))GOTO 23067
      IF (.NOT.(LB .LE. SESTAK (I)))GOTO 23068
      GOTO 23067
23068 CONTINUE
      IF (.NOT.(LB .LE. SESTAK (I+1)))GOTO 23070
      CALL SYNERR (21Hduplicate case label.)
23070 CONTINUE
23069 CONTINUE
23066 I = I + 3
      GOTO 23065
23067 CONTINUE
      IF (.NOT.(I .LT. SELAST .AND. UB .GE. SESTAK (I)))GOTO 23072
      CALL SYNERR (21Hduplicate case label.)
23072 CONTINUE
      J = SELAST
23074 IF (.NOT.(J .GT. I))GOTO 23076
      SESTAK (J+2) = SESTAK (J-1)
23075 J = J - 1
      GOTO 23074
23076 CONTINUE
      SESTAK (I) = LB
      SESTAK (I + 1) = UB
      SESTAK (I + 2) = L
      SESTAK (SETOP + 1) = SESTAK (SETOP + 1) + 1
      SELAST = SELAST + 3
      IF (.NOT.(T .EQ. 58))GOTO 23077
      GOTO 23058
23077 CONTINUE
      IF (.NOT.(T .NE. 44))GOTO 23079
      CALL SYNERR (20Hillegal case syntax.)
23079 CONTINUE
23078 CONTINUE
      GOTO 23057
23058 CONTINUE
      GOTO 23056
23055 CONTINUE
      T = GNBTOK (SCRTOK, 120)
      IF (.NOT.(SESTAK (SETOP + 2) .NE. 0))GOTO 23081
      CALL BADERR (38Hmultiple defaults in select statement.)
      GOTO 23082
23081 CONTINUE
      SESTAK (SETOP + 2) = L
23082 CONTINUE
23056 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23083
      CALL SYNERR (15Hunexpected EOF.)
      GOTO 23084
23083 CONTINUE
      IF (.NOT.(T .NE. 58))GOTO 23085
      CALL BADERR (39Hmissing colon in case or default label.)
23085 CONTINUE
23084 CONTINUE
      XFER = 0
      CALL OUTCON (L)
      RETURN
      END
      INTEGER FUNCTION CASLAB (N, T)
      INTEGER N, T
      LOGICAL*1 TOK (120)
      INTEGER I, S
      LOGICAL*1 GNBTOK
      INTEGER CTOI
      T = GNBTOK (TOK, 120)
23087 IF (.NOT.(T .EQ. 10))GOTO 23088
      T = GNBTOK (TOK, 120)
      GOTO 23087
23088 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23089
      CASLAB=(T)
      RETURN
23089 CONTINUE
      IF (.NOT.(T .EQ. 45))GOTO 23091
      S = -1
      GOTO 23092
23091 CONTINUE
      S = +1
23092 CONTINUE
      IF (.NOT.(T .EQ. 45 .OR. T .EQ. 43))GOTO 23093
      T = GNBTOK (TOK, 120)
23093 CONTINUE
      IF (.NOT.(T .NE. 2))GOTO 23095
      CALL SYNERR (19Hinvalid case label.)
      N = 0
      GOTO 23096
23095 CONTINUE
      I = 1
      N = S * CTOI (TOK, I)
23096 CONTINUE
      T = GNBTOK (TOK, 120)
23097 IF (.NOT.(T .EQ. 10))GOTO 23098
      T = GNBTOK (TOK, 120)
      GOTO 23097
23098 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CNDGET(TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN(120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 23099
      CALL BADERR(31HConditionals nested too deeply.)
23099 CONTINUE
      CSP = CSP + 1
      CNDSTK (CSP) = CURCND
      CALL SKPBLK
      IF (.NOT.(GTOK(TOKEN, TOKSIZ) .NE. 40))GOTO 23101
      CALL BADERR(27Hmissing `(' in conditional.)
23101 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GTOK(TOKEN, TOKSIZ) .NE. -9))GOTO 23103
      CALL BADERR(26Hinvalid conditional token.)
23103 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GTOK(PTOK, 3) .NE. 41))GOTO 23105
      CALL BADERR(27Hmissing `)' in conditional.)
23105 CONTINUE
      IF (.NOT.(LOOKUP(TOKEN, VALUE, DEFTBL) .EQ. 1))GOTO 23107
      CNDGET = 1
      GOTO 23108
23107 CONTINUE
      CNDGET = -1
23108 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION CNDLU (TOKEN)
      LOGICAL*1 TOKEN(120)
      INTEGER I, J
      LOGICAL*1 TEMP (9)
      INTEGER INDEXC, EQUAL
      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.(INDEXC (LETTS, TOKEN (1)) .GT. 0))GOTO 23109
      I=1
23111 IF (.NOT.(CNDTBL(I) .NE. 0))GOTO 23113
      J=1
23114 IF (.NOT.(CNDTBL(I) .NE. 47))GOTO 23116
      TEMP(J) = CNDTBL(I)
23115 I=I+1
      J=J+1
      GOTO 23114
23116 CONTINUE
      TEMP(J) = 0
      I = I + 1
      J = EQUAL(TOKEN, TEMP)
      IF (.NOT.(J .EQ. 0))GOTO 23117
      CALL UPPER(TEMP)
      J = EQUAL(TOKEN, TEMP)
23117 CONTINUE
      IF (.NOT.(J .EQ. 1))GOTO 23119
      CNDLU = CNDTBL(I)
      GOTO 23113
23119 CONTINUE
23112 I=I+1
      GOTO 23111
23113 CONTINUE
23109 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION DEFTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T, C, DEFN (250)
      INTEGER AP, ARGSTK (100), CALLST (50), NLB, PLEV (50), IFL
      INTEGER LUDEF, PUSH, IFPARM
      LOGICAL*1 GCTOK
      LOGICAL*1 BALP(3)
      DATA BALP(1)/40/,BALP(2)/41/,BALP(3)/0/
      CP = 0
      AP = 1
      EP = 1
      T = GCTOK (TOKEN, TOKSIZ)
23121 IF (.NOT.(T .NE. -1))GOTO 23123
      IF (.NOT.(T .EQ. -9))GOTO 23124
      IF (.NOT.(LUDEF (TOKEN, DEFN, DEFTBL) .EQ. 0))GOTO 23126
      IF (.NOT.(CP .EQ. 0))GOTO 23128
      GOTO 23123
23128 CONTINUE
      CALL PUTTOK (TOKEN)
23129 CONTINUE
      GOTO 23127
23126 CONTINUE
      IF (.NOT.(DEFN (1) .EQ. -4))GOTO 23130
      CALL GETDEF (TOKEN, TOKSIZ, DEFN, 250)
      CALL ENTDEF (TOKEN, DEFN, DEFTBL)
      GOTO 23131
23130 CONTINUE
      CP = CP + 1
      IF (.NOT.(CP .GT. 50))GOTO 23132
      CALL BADERR (20Hcall stack overflow.)
23132 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 23134
      T = GCTOK (TOKEN, TOKSIZ)
      CALL PBSTR (TOKEN)
      IF (.NOT.(T .NE. 40))GOTO 23136
      CALL PUTBAK (32)
23136 CONTINUE
      GOTO 23135
23134 CONTINUE
      CALL PBSTR (TOKEN)
23135 CONTINUE
      IF (.NOT.(T .NE. 40))GOTO 23138
      CALL PBSTR (BALP)
      GOTO 23139
23138 CONTINUE
      IF (.NOT.(IFPARM (DEFN) .EQ. 0))GOTO 23140
      CALL PBSTR (BALP)
23140 CONTINUE
23139 CONTINUE
      PLEV (CP) = 0
23131 CONTINUE
23127 CONTINUE
      GOTO 23125
23124 CONTINUE
      IF (.NOT.(T .EQ. -10))GOTO 23142
      NLB = 1
23144 CONTINUE
      T = GCTOK (TOKEN, TOKSIZ)
      IF (.NOT.(T .EQ. -10))GOTO 23147
      NLB = NLB + 1
      GOTO 23148
23147 CONTINUE
      IF (.NOT.(T .EQ. -11))GOTO 23149
      NLB = NLB - 1
      IF (.NOT.(NLB .EQ. 0))GOTO 23151
      GOTO 23146
23151 CONTINUE
      GOTO 23150
23149 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23153
      CALL BADERR (14HEOF in string.)
23153 CONTINUE
23150 CONTINUE
23148 CONTINUE
      CALL PUTTOK (TOKEN)
23145 GOTO 23144
23146 CONTINUE
      GOTO 23143
23142 CONTINUE
      IF (.NOT.(CP .EQ. 0))GOTO 23155
      GOTO 23123
23155 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23157
      IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23159
      CALL PUTTOK (TOKEN)
23159 CONTINUE
      PLEV (CP) = PLEV (CP) + 1
      GOTO 23158
23157 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23161
      PLEV (CP) = PLEV (CP) - 1
      IF (.NOT.(PLEV (CP) .GT. 0))GOTO 23163
      CALL PUTTOK (TOKEN)
      GOTO 23164
23163 CONTINUE
      CALL PUTCHR (0)
      CALL EVALR (ARGSTK, CALLST (CP), AP - 1)
      AP = CALLST (CP)
      EP = ARGSTK (AP)
      CP = CP - 1
23164 CONTINUE
      GOTO 23162
23161 CONTINUE
      IF (.NOT.(T .EQ. 44 .AND. PLEV (CP) .EQ. 1))GOTO 23165
      CALL PUTCHR (0)
      AP = PUSH (EP, ARGSTK, AP)
      GOTO 23166
23165 CONTINUE
      CALL PUTTOK (TOKEN)
23166 CONTINUE
23162 CONTINUE
23158 CONTINUE
23156 CONTINUE
23143 CONTINUE
23125 CONTINUE
23122 T = GCTOK (TOKEN, TOKSIZ)
      GOTO 23121
23123 CONTINUE
      DEFTOK = T
      IF (.NOT.(T .EQ. -9))GOTO 23167
      CALL FOLD (TOKEN)
23167 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER K, L, ANS, FIRST, SECOND
      LOGICAL*1 OP
      INTEGER CTOI
      K = ARGSTK (I + 2)
      FIRST = CTOI(EVALST, K)
      L = ARGSTK (I + 4)
      SECOND = CTOI(EVALST, L)
      OP = EVALST (ARGSTK (I + 3))
      IF (.NOT.(OP .EQ. 43))GOTO 23169
      CALL PBNUM (FIRST + SECOND)
      GOTO 23170
23169 CONTINUE
      IF (.NOT.(OP .EQ. 45))GOTO 23171
      CALL PBNUM (FIRST - SECOND)
      GOTO 23172
23171 CONTINUE
      IF (.NOT.(OP .EQ. 42 ))GOTO 23173
      IF (.NOT.(EVALST(ARGSTK(I+3) + 1) .EQ. 42))GOTO 23175
      ANS = 1
23177 IF (.NOT.(SECOND .GT. 0))GOTO 23179
      ANS = ANS * FIRST
23178 SECOND = SECOND - 1
      GOTO 23177
23179 CONTINUE
      CALL PBNUM(ANS)
      GOTO 23176
23175 CONTINUE
      CALL PBNUM (FIRST * SECOND)
23176 CONTINUE
      GOTO 23174
23173 CONTINUE
      IF (.NOT.(OP .EQ. 47 ))GOTO 23180
      CALL PBNUM (FIRST / SECOND)
      GOTO 23181
23180 CONTINUE
      CALL SYNERR (12Harith error.)
23181 CONTINUE
23174 CONTINUE
23172 CONTINUE
23170 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GNBTOK
      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 (SCRTOK, 120) .EQ. 2))GOTO 23182
      CALL OUTSTR (SCRTOK)
      GOTO 23183
23182 CONTINUE
      CALL PBSTR (SCRTOK)
      CALL OUTNUM (LAB)
23183 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER A2, A3, A4, A5
      INTEGER EQUAL
      IF (.NOT.(J - I .LT. 5))GOTO 23184
      RETURN
23184 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 23186
      CALL PBSTR (EVALST (A4))
      GOTO 23187
23186 CONTINUE
      CALL PBSTR (EVALST (A5))
23187 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER A2, A3
      IF (.NOT.(J - I .GT. 2))GOTO 23188
      A2 = ARGSTK (I + 2)
      A3 = ARGSTK (I + 3)
      CALL ENTDEF (EVALST (A2), EVALST (A3), DEFTBL)
23188 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER AP, FC, K, NC
      INTEGER CTOI, LENGTH
      IF (.NOT.(J - I .LT. 3))GOTO 23190
      RETURN
23190 CONTINUE
      IF (.NOT.(J - I .LT. 4))GOTO 23192
      NC = 120
      GOTO 23193
23192 CONTINUE
      K = ARGSTK (I + 4)
      NC = CTOI (EVALST, K)
23193 CONTINUE
      K = ARGSTK (I + 3)
      AP = ARGSTK (I + 2)
      FC = AP + CTOI (EVALST, K) - 1
      IF (.NOT.(FC .GE. AP .AND. FC .LT. AP + LENGTH (EVALST (AP))))GOTO
     * 23194
      K = FC + MIN0(NC, LENGTH (EVALST (FC))) - 1
23196 IF (.NOT.(K .GE. FC))GOTO 23198
      CALL PUTBAK (EVALST (K))
23197 K = K - 1
      GOTO 23196
23198 CONTINUE
23194 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION DOTHER(TOKEN)
      LOGICAL*1 TOKEN(120), T
      LOGICAL*1 GETTOK
      CALL OUTTAB
23199 CONTINUE
      T = GETTOK(TOKEN, 120)
      IF (.NOT.(T .EQ. 59 .OR. T .EQ. 125))GOTO 23202
      GOTO 23201
23202 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23204
      CALL SYNERR(15Hunexpected EOF.)
      CALL PBSTR(TOKEN)
      GOTO 23201
23204 CONTINUE
      IF (.NOT.(T .NE. 10))GOTO 23206
      CALL OUTSTR(TOKEN)
23206 CONTINUE
23200 GOTO 23199
23201 CONTINUE
      CALL OUTDON
      DOTHER=(T)
      RETURN
      END
      SUBROUTINE EATUP
      LOGICAL*1 PTOKEN (120), T, TOKEN (120)
      INTEGER NLPAR
      LOGICAL*1 GETTOK
      NLPAR = 0
23208 CONTINUE
      T = GETTOK (TOKEN, 120)
      IF (.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23211
      GOTO 23210
23211 CONTINUE
      IF (.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23213
      CALL PBSTR (TOKEN)
      GOTO 23210
23213 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23215
      CALL SYNERR (15Hunexpected EOF.)
      CALL PBSTR (TOKEN)
      GOTO 23210
23215 CONTINUE
      IF (.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 .
     *OR. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T
     * .EQ. 33 .OR. T .EQ. 126 .OR. T .EQ. 94 .OR. T .EQ. 61))GOTO 23217
23219 IF (.NOT.(GETTOK (PTOKEN, 120) .EQ. 10))GOTO 23220
      GOTO 23219
23220 CONTINUE
      CALL PBSTR (PTOKEN)
23217 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23221
      NLPAR = NLPAR + 1
      GOTO 23222
23221 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23223
      NLPAR = NLPAR - 1
23223 CONTINUE
23222 CONTINUE
      CALL OUTSTR (TOKEN)
23209 IF (.NOT.(NLPAR .LT. 0))GOTO 23208
23210 CONTINUE
      IF (.NOT.(NLPAR .NE. 0))GOTO 23225
      CALL SYNERR (23Hunbalanced parentheses.)
23225 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ELENTH(BUF)
      LOGICAL*1 BUF(100), C
      INTEGER I, N
      LOGICAL*1 ESC
      N = 0
      I=1
23227 IF (.NOT.(BUF(I) .NE. 0))GOTO 23229
      C = ESC(BUF, I)
      N = N + 1
23228 I=I+1
      GOTO 23227
23229 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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)
      LOGICAL*1 SSELCT(7)
      LOGICAL*1 SCASE(5)
      LOGICAL*1 SDEFLT(8)
      DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/0/
      DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE
     *(5)/0/
      DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S
     *WHILE(5)/101/,SWHILE(6)/0/
      DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/0/
      DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR
     *EAK(5)/107/,SBREAK(6)/0/
      DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT
     *(5)/0/
      DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/0/
      DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT
     *(5)/97/,SREPT(6)/116/,SREPT(7)/0/
      DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S
     *UNTIL(5)/108/,SUNTIL(6)/0/
      DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
     *14/,SRET(6)/110/,SRET(7)/0/
      DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1
     *10/,SSTR(6)/103/,SSTR(7)/0/
      DATA SSELCT(1)/115/,SSELCT(2)/101/,SSELCT(3)/108/,SSELCT(4)/101/,S
     *SELCT(5)/99/,SSELCT(6)/116/,SSELCT(7)/0/
      DATA SCASE(1)/99/,SCASE(2)/97/,SCASE(3)/115/,SCASE(4)/101/,SCASE(5
     *)/0/
      DATA SDEFLT(1)/100/,SDEFLT(2)/101/,SDEFLT(3)/102/,SDEFLT(4)/97/,SD
     *EFLT(5)/117/,SDEFLT(6)/108/,SDEFLT(7)/116/,SDEFLT(8)/0/
      JUNK = ENTER (SIF, -19, RKWTBL)
      JUNK = ENTER (SELSE, -11, RKWTBL)
      JUNK = ENTER (SWHILE, -15, RKWTBL)
      JUNK = ENTER (SDO, -10, RKWTBL)
      JUNK = ENTER (SBREAK, -8, RKWTBL)
      JUNK = ENTER (SNEXT, -13, RKWTBL)
      JUNK = ENTER (SFOR, -16, RKWTBL)
      JUNK = ENTER (SREPT, -17, RKWTBL)
      JUNK = ENTER (SUNTIL, -18, RKWTBL)
      JUNK = ENTER (SRET, -20, RKWTBL)
      JUNK = ENTER (SSTR, -23, RKWTBL)
      JUNK = ENTER (SSELCT, -24, RKWTBL)
      JUNK = ENTER (SCASE, -25, RKWTBL)
      JUNK = ENTER (SDEFLT, -26, 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER ARGNO, K, M, N, T, TD
      INTEGER INDEXC, 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 23230
      CALL DOMAC (ARGSTK, I, J)
      GOTO 23231
23230 CONTINUE
      IF (.NOT.(TD .EQ. -12))GOTO 23232
      CALL DOINCR (ARGSTK, I, J)
      GOTO 23233
23232 CONTINUE
      IF (.NOT.(TD .EQ. -13))GOTO 23234
      CALL DOSUB (ARGSTK, I, J)
      GOTO 23235
23234 CONTINUE
      IF (.NOT.(TD .EQ. -11))GOTO 23236
      CALL DOIF (ARGSTK, I, J)
      GOTO 23237
23236 CONTINUE
      IF (.NOT.(TD .EQ. -14))GOTO 23238
      CALL DOARTH (ARGSTK, I, J)
      GOTO 23239
23238 CONTINUE
      K = T + LENGTH (EVALST (T)) - 1
23240 IF (.NOT.(K .GT. T))GOTO 23242
      IF (.NOT.(EVALST (K - 1) .NE. 36))GOTO 23243
      CALL PUTBAK (EVALST (K))
      GOTO 23244
23243 CONTINUE
      ARGNO = INDEXC (DIGITS, EVALST (K)) - 1
      IF (.NOT.(ARGNO .GE. 0))GOTO 23245
      IF (.NOT.(ARGNO .LT. J - I))GOTO 23247
      N = I + ARGNO + 1
      M = ARGSTK (N)
      CALL PBSTR (EVALST (M))
23247 CONTINUE
      K = K - 1
      GOTO 23246
23245 CONTINUE
      CALL PUTBAK (EVALST (K))
23246 CONTINUE
23244 CONTINUE
23241 K = K - 1
      GOTO 23240
23242 CONTINUE
      IF (.NOT.(K .EQ. T))GOTO 23249
      CALL PUTBAK (EVALST (K))
23249 CONTINUE
23239 CONTINUE
23237 CONTINUE
23235 CONTINUE
23233 CONTINUE
23231 CONTINUE
      RETURN
      END
      SUBROUTINE FCLAUS
      LOGICAL*1 TOKEN(120), T
      INTEGER BRACE
      LOGICAL*1 GNBTOK, DOTHER
      IF (.NOT.(GNBTOK(TOKEN, 120) .EQ. 123))GOTO 23251
      BRACE = 1
      GOTO 23252
23251 CONTINUE
      CALL PBSTR(TOKEN)
      BRACE = 0
23252 CONTINUE
      T = DOTHER(TOKEN)
      IF (.NOT.(BRACE .EQ. 1))GOTO 23253
23255 IF (.NOT.(T .NE. 125 .AND. T .NE. -1))GOTO 23256
      T = GNBTOK(TOKEN, 120)
      CALL PBSTR(TOKEN)
      T = DOTHER(TOKEN)
      GOTO 23255
23256 CONTINUE
      IF (.NOT.(GNBTOK(TOKEN, 120) .NE. 59))GOTO 23257
      CALL SYNERR(19Hinvalid for clause.)
23257 CONTINUE
23253 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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
      SETOP = 0
      SELAST = 1
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T
      INTEGER I, J, NLPAR, LEN
      LOGICAL*1 GETTOK, GNBTOK
      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 (SCRTOK, 120) .NE. 40))GOTO 23259
      CALL SYNERR (19Hmissing left paren.)
      RETURN
23259 CONTINUE
      IF (.NOT.(GNBTOK (SCRTOK, 120) .NE. 59))GOTO 23261
      CALL PBSTR (SCRTOK)
      CALL FCLAUS
23261 CONTINUE
      IF (.NOT.(GNBTOK (SCRTOK, 120) .EQ. 59))GOTO 23263
      CALL OUTCON (LAB)
      GOTO 23264
23263 CONTINUE
      CALL PBSTR (SCRTOK)
      CALL OUTNUM (LAB)
      CALL OUTTAB
      CALL OUTSTR (IFNOT)
      CALL OUTCH (40)
      NLPAR = 0
23265 IF (.NOT.(NLPAR .GE. 0))GOTO 23266
      T = GETTOK (SCRTOK, 120)
      IF (.NOT.(T .EQ. 59))GOTO 23267
      GOTO 23266
23267 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23269
      NLPAR = NLPAR + 1
      GOTO 23270
23269 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23271
      NLPAR = NLPAR - 1
23271 CONTINUE
23270 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23273
      CALL PBSTR (SCRTOK)
      RETURN
23273 CONTINUE
      IF (.NOT.(T .NE. 10))GOTO 23275
      CALL OUTSTR (SCRTOK)
23275 CONTINUE
      GOTO 23265
23266 CONTINUE
      CALL OUTCH (41)
      CALL OUTCH (41)
      CALL OUTGO (LAB+2)
      IF (.NOT.(NLPAR .LT. 0))GOTO 23277
      CALL SYNERR (19Hinvalid for clause.)
23277 CONTINUE
23264 CONTINUE
      FORDEP = FORDEP + 1
      LEN = 0
      J = 1
      I = 1
23279 IF (.NOT.(I .LT. FORDEP))GOTO 23281
      J = J + LENGTH (FORSTK (J)) + 1
23280 I = I + 1
      GOTO 23279
23281 CONTINUE
      FORSTK (J) = 0
      NLPAR = 0
      T = GNBTOK (SCRTOK, 120)
      CALL PBSTR (SCRTOK)
23282 IF (.NOT.(NLPAR .GE. 0))GOTO 23283
      T = GETTOK (SCRTOK, 120)
      IF (.NOT.(T .EQ. 40))GOTO 23284
      NLPAR = NLPAR + 1
      GOTO 23285
23284 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23286
      NLPAR = NLPAR - 1
23286 CONTINUE
23285 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23288
      CALL PBSTR (SCRTOK)
      GOTO 23283
23288 CONTINUE
      IF (.NOT.(NLPAR .GE. 0 .AND. T .NE. 10))GOTO 23290
      IF (.NOT.(J + LENGTH (SCRTOK) .GE. 300))GOTO 23292
      CALL BADERR (20Hfor clause too long.)
23292 CONTINUE
      CALL SCOPY (SCRTOK, 1, FORSTK, J)
      J = J + LENGTH (SCRTOK)
      LEN = LEN + LENGTH (SCRTOK)
      GOTO 23291
23290 CONTINUE
      IF (.NOT.(NLPAR .EQ. -1 .AND. LEN .GT. 0))GOTO 23294
      IF (.NOT.(J .LT. 300))GOTO 23296
      CALL SCOPY(SEMI, 1, FORSTK, J)
      GOTO 23297
23296 CONTINUE
      CALL BADERR(20Hfor clause too long.)
23297 CONTINUE
23294 CONTINUE
23291 CONTINUE
      GOTO 23282
23283 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, J
      INTEGER LENGTH
      XFER = 0
      CALL OUTNUM (LAB)
      J = 1
      I = 1
23298 IF (.NOT.(I .LT. FORDEP))GOTO 23300
      J = J + LENGTH (FORSTK (J)) + 1
23299 I = I + 1
      GOTO 23298
23300 CONTINUE
      IF (.NOT.(LENGTH (FORSTK (J)) .GT. 0))GOTO 23301
      CALL PBSTR (FORSTK (J))
      CALL FCLAUS
23301 CONTINUE
      CALL OUTGO (LAB - 1)
      CALL OUTCON (LAB + 1)
      FORDEP = FORDEP - 1
      RETURN
      END
      LOGICAL*1 FUNCTION GCTOK(TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN(120)
      INTEGER TOKSIZ
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C
      INTEGER NEWCND
      LOGICAL*1 GTOK, CNDLU
      INTEGER CNDGET
      GCTOK=GTOK(TOKEN,TOKSIZ)
23303 IF (.NOT.(GCTOK .NE. -1))GOTO 23305
      C = CNDLU (TOKEN)
      IF (.NOT.(C .EQ. -19))GOTO 23306
      IF (.NOT.(CURCND .EQ. 1))GOTO 23308
      GOTO 23305
23308 CONTINUE
      GOTO 23307
23306 CONTINUE
      IF (.NOT.(C .EQ. -18))GOTO 23310
      IF (.NOT.(CSP .LE. 0))GOTO 23312
      CALL BADERR(27HIllegal enddef encountered.)
23312 CONTINUE
      CURCND = CNDSTK(CSP)
      CSP = CSP - 1
      GOTO 23311
23310 CONTINUE
      IF (.NOT.(C .EQ. -15))GOTO 23314
      NEWCND = CNDGET (TOKEN, TOKSIZ)
      GOTO 23315
23314 CONTINUE
      IF (.NOT.(C .EQ. -16))GOTO 23316
      NEWCND = - CNDGET (TOKEN, TOKSIZ)
      GOTO 23317
23316 CONTINUE
      NEWCND = - CURCND
23317 CONTINUE
23315 CONTINUE
      CURCND = MIN0(NEWCND, CNDSTK (CSP) )
23311 CONTINUE
23307 CONTINUE
23304 GCTOK=GTOK(TOKEN,TOKSIZ)
      GOTO 23303
23305 CONTINUE
      RETURN
      END
      SUBROUTINE GETDEF (TOKEN, TOKSIZ, DEFN, DEFSIZ)
      LOGICAL*1 TOKEN (120), 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C, T, PTOKEN (120)
      INTEGER I, NLPAR
      LOGICAL*1 GCTOK, NGETCH
      CALL SKPBLK
      C = GCTOK (PTOKEN, 120)
      IF (.NOT.(C .EQ. 40))GOTO 23318
      T = 40
      GOTO 23319
23318 CONTINUE
      T = 32
      CALL PBSTR (PTOKEN)
23319 CONTINUE
      CALL SKPBLK
      IF (.NOT.(GCTOK (TOKEN, TOKSIZ) .NE. -9))GOTO 23320
      CALL BADERR (22Hnon-alphanumeric name.)
23320 CONTINUE
      CALL SKPBLK
      C = GCTOK (PTOKEN, 120)
      IF (.NOT.(T .EQ. 32))GOTO 23322
      CALL PBSTR (PTOKEN)
      I = 1
23324 CONTINUE
      C = NGETCH (C)
      IF (.NOT.(I .GT. DEFSIZ))GOTO 23327
      CALL BADERR (20Hdefinition too long.)
23327 CONTINUE
      DEFN (I) = C
      I = I + 1
23325 IF (.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. -1))GOTO 23324
23326 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23329
      CALL PUTBAK (C)
23329 CONTINUE
      GOTO 23323
23322 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23331
      IF (.NOT.(C .NE. 44))GOTO 23333
      CALL BADERR (24Hmissing comma in define.)
23333 CONTINUE
      NLPAR = 0
      I = 1
23335 IF (.NOT.(NLPAR .GE. 0))GOTO 23337
      IF (.NOT.(I .GT. DEFSIZ))GOTO 23338
      CALL BADERR (20Hdefinition too long.)
      GOTO 23339
23338 CONTINUE
      IF (.NOT.(NGETCH (DEFN (I)) .EQ. -1))GOTO 23340
      CALL BADERR (20Hmissing right paren.)
      GOTO 23341
23340 CONTINUE
      IF (.NOT.(DEFN (I) .EQ. 40))GOTO 23342
      NLPAR = NLPAR + 1
      GOTO 23343
23342 CONTINUE
      IF (.NOT.(DEFN (I) .EQ. 41))GOTO 23344
      NLPAR = NLPAR - 1
23344 CONTINUE
23343 CONTINUE
23341 CONTINUE
23339 CONTINUE
23336 I = I + 1
      GOTO 23335
23337 CONTINUE
      GOTO 23332
23331 CONTINUE
      CALL BADERR (19Hgetdef is confused.)
23332 CONTINUE
23323 CONTINUE
      DEFN (I - 1) = 0
      RETURN
      END
      LOGICAL*1 FUNCTION GETTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I, LEN
      LOGICAL*1 NAME (40), T
      INTEGER EQUAL, OPEN, LENGTH
      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/
23346 IF (.NOT.(LEVEL .GT. 0))GOTO 23348
      GETTOK = DEFTOK (TOKEN, TOKSIZ)
23349 IF (.NOT.(GETTOK .NE. -1))GOTO 23351
      IF (.NOT.(EQUAL (TOKEN, FNCN) .EQ. 1))GOTO 23352
      CALL SKPBLK
      T = DEFTOK (FCNAME, 40)
      CALL PBSTR (FCNAME)
      IF (.NOT.(T .NE. -9))GOTO 23354
      CALL SYNERR (22Hmissing function name.)
23354 CONTINUE
      CALL PUTBAK (32)
      RETURN
23352 CONTINUE
      IF (.NOT.(EQUAL (TOKEN, INCL) .EQ. 0))GOTO 23356
      RETURN
23356 CONTINUE
23353 CONTINUE
      CALL SKPBLK
      T = DEFTOK (NAME, 40)
      IF (.NOT.(T .EQ. 39 .OR. T .EQ. 34))GOTO 23358
      LEN = LENGTH (NAME) - 1
      I = 1
23360 IF (.NOT.(I .LT. LEN))GOTO 23362
      NAME (I) = NAME (I + 1)
23361 I = I + 1
      GOTO 23360
23362 CONTINUE
      NAME (I) = 0
23358 CONTINUE
      I = LENGTH (NAME) + 1
      IF (.NOT.(LEVEL .GE. 4))GOTO 23363
      CALL SYNERR (27Hincludes nested too deeply.)
      GOTO 23364
23363 CONTINUE
      INFILE (LEVEL + 1) = OPEN (NAME, 1)
      LINECT (LEVEL + 1) = 1
      IF (.NOT.(INFILE (LEVEL + 1) .EQ. -3))GOTO 23365
      CALL SYNERR (19Hcan't open include.)
      GOTO 23366
23365 CONTINUE
      LEVEL = LEVEL + 1
      IF (.NOT.(FNAMP + I .LE.  160))GOTO 23367
      CALL SCOPY (NAME, 1, FNAMES, FNAMP)
      FNAMP = FNAMP + I
23367 CONTINUE
23366 CONTINUE
23364 CONTINUE
23350 GETTOK = DEFTOK (TOKEN, TOKSIZ)
      GOTO 23349
23351 CONTINUE
      IF (.NOT.(LEVEL .GT. 1))GOTO 23369
      CALL CLOSE (INFILE (LEVEL))
      FNAMP = FNAMP - 1
23371 IF (.NOT.(FNAMP .GT. 1))GOTO 23373
      IF (.NOT.(FNAMES (FNAMP - 1) .EQ. 0))GOTO 23374
      GOTO 23373
23374 CONTINUE
23372 FNAMP = FNAMP - 1
      GOTO 23371
23373 CONTINUE
23369 CONTINUE
23347 LEVEL = LEVEL - 1
      GOTO 23346
23348 CONTINUE
      TOKEN (1) = -1
      TOKEN (2) = 0
      GETTOK = -1
      RETURN
      END
      LOGICAL*1 FUNCTION GNBTOK (TOKEN, TOKSIZ)
      LOGICAL*1 TOKEN (120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GETTOK
23376 CONTINUE
      CALL SKPBLK
      GNBTOK = GETTOK (TOKEN, TOKSIZ)
23377 IF (.NOT.(GNBTOK .NE. 32))GOTO 23376
23378 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION GTOK (LEXSTR, TOKSIZ)
      LOGICAL*1 LEXSTR (120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C
      INTEGER I, B, N, D
      LOGICAL*1 NGETCH, TYPE, CLOWER, ESC
      INTEGER ITOC, INDEXC
      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/
23379 CONTINUE
      C = NGETCH (LEXSTR (1))
      IF (.NOT.(C .EQ. 95))GOTO 23382
      IF (.NOT.(NGETCH(C) .NE. 10))GOTO 23384
      CALL PUTBAK(C)
      C = 95
      GOTO 23381
23384 CONTINUE
23382 CONTINUE
23380 IF (.NOT.(LEXSTR(1) .NE. 95))GOTO 23379
23381 CONTINUE
      IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23386
      LEXSTR (1) = 32
23388 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23389
      C = NGETCH (C)
      GOTO 23388
23389 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23390
23392 IF (.NOT.(NGETCH (C) .NE. 10))GOTO 23393
      GOTO 23392
23393 CONTINUE
23390 CONTINUE
      IF (.NOT.(C .NE. 10))GOTO 23394
      CALL PUTBAK (C)
      GOTO 23395
23394 CONTINUE
      LEXSTR (1) = 10
23395 CONTINUE
      LEXSTR (2) = 0
      GTOK = LEXSTR (1)
      RETURN
23386 CONTINUE
      I = 1
      IF (.NOT.(((65.LE.C.AND.C.LE.90).OR.(97.LE.C.AND.C.LE.122))))GOTO 
     *23396
      I = 1
23398 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23400
      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 23401
      GOTO 23400
23401 CONTINUE
23399 I = I + 1
      GOTO 23398
23400 CONTINUE
      CALL PUTBAK (C)
      GTOK = -9
      GOTO 23397
23396 CONTINUE
      IF (.NOT.((48.LE.C.AND.C.LE.57)))GOTO 23403
      B = C - 48
      I = 1
23405 IF (.NOT.(I .LT. TOKSIZ - 2))GOTO 23407
      C = NGETCH (LEXSTR (I + 1))
      IF (.NOT.(.NOT.(48.LE.C.AND.C.LE.57)))GOTO 23408
      GOTO 23407
23408 CONTINUE
      B = 10 * B + C - 48
23406 I = I + 1
      GOTO 23405
23407 CONTINUE
      IF (.NOT.(C .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO 23410
      N = 0
23412 CONTINUE
      D = INDEXC (DIGITS, CLOWER (NGETCH (C))) - 1
      IF (.NOT.(D .LT. 0))GOTO 23415
      GOTO 23414
23415 CONTINUE
      N = B * N + D
23413 GOTO 23412
23414 CONTINUE
      CALL PUTBAK (C)
      I = ITOC (N, LEXSTR, TOKSIZ)
      GOTO 23411
23410 CONTINUE
      CALL PUTBAK (C)
23411 CONTINUE
      GTOK = 2
      GOTO 23404
23403 CONTINUE
      IF (.NOT.(C .EQ. 91))GOTO 23417
      LEXSTR (1) = 123
      GTOK = 123
      GOTO 23418
23417 CONTINUE
      IF (.NOT.(C .EQ. 93))GOTO 23419
      LEXSTR (1) = 125
      GTOK = 125
      GOTO 23420
23419 CONTINUE
      IF (.NOT.(C .EQ. 36))GOTO 23421
      IF (.NOT.(NGETCH (LEXSTR (2)) .EQ. 40))GOTO 23423
      I = 2
      GTOK = -10
      GOTO 23424
23423 CONTINUE
      IF (.NOT.(LEXSTR (2) .EQ. 41))GOTO 23425
      I = 2
      GTOK = -11
      GOTO 23426
23425 CONTINUE
      CALL PUTBAK (LEXSTR (2))
      GTOK = 36
23426 CONTINUE
23424 CONTINUE
      GOTO 23422
23421 CONTINUE
      IF (.NOT.(C .EQ. 39))GOTO 23427
      I = 2
      IF (.NOT.(NGETCH(LEXSTR(1)) .EQ. 64))GOTO 23429
      C = NGETCH(LEXSTR(2))
      I = 3
23429 CONTINUE
      LEXSTR(I) = 0
      I = 1
      C = ESC(LEXSTR, I)
      N = C
      I = ITOC(N, LEXSTR, TOKSIZ)
      GTOK = 2
      IF (.NOT.(NGETCH(C) .NE. 39))GOTO 23431
      CALL SYNERR(41Hmissing apostrophe in character constant.)
23433 IF (.NOT.(C .NE. -1))GOTO 23435
      IF (.NOT.(C .EQ. 39 .OR. C .EQ. 10))GOTO 23436
      GOTO 23435
23436 CONTINUE
23434 C = NGETCH(C)
      GOTO 23433
23435 CONTINUE
      IF (.NOT.(C .EQ. 10))GOTO 23438
      CALL PUTBAK(10)
23438 CONTINUE
23431 CONTINUE
      GOTO 23428
23427 CONTINUE
      IF (.NOT.(C .EQ. 34))GOTO 23440
      GTOK = C
      I = 2
23442 IF (.NOT.(NGETCH(C) .NE. -1))GOTO 23444
      LEXSTR(I) = C
      IF (.NOT.(C .EQ. 64))GOTO 23445
      IF (.NOT.(NGETCH(C) .EQ. -1))GOTO 23447
      CALL PUTBAK(C)
      GOTO 23448
23447 CONTINUE
      I = I + 1
      IF (.NOT.(I .GE. TOKSIZ -1))GOTO 23449
      I = TOKSIZ - 1
23449 CONTINUE
      LEXSTR(I) = C
      C = 64
23448 CONTINUE
23445 CONTINUE
      IF (.NOT.(C .EQ. 34))GOTO 23451
      GOTO 23444
23451 CONTINUE
      IF (.NOT.(LEXSTR (I) .EQ. 95))GOTO 23453
      IF (.NOT.(NGETCH (C) .EQ. 10))GOTO 23455
23457 IF (.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23458
      C = NGETCH (C)
      GOTO 23457
23458 CONTINUE
      LEXSTR (I) = C
      GOTO 23456
23455 CONTINUE
      CALL PUTBAK (C)
23456 CONTINUE
23453 CONTINUE
      IF (.NOT.(LEXSTR (I) .EQ. 10 .OR. I .GE. TOKSIZ - 1))GOTO 23459
      CALL SYNERR (14Hmissing quote.)
      LEXSTR (I) = LEXSTR (1)
      CALL PUTBAK (10)
      GOTO 23444
23459 CONTINUE
23443 I = I + 1
      GOTO 23442
23444 CONTINUE
      GOTO 23441
23440 CONTINUE
      IF (.NOT.(C .EQ. 35))GOTO 23461
23463 IF (.NOT.(NGETCH (LEXSTR (1)) .NE. 10))GOTO 23464
      GOTO 23463
23464 CONTINUE
      GTOK = 10
      GOTO 23462
23461 CONTINUE
      IF (.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 33 .OR. C .EQ. 38 .
     *OR. C .EQ. 124 .OR. C .EQ. 61 .OR. C .EQ. 33 .OR. C .EQ. 126 .OR. 
     *C .EQ. 94))GOTO 23465
      CALL RELATE (LEXSTR, I)
      GTOK = C
      GOTO 23466
23465 CONTINUE
      GTOK = C
23466 CONTINUE
23462 CONTINUE
23441 CONTINUE
23428 CONTINUE
23422 CONTINUE
23420 CONTINUE
23418 CONTINUE
23404 CONTINUE
23397 CONTINUE
      IF (.NOT.(I .GE. TOKSIZ - 1))GOTO 23467
      CALL SYNERR (15Htoken too long.)
23467 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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
      INTEGER INDEXC
      LOGICAL*1 TYPE
      C = STRNG (1)
      IF (.NOT.(C .EQ. -12 .OR. C .EQ. -13 .OR. C .EQ. -11 .OR. C .EQ. -
     *14 .OR. C .EQ. -10))GOTO 23469
      IFPARM = 1
      GOTO 23470
23469 CONTINUE
      IFPARM = 0
      I = 1
23471 IF (.NOT.(INDEXC (STRNG (I), 36) .GT. 0))GOTO 23473
      I = I + INDEXC (STRNG (I), 36)
      IF (.NOT.(TYPE (STRNG (I)) .EQ. 2))GOTO 23474
      IF (.NOT.(TYPE (STRNG (I + 1)) .NE. 2))GOTO 23476
      IFPARM = 1
      GOTO 23473
23476 CONTINUE
23474 CONTINUE
23472 GOTO 23471
23473 CONTINUE
23470 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER MKTABL
      CALL DSINIT (4250)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER LENGTH
      XFER = 0
      IF (.NOT.(LENGTH (LEXSTR) .EQ. 5))GOTO 23478
      IF (.NOT.(LEXSTR (1) .EQ. 50 .AND. LEXSTR (2) .EQ. 51))GOTO 23480
      CALL SYNERR (33Hwarning: possible label conflict.)
23480 CONTINUE
23478 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LABGEN = LABEL
      LABEL = LABEL + N
      RETURN
      END
      INTEGER FUNCTION LEX (LEXSTR)
      LOGICAL*1 LEXSTR (120)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GNBTOK
      INTEGER LOOKUP
      LEX = GNBTOK (LEXSTR, 120)
23482 IF (.NOT.(LEX .EQ. 10))GOTO 23484
23483 LEX = GNBTOK (LEXSTR, 120)
      GOTO 23482
23484 CONTINUE
      IF (.NOT.(LEX .EQ. -1 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LEX 
     *.EQ. 125))GOTO 23485
      RETURN
23485 CONTINUE
      IF (.NOT.(LEX .EQ. 2))GOTO 23487
      LEX = -9
      GOTO 23488
23487 CONTINUE
      IF (.NOT.(LEX .EQ. 37))GOTO 23489
      LEX = -27
      GOTO 23490
23489 CONTINUE
      IF (.NOT.(LOOKUP (LEXSTR, LEX, RKWTBL) .EQ. 1))GOTO 23491
      GOTO 23492
23491 CONTINUE
      LEX = -14
23492 CONTINUE
23490 CONTINUE
23488 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 NGETCH
      IF (.NOT.(OUTP .GT. 0))GOTO 23493
      CALL OUTDON
23493 CONTINUE
      OUTP = 1
23495 IF (.NOT.(NGETCH (OUTBUF (OUTP)) .NE. 10))GOTO 23497
23496 OUTP = OUTP + 1
      GOTO 23495
23497 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 FBUF(40)
      INTEGER OPEN, LOCCOM
      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 23498
      CALL IMPATH(FNAMES)
      IF (.NOT.(LOCCOM(DEFNS, FNAMES, SUFFIX, FBUF) .EQ. 12))GOTO 23500
      INFILE(1) = OPEN(FBUF, 1)
      IF (.NOT.(INFILE(1) .EQ. -3))GOTO 23502
      CALL REMARK(38Hcannot open standard definitions file.)
      GOTO 23503
23502 CONTINUE
      CALL PARSE
      CALL CLOSE(INFILE(1))
23503 CONTINUE
      GOTO 23501
23500 CONTINUE
      CALL REMARK(40Hcannot locate standard definitions file.)
23501 CONTINUE
23498 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 GETCH
      IF (.NOT.(BP .GT. 0))GOTO 23504
      C = BUF(BP)
      BP = BP - 1
      GOTO 23505
23504 CONTINUE
      C = GETCH(C, INFILE (LEVEL) )
      IF (.NOT.(C .EQ. 10))GOTO 23506
      LINECT (LEVEL) = LINECT (LEVEL) + 1
23506 CONTINUE
23505 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER I
      IF (.NOT.(OUTP .GE. 72))GOTO 23508
      CALL OUTDON
      I = 1
23510 IF (.NOT.(I .LT. 6))GOTO 23512
      OUTBUF (I) = 32
23511 I = I + 1
      GOTO 23510
23512 CONTINUE
      OUTBUF (6) = 42
      OUTP = 6
23508 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 23513
      RETURN
23513 CONTINUE
      IF (.NOT.(N .GT. 0))GOTO 23515
      CALL OUTNUM (N)
23515 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 23517
      RETURN
23517 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
23519 CONTINUE
      I = I + 1
      CHARS (I) = MOD (M, 10) + 48
      M = M / 10
23520 IF (.NOT.(M .EQ. 0 .OR. I .GE. 20))GOTO 23519
23521 CONTINUE
      IF (.NOT.(N .LT. 0))GOTO 23522
      CALL OUTCH (45)
23522 CONTINUE
23524 IF (.NOT.(I .GT. 0))GOTO 23526
      CALL OUTCH (CHARS (I))
23525 I = I - 1
      GOTO 23524
23526 CONTINUE
      RETURN
      END
      SUBROUTINE OUTSTR (STR)
      LOGICAL*1 STR (100)
      LOGICAL*1 C
      INTEGER I, J, N
      LOGICAL*1 CUPPER
      INTEGER LENGTH
      IF (.NOT.(STR(1) .NE. 34))GOTO 23527
      I=1
23529 IF (.NOT.(STR(I) .NE. 0))GOTO 23531
      C = STR(I)
      CALL OUTCH (CUPPER(C))
23530 I=I+1
      GOTO 23529
23531 CONTINUE
      GOTO 23528
23527 CONTINUE
      J = LENGTH(STR)
      I=2
      N=0
23532 IF (.NOT.(I .LT. J))GOTO 23534
      IF (.NOT.(STR(I) .EQ. 34))GOTO 23535
      GOTO 23534
23535 CONTINUE
      IF (.NOT.(STR(I) .EQ. 64))GOTO 23537
      IF (.NOT.(STR(I+1) .EQ. 34))GOTO 23539
      I = I + 1
23539 CONTINUE
      N = N + 1
      GOTO 23538
23537 CONTINUE
      N = N + 1
23538 CONTINUE
23536 CONTINUE
23533 I=I+1
      GOTO 23532
23534 CONTINUE
      CALL OUTNUM (N)
      CALL OUTCH(72)
      I=2
23541 IF (.NOT.(I .LT. J))GOTO 23543
      IF (.NOT.(STR(I) .EQ. 64 .AND. STR(I+1) .EQ. 34))GOTO 23544
      I = I + 1
23544 CONTINUE
      CALL OUTCH(STR(I))
23542 I = I + 1
      GOTO 23541
23543 CONTINUE
23528 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
23546 IF (.NOT.(OUTP .LT. 6))GOTO 23547
      CALL OUTCH (32)
      GOTO 23546
23547 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 LEXSTR (120)
      INTEGER LAB, LABVAL (100), LEXTYP (100), SP, TOKEN, I
      INTEGER LEX
      CALL FINIT
      SP = 1
      LEXTYP (1) = -1
      TOKEN = LEX (LEXSTR)
23548 IF (.NOT.(TOKEN .NE. -1))GOTO 23550
      IF (.NOT.(TOKEN .EQ. -19))GOTO 23551
      CALL IFCODE (LAB)
      GOTO 23552
23551 CONTINUE
      IF (.NOT.(TOKEN .EQ. -10))GOTO 23553
      CALL DOCODE (LAB)
      GOTO 23554
23553 CONTINUE
      IF (.NOT.(TOKEN .EQ. -15))GOTO 23555
      CALL WHILEC (LAB)
      GOTO 23556
23555 CONTINUE
      IF (.NOT.(TOKEN .EQ. -16))GOTO 23557
      CALL FORCOD (LAB)
      GOTO 23558
23557 CONTINUE
      IF (.NOT.(TOKEN .EQ. -17))GOTO 23559
      CALL REPCOD (LAB)
      GOTO 23560
23559 CONTINUE
      IF (.NOT.(TOKEN .EQ. -24))GOTO 23561
      CALL SELCOD (LAB)
      GOTO 23562
23561 CONTINUE
      IF (.NOT.(TOKEN .EQ. -25 .OR. TOKEN .EQ. -26))GOTO 23563
      I = SP
23565 IF (.NOT.(I .GT. 0))GOTO 23567
      IF (.NOT.(LEXTYP (I) .EQ. -24))GOTO 23568
      GOTO 23567
23568 CONTINUE
23566 I = I - 1
      GOTO 23565
23567 CONTINUE
      IF (.NOT.(I .EQ. 0))GOTO 23570
      CALL SYNERR (24Hillegal case or default.)
      GOTO 23571
23570 CONTINUE
      CALL CASCOD (LABVAL (I), TOKEN)
23571 CONTINUE
      GOTO 23564
23563 CONTINUE
      IF (.NOT.(TOKEN .EQ. -9))GOTO 23572
      CALL LABELC (LEXSTR)
      GOTO 23573
23572 CONTINUE
      IF (.NOT.(TOKEN .EQ. -11))GOTO 23574
      IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23576
      CALL ELSEIF (LABVAL (SP))
      GOTO 23577
23576 CONTINUE
      CALL SYNERR (13Hillegal else.)
23577 CONTINUE
      GOTO 23575
23574 CONTINUE
      IF (.NOT.(TOKEN .EQ. -27))GOTO 23578
      CALL LITRAL
23578 CONTINUE
23575 CONTINUE
23573 CONTINUE
23564 CONTINUE
23562 CONTINUE
23560 CONTINUE
23558 CONTINUE
23556 CONTINUE
23554 CONTINUE
23552 CONTINUE
      IF (.NOT.(TOKEN .EQ. -19 .OR. TOKEN .EQ. -11 .OR. TOKEN .EQ. -15 .
     *OR. TOKEN .EQ. -16 .OR. TOKEN .EQ. -17  .OR. TOKEN .EQ. -24  .OR. 
     *TOKEN .EQ. -10 .OR. TOKEN .EQ. -9 .OR. TOKEN .EQ. 123))GOTO 23580
      SP = SP + 1
      IF (.NOT.(SP .GT. 100))GOTO 23582
      CALL BADERR (25Hstack overflow in parser.)
23582 CONTINUE
      LEXTYP (SP) = TOKEN
      LABVAL (SP) = LAB
      GOTO 23581
23580 CONTINUE
      IF (.NOT.(TOKEN .NE. -25 .AND. TOKEN .NE. -26))GOTO 23584
      IF (.NOT.(TOKEN .EQ. 125))GOTO 23586
      IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23588
      SP = SP - 1
      GOTO 23589
23588 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -24))GOTO 23590
      CALL SELEND (LABVAL (SP))
      SP = SP - 1
      GOTO 23591
23590 CONTINUE
      CALL SYNERR (20Hillegal right brace.)
23591 CONTINUE
23589 CONTINUE
      GOTO 23587
23586 CONTINUE
      IF (.NOT.(TOKEN .EQ. -14))GOTO 23592
      CALL OTHERC (LEXSTR)
      GOTO 23593
23592 CONTINUE
      IF (.NOT.(TOKEN .EQ. -8 .OR. TOKEN .EQ. -13))GOTO 23594
      CALL BRKNXT (SP, LEXTYP, LABVAL, TOKEN)
      GOTO 23595
23594 CONTINUE
      IF (.NOT.(TOKEN .EQ. -20))GOTO 23596
      CALL RETCOD
      GOTO 23597
23596 CONTINUE
      IF (.NOT.(TOKEN .EQ. -23))GOTO 23598
      CALL STRDCL
23598 CONTINUE
23597 CONTINUE
23595 CONTINUE
23593 CONTINUE
23587 CONTINUE
      TOKEN = LEX (LEXSTR)
      CALL PBSTR (LEXSTR)
      CALL UNSTAK (SP, LEXTYP, LABVAL, TOKEN)
23584 CONTINUE
23581 CONTINUE
23549 TOKEN = LEX (LEXSTR)
      GOTO 23548
23550 CONTINUE
      IF (.NOT.(SP .NE. 1))GOTO 23600
      CALL SYNERR (15Hunexpected EOF.)
23600 CONTINUE
      IF (.NOT.(CSP .GT. 0))GOTO 23602
      CALL SYNERR(43Hconditional processing still active at EOF.)
23602 CONTINUE
      RETURN
      END
      SUBROUTINE PBNUM (N)
      INTEGER N
      INTEGER M, NUM
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT
     *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D
     *IGITS(10)/57/,DIGITS(11)/0/
      NUM = IABS(N)
23604 CONTINUE
      M = MOD (NUM, 10)
      CALL PUTBAK (DIGITS (M + 1))
      NUM = NUM / 10
23605 IF (.NOT.(NUM .EQ. 0))GOTO 23604
23606 CONTINUE
      IF (.NOT.(N .LT. 0))GOTO 23607
      CALL PUTBAK(45)
23607 CONTINUE
      RETURN
      END
      SUBROUTINE PBSTR (IN)
      LOGICAL*1 IN (100)
      INTEGER I
      INTEGER LENGTH
      I = LENGTH (IN)
23609 IF (.NOT.(I .GT. 0))GOTO 23611
      CALL PUTBAK (IN (I))
23610 I = I - 1
      GOTO 23609
23611 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PUSH (EP, ARGSTK, AP)
      INTEGER AP, ARGSTK (100), EP
      IF (.NOT.(AP .GT. 100))GOTO 23612
      CALL BADERR (19Harg stack overflow.)
23612 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      IF (.NOT.(BP .GE. 500))GOTO 23614
      CALL BADERR (32Htoo many characters pushed back.)
      GOTO 23615
23614 CONTINUE
      BP = BP + 1
      BUF (BP) = C
23615 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      IF (.NOT.(EP .GT. 500))GOTO 23616
      CALL BADERR (26Hevaluation stack overflow.)
23616 CONTINUE
      EVALST (EP) = C
      EP = EP + 1
      RETURN
      END
      SUBROUTINE PUTTOK (STR)
      LOGICAL*1 STR (120)
      INTEGER I
      I = 1
23618 IF (.NOT.(STR (I) .NE. 0))GOTO 23620
      CALL PUTCHR (STR (I))
23619 I = I + 1
      GOTO 23618
23620 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 23621
      CALL PUTBAK (TOKEN (2))
      TOKEN (3) = 116
      GOTO 23622
23621 CONTINUE
      TOKEN (3) = 101
23622 CONTINUE
      TOKEN (4) = 46
      TOKEN (5) = 0
      TOKEN (6) = 0
      IF (.NOT.(TOKEN (1) .EQ. 62))GOTO 23623
      TOKEN (2) = 103
      GOTO 23624
23623 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 60))GOTO 23625
      TOKEN (2) = 108
      GOTO 23626
23625 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 33 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .E
     *Q. 126 .OR. TOKEN(1) .EQ. 94))GOTO 23627
      IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23629
      TOKEN (3) = 111
      TOKEN (4) = 116
      TOKEN (5) = 46
23629 CONTINUE
      TOKEN (2) = 110
      GOTO 23628
23627 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 61))GOTO 23631
      IF (.NOT.(TOKEN (2) .NE. 61))GOTO 23633
      TOKEN (2) = 0
      LAST = 1
      RETURN
23633 CONTINUE
      TOKEN (2) = 101
      TOKEN (3) = 113
      GOTO 23632
23631 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 38))GOTO 23635
      TOKEN (2) = 97
      TOKEN (3) = 110
      TOKEN (4) = 100
      TOKEN (5) = 46
      GOTO 23636
23635 CONTINUE
      IF (.NOT.(TOKEN (1) .EQ. 124))GOTO 23637
      TOKEN (2) = 111
      TOKEN (3) = 114
      GOTO 23638
23637 CONTINUE
      TOKEN (2) = 0
23638 CONTINUE
23636 CONTINUE
23632 CONTINUE
23628 CONTINUE
23626 CONTINUE
23624 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 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 (SCRTOK, 120)
      IF (.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23639
      CALL PBSTR (SCRTOK)
      CALL OUTTAB
      CALL SCOPY (FCNAME, 1, SCRTOK, 1)
      CALL OUTSTR (SCRTOK)
      CALL OUTCH (61)
      CALL EATUP
      CALL OUTDON
      GOTO 23640
23639 CONTINUE
      IF (.NOT.(T .EQ. 125))GOTO 23641
      CALL PBSTR (SCRTOK)
23641 CONTINUE
23640 CONTINUE
      CALL OUTTAB
      CALL OUTSTR (SRET)
      CALL OUTDON
      XFER = 1
      RETURN
      END
      SUBROUTINE SELCOD (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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER LABGEN, GNBTOK
      LAB = LABGEN (2)
      IF (.NOT.(SELAST + 3 .GT. 300))GOTO 23643
      CALL BADERR (22Hselect table overflow.)
23643 CONTINUE
      SESTAK (SELAST) = SETOP
      SESTAK (SELAST + 1) = 0
      SESTAK (SELAST + 2) = 0
      SETOP = SELAST
      SELAST = SELAST + 3
      XFER = 0
      CALL OUTTAB
      CALL SELVAR (LAB)
      CALL OUTCH (61)
      CALL BALPAR
      CALL OUTDON
      CALL OUTGO (LAB)
      XFER = 1
23645 IF (.NOT.(GNBTOK (SCRTOK, 120) .EQ. 10))GOTO 23646
      GOTO 23645
23646 CONTINUE
      IF (.NOT.(SCRTOK (1) .NE. 123))GOTO 23647
      CALL SYNERR (39Hmissing left brace in select statement.)
      CALL PBSTR (SCRTOK)
23647 CONTINUE
      RETURN
      END
      SUBROUTINE SELEND (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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER LB, UB, N, I, J
      LOGICAL*1 SIF(5)
      LOGICAL*1 SLT(10)
      LOGICAL*1 SGT(5)
      LOGICAL*1 SGOTO(7)
      LOGICAL*1 SEQ(5)
      LOGICAL*1 SGE(5)
      LOGICAL*1 SLE(5)
      LOGICAL*1 SAND(6)
      DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/32/,SIF(4)/40/,SIF(5)/0/
      DATA SLT(1)/46/,SLT(2)/108/,SLT(3)/116/,SLT(4)/46/,SLT(5)/49/,SLT(
     *6)/46/,SLT(7)/111/,SLT(8)/114/,SLT(9)/46/,SLT(10)/0/
      DATA SGT(1)/46/,SGT(2)/103/,SGT(3)/116/,SGT(4)/46/,SGT(5)/0/
      DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO
     *(5)/32/,SGOTO(6)/40/,SGOTO(7)/0/
      DATA SEQ(1)/46/,SEQ(2)/101/,SEQ(3)/113/,SEQ(4)/46/,SEQ(5)/0/
      DATA SGE(1)/46/,SGE(2)/103/,SGE(3)/101/,SGE(4)/46/,SGE(5)/0/
      DATA SLE(1)/46/,SLE(2)/108/,SLE(3)/101/,SLE(4)/46/,SLE(5)/0/
      DATA SAND(1)/46/,SAND(2)/97/,SAND(3)/110/,SAND(4)/100/,SAND(5)/46/
     *,SAND(6)/0/
      LB = SESTAK (SETOP + 3)
      UB = SESTAK (SELAST - 2)
      N = SESTAK (SETOP + 1)
      CALL OUTGO (LAB + 1)
      IF (.NOT.(SESTAK (SETOP + 2) .EQ. 0))GOTO 23649
      SESTAK (SETOP + 2) = LAB + 1
23649 CONTINUE
      XFER = 0
      CALL OUTCON (LAB)
      IF (.NOT.(N .GE. 3 .AND. UB - LB + 1 .LT. 2 * N))GOTO 23651
      IF (.NOT.(LB .NE. 1))GOTO 23653
      CALL OUTTAB
      CALL SELVAR (LAB)
      CALL OUTCH (61)
      CALL SELVAR (LAB)
      IF (.NOT.(LB .LT. 1))GOTO 23655
      CALL OUTCH (43)
23655 CONTINUE
      CALL OUTNUM (-LB + 1)
      CALL OUTDON
23653 CONTINUE
      CALL OUTTAB
      CALL OUTSTR (SIF)
      CALL SELVAR (LAB)
      CALL OUTSTR (SLT)
      CALL SELVAR (LAB)
      CALL OUTSTR (SGT)
      CALL OUTNUM (UB - LB + 1)
      CALL OUTCH (41)
      CALL OUTGO (SESTAK (SETOP + 2))
      CALL OUTTAB
      CALL OUTSTR (SGOTO)
      J = LB
      I = SETOP + 3
23657 IF (.NOT.(I .LT. SELAST))GOTO 23659
23660 IF (.NOT.(J .LT. SESTAK (I)))GOTO 23662
      CALL OUTNUM (SESTAK (SETOP + 2))
      CALL OUTCH (44)
23661 J = J + 1
      GOTO 23660
23662 CONTINUE
      J = SESTAK (I + 1) - SESTAK (I)
23663 IF (.NOT.(J .GE. 0))GOTO 23665
      CALL OUTNUM (SESTAK (I + 2))
23664 J = J - 1
      GOTO 23663
23665 CONTINUE
      J = SESTAK (I + 1) + 1
      IF (.NOT.(I .LT. SELAST - 3))GOTO 23666
      CALL OUTCH (44)
23666 CONTINUE
23658 I = I + 3
      GOTO 23657
23659 CONTINUE
      CALL OUTCH (41)
      CALL OUTCH (44)
      CALL SELVAR (LAB)
      CALL OUTDON
      GOTO 23652
23651 CONTINUE
      IF (.NOT.(N .GT. 0))GOTO 23668
      I = SETOP + 3
23670 IF (.NOT.(I .LT. SELAST))GOTO 23672
      CALL OUTTAB
      CALL OUTSTR (SIF)
      CALL SELVAR (LAB)
      IF (.NOT.(SESTAK (I) .EQ. SESTAK (I+1)))GOTO 23673
      CALL OUTSTR (SEQ)
      CALL OUTNUM (SESTAK (I))
      GOTO 23674
23673 CONTINUE
      CALL OUTSTR (SGE)
      CALL OUTNUM (SESTAK (I))
      CALL OUTSTR (SAND)
      CALL SELVAR (LAB)
      CALL OUTSTR (SLE)
      CALL OUTNUM (SESTAK (I + 1))
23674 CONTINUE
      CALL OUTCH (41)
      CALL OUTGO (SESTAK (I + 2))
23671 I = I + 3
      GOTO 23670
23672 CONTINUE
      IF (.NOT.(LAB + 1 .NE. SESTAK (SETOP + 2)))GOTO 23675
      CALL OUTGO (SESTAK (SETOP + 2))
23675 CONTINUE
23668 CONTINUE
23652 CONTINUE
      CALL OUTCON (LAB + 1)
      SELAST = SETOP
      SETOP = SESTAK (SETOP)
      RETURN
      END
      SUBROUTINE SELVAR (LAB)
      INTEGER LAB
      CALL OUTCH (73)
      CALL OUTNUM (LAB)
      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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 C
      LOGICAL*1 NGETCH
      C = NGETCH (C)
23677 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23679
23678 C = NGETCH (C)
      GOTO 23677
23679 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 T, DCHAR (120)
      INTEGER I, J, K, N, LEN
      LOGICAL*1 GNBTOK, ESC
      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 (SCRTOK, 120)
      IF (.NOT.(T .NE. -9))GOTO 23680
      CALL SYNERR (22Hmissing string scrtok.)
23680 CONTINUE
      CALL OUTTAB
      CALL PBSTR (CHAR)
23682 CONTINUE
      T = GNBTOK (DCHAR, 120)
      IF (.NOT.(T .EQ. 47))GOTO 23685
      GOTO 23684
23685 CONTINUE
      CALL OUTSTR (DCHAR)
23683 GOTO 23682
23684 CONTINUE
      CALL OUTCH (32)
      CALL OUTSTR (SCRTOK)
      CALL ADDSTR (SCRTOK, SBUF, SBP, 600)
      CALL ADDCHR (0, SBUF, SBP, 600)
      IF (.NOT.(GNBTOK (SCRTOK, 120) .NE. 40))GOTO 23687
      LEN = ELENTH (SCRTOK) + 1
      IF (.NOT.(SCRTOK (1) .EQ. 39 .OR. SCRTOK (1) .EQ. 34))GOTO 23689
      LEN = LEN - 2
23689 CONTINUE
      GOTO 23688
23687 CONTINUE
      T = GNBTOK (SCRTOK, 120)
      I = 1
      LEN = CTOI (SCRTOK, I)
      IF (.NOT.(SCRTOK (I) .NE. 0))GOTO 23691
      CALL SYNERR (20Hinvalid string size.)
23691 CONTINUE
      IF (.NOT.(GNBTOK (SCRTOK, 120) .NE. 41))GOTO 23693
      CALL SYNERR (20Hmissing right paren.)
      GOTO 23694
23693 CONTINUE
      T = GNBTOK (SCRTOK, 120)
23694 CONTINUE
23688 CONTINUE
      CALL OUTCH (40)
      CALL OUTNUM (LEN)
      CALL OUTCH (41)
      CALL OUTDON
      IF (.NOT.(SCRTOK (1) .EQ. 39 .OR. SCRTOK (1) .EQ. 34))GOTO 23695
      LEN = LENGTH (SCRTOK)
      SCRTOK (LEN) = 0
      CALL ADDSTR (SCRTOK (2), SBUF, SBP, 600)
      GOTO 23696
23695 CONTINUE
      CALL ADDSTR (SCRTOK, SBUF, SBP, 600)
23696 CONTINUE
      CALL ADDCHR (0, SBUF, SBP, 600)
      T = LEX (SCRTOK)
      CALL PBSTR (SCRTOK)
      IF (.NOT.(T .NE. -23))GOTO 23697
      I = 1
23699 IF (.NOT.(I .LT. SBP))GOTO 23701
      CALL OUTTAB
      CALL OUTSTR (DAT)
      K = 1
      J = I + LENGTH (SBUF (I)) + 1
23702 CONTINUE
      IF (.NOT.(K .GT. 1))GOTO 23705
      CALL OUTCH (44)
23705 CONTINUE
      CALL OUTSTR (SBUF (I))
      CALL OUTCH (40)
      CALL OUTNUM (K)
      CALL OUTCH (41)
      CALL OUTCH (47)
      IF (.NOT.(SBUF (J) .EQ. 0))GOTO 23707
      GOTO 23704
23707 CONTINUE
      N = ESC (SBUF, J)
      CALL OUTNUM (N)
      CALL OUTCH (47)
      K = K + 1
23703 J = J + 1
      GOTO 23702
23704 CONTINUE
      CALL PBSTR (EOSS)
23709 CONTINUE
      T = GNBTOK (SCRTOK, 120)
      CALL OUTSTR (SCRTOK)
23710 IF (.NOT.(T .EQ. 47))GOTO 23709
23711 CONTINUE
      CALL OUTDON
23700 I = J + 1
      GOTO 23699
23701 CONTINUE
      SBP = 1
23697 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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 23712
      I = LEVEL
      GOTO 23713
23712 CONTINUE
      I = 1
23713 CONTINUE
      JUNK = ITOC (LINECT (I), LC, 20)
      CALL PUTLIN (LC, 3)
      I = FNAMP - 1
23714 IF (.NOT.(I .GT. 1))GOTO 23716
      IF (.NOT.(FNAMES (I - 1) .EQ. 0))GOTO 23717
      CALL PUTLIN (IN, 3)
      CALL PUTLIN (FNAMES (I), 3)
      GOTO 23716
23717 CONTINUE
23715 I = I - 1
      GOTO 23714
23716 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      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
23719 IF (.NOT.(SP .GT. 1))GOTO 23721
      IF (.NOT.(LEXTYP (SP) .EQ. 123))GOTO 23722
      GOTO 23721
23722 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -24))GOTO 23724
      GOTO 23721
23724 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -19 .AND. TOKEN .EQ. -11))GOTO 23726
      GOTO 23721
23726 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -19))GOTO 23728
      CALL OUTCON (LABVAL (SP))
      GOTO 23729
23728 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -11))GOTO 23730
      IF (.NOT.(SP .GT. 2))GOTO 23732
      SP = SP - 1
23732 CONTINUE
      CALL OUTCON (LABVAL (SP) + 1)
      GOTO 23731
23730 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -10))GOTO 23734
      CALL DOSTAT (LABVAL (SP))
      GOTO 23735
23734 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -15))GOTO 23736
      CALL WHILES (LABVAL (SP))
      GOTO 23737
23736 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -16))GOTO 23738
      CALL FORS (LABVAL (SP))
      GOTO 23739
23738 CONTINUE
      IF (.NOT.(LEXTYP (SP) .EQ. -17))GOTO 23740
      CALL UNTILS (LABVAL (SP), TOKEN)
23740 CONTINUE
23739 CONTINUE
23737 CONTINUE
23735 CONTINUE
23731 CONTINUE
23729 CONTINUE
23720 SP = SP - 1
      GOTO 23719
23721 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 /CSELCT/ SETOP, SELAST, SESTAK (300)
      INTEGER SETOP
      INTEGER SELAST
      INTEGER SESTAK
      COMMON /CKWORD/ RKWTBL
      INTEGER RKWTBL
      COMMON /CONDPP/ CSP, CURCND, CNDSTK(10)
      INTEGER CSP
      INTEGER CURCND
      INTEGER CNDSTK
      COMMON / CSCTOK / SCRTOK(120)
      LOGICAL*1 SCRTOK
      INTEGER MEM( 4250)
      LOGICAL*1 CMEM(8500)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 PTOKEN (120)
      INTEGER JUNK
      INTEGER LEX
      XFER = 0
      CALL OUTNUM (LAB)
      IF (.NOT.(TOKEN .EQ. -18))GOTO 23742
      JUNK = LEX (PTOKEN)
      CALL IFGO (LAB - 1)
      GOTO 23743
23742 CONTINUE
      CALL OUTGO (LAB - 1)
23743 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
