#				FILE= RAT3.RAT
#
# EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT
# SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.
# BOB DENNY
# 25-MAR-80
#
IFNOTDEF(ALPHA)
INCLUDE/NL DEFIN
INCLUDE RATDEF
ENDIFDEF
#
   SUBROUTINE OUTCON(N)
# OUTCON - GENERATE  "N   CONTINUE" CODE
#
#
   INTEGER N
#
INCLUDE CUCLC
#
   STRING CONU "CONTINUE"
   STRING CONL "continue"
#
   IF (N > 0)
      CALL OUTNUM(N)		#OUTPUT STATEMENT NUMBER, IF ANY
   CALL OUTTAB
   IF (LC == YES)
      CALL OUTSTR(CONL)
   ELSE
      CALL OUTSTR(CONU)
   CALL OUTDON
#
   RETURN
   END
   SUBROUTINE OUTDON
#
# OUTDON - FINISH OFF A FORTRAN CODE (OUTPUT) LINE
# PCN #77, 5 JAN 80, DELETE 'NEWLINE' CHARACTER AT END OF LINE.
#
#
INCLUDE COUTLN
#
   IF (OUTP < 0)
      OUTP=IABS(OUTP)			#RESTORE CORRECT VALUE
## OUTBUF(OUTP+1) = NEWLINE		#PCN #77
   OUTBUF(OUTP+1) = EOS
   CALL PUTLIN(OUTBUF, STDOUT, NO)	#PCN 77, NO CARRIAGE CONTROL
   OUTP = 0
#
   RETURN
   END
   SUBROUTINE OUTGO(N)
#
# OUTGO - GENERATE "GOTO  N" CODE
# PCN#56, 14 APR 79, DROP BLANK AFTER 'GOTO' IF COMPRESSING
#
#
   INTEGER N
#
INCLUDE CUCLC
#
   STRING GOTOU "GOTO"
   STRING GOTOL "goto"
#
   CALL OUTTAB		#TAB OVER, IF BEGINNING OF LINE
   IF (LC == YES)		#OUTPUT "GOTO "
      CALL OUTSTR(GOTOL)
   ELSE
      CALL OUTSTR(GOTOU)
   IF (COMPRS == NO)		#PCN #56
      CALL OUTCH(BLANK)
   CALL OUTNUM(N)		#OUTPUT THE NUMBER
   CALL OUTDON		#FINISH OFF THE LINE
#
   RETURN
   END
   SUBROUTINE OUTIF
#
# OUTIF - GENERATE "IF (.NOT." CODE FOR 'FOR' AND 'IF' STATEMENTS
# SYKES,18FEB77
# PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
# PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT
#
#
INCLUDE CPRTLN
#
INCLUDE CUCLC
#
#
   STRING IFNOTU "IF (.NOT."		#PCN#76, ADD BLANK
   STRING IFNOTL "if (.not."
#
   CALL OUTTAB      			# GET TO COLUMN 7
   IF (LC == YES)
      CALL OUTSTR(IFNOTL)		# " IF(.NOT. "
   ELSE
      CALL OUTSTR(IFNOTU)
#
   IFTYP=YES				#PCN #75, TELL 'PRTLN' IS WAS AN 'IF'
#
   RETURN
   END
IFNOTDEF (ASCII)
   CHARFUNC FUNCTION OUTMAP FUNCSIZE (INCHAR)
#
# OUTMAP - CONVERT INTERNAL ASCII TO EXTERNAL CODE
#
#
   INTEGER I
   CHARACTER INCHAR
#
INCLUDE CCHAR
#
   IF (INCHAR == INTBLK) 
      RETURN (EXTBLK)
   DO I = 1, 10
      IF (INCHAR == INTDIG(I)) 
         RETURN (EXTDIG(I))
   DO I = 1, 26
      IF (INCHAR == INTLET(I)) 
         RETURN (EXTLET(I))
   DO I = 1, 26
      IF (INCHAR == INTBIG(I)) 
         RETURN (EXTBIG(I))
   DO I = 1, NCHARS
      IF (INCHAR == INTCHR(I)) 
         RETURN (EXTCHR(I))
   RETURN (INCHAR)
   END
