C  ========== ratfor in fortran for bootstrap ==========
C
C BLOCK DATA - INITIALIZE GLOBAL VARIABLES
C
       BLOCK DATA
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       DATA OUTP /0/
       DATA LEVEL /1/
       DATA LINECT(1) /1/
       DATA INFILE(1) /5/
       DATA BP /0/
       DATA FORDEP /0/
       DATA LASTP /0/
       DATA LASTT /0/
       DATA SDO(1), SDO(2), SDO(3) /100, 111, 10002/
       DATA VDO(1), VDO(2) /10266, 10002/
       DATA SIF(1), SIF(2), SIF(3) /105, 102, 10002/
       DATA VIF(1), VIF(2) /10261, 10002/
       DATA SELSE(1), SELSE(2), SELSE(3), SELSE(4), SELSE(5) /101,  108,
     * 115, 101, 10002/
       DATA VELSE(1), VELSE(2) /10262, 10002/
       DATA SWHILE(1), SWHILE(2), SWHILE(3), SWHILE(4), SWHILE(5), SWHIL
     *E(6) /119, 104, 105, 108, 101, 10002/
       DATA VWHILE(1), VWHILE(2) /10263, 10002/
       DATA SBREAK(1), SBREAK(2), SBREAK(3), SBREAK(4), SBREAK(5), SBREA
     *K(6) /98, 114, 101, 97, 107, 10002/
       DATA VBREAK(1), VBREAK(2) /10264, 10002/
       DATA SNEXT(1), SNEXT(2), SNEXT(3), SNEXT(4), SNEXT(5) /110,  101,
     * 120, 116, 10002/
       DATA VNEXT(1), VNEXT(2) /10265, 10002/
       DATA SFOR(1), SFOR(2), SFOR(3), SFOR(4) /102,  111, 114, 10002/
       DATA VFOR(1), VFOR(2) /10268, 10002/
       DATA SREPT(1), SREPT(2), SREPT(3), SREPT(4), SREPT(5), SREPT(6),
     * SREPT(7) /114, 101, 112, 101, 97, 116, 10002/
       DATA VREPT(1), VREPT(2) /10269, 10002/
       DATA SUNTIL(1), SUNTIL(2), SUNTIL(3), SUNTIL(4), SUNTIL(5), SUNTI
     *L(6) /117, 110, 116, 105, 108, 10002/
       DATA VUNTIL(1), VUNTIL(2) /10270, 10002/
       DATA EXTBLK /1H /, INTBLK /32/
       DATA EXTDIG(1) /1H0/, INTDIG(1) /48/
       DATA EXTDIG(2) /1H1/, INTDIG(2) /49/
       DATA EXTDIG(3) /1H2/, INTDIG(3) /50/
       DATA EXTDIG(4) /1H3/, INTDIG(4) /51/
       DATA EXTDIG(5) /1H4/, INTDIG(5) /52/
       DATA EXTDIG(6) /1H5/, INTDIG(6) /53/
       DATA EXTDIG(7) /1H6/, INTDIG(7) /54/
       DATA EXTDIG(8) /1H7/, INTDIG(8) /55/
       DATA EXTDIG(9) /1H8/, INTDIG(9) /56/
       DATA EXTDIG(10) /1H9/, INTDIG(10) /57/
       DATA EXTLET(1) /1HA/, INTLET(1) /97/
       DATA EXTLET(2) /1HB/, INTLET(2) /98/
       DATA EXTLET(3) /1HC/, INTLET(3) /99/
       DATA EXTLET(4) /1HD/, INTLET(4) /100/
       DATA EXTLET(5) /1HE/, INTLET(5) /101/
       DATA EXTLET(6) /1HF/, INTLET(6) /102/
       DATA EXTLET(7) /1HG/, INTLET(7) /103/
       DATA EXTLET(8) /1HH/, INTLET(8) /104/
       DATA EXTLET(9) /1HI/, INTLET(9) /105/
       DATA EXTLET(10) /1HJ/, INTLET(10) /106/
       DATA EXTLET(11) /1HK/, INTLET(11) /107/
       DATA EXTLET(12) /1HL/, INTLET(12) /108/
       DATA EXTLET(13) /1HM/, INTLET(13) /109/
       DATA EXTLET(14) /1HN/, INTLET(14) /110/
       DATA EXTLET(15) /1HO/, INTLET(15) /111/
       DATA EXTLET(16) /1HP/, INTLET(16) /112/
       DATA EXTLET(17) /1HQ/, INTLET(17) /113/
       DATA EXTLET(18) /1HR/, INTLET(18) /114/
       DATA EXTLET(19) /1HS/, INTLET(19) /115/
       DATA EXTLET(20) /1HT/, INTLET(20) /116/
       DATA EXTLET(21) /1HU/, INTLET(21) /117/
       DATA EXTLET(22) /1HV/, INTLET(22) /118/
       DATA EXTLET(23) /1HW/, INTLET(23) /119/
       DATA EXTLET(24) /1HX/, INTLET(24) /120/
       DATA EXTLET(25) /1HY/, INTLET(25) /121/
       DATA EXTLET(26) /1HZ/, INTLET(26) /122/
       DATA EXTBIG(1) /1HA/, INTBIG(1) /65/
       DATA EXTBIG(2) /1HB/, INTBIG(2) /66/
       DATA EXTBIG(3) /1HC/, INTBIG(3) /67/
       DATA EXTBIG(4) /1HD/, INTBIG(4) /68/
       DATA EXTBIG(5) /1HE/, INTBIG(5) /69/
       DATA EXTBIG(6) /1HF/, INTBIG(6) /70/
       DATA EXTBIG(7) /1HG/, INTBIG(7) /71/
       DATA EXTBIG(8) /1HH/, INTBIG(8) /72/
       DATA EXTBIG(9) /1HI/, INTBIG(9) /73/
       DATA EXTBIG(10) /1HJ/, INTBIG(10) /74/
       DATA EXTBIG(11) /1HK/, INTBIG(11) /75/
       DATA EXTBIG(12) /1HL/, INTBIG(12) /76/
       DATA EXTBIG(13) /1HM/, INTBIG(13) /77/
       DATA EXTBIG(14) /1HN/, INTBIG(14) /78/
       DATA EXTBIG(15) /1HO/, INTBIG(15) /79/
       DATA EXTBIG(16) /1HP/, INTBIG(16) /80/
       DATA EXTBIG(17) /1HQ/, INTBIG(17) /81/
       DATA EXTBIG(18) /1HR/, INTBIG(18) /82/
       DATA EXTBIG(19) /1HS/, INTBIG(19) /83/
       DATA EXTBIG(20) /1HT/, INTBIG(20) /84/
       DATA EXTBIG(21) /1HU/, INTBIG(21) /85/
       DATA EXTBIG(22) /1HV/, INTBIG(22) /86/
       DATA EXTBIG(23) /1HW/, INTBIG(23) /87/
       DATA EXTBIG(24) /1HX/, INTBIG(24) /88/
       DATA EXTBIG(25) /1HY/, INTBIG(25) /89/
       DATA EXTBIG(26) /1HZ/, INTBIG(26) /90/
       DATA EXTCHR(1) /1H]/, INTCHR(1) /33/
       DATA EXTCHR(2) /1H"/, INTCHR(2) /34/
       DATA EXTCHR(3) /1H#/, INTCHR(3) /35/
       DATA EXTCHR(4) /1H$/, INTCHR(4) /36/
       DATA EXTCHR(5) /1H%/, INTCHR(5) /37/
       DATA EXTCHR(6) /1H&/, INTCHR(6) /38/
       DATA EXTCHR(7) /1H'/, INTCHR(7) /39/
       DATA EXTCHR(8) /1H(/, INTCHR(8) /40/
       DATA EXTCHR(9) /1H)/, INTCHR(9) /41/
       DATA EXTCHR(10) /1H*/, INTCHR(10) /42/
       DATA EXTCHR(11) /1H+/, INTCHR(11) /43/
       DATA EXTCHR(12) /1H,/, INTCHR(12) /44/
       DATA EXTCHR(13) /1H-/, INTCHR(13) /45/
       DATA EXTCHR(14) /1H./, INTCHR(14) /46/
       DATA EXTCHR(15) /1H//, INTCHR(15) /47/
       DATA EXTCHR(16) /1H:/, INTCHR(16) /58/
       DATA EXTCHR(17) /1H;/, INTCHR(17) /59/
       DATA EXTCHR(18) /1H</, INTCHR(18) /60/
       DATA EXTCHR(19) /1H=/, INTCHR(19) /61/
       DATA EXTCHR(20) /1H>/, INTCHR(20) /62/
       DATA EXTCHR(21) /1H?/, INTCHR(21) /63/
       DATA EXTCHR(22) /1H@/, INTCHR(22) /64/
       DATA EXTCHR(23) /1HÕ/, INTCHR(23) /91/
       DATA EXTCHR(24) /1H\/, INTCHR(24) /92/
       DATA EXTCHR(25) /1Hå/, INTCHR(25) /93/
       DATA EXTCHR(26) /1H_/, INTCHR(26) /95/
       DATA EXTCHR(27) /1H{/, INTCHR(27) /123/
       DATA EXTCHR(28) /1H!/, INTCHR(28) /124/
       DATA EXTCHR(29) /1H}/, INTCHR(29) /125/
       DATA EXTCHR(30) /1H/, INTCHR(30) /8/
       DATA EXTCHR(31) /1H	/, INTCHR(31) /9/
       DATA EXTCHR(32) /1H^/, INTCHR(32) /33/
       DATA EXTCHR(33) /1H~/, INTCHR(33) /33/
       END
