      CALL PARSE
      CALL EXIT
      STOP
      END
      BLOCK DATA
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      DATA FDTAB(1) /1/
      DATA FILTAB(1), FILTAB(2), FILTAB(3), FILTAB(4), FILTAB(5)/ 1, 0,
     *0, 5, 0/
      DATA FDTAB(2) /141/
      DATA FILTAB(141), FILTAB(142), FILTAB(143), FILTAB(144), FILTAB(14
     *5)/ 1, 1, 0, 6, 146/
      DATA FDTAB(3) /281/
      DATA FILTAB(281), FILTAB(282), FILTAB(283), FILTAB(284), FILTAB(28
     *5)/ 1, 1, 0, 6, 286/
      DATA FDTAB(4) /0/
      DATA FILTAB(421) /0/
      DATA FDTAB(5) /0/
      DATA FILTAB(561) /0/
      DATA FDTAB(6) /0/
      DATA FILTAB(701) /0/
      DATA FDTAB(7) /0/
      DATA FILTAB(841) /0/
      DATA FDTAB(8) /0/
      DATA FILTAB(981) /0/
      DATA EXTCHR( 1) /1H /, INTCHR( 1) /32/
      DATA EXTCHR( 2) /1H0/, INTCHR( 2) /48/
      DATA EXTCHR( 3) /1H1/, INTCHR( 3) /49/
      DATA EXTCHR( 4) /1H2/, INTCHR( 4) /50/
      DATA EXTCHR( 5) /1H3/, INTCHR( 5) /51/
      DATA EXTCHR( 6) /1H4/, INTCHR( 6) /52/
      DATA EXTCHR( 7) /1H5/, INTCHR( 7) /53/
      DATA EXTCHR( 8) /1H6/, INTCHR( 8) /54/
      DATA EXTCHR( 9) /1H7/, INTCHR( 9) /55/
      DATA EXTCHR(10) /1H8/, INTCHR(10) /56/
      DATA EXTCHR(11) /1H9/, INTCHR(11) /57/
      DATA EXTCHR(12) /1HA/, INTCHR(12) /97/
      DATA EXTCHR(13) /1HB/, INTCHR(13) /98/
      DATA EXTCHR(14) /1HC/, INTCHR(14) /99/
      DATA EXTCHR(15) /1HD/, INTCHR(15) /100/
      DATA EXTCHR(16) /1HE/, INTCHR(16) /101/
      DATA EXTCHR(17) /1HF/, INTCHR(17) /102/
      DATA EXTCHR(18) /1HG/, INTCHR(18) /103/
      DATA EXTCHR(19) /1HH/, INTCHR(19) /104/
      DATA EXTCHR(20) /1HI/, INTCHR(20) /105/
      DATA EXTCHR(21) /1HJ/, INTCHR(21) /106/
      DATA EXTCHR(22) /1HK/, INTCHR(22) /107/
      DATA EXTCHR(23) /1HL/, INTCHR(23) /108/
      DATA EXTCHR(24) /1HM/, INTCHR(24) /109/
      DATA EXTCHR(25) /1HN/, INTCHR(25) /110/
      DATA EXTCHR(26) /1HO/, INTCHR(26) /111/
      DATA EXTCHR(27) /1HP/, INTCHR(27) /112/
      DATA EXTCHR(28) /1HQ/, INTCHR(28) /113/
      DATA EXTCHR(29) /1HR/, INTCHR(29) /114/
      DATA EXTCHR(30) /1HS/, INTCHR(30) /115/
      DATA EXTCHR(31) /1HT/, INTCHR(31) /116/
      DATA EXTCHR(32) /1HU/, INTCHR(32) /117/
      DATA EXTCHR(33) /1HV/, INTCHR(33) /118/
      DATA EXTCHR(34) /1HW/, INTCHR(34) /119/
      DATA EXTCHR(35) /1HX/, INTCHR(35) /120/
      DATA EXTCHR(36) /1HY/, INTCHR(36) /121/
      DATA EXTCHR(37) /1HZ/, INTCHR(37) /122/
      DATA EXTCHR(38) /1HA/, INTCHR(38) /65/
      DATA EXTCHR(39) /1HB/, INTCHR(39) /66/
      DATA EXTCHR(40) /1HC/, INTCHR(40) /67/
      DATA EXTCHR(41) /1HD/, INTCHR(41) /68/
      DATA EXTCHR(42) /1HE/, INTCHR(42) /69/
      DATA EXTCHR(43) /1HF/, INTCHR(43) /70/
      DATA EXTCHR(44) /1HG/, INTCHR(44) /71/
      DATA EXTCHR(45) /1HH/, INTCHR(45) /72/
      DATA EXTCHR(46) /1HI/, INTCHR(46) /73/
      DATA EXTCHR(47) /1HJ/, INTCHR(47) /74/
      DATA EXTCHR(48) /1HK/, INTCHR(48) /75/
      DATA EXTCHR(49) /1HL/, INTCHR(49) /76/
      DATA EXTCHR(50) /1HM/, INTCHR(50) /77/
      DATA EXTCHR(51) /1HN/, INTCHR(51) /78/
      DATA EXTCHR(52) /1HO/, INTCHR(52) /79/
      DATA EXTCHR(53) /1HP/, INTCHR(53) /80/
      DATA EXTCHR(54) /1HQ/, INTCHR(54) /81/
      DATA EXTCHR(55) /1HR/, INTCHR(55) /82/
      DATA EXTCHR(56) /1HS/, INTCHR(56) /83/
      DATA EXTCHR(57) /1HT/, INTCHR(57) /84/
      DATA EXTCHR(58) /1HU/, INTCHR(58) /85/
      DATA EXTCHR(59) /1HV/, INTCHR(59) /86/
      DATA EXTCHR(60) /1HW/, INTCHR(60) /87/
      DATA EXTCHR(61) /1HX/, INTCHR(61) /88/
      DATA EXTCHR(62) /1HY/, INTCHR(62) /89/
      DATA EXTCHR(63) /1HZ/, INTCHR(63) /90/
      DATA EXTCHR(64) /1H!/, INTCHR(64) /33/
      DATA EXTCHR(65) /1H"/, INTCHR(65) /34/
      DATA EXTCHR(66) /1H#/, INTCHR(66) /35/
      DATA EXTCHR(67) /1H$/, INTCHR(67) /36/
      DATA EXTCHR(68) /1H%/, INTCHR(68) /37/
      DATA EXTCHR(69) /1H&/, INTCHR(69) /38/
      DATA EXTCHR(70) /1H'/, INTCHR(70) /39/
      DATA EXTCHR(71) /1H(/, INTCHR(71) /40/
      DATA EXTCHR(72) /1H)/, INTCHR(72) /41/
      DATA EXTCHR(73) /1H*/, INTCHR(73) /42/
      DATA EXTCHR(74) /1H+/, INTCHR(74) /43/
      DATA EXTCHR(75) /1H,/, INTCHR(75) /44/
      DATA EXTCHR(76) /1H-/, INTCHR(76) /45/
      DATA EXTCHR(77) /1H./, INTCHR(77) /46/
      DATA EXTCHR(78) /1H//, INTCHR(78) /47/
      DATA EXTCHR(79) /1H:/, INTCHR(79) /58/
      DATA EXTCHR(80) /1H;/, INTCHR(80) /59/
      DATA EXTCHR(81) /1H</, INTCHR(81) /60/
      DATA EXTCHR(82) /1H=/, INTCHR(82) /61/
      DATA EXTCHR(83) /1H>/, INTCHR(83) /62/
      DATA EXTCHR(84) /1H?/, INTCHR(84) /63/
      DATA EXTCHR(85) /1H@/, INTCHR(85) /64/
      DATA EXTCHR(86) /1H[/, INTCHR(86) /91/
      DATA EXTCHR(87) /1H\/, INTCHR(87) /92/
      DATA EXTCHR(88) /1H]/, INTCHR(88) /93/
      DATA EXTCHR(89) /1H_/, INTCHR(89) /95/
      DATA EXTCHR(90) /1H</, INTCHR(90) /123/
      DATA EXTCHR(91) /1H\/, INTCHR(91) /124/
      DATA EXTCHR(92) /1H!/, INTCHR(92) /125/
      DATA EXTCHR(93) /1H6/, INTCHR(93) /8/
      DATA EXTCHR(94) /1H%/, INTCHR(94) /9/
      DATA EXTCHR(95) /1H^/, INTCHR(95) /94/
      DATA EXTCHR(96) /1H^/, INTCHR(96) /126/
      END
      SUBROUTINE CLOSE(FD)
      INTEGER FD
      INTEGER I, K
      INTEGER WRLIN, OUTMAP
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      I = FDTAB(FD+1)
      IF(.NOT.(I .EQ. 0))GOTO 23000
      RETURN
23000 CONTINUE
      FILTAB(I+0) = FILTAB(I+0) - 1
      IF(.NOT.(FILTAB(I+0) .LE. 0))GOTO 23002
      IF(.NOT.(FILTAB(I+1) .EQ. 1 .AND. FILTAB(I+4) .GT. I + 5))GOTO 230
     *04
      K = FILTAB(I+4)
      J = I + 5
23006 IF(.NOT.(J .LT. K))GOTO 23008
      FILTAB(J) = OUTMAP(FILTAB(J))
23007 J = J + 1
      GOTO 23006
23008 CONTINUE
      K = WRLIN(FILTAB(I+5), K - (I + 5), FILTAB(I+3))
      FILTAB(I+4) = I + 5
23004 CONTINUE
      CALL CLSFIL(FILTAB(I+3), FILTAB(I+1))