ENDIFDEF
   SUBROUTINE OUTNUM(N)
#
# OUTNUM - OUTPUT DECIMAL NUMBER TO FORTRAN CODE FILE
#
#
   CHARACTER CHARS(MAXCHARS)
   INTEGER JUNK, LEN, N, SITOC
#
   JUNK=SITOC(N, CHARS, MAXCHARS)	#SYKES 6 OCT 76 DON'T GO OVER END OF LINE
   CALL OUTSTR(CHARS)
#
   RETURN
   END
   SUBROUTINE OUTSTR(STR)
#
# OUTSTR - OUTPUT A STRING TO FORTRAN CODE FILE
#  ALSO CONVERT DOUBLE QUOTED STRINGS TO HOLLERITH.
#   PASS SINGLE QUOTED STRINGS UNPROCESSED.
#
#
   CHARACTER C, STR(DUMMYSIZE), CHARS(MAXCHARS)
   INTEGER I, J, SLEN, LEN, K, SITOC
#
INCLUDE COUTLN
#
INCLUDE CUCLC
#
   I=SLEN(STR)
   IF ((OUTP + I >= 72) & (OUTP > 6))		#FORCE IMMEDIATE
      OUTP = -OUTP				#ADVANCE INSTEAD OF RUNNING OVER EOL
   FOR (I = 1; STR(I) != EOS; INCREMENT (I)) [
      C = STR(I)
      IF (C != DQUOTE)
         CALL OUTCH(C)
      ELSE [
         INCREMENT (I)
         FOR (J = I; STR(J) != C; INCREMENT (J))	# FIND END
             ;
         LEN=SITOC(J-I, CHARS, MAXCHARS)
         FOR (K=1; K <= LEN; INCREMENT(K))
         CALL OUTCH (CHARS(K))
         IF (LC == YES)
            CALL OUTCH(LETH)
         ELSE
            CALL OUTCH(BIGH)
         FOR ( ; I < J; INCREMENT (I))
            CALL OUTCH(STR(I))
         ] 
      ] 
#
   RETURN
   END
   SUBROUTINE OUTTAB
#
# OUTTAB - GENERATE A TAB AT BEGINNING OF FORTRAN LINE
# PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
#
#
INCLUDE COUTLN
#
INCLUDE CLINE				#PCN#75
#
   WHILE (OUTP < 6)
      CALL OUTCH(BLANK)
#
   IF (OUTP == 6)		#PCN #75, MAY BE CALLED IN MIDDLE OF LINE
      INCREMENT (FTNLN)	#PCN75, COUNT THIS FTN LINE, IF A NEW ONE
#
   RETURN
   END
    SUBROUTINE PARSE
#
# PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE
# PCN # 93, 17 FEB 80, MOVE FINDING PROCESSOR FEATURES HERE FROM GETTOK.
# PCN #92, 20 FEB 80, ADD RETURN (EXPRESSION).
#
#
   CHARACTER LEXSTR(MAXTOK), LAST
   INTEGER LEX, STRNGS
   INTEGER LAB, LABVAL(MAXSTACK), LEXTYP(MAXSTACK), SP, TOK
   DATA STRNGS / NO /