C
C RATFOR - MAIN PROGRAM FOR RATFOR
C
       CALL PARSE
       STOP
       END
C
C ALLDIG - RETURN YES IF STR IS ALL DIGITS
C
       INTEGER FUNCTION ALLDIG(STR)
       INTEGER TYPE
       INTEGER STR(100)
       INTEGER I
       ALLDIG = 0
       IF(.NOT.(STR(1) .EQ. 10002))  GOTO 23000
       RETURN
23000  CONTINUE
       CONTINUE
       I = 1
23002  IF(.NOT.( STR(I) .NE. 10002)) GOTO 23004
       IF(.NOT.(TYPE(STR(I)) .NE. 2))   GOTO 23005
       RETURN
23005  CONTINUE
23003   I = I + 1
       GOTO 23002
23004  CONTINUE
       ALLDIG = 1
       RETURN
       END
C
C BALPAR - COPY BALANCED PAREN STRING
C
       SUBROUTINE BALPAR
       INTEGER GETTOK
       INTEGER T, TOKEN(200)
       INTEGER NLPAR
       IF(.NOT.(GETTOK(TOKEN, 200) .NE. 40))  GOTO 23007
       CALL SYNERR(19HMISSING LEFT PAREN.)
       RETURN
23007  CONTINUE
       CALL OUTSTR(TOKEN)
       NLPAR = 1
       CONTINUE
23009  CONTINUE
       T = GETTOK(TOKEN, 200)
       IF(.NOT.(T.EQ.59 .OR. T.EQ.123 .OR. T.EQ.125 .OR. T.EQ.10003)) GO
     *TO 23012
       CALL PBSTR(TOKEN)
       GOTO 23011
23012  CONTINUE
       IF(.NOT.(T .EQ. 10)) GOTO 23014
       TOKEN(1) = 10002
       GOTO 23015
23014  CONTINUE
       IF(.NOT.(T .EQ. 40)) GOTO 23016
       NLPAR = NLPAR + 1
       GOTO 23017
23016  CONTINUE
       IF(.NOT.(T .EQ. 41)) GOTO 23018
       NLPAR = NLPAR - 1
23018  CONTINUE
23017  CONTINUE
23015  CONTINUE
       CALL OUTSTR(TOKEN)
23010  IF(.NOT.(NLPAR .LE. 0)) GOTO 23009
23011  CONTINUE
       IF(.NOT.(NLPAR .NE. 0)) GOTO 23020
       CALL SYNERR(33HMISSING PARENTHESIS IN CONDITION.)
23020  CONTINUE
       RETURN
       END
C
C BRKNXT - GENERATE CODE FOR BREAK AND NEXT
C
       SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
       INTEGER I, LABVAL(100), LEXTYP(100), SP, TOKEN
       CONTINUE
       I = SP
23022  IF(.NOT.( I .GT. 0)) GOTO 23024
       IF(.NOT.(LEXTYP(I) .EQ. 10263 .OR. LEXTYP(I) .EQ. 10266       .OR
     *. LEXTYP(I) .EQ. 10268 .OR. LEXTYP(I) .EQ. 10269))  GOTO 23025
       IF(.NOT.(TOKEN .EQ. 10264))   GOTO 23027
       CALL OUTGO(LABVAL(I)+1)
       GOTO 23028
23027  CONTINUE
       CALL OUTGO(LABVAL(I))
23028  CONTINUE
       RETURN
23025  CONTINUE
23023   I = I - 1
       GOTO 23022
23024  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10264))   GOTO 23029
       CALL SYNERR(14HILLEGAL BREAK.)
       GOTO 23030
23029  CONTINUE
       CALL SYNERR(13HILLEGAL NEXT.)
23030  CONTINUE
       RETURN
       END
C
C CLOSE - EXCEEDINGLY TEMPORARY VERSION FOR GETTOK
C
       SUBROUTINE CLOSE(FD)
       INTEGER FD
       REWIND FD
       RETURN
       END
C
C CTOI - CONVERT STRING AT IN(I) TO INTEGER, INCREMENT I
C
       INTEGER FUNCTION CTOI(IN, I)
       INTEGER IN(100)
       INTEGER INDEX
       INTEGER D, I
       INTEGER DIGITS(11)
       DATA DIGITS(1) /48/
       DATA DIGITS(2) /49/
       DATA DIGITS(3) /50/
       DATA DIGITS(4) /51/
       DATA DIGITS(5) /52/
       DATA DIGITS(6) /53/
       DATA DIGITS(7) /54/
       DATA DIGITS(8) /55/
       DATA DIGITS(9) /56/
       DATA DIGITS(10) /57/
       DATA DIGITS(11) /10002/
       CONTINUE
23031  IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))   GOTO 23032
       I = I + 1
       GOTO 23031
23032  CONTINUE
       CONTINUE
       CTOI = 0
23033  IF(.NOT.( IN(I) .NE. 10002))  GOTO 23035
       D = INDEX(DIGITS, IN(I))
       IF(.NOT.(D .EQ. 0))  GOTO 23036
       GOTO 23035
23036  CONTINUE
       CTOI = 10 * CTOI + D - 1
23034   I = I + 1
       GOTO 23033
23035  CONTINUE
       RETURN
       END
C
C DEFTOK - GET TOKEN; PROCESS MACRO CALLS AND INVOCATIONS
C
       INTEGER FUNCTION DEFTOK(TOKEN, TOKSIZ, FD)
       INTEGER GTOK
       INTEGER FD, TOKSIZ
       INTEGER DEFN(200), T, TOKEN(TOKSIZ)
       INTEGER LOOKUP
       CONTINUE
       T=GTOK(TOKEN, TOKSIZ, FD)
23038  IF(.NOT.( T.NE.10003))  GOTO 23040
       IF(.NOT.(T .NE. 10100)) GOTO 23041
       GOTO 23040
23041  CONTINUE
       IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))  GOTO 23043
       GOTO 23040
23043  CONTINUE
       IF(.NOT.(DEFN(1) .EQ. 10010)) GOTO 23045
       CALL GETDEF(TOKEN, TOKSIZ, DEFN, 200, FD)
       CALL INSTAL(TOKEN, DEFN)
       GOTO 23046
23045  CONTINUE
       CALL PBSTR(DEFN)
23046  CONTINUE
23039   T=GTOK(TOKEN, TOKSIZ, FD)
       GOTO 23038
23040  CONTINUE
       DEFTOK = T
       IF(.NOT.(DEFTOK .EQ. 10100))  GOTO 23047
       CALL FOLD(TOKEN)
23047  CONTINUE
       RETURN
       END
C
C FOLD - CONVERT ALPHABETIC TOKEN TO SINGLE CASE
C
       SUBROUTINE FOLD(TOKEN)
       INTEGER TOKEN(100)
       INTEGER I
       CONTINUE
       I = 1
23049  IF(.NOT.( TOKEN(I) .NE. 10002))  GOTO 23051
       IF(.NOT.(TOKEN(I) .GE. 65 .AND. TOKEN(I) .LE. 90)) GOTO 23052
       TOKEN(I) = TOKEN(I) - 65 + 97
23052  CONTINUE
23050   I = I + 1
       GOTO 23049
23051  CONTINUE
       RETURN
       END
