INCLUDE RATDEFS.RAT

#MAIN
%#FCOMMON.FOR
CHARACTER*25 INP,OUT
DATA OUTFIL /1/, INFIL /1/

WRITE(1)' SSS/SUPERSOFT RATFOR TRANSLATOR       VER. 4.1.',CRLF,CRLF

REPEAT [WRITE(1)' INPUT FILE? '
        READ(1,101)INP;   101 FORMAT(A0)
        IF (KLEN(INP)==0) BREAK
        IF (! IOREAD(5,2,0,INP)) [
            INFIL = 5
            BREAK ]
        CALL ERROR("BAD INPUT FILE")
       ]

REPEAT [WRITE(1)' OUTPUT FILE? '
        READ(1,101)OUT
        IF (KLEN(OUT)==0) BREAK
        IF (! IOWRIT(6,2,0,OUT)) [
            OUTFIL = 6
            BREAK ]
        CALL ERROR("BAD OUTPUT FILE") 
       ]

CALL PARSE

IF (INFIL == 5) X = IOCLOS(5)
IF (OUTFIL == 6) X = IOCLOS(6)

IF (ERRCNT!=0) WRITE(1,100)ERRCNT," ERRORS DETECTED",BELL

STOP

100 FORMAT(I4,A0,A1)
END




#ADDTO
SUBROUTINE ADDTO(LSCRAT,GCBUF,I)
CHARACTER*SCRATSIZE LSCRAT,GCBUF,SUBSTG 

IF (KLEN(LSCRAT)+I <= SCRATSIZE)
     CALL ADDSTG(LSCRAT,SUBSTG(GCBUF,1,I))
ELSE CALL ERROR("STATEMENT TOO LONG")
GCBUF = SUBSTG(GCBUF,I+1,9999) 

RETURN
END




#BYFILL
INTEGER FUNCTION BYFILL(BUF,I)
%#FCOMMON.FOR
CHARACTER*SCRATSIZE BUF

BYFILL=I
REPEAT[ 
       BYFILL=IVERFY(BUF,BYFILL,FILL)
       IF (BYFILL!=0) RETURN
       CALL READCD(BUF)
       IF (EOFL) RETURN
       BYFILL=1
      ]

END



#KEYLUK
INTEGER FUNCTION KEYLUK(STR)
CHARACTER*MAXLIN STR

KEYLUK=0

GOTO(1,2,3,4,5,6,7),KLEN(STR)

1 RETURN

2 IF (STR=="IF"){KEYLUK=LEXIF;RETURN}
  IF (STR=="DO")KEYLUK=LEXDO
  RETURN

3 IF (STR=="END"){KEYLUK=LEXEND;RETURN}
  IF (STR=="FOR")KEYLUK=LEXFOR
  RETURN

4 IF (STR=="ELSE"){KEYLUK=LEXELSE;RETURN}
  IF (STR=="NEXT")KEYLUK=LEXNEXT
  RETURN

5 IF (STR=="WHILE"){KEYLUK=LEXWHILE;RETURN}
  IF (STR=="UNTIL"){KEYLUK=LEXUNTIL;RETURN}
  IF (STR=="BREAK")KEYLUK=LEXBREAK
  RETURN

6 IF (STR=="REPEAT"){KEYLUK=LEXREPEAT;RETURN}
  IF (STR=="DEFINE")KEYLUK=LEXDEFINE
  RETURN

7 IF (STR=="INCLUDE")KEYLUK=LEXINCLUDE
  RETURN

END




#LOOKUP
CHARACTER*TEXTSIZE FUNCTION LOOKUP(STRING) 
%#FCOMMON.FOR
CHARACTER*DEFSIZE STRING,SUBSTG
CHARACTER*DEFSIZE2 ASTRNG

CALL SETLEN(DTEXT,LDTEXT)
CALL SETLEN(DNAMES,LDNAMS)

# LOCATE ",STRING,"
CALL CONCAT(ASTRNG,",",STRING,",") 
I=INDEX(ASTRNG,DNAMES,1)
IF (I<=0 | I>=KLEN(DNAMES)) [
    LOOKUP=STRING
    RETURN ]