#
   SP = 1
   LEXTYP(1) = EOF
   FOR ( TOK = LEX(LEXSTR);  TOK != EOF;  TOK = LEX(LEXSTR) ) [
      IF (STRNGS == YES & TOK != LEXSTRNG & TOK != SEMICOL) [	#PCN #93
         CALL ENDSTR
         STRNGS=NO
         ]
      IF (TOK == LEXIF)
         CALL IFCODE(LAB)
      ELSE IF (TOK == LEXDEFINE \ TOK == LEXMACRO) 
         CALL ADDDEF (LEXSTR, MAXTOK)			#PCN #93
      ELSE IF (TOK == LEXDO)
         CALL DOCODE(LAB)
      ELSE IF (TOK == LEXDIGITS)
         CALL LABELC(LEXSTR)
      ELSE IF (TOK == LEXEND)
          CALL ENDCOD (LEXSTR, SP)
      ELSE IF (TOK == LEXENDIF) 			#PCN # 93
            ;						#NO ACTION NEEDED
      ELSE IF (TOK == LEXIFDEF) 			#PCN #93
         CALL IFDEFC (YES)
      ELSE IF (TOK == LEXIFNOT) 			#PCN #93
         CALL IFDEFC (NO)
      ELSE IF (TOK == LEXINCLUD)			#PCN #93
         CALL OPENI					#OPEN THE INCLUDE FILE
      ELSE IF (TOK == LEXFOR)
         CALL FORCOD(LAB, SP)
      ELSE IF (TOK == LEXREPEAT)
         CALL REPCOD(LAB, SP)
      ELSE IF (TOK == LEXSTRNG) [			#PCN #93
         STRNGS=YES				#AT LEAST 1 STRING HAS BEEN FOUND
         CALL STRNGC
         ]
      ELSE IF (TOK == LEXELSE) [
         IF (LEXTYP(SP) == LEXIF)
            CALL ELSEIF(LABVAL(SP), LAST)		#PCN#10
         ELSE
            CALL SYNERR("ILLEGAL ELSE.")
         ] 
      ELSE IF (TOK == LEXWHILE)
         CALL WHILEC(LAB, SP)			#SYKES 6 OCT 76
#
#PCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR)
      IF (TOK != RBRACE)
         LAST=TOK
#
      IF (TOK==LEXIF \ TOK==LEXELSE \ TOK==LEXWHILE
                     \ TOK==LEXFOR \ TOK==LEXREPEAT
                     \ TOK==LEXDO \ TOK==LEXDIGITS \ TOK==LBRACE) [
         INCREMENT (SP)     				 	#START OF STATEMENT
         IF (SP > MAXSTACK)
            CALL ERROR("STACK OVERFLOW IN PARSER.")	#TERMINATE
         LEXTYP(SP) = TOK   				# STACK TYPE  VALUE
         LABVAL(SP) = LAB
         ] 
      ELSE [  			   	# END OF STATEMENT-PREPARE TO UNSTACK
         IF (TOK == RBRACE) [
            IF (LEXTYP(SP) == LBRACE)
               DECREMENT (SP)
            ELSE
               CALL SYNERR("ILLEGAL ].")
            ]
         ELSE IF (TOK == LEXOTHER \ TOK == LEXSTOP)
            CALL OTHERC (LEXSTR)
         ELSE IF (TOK == LEXRETURN)				#PCN #92
            CALL RETCOD (LEXSTR)
         ELSE IF (TOK == LEXBREAK \ TOK == LEXNEXT)
            CALL BRKNXT(SP, LEXTYP, LABVAL, TOK)
#
         TOK = LEX(LEXSTR)  			 	# PEEK AT NEXT TOK
         CALL PBSTR(LEXSTR)
         CALL UNSTAK(SP, LEXTYP, LABVAL, TOK, LAST)
         ] 
      ] 
#
   RETURN
   END
   SUBROUTINE PBSTR(IN)
#
# PBSTR - PUSH STRING BACK ONTO INPUT FOR LATER RE-INPUT
#
#
   CHARACTER IN(DUMMYSIZE)
   INTEGER I, SLEN
#
   FOR (I=SLEN(IN); I > 0; DECREMENT(I))
      CALL PUTBAK(IN(I))
#
   RETURN
   END
   SUBROUTINE PUTBAK(C)
#
# PUTBAK - PUSH CHARACTER BACK ONTO INPUT FOR LATER RE-RETRIVAL
#
#
   CHARACTER C
#
INCLUDE CDEFIO
#
   INCREMENT (BP)
   IF (BP > BUFSIZE)
      CALL ERROR("PUSHBACK STACK OVERFLOW.")		#TERMINATE
   ELSE
      BUF(BP) = C
#
   RETURN
   END
   SUBROUTINE RATGO (SWITCH)