C
C DOCODE - GENERATE CODE FOR BEGINNING OF DO
C
       SUBROUTINE DOCODE(LAB)
       INTEGER LABGEN
       INTEGER LAB
       INTEGER DOSTR(4)
       DATA DOSTR(1), DOSTR(2), DOSTR(3), DOSTR(4)/100, 111, 32, 10002/
       CALL OUTTAB
       CALL OUTSTR(DOSTR)
       LAB = LABGEN(2)
       CALL OUTNUM(LAB)
       CALL EATUP
       CALL OUTDON
       RETURN
       END
C
C DOSTAT - GENERATE CODE FOR END OF DO STATEMENT
C
       SUBROUTINE DOSTAT(LAB)
       INTEGER LAB
       CALL OUTCON(LAB)
       CALL OUTCON(LAB+1)
       RETURN
       END
C
C EATUP - PROCESS REST OF STATEMENT; INTERPRET CONTINUATIONS
C
       SUBROUTINE EATUP
       INTEGER GETTOK
       INTEGER PTOKEN(200), T, TOKEN(200)
       INTEGER NLPAR
       NLPAR = 0
       CONTINUE
23054  CONTINUE
       T = GETTOK(TOKEN, 200)
       IF(.NOT.(T .EQ. 59 .OR. T .EQ. 10)) GOTO 23057
       GOTO 23056
23057  CONTINUE
       IF(.NOT.(T .EQ. 125))   GOTO 23059
       CALL PBSTR(TOKEN)
       GOTO 23056
23059  CONTINUE
       IF(.NOT.(T .EQ. 123 .OR. T .EQ. 10003))   GOTO 23061
       CALL SYNERR(24HUNEXPECTED BRACE OR EOF.)
       CALL PBSTR(TOKEN)
       GOTO 23056
23061  CONTINUE
       IF(.NOT.(T .EQ. 44 .OR. T .EQ. 95)) GOTO 23063
       IF(.NOT.(GETTOK(PTOKEN, 200) .NE. 10)) GOTO 23065
       CALL PBSTR(PTOKEN)
23065  CONTINUE
       IF(.NOT.(T .EQ. 95)) GOTO 23067
       TOKEN(1) = 10002
23067  CONTINUE
       GOTO 23064
23063  CONTINUE
       IF(.NOT.(T .EQ. 40)) GOTO 23069
       NLPAR = NLPAR + 1
       GOTO 23070
23069  CONTINUE
       IF(.NOT.(T .EQ. 41)) GOTO 23071
       NLPAR = NLPAR - 1
23071  CONTINUE
23070  CONTINUE
23064  CONTINUE
       CALL OUTSTR(TOKEN)
23055  IF(.NOT.(NLPAR .LT. 0)) GOTO 23054
23056  CONTINUE
       IF(.NOT.(NLPAR .NE. 0)) GOTO 23073
       CALL SYNERR(23HUNBALANCED PARENTHESES.)
23073  CONTINUE
       RETURN
       END
C
C ELSEIF - GENERATE CODE FOR END OF IF BEFORE ELSE
C
       SUBROUTINE ELSEIF(LAB)
       INTEGER LAB
       CALL OUTGO(LAB+1)
       CALL OUTCON(LAB)
       RETURN
       END
C
C EQUAL - COMPARE STR1 TO STR2; RETURN YES IF EQUAL, NO IF NOT
C
       INTEGER FUNCTION EQUAL(STR1, STR2)
       INTEGER STR1(100), STR2(100)
       INTEGER I
       CONTINUE
       I = 1
23075  IF(.NOT.( STR1(I) .EQ. STR2(I))) GOTO 23077
       IF(.NOT.(STR1(I) .EQ. 10002)) GOTO 23078
       EQUAL = 1
       RETURN
23078  CONTINUE
23076   I = I + 1
       GOTO 23075
23077  CONTINUE
       EQUAL = 0
       RETURN
       END
C
C ERROR - PRINT FATAL ERROR MESSAGE, THEN DIE
C
       SUBROUTINE ERROR(BUF)
       INTEGER BUF(100)
       CALL REMARK(BUF)
       STOP
       END
C
C FORCOD - BEGINNING OF FOR STATEMENT
C
       SUBROUTINE FORCOD(LAB)
       INTEGER GETTOK
       INTEGER T, TOKEN(200)
       INTEGER LENGTH, LABGEN
       INTEGER I, J, LAB, NLPAR
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       INTEGER IFNOT(9)
       DATA IFNOT(1) /105/
       DATA IFNOT(2) /102/
       DATA IFNOT(3) /40/
       DATA IFNOT(4) /46/
       DATA IFNOT(5) /110/
       DATA IFNOT(6) /111/
       DATA IFNOT(7) /116/
       DATA IFNOT(8) /46/
       DATA IFNOT(9) /10002/
       LAB = LABGEN(3)
       CALL OUTCON(0)
       IF(.NOT.(GETTOK(TOKEN, 200) .NE. 40))  GOTO 23080
       CALL SYNERR(19HMISSING LEFT PAREN.)
       RETURN
23080  CONTINUE
       IF(.NOT.(GETTOK(TOKEN, 200) .NE. 59))  GOTO 23082
       CALL PBSTR(TOKEN)
       CALL OUTTAB
       CALL EATUP
       CALL OUTDON
23082  CONTINUE
       IF(.NOT.(GETTOK(TOKEN, 200) .EQ. 59))  GOTO 23084
       CALL OUTCON(LAB)
       GOTO 23085
23084  CONTINUE
       CALL PBSTR(TOKEN)
       CALL OUTNUM(LAB)
       CALL OUTTAB
       CALL OUTSTR(IFNOT)
       CALL OUTCH(40)
       NLPAR = 0
       CONTINUE
23086  IF(.NOT.(NLPAR .GE. 0)) GOTO 23087
       T = GETTOK(TOKEN, 200)
       IF(.NOT.(T .EQ. 59)) GOTO 23088
       GOTO 23087
23088  CONTINUE
       IF(.NOT.(T .EQ. 40)) GOTO 23090
       NLPAR = NLPAR + 1
       GOTO 23091
23090  CONTINUE
       IF(.NOT.(T .EQ. 41)) GOTO 23092
       NLPAR = NLPAR - 1
23092  CONTINUE
23091  CONTINUE
       IF(.NOT.(T .NE. 10 .AND. T .NE. 95))   GOTO 23094
       CALL OUTSTR(TOKEN)
23094  CONTINUE
       GOTO 23086
23087  CONTINUE
       CALL OUTCH(41)
       CALL OUTCH(41)
       CALL OUTGO(LAB+2)
       IF(.NOT.(NLPAR .LT. 0)) GOTO 23096
       CALL SYNERR(19HINVALID FOR CLAUSE.)
23096  CONTINUE
23085  CONTINUE
       FORDEP = FORDEP + 1
       J = 1
       CONTINUE
       I = 1
23098  IF(.NOT.( I .LT. FORDEP))  GOTO 23100
       J = J + LENGTH(FORSTK(J)) + 1
23099   I = I + 1
       GOTO 23098
23100  CONTINUE
       FORSTK(J) = 10002
       NLPAR = 0
       CONTINUE
23101  IF(.NOT.(NLPAR .GE. 0)) GOTO 23102
       T = GETTOK(TOKEN, 200)
       IF(.NOT.(T .EQ. 40)) GOTO 23103
       NLPAR = NLPAR + 1
       GOTO 23104
23103  CONTINUE
       IF(.NOT.(T .EQ. 41)) GOTO 23105
       NLPAR = NLPAR - 1
23105  CONTINUE
23104  CONTINUE
       IF(.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))  GOTO 231
     *07
       CALL SCOPY(TOKEN, 1, FORSTK, J)
       J = J + LENGTH(TOKEN)
23107  CONTINUE
       GOTO 23101
23102  CONTINUE
       LAB = LAB + 1
       RETURN
       END
C
C FORS - PROCESS END OF FOR STATEMENT
C
       SUBROUTINE FORS(LAB)
       INTEGER LENGTH
       INTEGER I, J, LAB
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CALL OUTNUM(LAB)
       J = 1
       CONTINUE
       I = 1
23109  IF(.NOT.( I .LT. FORDEP))  GOTO 23111
       J = J + LENGTH(FORSTK(J)) + 1
23110   I = I + 1
       GOTO 23109
23111  CONTINUE
       IF(.NOT.(LENGTH(FORSTK(J)) .GT. 0)) GOTO 23112
       CALL OUTTAB
       CALL OUTSTR(FORSTK(J))
       CALL OUTDON