23002 CONTINUE
      FDTAB(FD+1) = 0
      RETURN
      END
      SUBROUTINE CLSFIL(UNIT, MD)
      INTEGER UNIT, MD
      REWIND UNIT
      RETURN
      END
      INTEGER FUNCTION CREATE(NAME, MD)
      INTEGER NAME(30)
      INTEGER MD
      INTEGER OPEN
      CREATE = OPEN(NAME, MD)
      RETURN
      END
      INTEGER FUNCTION DUP(FD)
      INTEGER FD
      INTEGER I
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      DUP = 0
23009 IF(.NOT.(DUP .LT. 8))GOTO 23011
      IF(.NOT.(FDTAB(DUP+1) .EQ. 0))GOTO 23012
      GOTO 23011
23012 CONTINUE
23010 DUP = DUP + 1
      GOTO 23009
23011 CONTINUE
      IF(.NOT.(DUP .GE. 8))GOTO 23014
      DUP = 10001
      GOTO 23015
23014 CONTINUE
      FDTAB(DUP+1) = FDTAB(FD+1)
      I = FDTAB(DUP+1)
      FILTAB(I+0) = FILTAB(I+0) + 1
23015 CONTINUE
      RETURN
      END
      SUBROUTINE ERROR(MSG)
      INTEGER MSG(80)
      CALL REMARK(MSG)
      CALL EXIT
      RETURN
      END
      SUBROUTINE EXIT
      INTEGER FD
      FD = 0
23016 IF(.NOT.(FD .LT. 8))GOTO 23018
      CALL CLOSE(FD)
23017 FD = FD + 1
      GOTO 23016
23018 CONTINUE
      STOP
      RETURN
      END
      INTEGER FUNCTION GETCH(C, FD)
      INTEGER C
      INTEGER INMAP
      INTEGER FD, I, J, K, N
      INTEGER RDLIN
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      I = FDTAB(FD+1)
      IF(.NOT.(FILTAB(I+1) .NE. 0))GOTO 23019
      CALL ERROR(42H INPUT ERROR: FILE NOT OPENED FOR READING.)
23019 CONTINUE
      IF(.NOT.(FILTAB(I+2) .EQ. 1))GOTO 23021
      GO TO 10
23021 CONTINUE
      K = FILTAB(I+4)
      IF(.NOT.(K .EQ. 0))GOTO 23023
      N = FILTAB(I+3)
      K = RDLIN(FILTAB(I+5), N)
      IF(.NOT.(K .EQ. 10003))GOTO 23025
      GO TO 10
      GOTO 23026
23025 CONTINUE
      IF(.NOT.(K .EQ. 10001))GOTO 23027
      CALL ERROR(13H INPUT ERROR.)
23027 CONTINUE
23026 CONTINUE
      J = I + 5 + K
      FILTAB(J) = 10
      J = I + 5
23029 IF(.NOT.(K .GT. 0))GOTO 23031
      FILTAB(J) = INMAP(FILTAB(J))
      K = K - 1
23030 J = J + 1
      GOTO 23029
23031 CONTINUE
      K = I + 5
      FILTAB(I+4) = K
23023 CONTINUE
      C = FILTAB(K)
      GETCH = C
      IF(.NOT.(C .EQ. 10))GOTO 23032
      FILTAB(I+4) = 0
      GOTO 23033
23032 CONTINUE
      FILTAB(I+4) = K + 1
23033 CONTINUE
      RETURN
10    FILTAB(I+2) = 1
      C = 10003
      GETCH = 10003
      RETURN
      END
      INTEGER FUNCTION INMAP(C)
      INTEGER C
      INTEGER I
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      DO23034 I = 1, 96
      IF(.NOT.(C .EQ. EXTCHR(I)))GOTO 23036
      INMAP = INTCHR(I)
      RETURN
23036 CONTINUE
23034 CONTINUE
23035 CONTINUE
      INMAP = C
      RETURN
      END
      INTEGER FUNCTION OPEN(NAME, MD)
      INTEGER NAME(30)
      INTEGER MD
      INTEGER FD, I
      INTEGER OPNFIL
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      OPEN = 10001
      FD = 0
23038 IF(.NOT.(FD .LT. 8))GOTO 23040
      IF(.NOT.(FDTAB(FD+1) .EQ. 0))GOTO 23041
      GOTO 23040
23041 CONTINUE
23039 FD = FD + 1
      GOTO 23038
23040 CONTINUE
      IF(.NOT.(FD .GE. 8))GOTO 23043
      RETURN
23043 CONTINUE
      I = 1
23045 IF(.NOT.(I .LT. 140*8))GOTO 23047
      IF(.NOT.(FILTAB(I+0) .EQ. 0))GOTO 23048
      GOTO 23047
23048 CONTINUE
23046 I = I + 140
      GOTO 23045
23047 CONTINUE
      IF(.NOT.(I .GE. 140*8))GOTO 23050
      RETURN
23050 CONTINUE
      FILTAB(I+3) = OPNFIL(NAME, MD, FD)
      IF(.NOT.(FILTAB(I+3) .EQ. 10001))GOTO 23052
      RETURN
23052 CONTINUE
      FILTAB(I+0) = 1
      FILTAB(I+1) = MD
      FILTAB(I+2) = 0
      IF(.NOT.(MD .EQ. 0))GOTO 23054
      FILTAB(I+4) = 0
      GOTO 23055
23054 CONTINUE
      FILTAB(I+4) = I + 5
23055 CONTINUE
      FDTAB(FD+1) = I
      OPEN = FD
      RETURN
      END
      INTEGER FUNCTION OPNFIL(NAME, MODE, FD)
      INTEGER NAME(30)
      INTEGER MODE, FD
      INTEGER I
      INTEGER CTOI
      I = 1
      OPNFIL=(CTOI(NAME, I))
      RETURN
      END
      INTEGER FUNCTION OUTMAP(C)
      INTEGER C
      INTEGER I
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      DO23056 I = 1, 96
      IF(.NOT.(C .EQ. INTCHR(I)))GOTO 23058
      OUTMAP = EXTCHR(I)
      RETURN
23058 CONTINUE
23056 CONTINUE
23057 CONTINUE
      OUTMAP = C
      RETURN
      END
      SUBROUTINE PUTCH(C, FD)
      INTEGER C
      INTEGER FD
      INTEGER I, J, K
      INTEGER OUTMAP, WRLIN
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      I = FDTAB(FD+1)
      IF(.NOT.(FILTAB(I+1) .NE. 1))GOTO 23060
      CALL ERROR(43H OUTPUT ERROR: FILE NOT OPENED FOR WRITING.)
23060 CONTINUE
      K = FILTAB(I+4)
      IF(.NOT.(C .EQ. 10 .OR. K .GT. I + 5 + 132 - 1))GOTO 23062
      J = I + 5
23064 IF(.NOT.(J .LT. K))GOTO 23066
      FILTAB(J) = OUTMAP(FILTAB(J))
23065 J = J + 1
      GOTO 23064
23066 CONTINUE
      IF(.NOT.(WRLIN(FILTAB(I+5), K - (I + 5), FILTAB(I+3)) .EQ. 10001))
     *GOTO 23067
      CALL ERROR(14H OUTPUT ERROR.)
23067 CONTINUE
      FILTAB(I+4) = I + 5
      GOTO 23063
23062 CONTINUE
      FILTAB(K) = C
      FILTAB(I+4) = K + 1
23063 CONTINUE
      RETURN
      END
      INTEGER FUNCTION RDLIN(BUF, N)
      INTEGER BUF(80), N
      INTEGER EXTBLK
      INTEGER I
      DATA EXTBLK /1H /
      READ(N, 100, END=10) BUF
100   FORMAT(80 A1)
      RDLIN = 80
23069 IF(.NOT.(RDLIN .GT. 0))GOTO 23071
      IF(.NOT.(BUF(RDLIN) .NE. EXTBLK))GOTO 23072
      GOTO 23071
23072 CONTINUE
23070 RDLIN = RDLIN - 1
      GOTO 23069
23071 CONTINUE
      RETURN
10    RDLIN = 10003
      RETURN
      END
      SUBROUTINE REMARK(BUF)
      INTEGER BUF(132)
      INTEGER I, N
      COMMON /CRATIO/ FDTAB(8), FILTAB(1120), EXTCHR(96), INTCHR(96)
      INTEGER FDTAB
      INTEGER FILTAB
      INTEGER EXTCHR
      INTEGER INTCHR
      I = 2
      I = FDTAB(I+1)
      N = FILTAB(I+3)
      WRITE(N, 10) (BUF(I), I = 1, 10)
10    FORMAT(10A 5)
      RETURN
      END
      SUBROUTINE REMOVE(NAME)
      INTEGER NAME(30)
      RETURN
      END
      INTEGER FUNCTION WRLIN(BUF, K, N)
      INTEGER BUF(132), K, N
      INTEGER I
      IF(.NOT.(K .GT. 0))GOTO 23074
      WRITE(N, 100) (BUF(I), I = 1, K)
100   FORMAT(132 A1)
      GOTO 23075
23074 CONTINUE
      WRITE(N, 200)
200   FORMAT(/)
23075 CONTINUE
      WRLIN = 0
      RETURN
      END
      SUBROUTINE ADDCHR(C, BUF, BP, MAXSIZ)
      INTEGER BP, MAXSIZ
      INTEGER C, BUF(100)
      IF(.NOT.(BP .GT. MAXSIZ))GOTO 23000
      CALL BADERR(16HBUFFER OVERFLOW.)
23000 CONTINUE
      BUF(BP) = C
      BP = BP + 1
      RETURN
      END
      SUBROUTINE ADDSTR(S, BUF, BP, MAXSIZ)
      INTEGER S(100), BUF(100)
      INTEGER BP, MAXSIZ
      INTEGER I
      I = 1