#
# RATGO - RATFOR INITIALIZATION ROUTINE
# SYKES 26 SEP 76
#
#
   INTEGER SWITCH, JUNK, I, LABGEN
#
INCLUDE CDEFIO
#
INCLUDE CFOR
#
INCLUDE CFUNC
#
INCLUDE CLINE
#
INCLUDE CLIST
#
INCLUDE CLOOK
#
INCLUDE COUTLN
#
INCLUDE CPRTLN
#
INCLUDE CSTR
#
#
###COUTLN
      OUTP=0
#
### CLINE
      LEVEL=1
      LINECT=1 
      INFILE(1)=STDIN
      FTNLN=0				#PCN #75
#
### CDEFIO
      BP=0
#
### CFOR
      FORDEP=0
      FORLEN=1
#
### CFUNC
      INFUNC=NO			#PCN #92
#
### CLOOK
      IF (SWITCH == YES) [
         LASTP=0		#INITIALIZE DEFINITION TABLE PARAMETERS
         LASTT=0
         TWOS=1
         ]
#
### CLIST
      PAGE=0
      PLINE=9999		#FORCE HEADER UPON FIRST PAGE
      ERRORS=0
      INIF=NO
#
### CPRTLN
      READY=NO		#MUSTN'T PRINT VERY FIRST TIME
#
### CSTR
      LASTS=0
      LASTR=0
#
   I=LABGEN(0)		#RESET STARTING LABEL TO 20000
   JUNK=LABGEN(20000-I)
#
   RETURN
   END
   SUBROUTINE RELATE (TOKEN, LAST)		#PCN #94
#
# RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG FORM
#SYKES, 20 NOV 76
# PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD  && FOR .EQV.
# PCN #77, 5 JAN 80, USE FOLD TO GET LOWER CASE VERSIONS, IF NEEDED
# PCN #87, 10 FEB 80, ALLOW << AND >> FOR < AND >.
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
#
#
   CHARACTER NGETCH, DOTS(6,11), TOKEN(DUMMYSIZE), NEXTCH, THISCH
   INTEGER LAST, LINE, JUNK, SCOPY
#
INCLUDE CUCLC
#
   DATA DOTS/ PERIOD, BIGG, BIGE, PERIOD, EOS, EOS,
              PERIOD, BIGG, BIGT, PERIOD, EOS, EOS,
              PERIOD, BIGL, BIGE, PERIOD, EOS, EOS,
              PERIOD, BIGL, BIGT, PERIOD, EOS, EOS,
              PERIOD, BIGN, BIGE, PERIOD, EOS, EOS,
              PERIOD, BIGN, BIGO, BIGT, PERIOD, EOS,
              PERIOD, BIGE, BIGQ, PERIOD, EOS, EOS,
              PERIOD, BIGA, BIGN, BIGD, PERIOD, EOS,
              PERIOD, BIGO, BIGR, PERIOD, EOS, EOS,
              PERIOD, BIGX, BIGO, BIGR, PERIOD, EOS,
              PERIOD, BIGE, BIGQ, BIGV, PERIOD, EOS/	#PCN #73, DEC 79, PCN#77, JAN 80
#
   LINE=0
   THISCH=TOKEN(1)
   NEXTCH=NGETCH(NEXTCH)		#PCN 73, DEC 79, WE NEED TO LOOK AT NEXT CHAR
   IF (THISCH == GREATER)
      IF (NEXTCH == EQUALS)		#>=
         LINE=1			#.GE.
      ELSE IF (NEXTCH == LESS)	#><
         LINE=5			#.NE. PCN#73
      ELSE IF (NEXTCH == GREATER)	#>> PCN # 87
         LINE=2			#.GT.
      ELSE [
         LINE=2			#.GT.
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
         ]
   ELSE IF (THISCH == LESS)
      IF (NEXTCH == EQUALS)		#<=
         LINE=3			#.LE.
      ELSE IF (NEXTCH == GREATER)	#<>
         LINE=5			#.NE.  PCN#73
      ELSE IF (NEXTCH == LESS)	#<<, PCN #87
         LINE=4			#.LT.
      ELSE [
         LINE=4			#.LT.
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
         ]
   ELSE IF (THISCH == NOT)
      IF (NEXTCH == EQUALS)		#!=
         LINE=5			#.NE.
      ELSE [
         LINE=6			#.NOT.
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
         ]
   ELSE IF (THISCH == EQUALS)
      IF (NEXTCH == EQUALS)		#==
         LINE=7			#.EQ.
      ELSE
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
   ELSE IF (THISCH == AMPER)
      IF (NEXTCH == AMPER)		#PCN#73, DEC 79, .EQV.
         LINE=11			#.EQV.
      ELSE [
         LINE=8			#.AND.
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
         ]
   ELSE IF (THISCH == BAR)
      IF (NEXTCH == BAR \ NEXTCH == BACKSLASH)	#***DPS9MAR7
         LINE=10			#.XOR.
      ELSE [
         LINE=9			#.OR.
         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED
         ]