23112  CONTINUE
       CALL OUTGO(LAB-1)
       CALL OUTCON(LAB+1)
       FORDEP = FORDEP - 1
       RETURN
       END
C
C GETCH - GET CHARACTERS FROM FILE
C
       INTEGER FUNCTION GETCH(C, F)
       INTEGER INMAP
       INTEGER BUF(81), C
       INTEGER F, I, LASTC
       DATA LASTC /81/, BUF(81) /10/
       IF(.NOT.(BUF(LASTC) .EQ. 10 .OR. LASTC .GE. 81))   GOTO 23114
       READ(F, 1, END=10) (BUF(I), I = 1, 80)
1         FORMAT(80 A1)
       CONTINUE
       I = 1
23116  IF(.NOT.( I .LE. 80))   GOTO 23118
       BUF(I) = INMAP(BUF(I))
23117   I = I + 1
       GOTO 23116
23118  CONTINUE
       CONTINUE
       I = 80
23119  IF(.NOT.( I .GT. 0)) GOTO 23121
       IF(.NOT.(BUF(I) .NE. 32))  GOTO 23122
       GOTO 23121
23122  CONTINUE
23120   I = I - 1
       GOTO 23119
23121  CONTINUE
       BUF(I+1) = 10
       LASTC = 0
23114  CONTINUE
       LASTC = LASTC + 1
       C = BUF(LASTC)
       GETCH = C
       RETURN
10        C = 10003
       GETCH = 10003
       RETURN
       END
C
C GETDEF (FOR NO ARGUMENTS) - GET NAME AND DEFINITION
C
       SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD)
       INTEGER GTOK, NGETCH
       INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ
       INTEGER C, DEFN(DEFSIZ), TOKEN(TOKSIZ)
       IF(.NOT.(NGETCH(C, FD) .NE. 40)) GOTO 23124
       CALL REMARK(19HMISSING LEFT PAREN.)
23124  CONTINUE
       IF(.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. 10100))   GOTO 23126
       CALL REMARK(22HNON-ALPHANUMERIC NAME.)
       GOTO 23127
23126  CONTINUE
       IF(.NOT.(NGETCH(C, FD) .NE. 44)) GOTO 23128
       CALL REMARK(24HMISSING COMMA IN DEFINE.)
23128  CONTINUE
23127  CONTINUE
       NLPAR = 0
       CONTINUE
       I = 1
23130  IF(.NOT.( NLPAR .GE. 0))   GOTO 23132
       IF(.NOT.(I .GT. DEFSIZ))   GOTO 23133
       CALL ERROR(20HDEFINITION TOO LONG.)
       GOTO 23134
23133  CONTINUE
       IF(.NOT.(NGETCH(DEFN(I), FD) .EQ. 10003)) GOTO 23135
       CALL ERROR(20HMISSING RIGHT PAREN.)
       GOTO 23136
23135  CONTINUE
       IF(.NOT.(DEFN(I) .EQ. 40)) GOTO 23137
       NLPAR = NLPAR + 1
       GOTO 23138
23137  CONTINUE
       IF(.NOT.(DEFN(I) .EQ. 41)) GOTO 23139
       NLPAR = NLPAR - 1
23139  CONTINUE
23138  CONTINUE
23136  CONTINUE
23134  CONTINUE
23131   I = I + 1
       GOTO 23130
23132  CONTINUE
       DEFN(I-1) = 10002
       RETURN
       END
C
C GETTOK - GET TOKEN. HANDLES FILE INCLUSION AND LINE NUMBERS
C
       INTEGER FUNCTION GETTOK(TOKEN, TOKSIZ)
       INTEGER EQUAL, OPEN
       INTEGER JUNK, TOKSIZ
       INTEGER DEFTOK
       INTEGER NAME(30), TOKEN(TOKSIZ)
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       INTEGER INCL(8)
       DATA INCL(1) /105/
       DATA INCL(2) /110/
       DATA INCL(3) /99/
       DATA INCL(4) /108/
       DATA INCL(5) /117/
       DATA INCL(6) /100/
       DATA INCL(7) /101/
       DATA INCL(8) /10002/
       CONTINUE
23141  IF(.NOT.( LEVEL .GT. 0))   GOTO 23143
       CONTINUE
       GETTOK = DEFTOK(TOKEN, TOKSIZ, INFILE(LEVEL))
23144  IF(.NOT.( GETTOK .NE. 10003)) GOTO 23146
       IF(.NOT.(EQUAL(TOKEN, INCL) .EQ. 0))   GOTO 23147
       RETURN
23147  CONTINUE
       JUNK = DEFTOK(NAME, 30, INFILE(LEVEL))
       IF(.NOT.(LEVEL .GE. 5)) GOTO 23149
       CALL SYNERR(27HINCLUDES NESTED TOO DEEPLY.)
       GOTO 23150
23149  CONTINUE
       INFILE(LEVEL+1) = OPEN(NAME, 0)
       LINECT(LEVEL+1) = 1
       IF(.NOT.(INFILE(LEVEL+1) .EQ. 10001))  GOTO 23151
       CALL SYNERR(19HCAN'T OPEN INCLUDE.)
       GOTO 23152
23151  CONTINUE
       LEVEL = LEVEL + 1
23152  CONTINUE
23150  CONTINUE
23145           GETTOK = DEFTOK(TOKEN, TOKSIZ, INFILE(LEVEL))
       GOTO 23144
23146  CONTINUE
       IF(.NOT.(LEVEL .GT. 1)) GOTO 23153
       CALL CLOSE(INFILE(LEVEL))
23153  CONTINUE
23142   LEVEL = LEVEL - 1
       GOTO 23141
23143  CONTINUE
       GETTOK = 10003
       RETURN
       END
C
C GTOK - GET TOKEN FOR RATFOR
C
       INTEGER FUNCTION GTOK(LEXSTR, TOKSIZ, FD)
       INTEGER NGETCH, TYPE
       INTEGER FD, I, TOKSIZ
       INTEGER C, LEXSTR(TOKSIZ)
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CONTINUE
23155  IF(.NOT.(NGETCH(C, FD) .NE. 10003)) GOTO 23156
       IF(.NOT.(C .NE. 32 .AND. C .NE. 9)) GOTO 23157
       GOTO 23156
23157  CONTINUE
       GOTO 23155
23156  CONTINUE
       CALL PUTBAK(C)
       CONTINUE
       I = 1
23159  IF(.NOT.( I .LT. TOKSIZ-1))   GOTO 23161
       GTOK = TYPE(NGETCH(LEXSTR(I), FD))
       IF(.NOT.(GTOK .NE. 1 .AND. GTOK .NE. 2))  GOTO 23162
       GOTO 23161
23162  CONTINUE
23160   I = I + 1
       GOTO 23159
23161  CONTINUE
       IF(.NOT.(I .GE. TOKSIZ-1)) GOTO 23164
       CALL SYNERR(15HTOKEN TOO LONG.)
23164  CONTINUE
       IF(.NOT.(I .GT. 1))  GOTO 23166
       CALL PUTBAK(LEXSTR(I))
       LEXSTR(I) = 10002
       GTOK = 10100
       GOTO 23167
23166  CONTINUE
       IF(.NOT.(LEXSTR(1) .EQ. 36))  GOTO 23168
       IF(.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40))  GOTO 23170
       LEXSTR(1) = 123
       GTOK = 123
       GOTO 23171
23170  CONTINUE
       IF(.NOT.(LEXSTR(2) .EQ. 41))  GOTO 23172
       LEXSTR(1) = 125
       GTOK = 125
       GOTO 23173
23172  CONTINUE
       CALL PUTBAK(LEXSTR(2))
23173  CONTINUE
23171  CONTINUE
       GOTO 23169
23168  CONTINUE
       IF(.NOT.(LEXSTR(1) .EQ. 39 .OR. LEXSTR(1) .EQ. 34))   GOTO 23174
       CONTINUE
       I = 2
23176  IF(.NOT.( NGETCH(LEXSTR(I), FD) .NE. LEXSTR(1)))   GOTO 23178
       IF(.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ-1))  GOTO 23179
       CALL SYNERR(14HMISSING QUOTE.)
       LEXSTR(I) = LEXSTR(1)
       CALL PUTBAK(10)
       GOTO 23178
23179  CONTINUE
23177   I = I + 1
       GOTO 23176
23178  CONTINUE
       GOTO 23175