23002 IF(.NOT.(S(I) .NE. 10002))GOTO 23004
      CALL ADDCHR(S(I), BUF, BP, MAXSIZ)
23003 I = I + 1
      GOTO 23002
23004 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ALLDIG(STR)
      INTEGER TYPE
      INTEGER STR(100)
      INTEGER I
      ALLDIG = 0
      IF(.NOT.(STR(1) .EQ. 10002))GOTO 23005
      RETURN
23005 CONTINUE
      I = 1
23007 IF(.NOT.(STR(I) .NE. 10002))GOTO 23009
      IF(.NOT.(TYPE(STR(I)) .NE. 2))GOTO 23010
      RETURN
23010 CONTINUE
23008 I = I + 1
      GOTO 23007
23009 CONTINUE
      ALLDIG = 1
      RETURN
      END
      SUBROUTINE BADERR(MSG)
      INTEGER MSG(100)
      CALL SYNERR(MSG)
      CALL EXIT
      RETURN
      END
      SUBROUTINE BALPAR
      INTEGER GETTOK, GNBTOK
      INTEGER T, TOKEN(200)
      INTEGER NLPAR
      IF(.NOT.(GNBTOK(TOKEN, 200) .NE. 40))GOTO 23012
      CALL SYNERR(19HMISSING LEFT PAREN.)
      RETURN
23012 CONTINUE
      CALL OUTSTR(TOKEN)
      NLPAR = 1
23014 CONTINUE
      T = GETTOK(TOKEN, 200)
      IF(.NOT.(T.EQ.59 .OR. T.EQ.123 .OR. T.EQ.125 .OR. T.EQ.10003))GOTO
     * 23017
      CALL PBSTR(TOKEN)
      GOTO 23016
23017 CONTINUE
      IF(.NOT.(T .EQ. 10))GOTO 23019
      TOKEN(1) = 10002
      GOTO 23020
23019 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23021
      NLPAR = NLPAR + 1
      GOTO 23022
23021 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23023
      NLPAR = NLPAR - 1
23023 CONTINUE
23022 CONTINUE
23020 CONTINUE
      CALL OUTSTR(TOKEN)
23015 IF(.NOT.(NLPAR .LE. 0))GOTO 23014
23016 CONTINUE
      IF(.NOT.(NLPAR .NE. 0))GOTO 23025
      CALL SYNERR(33HMISSING PARENTHESIS IN CONDITION.)
23025 CONTINUE
      RETURN
      END
      SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
      INTEGER I, N, ALLDIG, CTOI
      INTEGER T, PTOKEN(200), GNBTOK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      N = 0
      T = GNBTOK(PTOKEN, 200)
      IF(.NOT.(ALLDIG(PTOKEN) .EQ. 1))GOTO 23027
      I = 1
      N = CTOI(PTOKEN, I) - 1
      GOTO 23028
23027 CONTINUE
      IF(.NOT.(T .NE. 59))GOTO 23029
      CALL PBSTR(PTOKEN)
23029 CONTINUE
23028 CONTINUE
      I = SP
23031 IF(.NOT.(I .GT. 0))GOTO 23033
      IF(.NOT.(LEXTYP(I) .EQ. 10263 .OR. LEXTYP(I) .EQ. 10266 .OR. LEXTY
     *P(I) .EQ. 10268 .OR. LEXTYP(I) .EQ. 10269))GOTO 23034
      IF(.NOT.(N .GT. 0))GOTO 23036
      N = N - 1
      GOTO 23032
23036 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10264))GOTO 23038
      CALL OUTGO(LABVAL(I)+1)
      GOTO 23039
23038 CONTINUE
      CALL OUTGO(LABVAL(I))
23039 CONTINUE
23037 CONTINUE
      XFER = 1
      RETURN
23034 CONTINUE
23032 I = I - 1
      GOTO 23031
23033 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10264))GOTO 23040
      CALL SYNERR(14HILLEGAL BREAK.)
      GOTO 23041
23040 CONTINUE
      CALL SYNERR(13HILLEGAL NEXT.)
23041 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CTOI(IN, I)
      INTEGER IN(100)
      INTEGER I
23042 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23043
      I = I + 1
      GOTO 23042
23043 CONTINUE
      CTOI = 0
23044 IF(.NOT.(IN(I) .NE. 10002))GOTO 23046
      IF(.NOT.(IN(I) .LT. 48 .OR. IN(I) .GT. 57))GOTO 23047
      GOTO 23046
23047 CONTINUE
      CTOI = 10 * CTOI + IN(I) - 48
23045 I = I + 1
      GOTO 23044
23046 CONTINUE
      RETURN
      END
      INTEGER FUNCTION DEFTOK(TOKEN, TOKSIZ, FD)
      INTEGER GTOK
      INTEGER FD, TOKSIZ
      INTEGER DEFN(200), T, TOKEN(200)
      INTEGER LOOKUP
      T=GTOK(TOKEN, TOKSIZ, FD)
23049 IF(.NOT.(T.NE.10003))GOTO 23051
      IF(.NOT.(T .NE. 10100))GOTO 23052
      GOTO 23051
23052 CONTINUE
      IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23054
      GOTO 23051
23054 CONTINUE
      IF(.NOT.(DEFN(1) .EQ. 10010))GOTO 23056
      CALL GETDEF(TOKEN, TOKSIZ, DEFN, 200, FD)
      CALL INSTAL(TOKEN, DEFN)
      GOTO 23057
23056 CONTINUE
      CALL PBSTR(DEFN)
23057 CONTINUE
23050 T=GTOK(TOKEN, TOKSIZ, FD)
      GOTO 23049
23051 CONTINUE
      DEFTOK = T
      IF(.NOT.(DEFTOK .EQ. 10100))GOTO 23058
      CALL FOLD(TOKEN)
23058 CONTINUE
      RETURN
      END
      SUBROUTINE FOLD(TOKEN)
      INTEGER TOKEN(100)
      INTEGER I
      I = 1
23060 IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23062
      IF(.NOT.(TOKEN(I) .GE. 65 .AND. TOKEN(I) .LE. 90))GOTO 23063
      TOKEN(I) = TOKEN(I) - 65 + 97
23063 CONTINUE
23061 I = I + 1
      GOTO 23060
23062 CONTINUE
      RETURN
      END
      SUBROUTINE DOCODE(LAB)
      INTEGER LABGEN
      INTEGER LAB
      COMMON /CGOTO/ XFER
      INTEGER XFER
      INTEGER SDO(3)
      DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/
      XFER = 0
      CALL OUTTAB
      CALL OUTSTR(SDO)
      LAB = LABGEN(2)
      CALL OUTNUM(LAB)
      CALL EATUP
      CALL OUTDON
      RETURN
      END
      SUBROUTINE DOSTAT(LAB)
      INTEGER LAB
      CALL OUTCON(LAB)
      CALL OUTCON(LAB+1)
      RETURN
      END
      SUBROUTINE EATUP
      INTEGER GETTOK
      INTEGER PTOKEN(200), T, TOKEN(200)
      INTEGER NLPAR
      NLPAR = 0
23065 CONTINUE
      T = GETTOK(TOKEN, 200)
      IF(.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23068
      GOTO 23067
23068 CONTINUE
      IF(.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23070
      CALL PBSTR(TOKEN)
      GOTO 23067
23070 CONTINUE
      IF(.NOT.(T .EQ. 10003))GOTO 23072
      CALL SYNERR(15HUNEXPECTED EOF.)
      CALL PBSTR(TOKEN)
      GOTO 23067
23072 CONTINUE
      IF(.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 .O
     *R. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T
     *.EQ. 61 .OR. T .EQ. 95 ))GOTO 23074
23076 IF(.NOT.(GETTOK(PTOKEN, 200) .EQ. 10))GOTO 23077
      GOTO 23076
23077 CONTINUE
      CALL PBSTR(PTOKEN)
      IF(.NOT.(T .EQ. 95))GOTO 23078
      TOKEN(1) = 10002
23078 CONTINUE
23074 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23080
      NLPAR = NLPAR + 1
      GOTO 23081
23080 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23082
      NLPAR = NLPAR - 1
23082 CONTINUE
23081 CONTINUE
      CALL OUTSTR(TOKEN)
23066 IF(.NOT.(NLPAR .LT. 0))GOTO 23065
23067 CONTINUE
      IF(.NOT.(NLPAR .NE. 0))GOTO 23084
      CALL SYNERR(23HUNBALANCED PARENTHESES.)
23084 CONTINUE
      RETURN
      END
      SUBROUTINE ELSEIF(LAB)
      INTEGER LAB
      CALL OUTGO(LAB+1)
      CALL OUTCON(LAB)
      RETURN
      END
      INTEGER FUNCTION EQUAL(STR1, STR2)
      INTEGER STR1(100), STR2(100)
      INTEGER I
      I = 1
23086 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23088
      IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23089
      EQUAL = 1
      RETURN
23089 CONTINUE
23087 I = I + 1
      GOTO 23086
23088 CONTINUE
      EQUAL = 0
      RETURN
      END
      SUBROUTINE FORCOD(LAB)
      INTEGER GETTOK, GNBTOK
      INTEGER T, TOKEN(200)
      INTEGER LENGTH, LABGEN
      INTEGER I, J, LAB, NLPAR
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      INTEGER FORSTK
      INTEGER IFNOT(9)
      DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5
     *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/
      LAB = LABGEN(3)
      CALL OUTCON(0)
      IF(.NOT.(GNBTOK(TOKEN, 200) .NE. 40))GOTO 23091
      CALL SYNERR(19HMISSING LEFT PAREN.)
      RETURN
23091 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 200) .NE. 59))GOTO 23093
      CALL PBSTR(TOKEN)
      CALL OUTTAB
      CALL EATUP
      CALL OUTDON