# READ THE DTEXT DELIMITERS (2I3 FORMAT)
I=KLEN(ASTRNG)+I
ASTRNG=SUBSTG(DNAMES,I,I+5)
READ (ASTRNG,100)I,J
100 FORMAT(2I3)

LOOKUP=SUBSTG(DTEXT,I,J)   # GET THE SUBSTITUTION TEXT

RETURN
END





#PARSE
SUBROUTINE PARSE
%#FCOMMON.FOR
CHARACTER*MAXLIN LEXSTR
INTEGER LEXTYP(MAXSTACK), LABVAL(MAXSTACK)
LOGICAL NEED
DATA SP/1/, LEXTYP(1)/UNDEFINED/, NEED/.TRUE./

REPEAT [

   IF (NEED) TOKEN = LEX(LEXSTR)
   ELSE   NEED = .TRUE.

   REPEAT [
       GOTO (LEXDIGITS,LEXIF,LEXELSE,LEXFOR,LEXWHILE,99,99,LEXREPEAT,99,LEXDO),
                  TOKEN-LEXDIGITS+1
       99        BREAK
       LEXIF     CALL IFCODE(LAB); BREAK
       LEXDO     CALL DOCODE(LAB); BREAK
       LEXWHILE  CALL WHILEC(LAB); BREAK
       LEXFOR    CALL FORCOD(LAB); BREAK
       LEXREPEAT CALL REPCOD(LAB); BREAK
       LEXDIGITS WRITE(OUTFIL)LEXSTR,' '; BREAK
       LEXELSE   IF ( LEXTYP(SP) == LEXIF ) 
                        WRITE(OUTFIL,100)TAB,LABVAL(SP)+1,LABVAL(SP)
                 ELSE   CALL ERROR("ILLEGAL ELSE")
                 BREAK
      ]

      # BEGINNING OF STATEMENT - STACK THEM
   IF ( TOKEN == LEXIF  |  TOKEN == LEXELSE  |  TOKEN == LEXWHILE
      |  TOKEN == LEXFOR  |  TOKEN == LEXREPEAT 
      |  TOKEN == LEXDO  |  TOKEN == LEXDIGITS  |  INT1(TOKEN) == '[[' ) [
        INCREMENT SP
        IF ( SP>MAXSTACK ) [
            CALL ERROR("STACK OVERFLOW IN PARSER") 
            RETURN ]
        LEXTYP(SP) = TOKEN
        LABVAL(SP) = LAB ]

   ELSE [   # END OF STATEMENT - PREPARE TO UNSTACK

      IF ( INT1(TOKEN) == ']' )  
          IF ( INT1(LEXTYP(SP)) == '[[' )
                 DECREMENT SP
          ELSE   CALL ERROR("ILLEGAL ]")

      REPEAT [
         GOTO (LEXBREAK,LEXNEXT,98,98,98,LEXOTHER),TOKEN-LEXBREAK+1
         98       BREAK
         LEXOTHER CALL OTHERC(LEXSTR); BREAK
         LEXBREAK CALL EXIT(BREAKCODE); BREAK
         LEXNEXT  CALL EXIT(NEXTCODE) ; BREAK
         ]

      TOKEN = LEX(LEXSTR)   # PEEK AT NEXT TOKEN
      NEED = .FALSE.
      CALL UNSTAK(SP,LEXTYP,LABVAL,TOKEN)
   ]
] UNTIL( TOKEN == UNDEFINED )
RETURN

100 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE')
END





#UNSTAK
SUBROUTINE UNSTAK(SP,LEXTYP,LABVAL,TOKEN)

%#FCOMMON.FOR
   INTEGER LEXTYP(MAXSTACK), LABVAL(MAXSTACK)