#
   IF (LINE > 0) [
      LAST=SCOPY (DOTS(1,LINE), TOKEN, 10, JUNK)
      IF (LC == YES)
         CALL FOLD (TOKEN)		#CONVERT TO LOWER CASE, PCN#77
      ]
   ELSE [				# CAN'T HAPPEN EXCEPT FOR =
      TOKEN(2) = EOS
      LAST = 1
      ]
   RETURN
   END
   SUBROUTINE REPCOD(LAB, SP)
#
# REPCOD - GENERATE CODE FOR BEGINNING OF 'REPEAT'
#
#
   INTEGER LAB, SP, LABGEN
#
   IF (SP > 1)		#SYKES 6 OCT 76, ONLY IF THERE MIGHT BE SOMETHING
      CALL OUTCON(0)		# IN CASE THERE WAS A LABEL
   LAB = LABGEN(3)
   CALL OUTCON(LAB)
   INCREMENT (LAB)		# LABEL TO GO ON NEXT'S
#
   RETURN
   END
   SUBROUTINE RETCOD (LEXSTR)
#
# RETCOD - PROCESS RETURN (EXPRESSION).
# PCN #92, 20 FEB 80,
#
#
   CHARACTER LEXSTR(MAXTOK), TOKEN(MAXTOK), GTOK
#
INCLUDE CFUNC
#
INCLUDE CUCLC
#
   IF (INFUNC == YES & GTOK(TOKEN,MAXTOK) == LPAREN) [
      CALL PBSTR (TOKEN)					#PUT THE '(' BACK
      CALL OUTTAB
      IF (LC == YES)
         CALL FOLD (FNAM)			#FUNC NAME TO LOWER CASE
      CALL OUTSTR (FNAM)			#OUTPUT FUNCTION NAME
      IF (COMPRS == NO)
         CALL OUTCH (BLANK)
      CALL OUTCH (EQUALS)			#OUTPUT =
      IF (COMPRS == NO)
         CALL OUTCH (BLANK)
      CALL BALPAR				#OUTPUT (EXPRESSION)
      CALL OUTDON				#FINISH OFF LINE
      IF (LC == YES)
         CALL FOLD (LEXSTR)			#CONVERT 'RETURN' TO LC
      CALL OTHERC (LEXSTR)			#OUTPUT 'RETURN'
      ]
   ELSE [
      CALL PBSTR (TOKEN)			#FALSE ALARM, DON'T NEED IT
      CALL OTHERC (LEXSTR)			#JUST OUTPUT 'RETURN'
      ]
#
   RETURN
   END
   SUBROUTINE STRNGC 				#PCN 93