23174  CONTINUE
       IF(.NOT.(LEXSTR(1) .EQ. 35))  GOTO 23181
       CONTINUE
23183  IF(.NOT.(NGETCH(LEXSTR(1), FD) .NE. 10))  GOTO 23184
       GOTO 23183
23184  CONTINUE
       GTOK = 10
       GOTO 23182
23181  CONTINUE
       IF(.NOT.(LEXSTR(1) .EQ. 62 .OR. LEXSTR(1) .EQ. 60 .OR. LEXSTR(1)
     *.EQ. 33      .OR. LEXSTR(1) .EQ. 61 .OR. LEXSTR(1) .EQ. 38 .OR. LE
     *XSTR(1) .EQ. 124)) GOTO 23185
       CALL RELATE(LEXSTR, I, FD)
23185  CONTINUE
23182  CONTINUE
23175  CONTINUE
23169  CONTINUE
23167  CONTINUE
       LEXSTR(I+1) = 10002
       IF(.NOT.(LEXSTR(1) .EQ. 10))  GOTO 23187
       LINECT(LEVEL) = LINECT(LEVEL) + 1
23187  CONTINUE
       RETURN
       END
C
C IFCODE - GENERATE INITIAL CODE FOR IF
C
       SUBROUTINE IFCODE(LAB)
       INTEGER LABGEN
       INTEGER LAB
       LAB = LABGEN(2)
       CALL IFGO(LAB)
       RETURN
       END
C
C IFGO - GENERATE "IF(.NOT.(...))GOTO LAB"
C
       SUBROUTINE IFGO(LAB)
       INTEGER LAB
       INTEGER IFNOT(9)
       DATA IFNOT(1) /105/
       DATA IFNOT(2) /102/
       DATA IFNOT(3) /40/
       DATA IFNOT(4) /46/
       DATA IFNOT(5) /110/
       DATA IFNOT(6) /111/
       DATA IFNOT(7) /116/
       DATA IFNOT(8) /46/
       DATA IFNOT(9) /10002/
       CALL OUTTAB
       CALL OUTSTR(IFNOT)
       CALL BALPAR
       CALL OUTCH(41)
       CALL OUTGO(LAB)
       RETURN
       END
C
C INDEX - FIND CHARACTER  C  IN STRING  STR
C
       INTEGER FUNCTION INDEX(STR, C)
       INTEGER C, STR(100)
       CONTINUE
       INDEX = 1
23189  IF(.NOT.( STR(INDEX) .NE. 10002))   GOTO 23191
       IF(.NOT.(STR(INDEX) .EQ. C))  GOTO 23192
       RETURN
23192  CONTINUE
23190   INDEX = INDEX + 1
       GOTO 23189
23191  CONTINUE
       INDEX = 0
       RETURN
       END
C
C INITKW - INSTALL KEYWORD "DEFINE" IN TABLE
C
       SUBROUTINE INITKW
       INTEGER DEFNAM(7), DEFTYP(2)
       DATA DEFNAM(1) /100/, DEFNAM(2) /101/, DEFNAM(3) /102/
       DATA DEFNAM(4) /105/, DEFNAM(5) /110/, DEFNAM(6) /101/
       DATA DEFNAM(7) /10002/
       DATA DEFTYP(1), DEFTYP(2) /10010, 10002/
       CALL INSTAL(DEFNAM, DEFTYP)
       RETURN
       END
C
C INMAP - CONVERT LEFT ADJUSTED EXTERNAL REP TO RIGHT ADJ ASCII
C
       INTEGER FUNCTION INMAP(INCHAR)
       INTEGER I, INCHAR
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(INCHAR .EQ. EXTBLK)) GOTO 23194
       INMAP = INTBLK
       RETURN
23194  CONTINUE
       DO23196I = 1, 10
       IF(.NOT.(INCHAR .EQ. EXTDIG(I))) GOTO 23198
       INMAP = INTDIG(I)
       RETURN
23198  CONTINUE
23196  CONTINUE
23197  CONTINUE
       DO23200I = 1, 26
       IF(.NOT.(INCHAR .EQ. EXTLET(I))) GOTO 23202
       INMAP = INTLET(I)
       RETURN
23202  CONTINUE
23200  CONTINUE
23201  CONTINUE
       DO23204I = 1, 26
       IF(.NOT.(INCHAR .EQ. EXTBIG(I))) GOTO 23206
       INMAP = INTBIG(I)
       RETURN
23206  CONTINUE
23204  CONTINUE
23205  CONTINUE
       DO23208I = 1, 33
       IF(.NOT.(INCHAR .EQ. EXTCHR(I))) GOTO 23210
       INMAP = INTCHR(I)
       RETURN
23210  CONTINUE
23208  CONTINUE
23209  CONTINUE
       INMAP = INCHAR
       RETURN
       END
C
C INSTAL - ADD NAME AND DEFINITION TO TABLE
C
       SUBROUTINE INSTAL(NAME, DEFN)
       INTEGER DEFN(200), NAME(200)
       INTEGER LENGTH
       INTEGER DLEN, NLEN
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       NLEN = LENGTH(NAME) + 1
       DLEN = LENGTH(DEFN) + 1
       IF(.NOT.(LASTT + NLEN + DLEN .GT. 1500 .OR. LASTP .GE. 200))   GO
     *TO 23212
       CALL PUTLIN(NAME, 6)
       CALL REMARK(23H: TOO MANY DEFINITIONS.)
23212  CONTINUE
       LASTP = LASTP + 1
       NAMPTR(LASTP) = LASTT + 1
       CALL SCOPY(NAME, 1, TABLE, LASTT + 1)
       CALL SCOPY(DEFN, 1, TABLE, LASTT + NLEN + 1)
       LASTT = LASTT + NLEN + DLEN
       RETURN
       END
C
C ITOC - CONVERT INTEGER  INT  TO CHAR STRING IN  STR
C
       INTEGER FUNCTION ITOC(INT, STR, SIZE)
       INTEGER IABS, MOD
       INTEGER D, I, INT, INTVAL, J, K, SIZE
       INTEGER STR(SIZE)
       INTEGER DIGITS(11)
       DATA DIGITS(1) /48/
       DATA DIGITS(2) /49/
       DATA DIGITS(3) /50/
       DATA DIGITS(4) /51/
       DATA DIGITS(5) /52/
       DATA DIGITS(6) /53/
       DATA DIGITS(7) /54/
       DATA DIGITS(8) /55/
       DATA DIGITS(9) /56/
       DATA DIGITS(10) /57/
       DATA DIGITS(11) /10002/
       INTVAL = IABS(INT)
       STR(1) = 10002
       I = 1
       CONTINUE
23214  CONTINUE
       I = I + 1
       D = MOD(INTVAL, 10)
       STR(I) = DIGITS(D+1)
       INTVAL = INTVAL / 10
23215  IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE)) GOTO 23214
23216  CONTINUE
       IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))   GOTO 23217
       I = I + 1
       STR(I) = 45
23217  CONTINUE
       ITOC = I - 1
       CONTINUE
       J = 1
23219  IF(.NOT.( J .LT. I)) GOTO 23221
       K = STR(I)
       STR(I) = STR(J)
       STR(J) = K
       I = I - 1
23220   J = J + 1
       GOTO 23219
23221  CONTINUE
       RETURN
       END
C
C LABELC - OUTPUT STATEMENT NUMBER
C
       SUBROUTINE LABELC(LEXSTR)
       INTEGER LEXSTR(100)
       INTEGER LENGTH
       IF(.NOT.(LENGTH(LEXSTR) .EQ. 5)) GOTO 23222
       IF(.NOT.(LEXSTR(1) .EQ. 50 .AND. LEXSTR(2) .EQ. 51))  GOTO 23224
       CALL SYNERR(33HWARNING: POSSIBLE LABEL CONFLICT.)
23224  CONTINUE
23222  CONTINUE
       CALL OUTSTR(LEXSTR)
       CALL OUTTAB
       RETURN
       END
C
C LABGEN - GENERATE  N  CONSECUTIVE LABELS, RETURN FIRST ONE
C
       INTEGER FUNCTION LABGEN(N)
       INTEGER LABEL, N
       DATA LABEL /23000/
       LABGEN = LABEL
       LABEL = LABEL + N
       RETURN
       END
C
C LENGTH - COMPUTE LENGTH OF STRING
C
       INTEGER FUNCTION LENGTH(STR)
       INTEGER STR(100)
       CONTINUE
       LENGTH = 0