WHILE( SP > 1 ) [

   IF ( INT1(LEXTYP(SP)) == '[[' ) RETURN

   GOTO (LEXDIGITS,LEXIF,LEXELSE,LEXFOR,LEXWHILE,97,97,LEXREPEAT,97,LEXDO),
                LEXTYP(SP)-LEXDIGITS+1
   
   97        RETURN
   LEXIF     IF ( TOKEN == LEXELSE ) RETURN
             WRITE(OUTFIL,100)LABVAL(SP),TAB
             SP = SP - 1
             NEXT
   LEXELSE   WRITE(OUTFIL,100)LABVAL(SP-1)+1,TAB
             SP = SP - 2
             NEXT
   LEXDO     CALL DOSTAT(LABVAL(SP)) 
             SP = SP - 1
             NEXT
   LEXWHILE  CALL WHILES(LABVAL(SP)) 
             SP = SP - 1
             NEXT
   LEXFOR    CALL FORS(LABVAL(SP))
             SP = SP - 1
             NEXT
   LEXREPEAT IF ( TOKEN == LEXUNTIL ) 
                    CALL UNTILS(LABVAL(SP),1)
             ELSE   CALL UNTILS(LABVAL(SP),0)
             SP = SP - 1
             NEXT
   LEXDIGITS SP = SP - 1
             NEXT
   ]
RETURN

100 FORMAT(I6,A1,'CONTINUE')
END





#LEX
INTEGER FUNCTION LEX(LEXSTR)
%#FCOMMON.FOR
CHARACTER*MAXLIN LEXSTR,SUBSTG
INTEGER*1 LEX1
DATA LGCBUF /0/

CALL SETLEN(GCBUF,LGCBUF)
LEX=UNDEFINED

REPEAT[ 
       I=BYFILL(GCBUF,1)
       J = I+1
       K = J

       IF (EOFL) RETURN

       LEX1 = KHAR(GCBUF,I) 
       LEX=LEX1

       IF (LEX1 == ';' | LEX1 == '[[' | LEX1 == ']' ) BREAK

       K = IVERFY(GCBUF,I,ALPHANUMERIC); IF (K==0) K=9999 
       IF (K==I) [
           LEX = LEXOTHER
           BREAK ]

       J=K

       LEXSTR = SUBSTG(GCBUF,I,J-1)
       IF (IVERFY(LEXSTR,1,NUMERIC)==0) [
           LEX=LEXDIGITS
           BREAK ]

       LEX = KEYLUK(LEXSTR)

       IF (LEX==0) [
           LEX = LEXOTHER
           BREAK ]

       IF (LEX==LEXEND) [
           LEX = LEXOTHER
           REASHR = 2
           BREAK ]

       GCBUF = SUBSTG(GCBUF,J,9999); LGCBUF=KLEN(GCBUF)

       IF (LEX==LEXDEFINE) CALL DEFST
       ELSE IF (LEX==LEXINCLUDE) CALL INCLST
       ELSE RETURN

       CALL SETLEN(GCBUF,LGCBUF)
      ]

GCBUF = SUBSTG(GCBUF,J,9999); LGCBUF = KLEN(GCBUF)

RETURN
END





#DEFST
SUBROUTINE DEFST
%#FCOMMON.FOR
CHARACTER*DEFSIZE STR,SUBSTG
CHARACTER*DEFSIZE2 ASTR
INTEGER*1 K1
DATA LDTEXT,LDNAMS/0,0/

CALL SETLEN(DTEXT,LDTEXT)
CALL SETLEN(DNAMES,LDNAMS)
CALL SETLEN(GCBUF,LGCBUF)

I=BYFILL(GCBUF,1)
J=IFIND(GCBUF,I,FILL); IF (J==0) J=9999
CALL ADDSTG(DNAMES,",",SUBSTG(GCBUF,I,J-1),",")
I=BYFILL(GCBUF,J) 
DO J=KLEN(GCBUF),I,-1 [
                       K1 = KHAR(GCBUF,J)
                       IF (K1!=' ' & K1!=TAB) BREAK 
                      ]