23093 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 200) .EQ. 59))GOTO 23095
      CALL OUTCON(LAB)
      GOTO 23096
23095 CONTINUE
      CALL PBSTR(TOKEN)
      CALL OUTNUM(LAB)
      CALL OUTTAB
      CALL OUTSTR(IFNOT)
      CALL OUTCH(40)
      NLPAR = 0
23097 IF(.NOT.(NLPAR .GE. 0))GOTO 23098
      T = GETTOK(TOKEN, 200)
      IF(.NOT.(T .EQ. 59))GOTO 23099
      GOTO 23098
23099 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23101
      NLPAR = NLPAR + 1
      GOTO 23102
23101 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23103
      NLPAR = NLPAR - 1
23103 CONTINUE
23102 CONTINUE
      IF(.NOT.(T .EQ. 10003))GOTO 23105
      CALL PBSTR(TOKEN)
      RETURN
23105 CONTINUE
      IF(.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23107
      CALL OUTSTR(TOKEN)
23107 CONTINUE
      GOTO 23097
23098 CONTINUE
      CALL OUTCH(41)
      CALL OUTCH(41)
      CALL OUTGO(LAB+2)
      IF(.NOT.(NLPAR .LT. 0))GOTO 23109
      CALL SYNERR(19HINVALID FOR CLAUSE.)
23109 CONTINUE
23096 CONTINUE
      FORDEP = FORDEP + 1
      J = 1
      I = 1
23111 IF(.NOT.(I .LT. FORDEP))GOTO 23113
      J = J + LENGTH(FORSTK(J)) + 1
23112 I = I + 1
      GOTO 23111
23113 CONTINUE
      FORSTK(J) = 10002
      NLPAR = 0
      T = GNBTOK(TOKEN, 200)
      CALL PBSTR(TOKEN)
23114 IF(.NOT.(NLPAR .GE. 0))GOTO 23115
      T = GETTOK(TOKEN, 200)
      IF(.NOT.(T .EQ. 40))GOTO 23116
      NLPAR = NLPAR + 1
      GOTO 23117
23116 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23118
      NLPAR = NLPAR - 1
23118 CONTINUE
23117 CONTINUE
      IF(.NOT.(T .EQ. 10003))GOTO 23120
      CALL PBSTR(TOKEN)
      GOTO 23115
23120 CONTINUE
      IF(.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))GOTO 23122
      IF(.NOT.(J + LENGTH(TOKEN) .GE. 200))GOTO 23124
      CALL BADERR(20HFOR CLAUSE TOO LONG.)
23124 CONTINUE
      CALL SCOPY(TOKEN, 1, FORSTK, J)
      J = J + LENGTH(TOKEN)
23122 CONTINUE
      GOTO 23114
23115 CONTINUE
      LAB = LAB + 1
      RETURN
      END
      SUBROUTINE FORS(LAB)
      INTEGER LENGTH
      INTEGER I, J, LAB
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      INTEGER FORSTK
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTNUM(LAB)
      J = 1
      I = 1
23126 IF(.NOT.(I .LT. FORDEP))GOTO 23128
      J = J + LENGTH(FORSTK(J)) + 1
23127 I = I + 1
      GOTO 23126
23128 CONTINUE
      IF(.NOT.(LENGTH(FORSTK(J)) .GT. 0))GOTO 23129
      CALL OUTTAB
      CALL OUTSTR(FORSTK(J))
      CALL OUTDON
23129 CONTINUE
      CALL OUTGO(LAB-1)
      CALL OUTCON(LAB+1)
      FORDEP = FORDEP - 1
      RETURN
      END
      SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD)
      INTEGER GTOK, NGETCH
      INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ
      INTEGER C, DEFN(200), TOKEN(200), T, PTOKEN(200)
      CALL SKPBLK(FD)
      C = GTOK(PTOKEN, 200, FD)
      IF(.NOT.(C .EQ. 40))GOTO 23131
      T = 40
      GOTO 23132
23131 CONTINUE
      T = 32
      CALL PBSTR(PTOKEN)
23132 CONTINUE
      CALL SKPBLK(FD)
      IF(.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. 10100))GOTO 23133
      CALL BADERR(22HNON-ALPHANUMERIC NAME.)
23133 CONTINUE
      CALL SKPBLK(FD)
      C = GTOK(PTOKEN, 200, FD)
      IF(.NOT.(T .EQ. 32))GOTO 23135
      CALL PBSTR(PTOKEN)
      I = 1
23137 CONTINUE
      C = NGETCH(C, FD)
      IF(.NOT.(I .GT. DEFSIZ))GOTO 23140
      CALL BADERR(20HDEFINITION TOO LONG.)
23140 CONTINUE
      DEFN(I) = C
      I = I + 1
23138 IF(.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. 10003))GOTO 23137
23139 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23142
      CALL PUTBAK(C)
23142 CONTINUE
      GOTO 23136
23135 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23144
      IF(.NOT.(C .NE. 44))GOTO 23146
      CALL BADERR(24HMISSING COMMA IN DEFINE.)
23146 CONTINUE
      NLPAR = 0
      I = 1
23148 IF(.NOT.(NLPAR .GE. 0))GOTO 23150
      IF(.NOT.(I .GT. DEFSIZ))GOTO 23151
      CALL BADERR(20HDEFINITION TOO LONG.)
      GOTO 23152
23151 CONTINUE
      IF(.NOT.(NGETCH(DEFN(I), FD) .EQ. 10003))GOTO 23153
      CALL BADERR(20HMISSING RIGHT PAREN.)
      GOTO 23154
23153 CONTINUE
      IF(.NOT.(DEFN(I) .EQ. 40))GOTO 23155
      NLPAR = NLPAR + 1
      GOTO 23156
23155 CONTINUE
      IF(.NOT.(DEFN(I) .EQ. 41))GOTO 23157
      NLPAR = NLPAR - 1
23157 CONTINUE
23156 CONTINUE
23154 CONTINUE
23152 CONTINUE
23149 I = I + 1
      GOTO 23148
23150 CONTINUE
      GOTO 23145
23144 CONTINUE
      CALL BADERR(19HGETDEF IS CONFUSED.)
23145 CONTINUE
23136 CONTINUE
      DEFN(I-1) = 10002
      RETURN
      END
      INTEGER FUNCTION GETTOK(TOKEN, TOKSIZ)
      INTEGER EQUAL, OPEN, LENGTH
      INTEGER T, I, TOKSIZ, F
      INTEGER DEFTOK
      INTEGER NAME(30), TOKEN(200)
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      COMMON /CFNAME/ FCNAME(30)
      INTEGER FCNAME
      INTEGER FNCN(9)
      INTEGER INCL(8)
      DATA FNCN(1)/102/,FNCN(2)/117/,FNCN(3)/110/,FNCN(4)/99/,FNCN(5)/11
     *6/,FNCN(6)/105/,FNCN(7)/111/,FNCN(8)/110/,FNCN(9)/10002/
      DATA INCL(1)/105/,INCL(2)/110/,INCL(3)/99/,INCL(4)/108/,INCL(5)/11
     *7/,INCL(6)/100/,INCL(7)/101/,INCL(8)/10002/
23159 IF(.NOT.(LEVEL .GT. 0))GOTO 23161
      F = INFILE(LEVEL)
      GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
23162 IF(.NOT.(GETTOK .NE. 10003))GOTO 23164
      IF(.NOT.(EQUAL(TOKEN, FNCN) .EQ. 1))GOTO 23165
      CALL SKPBLK(INFILE(LEVEL))
      T = DEFTOK(FCNAME, 30, F)
      CALL PBSTR(FCNAME)
      IF(.NOT.(T .NE. 10100))GOTO 23167
      CALL SYNERR(22HMISSING FUNCTION NAME.)
23167 CONTINUE
      CALL PUTBAK(32)
      RETURN
23165 CONTINUE
      IF(.NOT.(EQUAL(TOKEN, INCL) .EQ. 0))GOTO 23169
      RETURN
23169 CONTINUE
23166 CONTINUE
      CALL SKPBLK(INFILE(LEVEL))
      I = 1
23171 CONTINUE
      T = DEFTOK(NAME(I), 30, F)
      IF(.NOT.(T .EQ. 10 .OR. T .EQ. 59))GOTO 23174
      CALL PBSTR(NAME(I))
      GOTO 23173
23174 CONTINUE
23172 I = LENGTH(NAME) + 1
      GOTO 23171
23173 CONTINUE
      NAME(I) = 10002
      IF(.NOT.(LEVEL .GE. 5))GOTO 23176
      CALL SYNERR(27HINCLUDES NESTED TOO DEEPLY.)
      GOTO 23177