23226  IF(.NOT.( STR(LENGTH+1) .NE. 10002))   GOTO 23228
23227   LENGTH = LENGTH + 1
       GOTO 23226
23228  CONTINUE
       RETURN
       END
C
C LEX - RETURN LEXICAL TYPE OF TOKEN
C
       INTEGER FUNCTION LEX(LEXSTR)
       INTEGER GETTOK
       INTEGER LEXSTR(200)
       INTEGER ALLDIG, EQUAL
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CONTINUE
23229  IF(.NOT.(GETTOK(LEXSTR, 200) .EQ. 10)) GOTO 23230
       GOTO 23229
23230  CONTINUE
       LEX = LEXSTR(1)
       IF(.NOT.(LEX.EQ.10003 .OR. LEX.EQ.59 .OR. LEX.EQ.123 .OR. LEX.EQ.
     *125))  GOTO 23231
       RETURN
23231  CONTINUE
       IF(.NOT.(ALLDIG(LEXSTR) .EQ. 1)) GOTO 23233
       LEX = 10260
       GOTO 23234
23233  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1))   GOTO 23235
       LEX = VIF(1)
       GOTO 23236
23235  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1)) GOTO 23237
       LEX = VELSE(1)
       GOTO 23238
23237  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1))   GOTO 23239
       LEX = VWHILE(1)
       GOTO 23240
23239  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1))   GOTO 23241
       LEX = VDO(1)
       GOTO 23242
23241  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1))   GOTO 23243
       LEX = VBREAK(1)
       GOTO 23244
23243  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1)) GOTO 23245
       LEX = VNEXT(1)
       GOTO 23246
23245  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1))  GOTO 23247
       LEX = VFOR(1)
       GOTO 23248
23247  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1)) GOTO 23249
       LEX = VREPT(1)
       GOTO 23250
23249  CONTINUE
       IF(.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1))   GOTO 23251
       LEX = VUNTIL(1)
       GOTO 23252
23251  CONTINUE
       LEX = 10267
23252  CONTINUE
23250  CONTINUE
23248  CONTINUE
23246  CONTINUE
23244  CONTINUE
23242  CONTINUE
23240  CONTINUE
23238  CONTINUE
23236  CONTINUE
23234  CONTINUE
       RETURN
       END
C
C LOOKUP - LOCATE NAME, EXTRACT DEFINITION FROM TABLE
C
       INTEGER FUNCTION LOOKUP(NAME, DEFN)
       INTEGER DEFN(200), NAME(200)
       INTEGER I, J, K
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CONTINUE
       I = LASTP
23253  IF(.NOT.( I .GT. 0)) GOTO 23255
       J = NAMPTR(I)
       CONTINUE
       K = 1
23256  IF(.NOT.( NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 10002))  GOTO
     *23258
       J = J + 1
23257   K = K + 1
       GOTO 23256
23258  CONTINUE
       IF(.NOT.(NAME(K) .EQ. TABLE(J))) GOTO 23259
       CALL SCOPY(TABLE, J+1, DEFN, 1)
       LOOKUP = 1
       RETURN
23259  CONTINUE
23254   I = I - 1
       GOTO 23253
23255  CONTINUE
       LOOKUP = 0
       RETURN
       END
C
C NGETCH - GET A (POSSIBLY PUSHED BACK) CHARACTER
C
       INTEGER FUNCTION NGETCH(C, FD)
       INTEGER GETCH
       INTEGER C
       INTEGER FD
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(BP .GT. 0)) GOTO 23261
       C = BUF(BP)
       GOTO 23262
23261  CONTINUE
       BP = 1
       BUF(BP) = GETCH(C, FD)
23262  CONTINUE
       BP = BP - 1
       NGETCH = C
       RETURN
       END
C
C OPEN - EXCEEDINGLY TEMPORARY VERSION FOR GETTOK
C
       INTEGER FUNCTION OPEN(NAME, MODE)
       INTEGER NAME(30)
       INTEGER CTOI
       INTEGER I, MODE
       I = 1
       OPEN = CTOI(NAME, I)
       RETURN
       END
C
C OTHERC - OUTPUT ORDINARY FORTRAN STATEMENT
C
       SUBROUTINE OTHERC(LEXSTR)
       INTEGER LEXSTR(100)
       CALL OUTTAB
       CALL OUTSTR(LEXSTR)
       CALL EATUP
       CALL OUTDON
       RETURN
       END
C
C OUTCH - PUT ONE CHARACTER INTO OUTPUT BUFFER
C
       SUBROUTINE OUTCH(C)
       INTEGER C
       INTEGER I
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(OUTP .GE. 72)) GOTO 23263
       CALL OUTDON
       CONTINUE
       I = 1
23265  IF(.NOT.( I .LT. 6)) GOTO 23267
       OUTBUF(I) = 32
23266   I = I + 1
       GOTO 23265
23267  CONTINUE
       OUTBUF(6) = 42
       OUTP = 6
23263  CONTINUE
       OUTP = OUTP + 1
       OUTBUF(OUTP) = C
       RETURN
       END
C
C OUTCON - OUTPUT "N   CONTINUE"
C
       SUBROUTINE OUTCON(N)
       INTEGER N
       INTEGER CONTIN(9)
       DATA CONTIN(1) /99/
       DATA CONTIN(2) /111/
       DATA CONTIN(3) /110/
       DATA CONTIN(4) /116/
       DATA CONTIN(5) /105/
       DATA CONTIN(6) /110/
       DATA CONTIN(7) /117/
       DATA CONTIN(8) /101/
       DATA CONTIN(9) /10002/
       IF(.NOT.(N .GT. 0))  GOTO 23268
       CALL OUTNUM(N)
23268  CONTINUE
       CALL OUTTAB
       CALL OUTSTR(CONTIN)
       CALL OUTDON
       RETURN
       END
C
C OUTDON - FINISH OFF AN OUTPUT LINE
C
       SUBROUTINE OUTDON
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       OUTBUF(OUTP+1) = 10
       OUTBUF(OUTP+2) = 10002
       CALL PUTLIN(OUTBUF, 6)
       OUTP = 0
       RETURN
       END
C
C OUTGO - OUTPUT "GOTO  N"
C
       SUBROUTINE OUTGO(N)
       INTEGER N
       INTEGER GOTO(6)
       DATA GOTO(1) /103/
       DATA GOTO(2) /111/
       DATA GOTO(3) /116/
       DATA GOTO(4) /111/
       DATA GOTO(5) /32/
       DATA GOTO(6) /10002/
       CALL OUTTAB
       CALL OUTSTR(GOTO)
       CALL OUTNUM(N)
       CALL OUTDON
       RETURN
       END
C
C OUTMAP - CONVERT RIGHT ADJ ASCII TO LEFT ADJUSTED EXTERNAL REP
C
       INTEGER FUNCTION OUTMAP(INCHAR)
       INTEGER I, INCHAR
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(INCHAR .EQ. INTBLK)) GOTO 23270
       OUTMAP = EXTBLK
       RETURN
23270  CONTINUE
       DO23272I = 1, 10
       IF(.NOT.(INCHAR .EQ. INTDIG(I))) GOTO 23274
       OUTMAP = EXTDIG(I)
       RETURN
23274  CONTINUE
23272  CONTINUE
23273  CONTINUE
       DO23276I = 1, 26
       IF(.NOT.(INCHAR .EQ. INTLET(I))) GOTO 23278
       OUTMAP = EXTLET(I)
       RETURN
23278  CONTINUE
23276  CONTINUE
23277  CONTINUE
       DO23280I = 1, 26
       IF(.NOT.(INCHAR .EQ. INTBIG(I))) GOTO 23282
       OUTMAP = EXTBIG(I)
       RETURN
23282  CONTINUE
23280  CONTINUE
23281  CONTINUE
       DO23284I = 1, 33
       IF(.NOT.(INCHAR .EQ. INTCHR(I))) GOTO 23286
       OUTMAP = EXTCHR(I)
       RETURN
23286  CONTINUE
23284  CONTINUE
23285  CONTINUE
       OUTMAP = INCHAR
       RETURN
       END
C
C OUTNUM - OUTPUT DECIMAL NUMBER
C
       SUBROUTINE OUTNUM(N)
       INTEGER CHARS(10)
       INTEGER ITOC
       INTEGER I, LEN, N
       LEN = ITOC(N, CHARS, 10)
       CONTINUE
       I = 1
23288  IF(.NOT.( I .LE. LEN))  GOTO 23290
       CALL OUTCH(CHARS(I))