#
# STRNGC - GENERATE FIRST PART OF CODE FOR 'STRING' KEYWORD
#SYKES 15OCT76, 12MAR77
# PCN # 21, 10 DEC 77
# PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
# PCN # 93, 17 FEB 80, CALL FROM PARSE, CHANGE CALLING SEQ.
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
#ASSUMES THAT THE TARGET COMPILER ALLOWS MULTIPLE ELEMENT SPECIFICATION
# IN DATA STATEMENTS .
#THE STRING KEYWORDS MUST BE POSITIONED AFTER ALL OTHER FORTRAN
#  SPECIFICATION STATEMENTS, EXCEPT FOR ANY DATA STATEMENTS.
#EACH "STRING FOO "BLATS"" LINE CAUSES IMMEDIATE OUTPUT OF A
# "CHARACTER FOO(4)" LINE AND A "DATA FOO/.../" LINE IS HELD UNTIL
# ALL STRING LINES HAVE BEEN PROCESSED, THEN INSERTED BEFORE THE
# FIRST NON-STRING LINE, SO THAT ALL DATA STATEMENTS ARE AT THE
# BOTTOM OF THE SPECIFICATION STATEMENTS.
#
#
IFDEF (STRINGS)
#
   CHARACTER TOKEN(MAXTOK), NAME(MAXTOK)
   CHARACTER DEFTOK
   INTEGER J, LEN, JUNK, INSTAL
#
INCLUDE CSTR
#
INCLUDE CUCLC
#
   STRING CHAR "CHARACTER"
#
   CALL PUTBAK (FORMFEED)		#SOME UNIQUE FLAG
   CALL PBSTR(CHAR)
   CALL OUTTAB
   WHILE (DEFTOK(TOKEN,MAXTOK) != FORMFEED) [		#PCN #93
      CALL OUTSTR (TOKEN)			#COMES BACK DEFINED
      IF (COMPRS == NO)			#***PCN # 21
         CALL OUTCH (BLANK)
      ]
   IF ((DEFTOK(NAME,MAXTOK) != ALPHA) \
       (DEFTOK(TOKEN,MAXTOK) != DQUOTE))  [
      CALL SYNERR ("ILLEGAL STRING.")
      RETURN
      ]
   CALL OUTSTR (NAME)
   IF (COMPRS == NO)			#***PCN # 21
      CALL OUTCH  (BLANK)
   CALL OUTCH  (LPAREN)
   FOR (LEN=2; TOKEN(LEN) != DQUOTE; INCREMENT(LEN))
      ;
   CALL OUTNUM (LEN-1)
   CALL OUTCH  (RPAREN)
   CALL OUTDON			#'CHARACTER NAME(N)'
   TOKEN(LEN)=EOS			#CLOBBER TRAILING "
#
# FILE THE ARRAY NAME AND THE STRING DEFINITION AWAY FOR FUTURE DUMPING
   IF (INSTAL(NAME,TOKEN(2),LASTS,LASTR,STRPTR,MAXSTR,NUMSTR,TABLES) == BAD)	#PCN#62
      CALL SYNERR ("TOO MANY STRINGS.")
#
ENDIFDEF
#
IFNOTDEF (STRINGS)
   CALL SYNERR ("STRING KEYWORD NOT ALLOWED.")
ENDIFDEF
#
   RETURN
   END
   CHARFUNC FUNCTION TOKDEF FUNCSIZE (TOKEN, TOKSIZ)		#PCN #94
#
# TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH'
#SYKES, APR77, 
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
#  USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH' BECAUSE 'MATH'
#  IS CALLED BY DEFTOK AND THEREFORE CANNOT CALL DEFTOK. THIS MAKES SURE
#  THAT SYMBOLS  WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING
#  MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLIC
#  CONSTANTS DEFINED AS NEGATIVE INTEGERS, WHICH ARE RETURNED AS A
#  SINGLE TOKEN INSTEAD OF TWO TOKENS.
#
#
   INTEGER TOKSIZ, LOOKFR, SUB
   CHARACTER DEFN(MAXDEF), T, TOKEN(TOKSIZ), GTOK, TYPE