23176 CONTINUE
      INFILE(LEVEL+1) = OPEN(NAME, 0)
      LINECT(LEVEL+1) = 1
      IF(.NOT.(INFILE(LEVEL+1) .EQ. 10001))GOTO 23178
      CALL SYNERR(19HCAN'T OPEN INCLUDE.)
      GOTO 23179
23178 CONTINUE
      LEVEL = LEVEL + 1
      IF(.NOT.(FNAMP + I .LE. 150))GOTO 23180
      CALL SCOPY(NAME, 1, FNAMES, FNAMP)
      FNAMP = FNAMP + I
23180 CONTINUE
      F = INFILE(LEVEL)
23179 CONTINUE
23177 CONTINUE
23163  GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
      GOTO 23162
23164 CONTINUE
      IF(.NOT.(LEVEL .GT. 1))GOTO 23182
      CALL CLOSE(INFILE(LEVEL))
      FNAMP = FNAMP - 1
23184 IF(.NOT.(FNAMP .GT. 1))GOTO 23186
      IF(.NOT.(FNAMES(FNAMP-1) .EQ. 10002))GOTO 23187
      GOTO 23186
23187 CONTINUE
23185 FNAMP = FNAMP - 1
      GOTO 23184
23186 CONTINUE
23182 CONTINUE
23160 LEVEL = LEVEL - 1
      GOTO 23159
23161 CONTINUE
      TOKEN(1) = 10003
      TOKEN(2) = 10002
      GETTOK = 10003
      RETURN
      END
      INTEGER FUNCTION GNBTOK(TOKEN, TOKSIZ)
      INTEGER TOKSIZ
      INTEGER TOKEN(200), GETTOK
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      CALL SKPBLK(INFILE(LEVEL))
      GNBTOK = GETTOK(TOKEN, TOKSIZ)
      RETURN
      END
      INTEGER FUNCTION GTOK(LEXSTR, TOKSIZ, FD)
      INTEGER NGETCH, TYPE
      INTEGER FD, I, B, N, TOKSIZ, ITOC
      INTEGER C, LEXSTR(200)
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      C = NGETCH(LEXSTR(1), FD)
      IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23189
      LEXSTR(1) = 32
23191 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23192
      C = NGETCH(C, FD)
      GOTO 23191
23192 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23193
23195 IF(.NOT.(NGETCH(C, FD) .NE. 10))GOTO 23196
      GOTO 23195
23196 CONTINUE
23193 CONTINUE
      IF(.NOT.(C .NE. 10))GOTO 23197
      CALL PUTBAK(C)
      GOTO 23198
23197 CONTINUE
      LEXSTR(1) = 10
23198 CONTINUE
      LEXSTR(2) = 10002
      GTOK = LEXSTR(1)
      RETURN
23189 CONTINUE
      I = 1
      GTOK = TYPE(C)
      IF(.NOT.(GTOK .EQ. 1))GOTO 23199
      I = 1
23201 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23203
      GTOK = TYPE(NGETCH(LEXSTR(I+1), FD))
      IF(.NOT.(GTOK .NE. 1 .AND. GTOK .NE. 2 .AND. GTOK .NE. 95 .AND. GT
     *OK .NE. 46))GOTO 23204
      GOTO 23203
23204 CONTINUE
23202 I = I + 1
      GOTO 23201
23203 CONTINUE
      CALL PUTBAK(LEXSTR(I+1))
      GTOK = 10100
      GOTO 23200
23199 CONTINUE
      IF(.NOT.(GTOK .EQ. 2))GOTO 23206
      B = C - 48
      I = 1
23208 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23210
      IF(.NOT.(TYPE(NGETCH(LEXSTR(I+1), FD)) .NE. 2))GOTO 23211
      GOTO 23210
23211 CONTINUE
      B = 10*B + LEXSTR(I+1) - 48
23209 I = I + 1
      GOTO 23208
23210 CONTINUE
      IF(.NOT.(LEXSTR(I+1) .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO
     *23213
      N = 0
23215 CONTINUE
      C = NGETCH(LEXSTR(1), FD)
      IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23218
      C = C - 97 + 57 + 1
      GOTO 23219
23218 CONTINUE
      IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23220
      C = C - 65 + 57 + 1
23220 CONTINUE
23219 CONTINUE
      IF(.NOT.(C .LT. 48 .OR. C .GE. 48 + B))GOTO 23222
      GOTO 23217
23222 CONTINUE
23216 N = B*N + C - 48
      GOTO 23215
23217 CONTINUE
      CALL PUTBAK(LEXSTR(1))
      I = ITOC(N, LEXSTR, TOKSIZ)
      GOTO 23214
23213 CONTINUE
      CALL PUTBAK(LEXSTR(I+1))
23214 CONTINUE
      GTOK = 2
      GOTO 23207
23206 CONTINUE
      IF(.NOT.(C .EQ. 91))GOTO 23224
      LEXSTR(1) = 123
      GTOK = 123
      GOTO 23225
23224 CONTINUE
      IF(.NOT.(C .EQ. 93))GOTO 23226
      LEXSTR(1) = 125
      GTOK = 125
      GOTO 23227
23226 CONTINUE
      IF(.NOT.(C .EQ. 36))GOTO 23228
      IF(.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40))GOTO 23230
      LEXSTR(1) = 123
      GTOK = 123
      GOTO 23231
23230 CONTINUE
      IF(.NOT.(LEXSTR(2) .EQ. 41))GOTO 23232
      LEXSTR(1) = 125
      GTOK = 125
      GOTO 23233
23232 CONTINUE
      CALL PUTBAK(LEXSTR(2))
23233 CONTINUE
23231 CONTINUE
      GOTO 23229
23228 CONTINUE
      IF(.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23234
      I = 2
23236 IF(.NOT.(NGETCH(LEXSTR(I), FD) .NE. LEXSTR(1)))GOTO 23238
      IF(.NOT.(LEXSTR(I) .EQ. 95))GOTO 23239
      IF(.NOT.(NGETCH(C, FD) .EQ. 10))GOTO 23241
23243 IF(.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23244
      C = NGETCH(C, FD)
      GOTO 23243
23244 CONTINUE
      LEXSTR(I) = C
      GOTO 23242
23241 CONTINUE
      CALL PUTBAK(C)
23242 CONTINUE
23239 CONTINUE
      IF(.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ-1))GOTO 23245
      CALL SYNERR(14HMISSING QUOTE.)
      LEXSTR(I) = LEXSTR(1)
      CALL PUTBAK(10)
      GOTO 23238
23245 CONTINUE
23237 I = I + 1
      GOTO 23236
23238 CONTINUE
      GOTO 23235
23234 CONTINUE
      IF(.NOT.(C .EQ. 35))GOTO 23247
23249 IF(.NOT.(NGETCH(LEXSTR(1), FD) .NE. 10))GOTO 23250
      GOTO 23249
23250 CONTINUE
      GTOK = 10
      GOTO 23248
23247 CONTINUE
      IF(.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 126 .OR. C .EQ. 33 .
     *OR. C .EQ. 94 .OR. C .EQ. 61 .OR. C .EQ. 38 .OR. C .EQ. 124))GOTO
     *23251
      CALL RELATE(LEXSTR, I, FD)
23251 CONTINUE
23248 CONTINUE
23235 CONTINUE
23229 CONTINUE
23227 CONTINUE
23225 CONTINUE
23207 CONTINUE
23200 CONTINUE
      IF(.NOT.(I .GE. TOKSIZ-1))GOTO 23253
      CALL SYNERR(15HTOKEN TOO LONG.)
23253 CONTINUE
      LEXSTR(I+1) = 10002
      IF(.NOT.(LEXSTR(1) .EQ. 10))GOTO 23255
      LINECT(LEVEL) = LINECT(LEVEL) + 1
23255 CONTINUE
      RETURN
      END
      SUBROUTINE IFCODE(LAB)
      INTEGER LABGEN
      INTEGER LAB
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      LAB = LABGEN(2)
      CALL IFGO(LAB)
      RETURN
      END
      SUBROUTINE IFGO(LAB)
      INTEGER LAB
      INTEGER IFNOT(9)
      DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5
     *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/
      CALL OUTTAB
      CALL OUTSTR(IFNOT)
      CALL BALPAR
      CALL OUTCH(41)
      CALL OUTGO(LAB)
      RETURN
      END
      SUBROUTINE INIT
      INTEGER I, DEFTYP(2)
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      INTEGER BUF
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      INTEGER FORSTK
      COMMON /CLOOK/ AVAIL, TABPTR(127), TABLE(7000)
      INTEGER AVAIL
      INTEGER TABPTR
      INTEGER TABLE
      COMMON /CFNAME/ FCNAME(30)
      INTEGER FCNAME
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      INTEGER SBUF
      INTEGER DEF(7)
      INTEGER BDEF(7)
      DATA DEF(1)/100/,DEF(2)/101/,DEF(3)/102/,DEF(4)/105/,DEF(5)/110/,D
     *EF(6)/101/,DEF(7)/10002/
      DATA BDEF(1)/68/,BDEF(2)/69/,BDEF(3)/70/,BDEF(4)/73/,BDEF(5)/78/,B
     *DEF(6)/69/,BDEF(7)/10002/
      DATA DEFTYP(1), DEFTYP(2) /10010, 10002/
      OUTP = 0
      LEVEL = 1
      LINECT(1) = 1
      INFILE(1) = 0
      FNAMP = 2
      FNAMES(1) = 10002
      BP = 0
      FORDEP = 0
      AVAIL = 1
      DO23257 I = 1,127
      TABPTR(I) = 0
23257 CONTINUE
23258 CONTINUE
      CALL INSTAL(DEF, DEFTYP)
      CALL INSTAL(BDEF, DEFTYP)
      FCNAME(1) = 10002
      LABEL = 23000
      SBP = 1
      RETURN
      END
      SUBROUTINE INSTAL(NAME, DEFN)
      INTEGER DEFN(200), NAME(200), C
      INTEGER LENGTH
      INTEGER DLEN, NLEN
      COMMON /CLOOK/ AVAIL, TABPTR(127), TABLE(7000)
      INTEGER AVAIL
      INTEGER TABPTR
      INTEGER TABLE
      NLEN = LENGTH(NAME) + 1
      DLEN = LENGTH(DEFN) + 1
      IF(.NOT.(AVAIL + NLEN + DLEN .GT. 7000))GOTO 23259
      CALL PUTLIN(NAME, 2)
      CALL REMARK(23H: TOO MANY DEFINITIONS.)
      RETURN
23259 CONTINUE
      C = NAME(1)
      TABLE(AVAIL) = TABPTR(C)
      TABPTR(C) = AVAIL
      CALL SCOPY(NAME, 1, TABLE, AVAIL + 1)
      CALL SCOPY(DEFN, 1, TABLE, AVAIL + NLEN + 1)
      AVAIL = AVAIL + NLEN + DLEN + 1
      RETURN
      END
      INTEGER FUNCTION ITOC(INT, STR, SIZE)
      INTEGER IABS, MOD
      INTEGER I, INT, INTVAL, J, K, SIZE
      INTEGER STR(10)
      INTVAL = IABS(INT)
      STR(1) = 10002
      I = 1
23261 CONTINUE
      I = I + 1
      STR(I) = MOD(INTVAL, 10) + 48
      INTVAL = INTVAL / 10
23262 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23261
23263 CONTINUE
      IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23264
      I = I + 1
      STR(I) = 45
23264 CONTINUE
      ITOC = I - 1
      J = 1
23266 IF(.NOT.(J .LT. I))GOTO 23268
      K = STR(I)
      STR(I) = STR(J)
      STR(J) = K
      I = I - 1
23267 J = J + 1
      GOTO 23266
23268 CONTINUE
      RETURN
      END
      SUBROUTINE LABELC(LEXSTR)
      INTEGER LEXSTR(100)
      INTEGER LENGTH
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      IF(.NOT.(LENGTH(LEXSTR) .EQ. 5))GOTO 23269
      IF(.NOT.(LEXSTR(1) .EQ. 50 .AND. LEXSTR(2) .EQ. 51))GOTO 23271
      CALL SYNERR(33HWARNING: POSSIBLE LABEL CONFLICT.)
23271 CONTINUE
23269 CONTINUE
      CALL OUTSTR(LEXSTR)
      CALL OUTTAB
      RETURN
      END
      INTEGER FUNCTION LABGEN(N)
      INTEGER N
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      LABGEN = LABEL
      LABEL = LABEL + N
      RETURN
      END
      INTEGER FUNCTION LENGTH(STR)
      INTEGER STR(100)
      LENGTH = 0
23273 IF(.NOT.(STR(LENGTH+1) .NE. 10002))GOTO 23275
23274 LENGTH = LENGTH + 1
      GOTO 23273
23275 CONTINUE
      RETURN
      END
      INTEGER FUNCTION LEX(LEXSTR)
      INTEGER GNBTOK
      INTEGER LEXSTR(200)
      INTEGER EQUAL
      INTEGER SIF(3)
      INTEGER SELSE(5)
      INTEGER SWHILE(6)
      INTEGER SDO(3)
      INTEGER SBREAK(6)
      INTEGER SNEXT(5)
      INTEGER SFOR(4)
      INTEGER SREPT(7)
      INTEGER SUNTIL(6)
      INTEGER SRET(7)
      INTEGER SSTR(7)
      DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/10002/
      DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE
     *(5)/10002/
      DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S
     *WHILE(5)/101/,SWHILE(6)/10002/
      DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/
      DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR
     *EAK(5)/107/,SBREAK(6)/10002/
      DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT
     *(5)/10002/
      DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/10002/
      DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT
     *(5)/97/,SREPT(6)/116/,SREPT(7)/10002/
      DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S
     *UNTIL(5)/108/,SUNTIL(6)/10002/
      DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
     *14/,SRET(6)/110/,SRET(7)/10002/
      DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1
     *10/,SSTR(6)/103/,SSTR(7)/10002/
      LEX = GNBTOK(LEXSTR, 200)
23276 IF(.NOT.(LEX .EQ. 10))GOTO 23278
23277  LEX = GNBTOK(LEXSTR, 200)
      GOTO 23276
23278 CONTINUE
      IF(.NOT.(LEX .EQ. 10003 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LE
     *X .EQ. 125))GOTO 23279
      RETURN
23279 CONTINUE
      IF(.NOT.(LEX .EQ. 2))GOTO 23281
      LEX = 10260
      GOTO 23282
23281 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1))GOTO 23283
      LEX = 10261
      GOTO 23284