K=KLEN(DTEXT)+1
WRITE(ASTR,100)K,K+J-I
100 FORMAT(I4,I3$

CALL ADDSTG(DNAMES,ASTR); LDNAMS=KLEN(DNAMES)
CALL ADDSTG(DTEXT,SUBSTG(GCBUF,I,J)); LDTEXT=KLEN(DTEXT)
CALL READCD(GCBUF); LGCBUF=KLEN(GCBUF)

IF (LDTEXT>DEFTAB | LDNAMS>DEFTAB)
    CALL ERROR("DEFINE TABLE SIZE EXCEEDED")

RETURN
END





#INCLST
SUBROUTINE INCLST
%#FCOMMON.FOR
CHARACTER*25 INCFIL,SUBSTG

IF (INFIL>15) [ # IF ALREADY OPENED UNITS 1,6,11,16 OR 5,10,15,20
    CALL ERROR("ONLY 3 NESTED INCLUDES ALLOWED")
    RETURN ]

CALL SETLEN(GCBUF,LGCBUF)

I = BYFILL(GCBUF,1) 
GCBUF = SUBSTG(GCBUF,I,9999) ;LGCBUF = KLEN(GCBUF)
CALL EATUP(SCRAT)
WRITE(INCFIL,100)SCRAT
WRITE(1)'INCLUDING FILE: ',SCRAT,CRLF
IF (IOREAD(INFIL+5,2,0,SUBSTG(INCFIL,1,9999))) 
     CALL ERROR("BAD INCLUDE FILE")
ELSE INFIL = INFIL+5

RETURN

100 FORMAT(1X,A0)
END





#IFCODE
SUBROUTINE IFCODE(LAB)
%#FCOMMON.FOR

WRITE(OUTFIL)TAB,'IF(.NOT.'
CALL BALPAR(SCRAT,SPLIT)
LAB = LABGEN(1EXTRA)
WRITE(OUTFIL,100)SCRAT,LAB
RETURN

100 FORMAT(1X,A0,')GOTO',I6)
END





#WHILEC
SUBROUTINE WHILEC(LAB)
%#FCOMMON.FOR

LAB = LABGEN(1EXTRA)
CALL PUSH(LAB)
WRITE(OUTFIL,100)TAB,LAB,TAB
CALL BALPAR(SCRAT,SPLIT)
WRITE(OUTFIL,200)SCRAT,LAB+1
RETURN

100 FORMAT(1X,A1,'CONTINUE;',I5,A1,'IF(.NOT.'$
200 FORMAT(1X,A0,')GOTO',I6)
END





#WHILES
SUBROUTINE WHILES(LAB)
%#FCOMMON.FOR

WRITE(OUTFIL,100)TAB,LAB,LAB+1
DECREMENT BRKPTR 
RETURN

100 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE')
END





#OTHERC
SUBROUTINE OTHERC(LEXSTR)
%#FCOMMON.FOR
CHARACTER*MAXLIN LEXSTR
DATA REASHR /1/

WRITE(OUTFIL)TAB,LEXSTR
CALL EATUP(SCRAT)
WRITE(OUTFIL)SCRAT,CRLF

GOTO (1,2,3),REASHR
3    WRITE(1)'TRANSLATING ',LEXSTR,SCRAT,CRLF
     REASHR = 1
     RETURN
2    REASHR = 3
1    RETURN

RETURN

END





#REPCOD
SUBROUTINE REPCOD(LAB)
%#FCOMMON.FOR

LAB = LABGEN(2EXTRA)
WRITE(OUTFIL,100)TAB,LAB
CALL PUSH(LAB+1)
RETURN

100 FORMAT(1X,A1,'CONTINUE;',I5,' CONTINUE')
END





#UNTILS
SUBROUTINE UNTILS(LAB,UN)
%#FCOMMON.FOR

IF ( UN > 0 ) [
       WRITE(OUTFIL,99)LAB+1,TAB
       CALL BALPAR(SCRAT,SPLIT)
       WRITE(OUTFIL,100)SCRAT,LAB,LAB+2 ]
ELSE   WRITE(OUTFIL,101)LAB+1,TAB,LAB,LAB+2

DECREMENT BRKPTR 
RETURN

99  FORMAT(I6,A1,'IF(.NOT.'$
100 FORMAT(1X,A0,')GOTO',I6,';',I5,' CONTINUE')
101 FORMAT(I6,A1,'GOTO',I6,';',I5,' CONTINUE')
END





#FORCOD
SUBROUTINE FORCOD(LAB)
%#FCOMMON.FOR
CHARACTER*MAXLIN INITL,TEST,CLAUSE,SUBSTG

LAB = LABGEN(2EXTRA)
CALL PUSH(LAB+1)
CALL BALPAR(SCRAT,NOSPLIT)

IF ( SCRAT == "" ) [
       FORLEN(FORPTR) = 0
       INCREMENT FORPTR
       RETURN ] 

CALL PUTCHR(SCRAT,1,' ')
INITL=CLAUSE(SCRAT)
TEST=CLAUSE(SCRAT)

# THE INCREMENT PART, PLUS ')', IS NOW IN SCRAT

IF (IVERFY(INITL,1," ") != 0 ) 
       WRITE(OUTFIL)TAB,INITL,CRLF
ELSE   WRITE(OUTFIL)TAB,'CONTINUE',CRLF   # IN CASE THERE WAS A LABEL

IF ( IVERFY(TEST,1," ") !=0 ) 
       WRITE(OUTFIL,100)LAB,TAB,TEST,LAB+2
ELSE   WRITE(OUTFIL,101)LAB,TAB    # IN CASE THERE WAS A LABEL

# STACK INCREMENT FOR LATER
JJ = KLEN(SCRAT)-1
FORSTK(FORPTR) = SUBSTG(SCRAT,1,JJ)
FORLEN(FORPTR) = JJ
INCREMENT FORPTR

RETURN

100 FORMAT(I6,A1,'IF (.NOT.(',A0,'))GOTO',I6)
101 FORMAT(I6,A1,'CONTINUE')
END





#CLAUSE
CHARACTER*MAXLIN FUNCTION CLAUSE(STRING)
IMPLICIT INTEGER (A-Z)
CHARACTER STRING,CH,SUBSTG

I=1
REPEAT [
        J = IFIND(STRING,I,"""';")
        CH = SUBSTG(STRING,J,J)
        IF (CH == ";") [
                CLAUSE = SUBSTG(STRING,1,J-1)
                STRING = SUBSTG(STRING,J+1,9999)
                RETURN ]
        I = IFIND(STRING,J+1,CH)+1  # FIND MATCHING QUOTE
       ]
UNTIL ( I == 1 )
CLAUSE = STRING
STRING = ""
RETURN
END





#FORS
SUBROUTINE FORS(LAB)
%#FCOMMON.FOR
DATA FORPTR /1/

DECREMENT BRKPTR 
DECREMENT FORPTR
CALL SETLEN(FORSTK(FORPTR),FORLEN(FORPTR))

IF ( IVERFY(FORSTK(FORPTR),1," ") != 0 ) 
       WRITE(OUTFIL,100)LAB+1,TAB,FORSTK(FORPTR)
ELSE   WRITE(OUTFIL,101)LAB+1,TAB
WRITE(OUTFIL,102)TAB,LAB,LAB+2

RETURN

100 FORMAT(I6,A1,A0)
101 FORMAT(I6,A1,'CONTINUE')
102 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE')

END





#DOCODE
SUBROUTINE DOCODE(LAB)
%#FCOMMON.FOR

LAB = LABGEN(1EXTRA)
CALL PUSH(LAB)
WRITE(OUTFIL,100)TAB,LAB
CALL EATUP(SCRAT)
WRITE(OUTFIL)SCRAT,CRLF

RETURN

100  FORMAT(1X,A1,'DO',I6$
END





#PUSH
SUBROUTINE PUSH(LAB)
%#FCOMMON.FOR

IF (BRKPTR < MAXBREAK) [
    INCREMENT BRKPTR
    BRKSTK(BRKPTR) = LAB ]

RETURN
END






#DOSTAT
SUBROUTINE DOSTAT(LAB)
%#FCOMMON.FOR

WRITE(OUTFIL,100)LAB,TAB,LAB+1
DECREMENT BRKPTR 

RETURN

100 FORMAT(I6,A1,'CONTINUE;',I5,' CONTINUE')
END





#EXIT
SUBROUTINE EXIT(CODE)
%#FCOMMON.FOR
DATA BRKPTR /0/

IF ( BRKPTR < 1 )
       CALL ERROR("ILLEGAL BREAK OR NEXT")
IF ( BRKPTR > MAXBREAK )
       CALL ERROR("BREAK OR NEXT NESTED TOO DEEP")
ELSE   WRITE(OUTFIL,100)TAB,BRKSTK(BRKPTR)+CODE

RETURN

100 FORMAT(1X,A1,'GOTO',I6)
END





#LABGEN
INTEGER FUNCTION LABGEN(EXTRA)
INTEGER EXTRA
DATA LABEL /23000/

INCREMENT LABEL
LABGEN = LABEL
LABEL = LABEL+EXTRA

RETURN
END





#EATUP
SUBROUTINE EATUP(LSCRAT)
%#FCOMMON.FOR
CHARACTER*SCRATSIZE LSCRAT, SUBSTG
CHARACTER CH

CALL SETLEN(GCBUF,LGCBUF)

I = 0; LSCRAT = ""
REPEAT [
        I = IFIND(GCBUF,I+1,"""';,+-[[]")
        IF (I==0) [
            I = KLEN(GCBUF)
            BREAK ]

        CH = SUBSTG(GCBUF,I,I)

        IF (CH=="""" | CH=="'") [
            I = IFIND(GCBUF,I+1,CH)
            IF (I==0) [
                CALL ERROR("MISSING QUOTE")
                K = KLEN(GCBUF)
                BREAK ]
            NEXT ]

        IF (CH=="[[" | CH=="]" | CH==";") [
            DECREMENT I
            BREAK ]

        IF (CH=="," | CH=="+" | CH=="-")[
            IF (IVERFY(GCBUF,I+1,FILL)==0) [
                CALL ADDTO(LSCRAT,GCBUF,I+1)
                WRITE(OUTFIL)LSCRAT,CRLF
                LSCRAT = "[09]1"
                CALL READCD(GCBUF) 
                I = 0 ]]
       ]

CALL ADDTO(LSCRAT,GCBUF,I); LGCBUF = KLEN(GCBUF)

RETURN
END





#BALPAR
SUBROUTINE BALPAR(LSCRAT,DOSPLT)
%#FCOMMON.FOR
CHARACTER*SCRATSIZE LSCRAT
CHARACTER SUBSTG,CH 

CALL SETLEN(GCBUF,LGCBUF)

NLPAR = 1 
J = 1
LSCRAT="" 
GCBUF=SUBSTG(GCBUF,IVERFY(GCBUF,1,FILL),9999)
IF (KHAR(GCBUF,1)!='(')
     CALL ERROR("MISSING (")
ELSE REPEAT [
             IF (EOFL) BREAK
             J = IFIND(GCBUF,J+1,"()""'[[]")
             CH = SUBSTG(GCBUF,J,J)
             IF (J==0) [
                  CALL ADDTO(LSCRAT,GCBUF,KLEN(GCBUF))
                  IF (DOSPLT==SPLIT) [
                      WRITE(OUTFIL)LSCRAT,CRLF
                      LSCRAT = "[09]1" ]
                  CALL READCD(GCBUF) ]
             ELSE IF (CH=="(")
                      INCREMENT NLPAR
             ELSE IF (CH==")") [
                      DECREMENT NLPAR
                      IF (NLPAR==0) BREAK ] 
             ELSE IF (CH=="""" | CH=="'")
                      J = IFIND(GCBUF,J+1,CH)
             ELSE [CALL ERROR("MISSING )")
                   DECREMENT J
                   BREAK ]
           ]

CALL ADDTO(LSCRAT,GCBUF,J)
LGCBUF = KLEN(GCBUF)

RETURN
END





#ERROR
SUBROUTINE ERROR(IAR)
%#FCOMMON.FOR
CHARACTER*30 IAR 
DATA ERRCNT /0/

WRITE(OUTFIL,100)IAR
INCREMENT ERRCNT

RETURN

100 FORMAT('CC ***ERROR*** ',A0)
END





#READCD
SUBROUTINE READCD(BUF)
%#FCOMMON.FOR
CHARACTER*MAXLIN INBUF,LBUF,BUF,LOOKUP,SUB,SUBSTG
DATA EOFL/.FALSE./

BUF = ""
IF (EOFL) RETURN
REPEAT [READ(INFIL,100,ENDFILE=200)INBUF

        IF (KHAR(INBUF,1)!='%') BREAK

        WRITE(OUTFIL,100)INBUF
        NEXT

        200 IF (INFIL>5) [
                   X = IOCLOS(INFIL)
                   INFIL = INFIL-5 ]
            ELSE [ EOFL = .TRUE.
                   RETURN ]
       ]

J = 0

REPEAT [

I = IFIND(INBUF,J+1,"""'<>=!&|[09]#{}"); IF (I==0) I=9999
LBUF = SUBSTG(INBUF,J+1,I-1)
J = I

REPEAT [
        L = IFIND(LBUF,1,ALPHANUMERIC)
        IF (L==0) BREAK
        K = IVERFY(LBUF,L,ALPHANUMERIC); IF (K==0) K=9999
        CALL ADDSTG(BUF,SUBSTG(LBUF,1,L-1),LOOKUP(SUBSTG(LBUF,L,K-1)))
        LBUF = SUBSTG(LBUF,K,9999)
       ]

CALL ADDSTG(BUF,LBUF)

 
GOTO (1,2,2,3,4,5,6,7,8,9,10,11,1),ITABLE("""'<>=!&|[09]{}#",1,KHAR(INBUF,I))+1

#       NOTHING SPECIAL REMAINING IN LBUF
1       RETURN

#       MATCH QUOTE
2       J = IFIND(INBUF,I+1,SUBSTG(INBUF,I,I))
        IF (J==0) [
            CALL ERROR("MISSING QUOTE")
            CALL ADDSTG(INBUF,SUBSTG(INBUF,I,I))
            J = 9999 ]
        CALL ADDSTG(BUF,SUBSTG(INBUF,I,J))
        NEXT

#       < OR <=
3       IF (KHAR(INBUF,I+1) != '=')
               CALL ADDSTG(BUF,".LT.")
        ELSE [ CALL ADDSTG(BUF,".LE.")
               INCREMENT J ]
        NEXT

#       > OR >=
4       IF (KHAR(INBUF,I+1) != '=') 
               CALL ADDSTG(BUF,".GT.")
        ELSE [ CALL ADDSTG(BUF,".GE.")
               INCREMENT J ]
        NEXT

#       = OR ==
5       IF (KHAR(INBUF,I+1) != '=') 
               CALL ADDSTG(BUF,"=")
        ELSE [ CALL ADDSTG(BUF,".EQ.")
               INCREMENT J ]
        NEXT

#       ! OR !=, BUT LEAVE !HEXCONSTANT! INTACT
6       K = IVERFY(INBUF,I+1,"0123456789ABCDEF")
        IF (KHAR(INBUF,K) == '!')
             J=K
        ELSE IF (KHAR(INBUF,I+1) != '=') 
                    CALL ADDSTG(BUF,".NOT.")
             ELSE [ CALL ADDSTG(BUF,".NE.")
                    INCREMENT J ]
        NEXT

#       & OR &&
7       IF (KHAR(INBUF,I+1) == '&') 
            INCREMENT J
        CALL ADDSTG(BUF,".AND.")
        NEXT

#       | OR ||
8       IF (KHAR(INBUF,I+1) == '|')
            INCREMENT J
        CALL ADDSTG(BUF,".OR.")
        NEXT

#       TAB
9       CALL ADDSTG(BUF," ")
        NEXT

#       {
10      CALL ADDSTG(BUF,"[[")
        NEXT

#       }
11      CALL ADDSTG(BUF,"]")
]

100 FORMAT(A0)
END
ADDSTG(BUF,".GE.")