#
   SUB=1
   FOR (T=GTOK(TOKEN(SUB), TOKSIZ); T != EOF;
                           T=GTOK(TOKEN(SUB), TOKSIZE)) [
      IF (T != ALPHA \ TYPE(TOKEN(SUB)) != LETTER)
         IF (T == MINUS) [			#IF A '-', ASSUME A NUMBER FOLLOWS
            SUB=2				#SO GO GET IT INTO 'TOKEN' AFTER THE '-'
            NEXT
            ]
         ELSE
            BREAK				#DONE WHEN WE GET A NUMBER
      CALL UNFOLD (TOKEN)			#FORCE TO UPPER CASE FOR LOOKUP
      IF (LOOKFR(TOKEN, DEFN) == NO) [		# UNDEFINED
         CALL SYNERR ("UNDEFINED SYMBOLIC IN <MATH>.")
         RETURN (BAD)
         ]
      ELSE
         CALL PBSTR (DEFN)		#TRY REDEFINING DEFINITION UNTIL WE GET A NUMBER
      ]
   RETURN (YES)
#
   END
   SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN, LAST)
#
# UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT
# PCN # 16, 14 NOV 77
# PCN 93, 16 FEB 80, MOVE FEATURE FINDING FROM GETTOK TO PARSE/LEX
#
#
   INTEGER LABVAL(MAXSTACK), LEXTYP(MAXSTACK), SP, TOKEN
   CHARACTER LAST
#
   IF (TOKEN != LEXIFNOT & TOKEN != LEXIFDEF  & TOKEN != LEXENDIF
                                               & TOKEN != LEXINCLUD ) [	#PCN #93
      FOR ( ; SP > 1; DECREMENT(SP)) [
         IF (LEXTYP(SP) == LBRACE)
            BREAK
         ELSE IF (LEXTYP(SP) == LEXIF & TOKEN == LEXELSE)	#PCN#20
            BREAK
         ELSE IF  (LEXTYP(SP) == LEXIF) [			#PCN#20
            CALL OUTCON(LABVAL(SP))
            LAST = BLANK					#PCN #16
            ]
         ELSE IF (LEXTYP(SP) == LEXELSE) [
            IF (SP > 2)
               DECREMENT (SP)
            CALL OUTCON(LABVAL(SP)+1)
            LAST = BLANK		#PCN 16, DON'T NEED TO IT ANYMORE WE CAN GET THERE
            ]
         ELSE IF (LEXTYP(SP) == LEXDO) [
            CALL OUTCON(LABVAL(SP))		#DOSTAT, END OF DO
            CALL OUTCON(LABVAL(SP)+1)
            ]
         ELSE IF (LEXTYP(SP) == LEXWHILE) [
            CALL OUTGO(LABVAL(SP))		#WHILES, END OF WHILE
            CALL OUTCON(LABVAL(SP)+1)
            ]
         ELSE IF (LEXTYP(SP) == LEXFOR)
            CALL FORS(LABVAL(SP))
         ELSE IF (LEXTYP(SP) == LEXREPEAT)
            CALL UNTILS(LABVAL(SP), TOKEN)
         ]
      ]
#
   RETURN
   END
   SUBROUTINE UNTILS(LAB, TOKEN)
#
# UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS
# PCN #75, DEC 79, ADD FTN LINE NUMBERS TO RATFOR LISTING
#
#
   CHARACTER PTOKEN(MAXTOK)
   INTEGER JUNK, LAB, TOKEN, LEX
#
INCLUDE CPRTLN
#
INCLUDE CUCLC			#PCN #75
#
   CALL OUTNUM(LAB)
   IF (TOKEN == LEXUNTIL) [
      JUNK = LEX(PTOKEN)
      CALL IFGO(LAB-1)
      FORTYP=YES		#PCN #75, HAVE PRTLIN SUBTRACT 1 FTN LINE NUM
     ]
   ELSE
      CALL OUTGO(LAB-1)
   CALL OUTCON(LAB+1)
#
   RETURN
   END
   SUBROUTINE WHILEC(LAB, SP)
#
# WHILEC - GENERATE CODE FOR BEGINNING OF 'WHILE' STATEMENTS
#
#
   INTEGER LAB, SP, LABGEN
#
   IF (SP > 1)		#SYKES, 6 OCT 76, 
      CALL OUTCON(0)		#UNLABELED CONTINUE, IN CASE THERE WAS A LABEL
   LAB = LABGEN(2)
   CALL OUTNUM(LAB)
   CALL IFGO(LAB+1)
#
   RETURN
   END