23283 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1))GOTO 23285
      LEX = 10262
      GOTO 23286
23285 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1))GOTO 23287
      LEX = 10263
      GOTO 23288
23287 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1))GOTO 23289
      LEX = 10266
      GOTO 23290
23289 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1))GOTO 23291
      LEX = 10264
      GOTO 23292
23291 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1))GOTO 23293
      LEX = 10265
      GOTO 23294
23293 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1))GOTO 23295
      LEX = 10268
      GOTO 23296
23295 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1))GOTO 23297
      LEX = 10269
      GOTO 23298
23297 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1))GOTO 23299
      LEX = 10270
      GOTO 23300
23299 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SRET) .EQ. 1))GOTO 23301
      LEX = 10271
      GOTO 23302
23301 CONTINUE
      IF(.NOT.(EQUAL(LEXSTR, SSTR) .EQ. 1))GOTO 23303
      LEX = 10274
      GOTO 23304
23303 CONTINUE
      LEX = 10267
23304 CONTINUE
23302 CONTINUE
23300 CONTINUE
23298 CONTINUE
23296 CONTINUE
23294 CONTINUE
23292 CONTINUE
23290 CONTINUE
23288 CONTINUE
23286 CONTINUE
23284 CONTINUE
23282 CONTINUE
      RETURN
      END
      INTEGER FUNCTION LOOKUP(NAME, DEFN)
      INTEGER DEFN(200), NAME(200), C
      INTEGER I, J, K
      COMMON /CLOOK/ AVAIL, TABPTR(127), TABLE(7000)
      INTEGER AVAIL
      INTEGER TABPTR
      INTEGER TABLE
      C = NAME(1)
      I = TABPTR(C)
23305 IF(.NOT.(I .GT. 0))GOTO 23307
      J = I + 1
      K = 1
23308 IF(.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 10002))GOTO 2331
     *0
      J = J + 1
23309 K = K + 1
      GOTO 23308
23310 CONTINUE
      IF(.NOT.(NAME(K) .EQ. TABLE(J)))GOTO 23311
      CALL SCOPY(TABLE, J+1, DEFN, 1)
      LOOKUP = 1
      RETURN
23311 CONTINUE
23306 I = TABLE(I)
      GOTO 23305
23307 CONTINUE
      LOOKUP = 0
      RETURN
      END
      INTEGER FUNCTION NGETCH(C, FD)
      INTEGER GETCH
      INTEGER C
      INTEGER FD
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      INTEGER BUF
      IF(.NOT.(BP .GT. 0))GOTO 23313
      C = BUF(BP)
      BP = BP - 1
      GOTO 23314
23313 CONTINUE
      C = GETCH(C, FD)
23314 CONTINUE
      NGETCH = C
      RETURN
      END
      SUBROUTINE OTHERC(LEXSTR)
      INTEGER LEXSTR(100)
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTTAB
      CALL OUTSTR(LEXSTR)
      CALL EATUP
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTCH(C)
      INTEGER C
      INTEGER I
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
      IF(.NOT.(OUTP .GE. 72))GOTO 23315
      CALL OUTDON
      I = 1
23317 IF(.NOT.(I .LT. 6))GOTO 23319
      OUTBUF(I) = 32
23318 I = I + 1
      GOTO 23317
23319 CONTINUE
      OUTBUF(6) = 42
      OUTP = 6
23315 CONTINUE
      OUTP = OUTP + 1
      OUTBUF(OUTP) = C
      RETURN
      END
      SUBROUTINE OUTCON(N)
      INTEGER N
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
      INTEGER CONTIN(9)
      DATA CONTIN(1)/99/,CONTIN(2)/111/,CONTIN(3)/110/,CONTIN(4)/116/,CO
     *NTIN(5)/105/,CONTIN(6)/110/,CONTIN(7)/117/,CONTIN(8)/101/,CONTIN(9
     *)/10002/
      XFER = 0
      IF(.NOT.(N .LE. 0 .AND. OUTP .EQ. 0))GOTO 23320
      RETURN
23320 CONTINUE
      IF(.NOT.(N .GT. 0))GOTO 23322
      CALL OUTNUM(N)
23322 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(CONTIN)
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTDON
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
      OUTBUF(OUTP+1) = 10
      OUTBUF(OUTP+2) = 10002
      CALL PUTLIN(OUTBUF, 1)
      OUTP = 0
      RETURN
      END
      SUBROUTINE OUTGO(N)
      INTEGER N
      COMMON /CGOTO/ XFER
      INTEGER XFER
      INTEGER GOTO(6)
      DATA GOTO(1)/103/,GOTO(2)/111/,GOTO(3)/116/,GOTO(4)/111/,GOTO(5)/3
     *2/,GOTO(6)/10002/
      IF(.NOT.(XFER .EQ. 1))GOTO 23324
      RETURN
23324 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(GOTO)
      CALL OUTNUM(N)
      CALL OUTDON
      RETURN
      END
      SUBROUTINE OUTNUM(N)
      INTEGER CHARS(10)
      INTEGER I, M
      M = N
      I = 0
23326 CONTINUE
      I = I + 1
      CHARS(I) = MOD(M, 10) + 48
      M = M / 10
23327 IF(.NOT.(M .EQ. 0 .OR. I .GE. 10))GOTO 23326
23328 CONTINUE
23329 IF(.NOT.(I .GT. 0))GOTO 23331
      CALL OUTCH(CHARS(I))
23330 I = I - 1
      GOTO 23329