23289   I = I + 1
       GOTO 23288
23290  CONTINUE
       RETURN
       END
C
C OUTSTR - OUTPUT STRING
C
       SUBROUTINE OUTSTR(STR)
       INTEGER C, STR(100)
       INTEGER I, J
       CONTINUE
       I = 1
23291  IF(.NOT.( STR(I) .NE. 10002)) GOTO 23293
       C = STR(I)
       IF(.NOT.(C .NE. 39 .AND. C .NE. 34))   GOTO 23294
       CALL OUTCH(C)
       GOTO 23295
23294  CONTINUE
       I = I + 1
       CONTINUE
       J = I
23296  IF(.NOT.( STR(J) .NE. C))  GOTO 23298
23297   J = J + 1
       GOTO 23296
23298  CONTINUE
       CALL OUTNUM(J-I)
       CALL OUTCH(104)
       CONTINUE
23299  IF(.NOT.( I .LT. J)) GOTO 23301
       CALL OUTCH(STR(I))
23300   I = I + 1
       GOTO 23299
23301  CONTINUE
23295  CONTINUE
23292   I = I + 1
       GOTO 23291
23293  CONTINUE
       RETURN
       END
C
C OUTTAB - GET PAST COLUMN 6
C
       SUBROUTINE OUTTAB
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CONTINUE
23302  IF(.NOT.(OUTP .LT. 6))  GOTO 23303
       CALL OUTCH(32)
       GOTO 23302
23303  CONTINUE
       RETURN
       END
C
C PARSE - PARSE RATFOR SOURCE PROGRAM
C
       SUBROUTINE PARSE
       INTEGER LEXSTR(200)
       INTEGER LEX
       INTEGER LAB, LABVAL(100), LEXTYP(100), SP, TOKEN
       CALL INITKW
       SP = 1
       LEXTYP(1) = 10003
       CONTINUE
       TOKEN = LEX(LEXSTR)
23304  IF(.NOT.( TOKEN .NE. 10003))  GOTO 23306
       IF(.NOT.(TOKEN .EQ. 10261))   GOTO 23307
       CALL IFCODE(LAB)
       GOTO 23308
23307  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10266))   GOTO 23309
       CALL DOCODE(LAB)
       GOTO 23310
23309  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10263))   GOTO 23311
       CALL WHILEC(LAB)
       GOTO 23312
23311  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10268))   GOTO 23313
       CALL FORCOD(LAB)
       GOTO 23314
23313  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10269))   GOTO 23315
       CALL REPCOD(LAB)
       GOTO 23316
23315  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10260))   GOTO 23317
       CALL LABELC(LEXSTR)
       GOTO 23318
23317  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10262))   GOTO 23319
       IF(.NOT.(LEXTYP(SP) .EQ. 10261)) GOTO 23321
       CALL ELSEIF(LABVAL(SP))
       GOTO 23322
23321  CONTINUE
       CALL SYNERR(13HILLEGAL ELSE.)
23322  CONTINUE
23319  CONTINUE
23318  CONTINUE
23316  CONTINUE
23314  CONTINUE
23312  CONTINUE
23310  CONTINUE
23308  CONTINUE
       IF(.NOT.(TOKEN.EQ.10261 .OR. TOKEN.EQ.10262 .OR. TOKEN.EQ.10263
     *      .OR. TOKEN.EQ.10268 .OR. TOKEN.EQ.10269         .OR. TOKEN.E
     *Q.10266 .OR. TOKEN.EQ.10260 .OR. TOKEN.EQ.123))  GOTO 23323
       SP = SP + 1
       IF(.NOT.(SP .GT. 100))  GOTO 23325
       CALL ERROR(25HSTACK OVERFLOW IN PARSER.)
23325  CONTINUE
       LEXTYP(SP) = TOKEN
       LABVAL(SP) = LAB
       GOTO 23324
23323  CONTINUE
       IF(.NOT.(TOKEN .EQ. 125))  GOTO 23327
       IF(.NOT.(LEXTYP(SP) .EQ. 123))   GOTO 23329
       SP = SP - 1
       GOTO 23330
23329  CONTINUE
       CALL SYNERR(20HILLEGAL RIGHT BRACE.)
23330  CONTINUE
       GOTO 23328
23327  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10267))   GOTO 23331
       CALL OTHERC(LEXSTR)
       GOTO 23332
23331  CONTINUE
       IF(.NOT.(TOKEN .EQ. 10264 .OR. TOKEN .EQ. 10265))  GOTO 23333
       CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
23333  CONTINUE
23332  CONTINUE
23328  CONTINUE
       TOKEN = LEX(LEXSTR)
       CALL PBSTR(LEXSTR)
       CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
23324  CONTINUE
23305   TOKEN = LEX(LEXSTR)
       GOTO 23304
23306  CONTINUE
       IF(.NOT.(SP .NE. 1)) GOTO 23335
       CALL SYNERR(15HUNEXPECTED EOF.)
23335  CONTINUE
       RETURN
       END
C
C PBSTR - PUSH STRING BACK ONTO INPUT
C
       SUBROUTINE PBSTR(IN)
       INTEGER IN(100)
       INTEGER LENGTH
       INTEGER I
       CONTINUE
       I = LENGTH(IN)
23337  IF(.NOT.( I .GT. 0)) GOTO 23339
       CALL PUTBAK(IN(I))
23338   I = I - 1
       GOTO 23337
23339  CONTINUE
       RETURN
       END
C
C PUTBAK - PUSH CHARACTER BACK ONTO INPUT
C
       SUBROUTINE PUTBAK(C)
       INTEGER C
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       BP = BP + 1
       IF(.NOT.(BP .GT. 300))  GOTO 23340
       CALL ERROR(32HTOO MANY CHARACTERS PUSHED BACK.)
23340  CONTINUE
       BUF(BP) = C
       RETURN
       END
C
C PUTCH (INTERIM VERSION)  PUT CHARACTERS
C
       SUBROUTINE PUTCH(C, F)
       INTEGER BUF(81), C
       INTEGER OUTMAP
       INTEGER F, I, LASTC
       DATA LASTC /0/
       IF(.NOT.(LASTC .GE. 81 .OR. C .EQ. 10))   GOTO 23342
       IF(.NOT.( LASTC .LE. 0 ))  GOTO 23344
       WRITE(F,2)
2         FORMAT(/)
       GOTO 23345
23344  CONTINUE
       WRITE(F, 1) (BUF(I), I = 1, LASTC)
1         FORMAT(80 A1)
23345  CONTINUE
       LASTC = 0
23342  CONTINUE
       IF(.NOT.(C .NE. 10)) GOTO 23346
       LASTC = LASTC + 1
       BUF(LASTC) = OUTMAP(C)
23346  CONTINUE
       RETURN
       END
C
C PUTLIN - PUT OUT LINE BY REPEATED CALLS TO PUTCH
C
       SUBROUTINE PUTLIN(B, F)
       INTEGER B(100)
       INTEGER F, I
       CONTINUE
       I = 1
23348  IF(.NOT.( B(I) .NE. 10002))   GOTO 23350
       CALL PUTCH(B(I), F)
23349   I = I + 1
       GOTO 23348
23350  CONTINUE
       RETURN
       END
C
C RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG FORM
C
       SUBROUTINE RELATE(TOKEN, LAST, FD)
       INTEGER NGETCH
       INTEGER TOKEN(100)
       INTEGER LENGTH
       INTEGER FD, LAST
       INTEGER DOTGE(5), DOTGT(5), DOTLT(5), DOTLE(5)
       INTEGER DOTNE(5), DOTNOT(6), DOTEQ(5), DOTAND(6), DOTOR(5)
       DATA DOTGE(1), DOTGE(2), DOTGE(3), DOTGE(4), DOTGE(5)/ 46, 103, 1
     *01, 46, 10002/
       DATA DOTGT(1), DOTGT(2), DOTGT(3), DOTGT(4), DOTGT(5)/ 46, 103, 1
     *16, 46, 10002/
       DATA DOTLE(1), DOTLE(2), DOTLE(3), DOTLE(4), DOTLE(5)/ 46, 108, 1
     *01, 46, 10002/
       DATA DOTLT(1), DOTLT(2), DOTLT(3), DOTLT(4), DOTLT(5)/ 46, 108, 1
     *16, 46, 10002/
       DATA DOTNE(1), DOTNE(2), DOTNE(3), DOTNE(4), DOTNE(5)/ 46, 110, 1
     *01, 46, 10002/
       DATA DOTEQ(1), DOTEQ(2), DOTEQ(3), DOTEQ(4), DOTEQ(5)/ 46, 101, 1
     *13, 46, 10002/
       DATA DOTOR(1), DOTOR(2), DOTOR(3), DOTOR(4), DOTOR(5)/ 46, 111, 1
     *14, 46, 10002/
       DATA DOTAND(1), DOTAND(2), DOTAND(3), DOTAND(4), DOTAND(5), DOTAN
     *D(6) /46, 97, 110, 100, 46, 10002/
       DATA DOTNOT(1), DOTNOT(2), DOTNOT(3), DOTNOT(4), DOTNOT(5), DOTNO
     *T(6) /46, 110, 111, 116, 46, 10002/
       IF(.NOT.(NGETCH(TOKEN(2), FD) .NE. 61))   GOTO 23351
       CALL PUTBAK(TOKEN(2))