23331 CONTINUE
      RETURN
      END
      SUBROUTINE OUTSTR(STR)
      INTEGER C, STR(100)
      INTEGER I, J
      I = 1
23332 IF(.NOT.(STR(I) .NE. 10002))GOTO 23334
      C = STR(I)
      IF(.NOT.(C .NE. 39 .AND. C .NE. 34))GOTO 23335
      IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23337
      C = C - 97 + 65
23337 CONTINUE
      CALL OUTCH(C)
      GOTO 23336
23335 CONTINUE
      I = I + 1
      J = I
23339 IF(.NOT.(STR(J) .NE. C))GOTO 23341
23340 J = J + 1
      GOTO 23339
23341 CONTINUE
      CALL OUTNUM(J-I)
      CALL OUTCH(72)
23342 IF(.NOT.(I .LT. J))GOTO 23344
      CALL OUTCH(STR(I))
23343 I = I + 1
      GOTO 23342
23344 CONTINUE
23336 CONTINUE
23333 I = I + 1
      GOTO 23332
23334 CONTINUE
      RETURN
      END
      SUBROUTINE OUTTAB
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
23345 IF(.NOT.(OUTP .LT. 6))GOTO 23346
      CALL OUTCH(32)
      GOTO 23345
23346 CONTINUE
      RETURN
      END
      SUBROUTINE PARSE
      INTEGER LEXSTR(200)
      INTEGER LEX
      INTEGER LAB, LABVAL(100), LEXTYP(100), SP, TOKEN
      COMMON /CGOTO/ XFER
      INTEGER XFER
      COMMON /CFOR/ FORDEP, FORSTK(200)
      INTEGER FORDEP
      INTEGER FORSTK
      COMMON /CFNAME/ FCNAME(30)
      INTEGER FCNAME
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      INTEGER SBUF
      COMMON /CLABEL/ LABEL
      INTEGER LABEL
      COMMON /CLOOK/ AVAIL, TABPTR(127), TABLE(7000)
      INTEGER AVAIL
      INTEGER TABPTR
      INTEGER TABLE
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      INTEGER BUF
      COMMON /COUTLN/ OUTP, OUTBUF(74)
      INTEGER OUTP
      INTEGER OUTBUF
      CALL INIT
      SP = 1
      LEXTYP(1) = 10003
      TOKEN = LEX(LEXSTR)
23347 IF(.NOT.(TOKEN .NE. 10003))GOTO 23349
      IF(.NOT.(TOKEN .EQ. 10261))GOTO 23350
      CALL IFCODE(LAB)
      GOTO 23351
23350 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10266))GOTO 23352
      CALL DOCODE(LAB)
      GOTO 23353
23352 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10263))GOTO 23354
      CALL WHILEC(LAB)
      GOTO 23355
23354 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10268))GOTO 23356
      CALL FORCOD(LAB)
      GOTO 23357
23356 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10269))GOTO 23358
      CALL REPCOD(LAB)
      GOTO 23359
23358 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10260))GOTO 23360
      CALL LABELC(LEXSTR)
      GOTO 23361
23360 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10262))GOTO 23362
      IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23364
      CALL ELSEIF(LABVAL(SP))
      GOTO 23365
23364 CONTINUE
      CALL SYNERR(13HILLEGAL ELSE.)
23365 CONTINUE
23362 CONTINUE
23361 CONTINUE
23359 CONTINUE
23357 CONTINUE
23355 CONTINUE
23353 CONTINUE
23351 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10261 .OR. TOKEN .EQ. 10262 .OR. TOKEN .EQ. 10
     *263 .OR. TOKEN .EQ. 10268 .OR. TOKEN .EQ. 10269 .OR. TOKEN .EQ. 10
     *266 .OR. TOKEN .EQ. 10260 .OR. TOKEN .EQ. 123))GOTO 23366
      SP = SP + 1
      IF(.NOT.(SP .GT. 100))GOTO 23368
      CALL BADERR(25HSTACK OVERFLOW IN PARSER.)
23368 CONTINUE
      LEXTYP(SP) = TOKEN
      LABVAL(SP) = LAB
      GOTO 23367
23366 CONTINUE
      IF(.NOT.(TOKEN .EQ. 125))GOTO 23370
      IF(.NOT.(LEXTYP(SP) .EQ. 123))GOTO 23372
      SP = SP - 1
      GOTO 23373
23372 CONTINUE
      CALL SYNERR(20HILLEGAL RIGHT BRACE.)
23373 CONTINUE
      GOTO 23371
23370 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10267))GOTO 23374
      CALL OTHERC(LEXSTR)
      GOTO 23375
23374 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10264 .OR. TOKEN .EQ. 10265))GOTO 23376
      CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
      GOTO 23377
23376 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10271))GOTO 23378
      CALL RETCOD
      GOTO 23379
23378 CONTINUE
      IF(.NOT.(TOKEN .EQ. 10274))GOTO 23380
      CALL STRDCL
23380 CONTINUE
23379 CONTINUE
23377 CONTINUE
23375 CONTINUE
23371 CONTINUE
      TOKEN = LEX(LEXSTR)
      CALL PBSTR(LEXSTR)
      CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
23367 CONTINUE
23348 TOKEN = LEX(LEXSTR)
      GOTO 23347
23349 CONTINUE
      IF(.NOT.(SP .NE. 1))GOTO 23382
      CALL SYNERR(15HUNEXPECTED EOF.)
23382 CONTINUE
      RETURN
      END
      SUBROUTINE PBSTR(IN)
      INTEGER IN(100)
      INTEGER LENGTH
      INTEGER I
      I = LENGTH(IN)
23384 IF(.NOT.(I .GT. 0))GOTO 23386
      CALL PUTBAK(IN(I))
23385 I = I - 1
      GOTO 23384
23386 CONTINUE
      RETURN
      END
      SUBROUTINE PUTBAK(C)
      INTEGER C
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      INTEGER BUF
      BP = BP + 1
      IF(.NOT.(BP .GT. 300))GOTO 23387
      CALL BADERR(32HTOO MANY CHARACTERS PUSHED BACK.)
23387 CONTINUE
      BUF(BP) = C
      RETURN
      END
      SUBROUTINE PUTLIN(B, F)
      INTEGER B(100)
      INTEGER F, I
      I = 1
23389 IF(.NOT.(B(I) .NE. 10002))GOTO 23391
      CALL PUTCH(B(I), F)
23390 I = I + 1
      GOTO 23389
23391 CONTINUE
      RETURN
      END
      SUBROUTINE RELATE(TOKEN, LAST, FD)
      INTEGER NGETCH
      INTEGER TOKEN(100)
      INTEGER LENGTH
      INTEGER FD, LAST
      IF(.NOT.(NGETCH(TOKEN(2), FD) .NE. 61))GOTO 23392
      CALL PUTBAK(TOKEN(2))
      TOKEN(3) = 116
      GOTO 23393
23392 CONTINUE
      TOKEN(3) = 101
23393 CONTINUE
      TOKEN(4) = 46
      TOKEN(5) = 10002
      TOKEN(6) = 10002
      IF(.NOT.(TOKEN(1) .EQ. 62))GOTO 23394
      TOKEN(2) = 103
      GOTO 23395
23394 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 60))GOTO 23396
      TOKEN(2) = 108
      GOTO 23397
23396 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 126 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ
     *. 94))GOTO 23398
      IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23400
      TOKEN(3) = 111
      TOKEN(4) = 116
      TOKEN(5) = 46
23400 CONTINUE
      TOKEN(2) = 110
      GOTO 23399
23398 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 61))GOTO 23402
      IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23404
      TOKEN(2) = 10002
      LAST = 1
      RETURN
23404 CONTINUE
      TOKEN(2) = 101
      TOKEN(3) = 113
      GOTO 23403
23402 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 38))GOTO 23406
      TOKEN(2) = 97
      TOKEN(3) = 110
      TOKEN(4) = 100
      TOKEN(5) = 46
      GOTO 23407
23406 CONTINUE
      IF(.NOT.(TOKEN(1) .EQ. 124))GOTO 23408
      TOKEN(2) = 111
      TOKEN(3) = 114
      GOTO 23409
23408 CONTINUE
      TOKEN(2) = 10002
23409 CONTINUE
23407 CONTINUE
23403 CONTINUE
23399 CONTINUE
23397 CONTINUE
23395 CONTINUE
      TOKEN(1) = 46
      LAST = LENGTH(TOKEN)
      RETURN
      END
      SUBROUTINE REPCOD(LAB)
      INTEGER LABGEN
      INTEGER LAB
      CALL OUTCON(0)
      LAB = LABGEN(3)
      CALL OUTCON(LAB)
      LAB = LAB + 1
      RETURN
      END
      SUBROUTINE RETCOD
      INTEGER TOKEN(200), GNBTOK, T
      COMMON /CFNAME/ FCNAME(30)
      INTEGER FCNAME
      COMMON /CGOTO/ XFER
      INTEGER XFER
      INTEGER SRET(7)
      DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
     *14/,SRET(6)/110/,SRET(7)/10002/
      T = GNBTOK(TOKEN, 200)
      IF(.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23410
      CALL PBSTR(TOKEN)
      CALL OUTTAB
      CALL OUTSTR(FCNAME)
      CALL OUTCH(61)
      CALL EATUP
      CALL OUTDON
      GOTO 23411
23410 CONTINUE
      IF(.NOT.(T .EQ. 125))GOTO 23412
      CALL PBSTR(TOKEN)
23412 CONTINUE
23411 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(SRET)
      CALL OUTDON
      XFER = 1
      RETURN
      END
      SUBROUTINE SCOPY(FROM, I, TO, J)
      INTEGER FROM(100), TO(100)
      INTEGER I, J, K1, K2
      K2 = J
      K1 = I
23414 IF(.NOT.(FROM(K1) .NE. 10002))GOTO 23416
      TO(K2) = FROM(K1)
      K2 = K2 + 1
23415 K1 = K1 + 1
      GOTO 23414
23416 CONTINUE
      TO(K2) = 10002
      RETURN
      END
      SUBROUTINE SKPBLK(FD)
      INTEGER FD
      INTEGER C, NGETCH
      C = NGETCH(C, FD)
23417 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23419
23418 C = NGETCH(C, FD)
      GOTO 23417
23419 CONTINUE
      CALL PUTBAK(C)
      RETURN
      END
      SUBROUTINE STRDCL
      INTEGER T, TOKEN(200), GNBTOK
      INTEGER I, J, K, LEN, LENGTH, CTOI, LEX
      COMMON /CSBUF/ SBP, SBUF(500)
      INTEGER SBP
      INTEGER SBUF
      INTEGER INT(9)
      INTEGER DAT(6)
      INTEGER EOSS(5)
      DATA INT(1)/105/,INT(2)/110/,INT(3)/116/,INT(4)/101/,INT(5)/103/,I
     *NT(6)/101/,INT(7)/114/,INT(8)/32/,INT(9)/10002/
      DATA DAT(1)/100/,DAT(2)/97/,DAT(3)/116/,DAT(4)/97/,DAT(5)/32/,DAT(
     *6)/10002/
      DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/47/,EOSS(5)/10002
     */
      T = GNBTOK(TOKEN, 200)
      IF(.NOT.(T .NE. 10100))GOTO 23420
      CALL SYNERR(21HMISSING STRING TOKEN.)
23420 CONTINUE
      CALL OUTTAB
      CALL OUTSTR(INT)
      CALL OUTSTR(TOKEN)
      CALL ADDSTR(TOKEN, SBUF, SBP, 500)
      CALL ADDCHR(10002, SBUF, SBP, 500)
      IF(.NOT.(GNBTOK(TOKEN, 200) .NE. 40))GOTO 23422
      LEN = LENGTH(TOKEN) + 1
      IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23424
      LEN = LEN - 2
23424 CONTINUE
      GOTO 23423
23422 CONTINUE
      T = GNBTOK(TOKEN, 200)
      I = 1
      LEN = CTOI(TOKEN, I)
      IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23426
      CALL SYNERR(20HINVALID STRING SIZE.)
23426 CONTINUE
      IF(.NOT.(GNBTOK(TOKEN, 200) .NE. 41))GOTO 23428
      CALL SYNERR(20HMISSING RIGHT PAREN.)
      GOTO 23429
23428 CONTINUE
      T = GNBTOK(TOKEN, 200)
23429 CONTINUE
23423 CONTINUE
      CALL OUTCH(40)
      CALL OUTNUM(LEN)
      CALL OUTCH(41)
      CALL OUTDON
      IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23430
      LEN = LENGTH(TOKEN)
      TOKEN(LEN) = 10002
      CALL ADDSTR(TOKEN(2), SBUF, SBP, 500)
      GOTO 23431
23430 CONTINUE
      CALL ADDSTR(TOKEN, SBUF, SBP, 500)
23431 CONTINUE
      CALL ADDCHR(10002, SBUF, SBP, 500)
      T = LEX(TOKEN)
      CALL PBSTR(TOKEN)
      IF(.NOT.(T .NE. 10274))GOTO 23432
      I = 1
23434 IF(.NOT.(I .LT. SBP))GOTO 23436
      CALL OUTTAB
      CALL OUTSTR(DAT)
      K = 1
      J = I + LENGTH(SBUF(I)) + 1
23437 CONTINUE
      IF(.NOT.(K .GT. 1))GOTO 23440
      CALL OUTCH(44)
23440 CONTINUE
      CALL OUTSTR(SBUF(I))
      CALL OUTCH(40)
      CALL OUTNUM(K)
      CALL OUTCH(41)
      CALL OUTCH(47)
      IF(.NOT.(SBUF(J) .EQ. 10002))GOTO 23442
      GOTO 23439
23442 CONTINUE
      CALL OUTNUM(SBUF(J))
      CALL OUTCH(47)
      K = K + 1
23438 J = J + 1
      GOTO 23437
23439 CONTINUE
      CALL PBSTR(EOSS)
23444 CONTINUE
      T = GNBTOK(TOKEN, 200)
      CALL OUTSTR(TOKEN)
23445 IF(.NOT.(T .EQ. 47))GOTO 23444
23446 CONTINUE
      CALL OUTDON
23435 I = J + 1
      GOTO 23434
23436 CONTINUE
      SBP = 1
23432 CONTINUE
      RETURN
      END
      SUBROUTINE SYNERR(MSG)
      INTEGER LC(10), MSG(100)
      INTEGER ITOC
      INTEGER I, JUNK
      COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5), FNAMP, FNAMES(150)
      INTEGER LEVEL
      INTEGER LINECT
      INTEGER INFILE
      INTEGER FNAMP
      INTEGER FNAMES
      INTEGER ERRMSG(15)
      INTEGER IN(5)
      DATA ERRMSG(1)/101/,ERRMSG(2)/114/,ERRMSG(3)/114/,ERRMSG(4)/111/,E
     *RRMSG(5)/114/,ERRMSG(6)/32/,ERRMSG(7)/97/,ERRMSG(8)/116/,ERRMSG(9)
     */32/,ERRMSG(10)/108/,ERRMSG(11)/105/,ERRMSG(12)/110/,ERRMSG(13)/10
     *1/,ERRMSG(14)/32/,ERRMSG(15)/10002/
      DATA IN(1)/32/,IN(2)/105/,IN(3)/110/,IN(4)/32/,IN(5)/10002/
      CALL PUTLIN(ERRMSG, 2)
      IF(.NOT.(LEVEL .GE. 1))GOTO 23447
      I = LEVEL
      GOTO 23448
23447 CONTINUE
      I = 1
23448 CONTINUE
      JUNK = ITOC(LINECT(I), LC, 10)
      CALL PUTLIN(LC, 2)
      I = FNAMP - 1
23449 IF(.NOT.(I .GT. 1))GOTO 23451
      IF(.NOT.(FNAMES(I-1) .EQ. 10002))GOTO 23452
      CALL PUTLIN(IN, 2)
      CALL PUTLIN(FNAMES(I), 2)
      GOTO 23451
23452 CONTINUE
23450 I = I - 1
      GOTO 23449
23451 CONTINUE
      CALL PUTCH(58, 2)
      CALL PUTCH(32, 2)
      CALL REMARK(MSG)
      RETURN
      END
      INTEGER FUNCTION TYPE(C)
      INTEGER C
      IF(.NOT.(C .GE. 48 .AND. C .LE. 57))GOTO 23454
      TYPE = 2
      GOTO 23455
23454 CONTINUE
      IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23456
      TYPE = 1
      GOTO 23457
23456 CONTINUE
      IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23458
      TYPE = 1
      GOTO 23459
23458 CONTINUE
      TYPE = C
23459 CONTINUE
23457 CONTINUE
23455 CONTINUE
      RETURN
      END
      SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
      INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
23460 IF(.NOT.(SP .GT. 1))GOTO 23462
      IF(.NOT.(LEXTYP(SP) .EQ. 123))GOTO 23463
      GOTO 23462
23463 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10261 .AND. TOKEN .EQ. 10262))GOTO 23465
      GOTO 23462
23465 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23467
      CALL OUTCON(LABVAL(SP))
      GOTO 23468
23467 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10262))GOTO 23469
      IF(.NOT.(SP .GT. 2))GOTO 23471
      SP = SP - 1
23471 CONTINUE
      CALL OUTCON(LABVAL(SP)+1)
      GOTO 23470
23469 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10266))GOTO 23473
      CALL DOSTAT(LABVAL(SP))
      GOTO 23474
23473 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10263))GOTO 23475
      CALL WHILES(LABVAL(SP))
      GOTO 23476
23475 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10268))GOTO 23477
      CALL FORS(LABVAL(SP))
      GOTO 23478
23477 CONTINUE
      IF(.NOT.(LEXTYP(SP) .EQ. 10269))GOTO 23479
      CALL UNTILS(LABVAL(SP), TOKEN)
23479 CONTINUE
23478 CONTINUE
23476 CONTINUE
23474 CONTINUE
23470 CONTINUE
23468 CONTINUE
23461 SP = SP - 1
      GOTO 23460
23462 CONTINUE
      RETURN
      END
      SUBROUTINE UNTILS(LAB, TOKEN)
      INTEGER PTOKEN(200)
      INTEGER LEX
      INTEGER JUNK, LAB, TOKEN
      COMMON /CGOTO/ XFER
      INTEGER XFER
      XFER = 0
      CALL OUTNUM(LAB)
      IF(.NOT.(TOKEN .EQ. 10270))GOTO 23481
      JUNK = LEX(PTOKEN)
      CALL IFGO(LAB-1)
      GOTO 23482
23481 CONTINUE
      CALL OUTGO(LAB-1)
23482 CONTINUE
      CALL OUTCON(LAB+1)
      RETURN
      END
      SUBROUTINE WHILEC(LAB)
      INTEGER LABGEN
      INTEGER LAB
      CALL OUTCON(0)
      LAB = LABGEN(2)
      CALL OUTNUM(LAB)
      CALL IFGO(LAB+1)
      RETURN
      END
      SUBROUTINE WHILES(LAB)
      INTEGER LAB
      CALL OUTGO(LAB)
      CALL OUTCON(LAB+1)
      RETURN
      END
#========== DEC-10 I/O SYSTEM ==========