23351  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 62))   GOTO 23353
       IF(.NOT.(TOKEN(2) .EQ. 61))   GOTO 23355
       CALL SCOPY(DOTGE, 1, TOKEN, 1)
       GOTO 23356
23355  CONTINUE
       CALL SCOPY(DOTGT, 1, TOKEN, 1)
23356  CONTINUE
       GOTO 23354
23353  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 60))   GOTO 23357
       IF(.NOT.(TOKEN(2) .EQ. 61))   GOTO 23359
       CALL SCOPY(DOTLE, 1, TOKEN, 1)
       GOTO 23360
23359  CONTINUE
       CALL SCOPY(DOTLT, 1, TOKEN, 1)
23360  CONTINUE
       GOTO 23358
23357  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 33))   GOTO 23361
       IF(.NOT.(TOKEN(2) .EQ. 61))   GOTO 23363
       CALL SCOPY(DOTNE, 1, TOKEN, 1)
       GOTO 23364
23363  CONTINUE
       CALL SCOPY(DOTNOT, 1, TOKEN, 1)
23364  CONTINUE
       GOTO 23362
23361  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 61))   GOTO 23365
       IF(.NOT.(TOKEN(2) .EQ. 61))   GOTO 23367
       CALL SCOPY(DOTEQ, 1, TOKEN, 1)
       GOTO 23368
23367  CONTINUE
       TOKEN(2) = 10002
23368  CONTINUE
       GOTO 23366
23365  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 38))   GOTO 23369
       CALL SCOPY(DOTAND, 1, TOKEN, 1)
       GOTO 23370
23369  CONTINUE
       IF(.NOT.(TOKEN(1) .EQ. 124))  GOTO 23371
       CALL SCOPY(DOTOR, 1, TOKEN, 1)
       GOTO 23372
23371  CONTINUE
       TOKEN(2) = 10002
23372  CONTINUE
23370  CONTINUE
23366  CONTINUE
23362  CONTINUE
23358  CONTINUE
23354  CONTINUE
       LAST = LENGTH(TOKEN)
       RETURN
       END
C
C REMARK - PRINT WARNING MESSAGE
C
       SUBROUTINE REMARK(BUF)
       INTEGER BUF(100), I
       WRITE(6, 10) (BUF(I), I = 1, 5)
10        FORMAT(5A4)
       RETURN
       END
C
C REPCOD - GENERATE CODE FOR BEGINNING OF REPEAT
C
       SUBROUTINE REPCOD(LAB)
       INTEGER LABGEN
       INTEGER LAB
       CALL OUTCON(0)
       LAB = LABGEN(3)
       CALL OUTCON(LAB)
       LAB = LAB + 1
       RETURN
       END
C
C SCOPY - COPY STRING AT FROM(I) TO TO(J)
C
       SUBROUTINE SCOPY(FROM, I, TO, J)
       INTEGER FROM(100), TO(100)
       INTEGER I, J, K1, K2
       K2 = J
       CONTINUE
       K1 = I
23373  IF(.NOT.( FROM(K1) .NE. 10002))  GOTO 23375
       TO(K2) = FROM(K1)
       K2 = K2 + 1
23374   K1 = K1 + 1
       GOTO 23373
23375  CONTINUE
       TO(K2) = 10002
       RETURN
       END
C
C SYNERR - REPORT RATFOR SYNTAX ERROR
C
       SUBROUTINE SYNERR(MSG)
       INTEGER LC(81), MSG(81)
       INTEGER ITOC
       INTEGER I, JUNK
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       CALL REMARK(14HERROR AT LINE.)
       CONTINUE
       I = 1
23376  IF(.NOT.( I .LE. LEVEL))   GOTO 23378
       CALL PUTCH(32, 6)
       JUNK = ITOC(LINECT(I), LC, 81)
       CALL PUTLIN(LC, 6)
23377   I = I + 1
       GOTO 23376
23378  CONTINUE
       CALL PUTCH(58, 6)
       CALL PUTCH(10, 6)
       CALL REMARK(MSG)
       RETURN
       END
C
C TYPE - RETURN LETTER, DIGIT OR CHARACTER
C
       INTEGER FUNCTION TYPE(C)
       INTEGER C
       IF(.NOT.( C .GE. 48 .AND. C .LE. 57 )) GOTO 23379
       TYPE = 2
       GOTO 23380
23379  CONTINUE
       IF(.NOT.( C .GE. 97 .AND. C .LE. 122 ))   GOTO 23381
       TYPE = 1
       GOTO 23382
23381  CONTINUE
       IF(.NOT.( C .GE. 65 .AND. C .LE. 90 )) GOTO 23383
       TYPE = 1
       GOTO 23384
23383  CONTINUE
       TYPE = C
23384  CONTINUE
23382  CONTINUE
23380  CONTINUE
       RETURN
       END
C
C UNSTAK - UNSTACK AT END OF STATEMENT
C
       SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
       INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
       CONTINUE
23385  IF(.NOT.( SP .GT. 1))   GOTO 23387
       IF(.NOT.(LEXTYP(SP) .EQ. 123))   GOTO 23388
       GOTO 23387
23388  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10261 .AND. TOKEN .EQ. 10262))  GOTO 233
     *90
       GOTO 23387
23390  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10261)) GOTO 23392
       CALL OUTCON(LABVAL(SP))
       GOTO 23393
23392  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10262)) GOTO 23394
       IF(.NOT.(SP .GT. 2)) GOTO 23396
       SP = SP - 1
23396  CONTINUE
       CALL OUTCON(LABVAL(SP)+1)
       GOTO 23395
23394  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10266)) GOTO 23398
       CALL DOSTAT(LABVAL(SP))
       GOTO 23399
23398  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10263)) GOTO 23400
       CALL WHILES(LABVAL(SP))
       GOTO 23401
23400  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10268)) GOTO 23402
       CALL FORS(LABVAL(SP))
       GOTO 23403
23402  CONTINUE
       IF(.NOT.(LEXTYP(SP) .EQ. 10269)) GOTO 23404
       CALL UNTILS(LABVAL(SP), TOKEN)
23404  CONTINUE
23403  CONTINUE
23401  CONTINUE
23399  CONTINUE
23395  CONTINUE
23393  CONTINUE
23386   SP = SP - 1
       GOTO 23385
23387  CONTINUE
       RETURN
       END
C
C UNTILS - GENERATE CODE FOR UNTIL OR END OF REPEAT
C
       SUBROUTINE UNTILS(LAB, TOKEN)
       INTEGER PTOKEN(200)
       INTEGER LEX
       INTEGER JUNK, LAB, TOKEN
       CALL OUTNUM(LAB)
       IF(.NOT.(TOKEN .EQ. 10270))   GOTO 23406
       JUNK = LEX(PTOKEN)
       CALL IFGO(LAB-1)
       GOTO 23407
23406  CONTINUE
       CALL OUTGO(LAB-1)
23407  CONTINUE
       CALL OUTCON(LAB+1)
       RETURN
       END
C
C WHILEC - GENERATE CODE FOR BEGINNING OF WHILE
C
       SUBROUTINE WHILEC(LAB)
       INTEGER LABGEN
       INTEGER LAB
       CALL OUTCON(0)
       LAB = LABGEN(2)
       CALL OUTNUM(LAB)
       CALL IFGO(LAB+1)
       RETURN
       END
C
C WHILES - GENERATE CODE FOR END OF WHILE
C
       SUBROUTINE WHILES(LAB)
       INTEGER LAB
       CALL OUTGO(LAB)
       CALL OUTCON(LAB+1)
       RETURN
       END