0023#				FILE= RAT3.RAT0005#0073# EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT0075# SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.0015# BOB DENNY0015# 25-MAR-800005#0019IFNOTDEF(ALPHA)0020INCLUDE/NL DEFIN0018INCLUDE RATDEF0012ENDIFDEF0005#00050027   SUBROUTINE OUTCON(N)0044# OUTCON - GENERATE  "N   CONTINUE" CODE0005#0005#0016   INTEGER N0005#0017INCLUDE CUCLC0005#0029   STRING CONU "CONTINUE"0029   STRING CONL "continue"0005#0017   IF (N > 0)^^^^^^^^^^^^^^^^^^0058      CALL OUTNUM(N)		#OUTPUT STATEMENT NUMBER, IF ANY0018   CALL OUTTAB0021   IF (LC == YES)0027      CALL OUTSTR(CONL)0011   ELSE0027      CALL OUTSTR(CONU)0018   CALL OUTDON0005#0013   RETURN0010   END00050024   SUBROUTINE OUTDON0005#0054# OUTDON - FINISH OFF A FORTRAN CODE (OUTPUT) LINE0067# PCN #77, 5 JAN 80, DELETE 'NEWLINE' CHARACTER AT END OF LINE.0005#0005#0018INCLUDE COUTLN0005#0020   IF (OUTP < 0)0050      OUTP=IABS(OUTP)			#RESTORE CORRECT VALUE0041## OUTBUF(OUTP+1) = NEWLINE		#PCN #77^^^^^0027   OUTBUF(OUTP+1) = EOS0067   CALL PUTLIN(OUTBUF, STDOUT, NO)	#PCN 77, NO CARRIAGE CONTROL0015   OUTP = 00005#0013   RETURN0010   END00050026   SUBROUTINE OUTGO(N)0005#0037# OUTGO - GENERATE "GOTO  N" CODE0063# PCN#56, 14 APR 79, DROP BLANK AFTER 'GOTO' IF COMPRESSING0005#0005#0016   INTEGER N0005#0017INCLUDE CUCLC0005#0026   STRING GOTOU "GOTO"0026   STRING GOTOL "goto"0005#0051   CALL OUTTAB		#TAB OVER, IF BEGINNING OF LINE0038   IF (LC == YES)		#OUTPUT "GOTO "0028      CALL OUTSTR(GOTOL)0011   ELSE^0028      CALL OUTSTR(GOTOU)0034   IF (COMPRS == NO)		#PCN #560027      CALL OUTCH(BLANK)0041   CALL OUTNUM(N)		#OUTPUT THE NUMBER0040   CALL OUTDON		#FINISH OFF THE LINE0005#0013   RETURN0010   END00050023   SUBROUTINE OUTIF0005#0069# OUTIF - GENERATE "IF (.NOT." CODE FOR 'FOR' AND 'IF' STATEMENTS0019# SYKES,18FEB770065# PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0072# PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT0005#0005#0018INCLUDE CPRTLN0005#0017INCLUDE CUCLC0005#^0005#0052   STRING IFNOTU "IF (.NOT."		#PCN#76, ADD BLANK0032   STRING IFNOTL "if (.not."0005#0044   CALL OUTTAB      			# GET TO COLUMN 70021   IF (LC == YES)0045      CALL OUTSTR(IFNOTL)		# " IF(.NOT. "0011   ELSE0029      CALL OUTSTR(IFNOTU)0005#0057   IFTYP=YES				#PCN #75, TELL 'PRTLN' IS WAS AN 'IF'0005#0013   RETURN0010   END00050020IFNOTDEF (ASCII)0049   CHARFUNC FUNCTION OUTMAP FUNCSIZE (INCHAR)0005#0054# OUTMAP - CONVERT INTERNAL ASCII TO EXTERNAL CODE0005#0005#0016   INTEGER I^^^^^^^^^^^^^^^^^^^0023   CHARACTER INCHAR0005#0017INCLUDE CCHAR0005#0029   IF (INCHAR == INTBLK) 0025      RETURN (EXTBLK)0019   DO I = 1, 100035      IF (INCHAR == INTDIG(I)) 0031         RETURN (EXTDIG(I))0019   DO I = 1, 260035      IF (INCHAR == INTLET(I)) 0031         RETURN (EXTLET(I))0019   DO I = 1, 260035      IF (INCHAR == INTBIG(I)) 0031         RETURN (EXTBIG(I))0023   DO I = 1, NCHARS0035      IF (INCHAR == INTCHR(I)) 0031         RETURN (EXTCHR(I))0022   RETURN (INCHAR)0010   END0012ENDIFDEF0005^^^^^^^^^^^^^^^0027   SUBROUTINE OUTNUM(N)0005#0057# OUTNUM - OUTPUT DECIMAL NUMBER TO FORTRAN CODE FILE0005#0005#0032   CHARACTER CHARS(MAXCHARS)0034   INTEGER JUNK, LEN, N, SITOC0005#0079   JUNK=SITOC(N, CHARS, MAXCHARS)	#SYKES 6 OCT 76 DON'T GO OVER END OF LINE0025   CALL OUTSTR(CHARS)0005#0013   RETURN0010   END00050029   SUBROUTINE OUTSTR(STR)0005#0051# OUTSTR - OUTPUT A STRING TO FORTRAN CODE FILE0055#  ALSO CONVERT DOUBLE QUOTED STRINGS TO HOLLERITH.0047#   PASS SINGLE QUOTED STRINGS UNPROCESSED.0005#0005#^^^^^^^^0051   CHARACTER C, STR(DUMMYSIZE), CHARS(MAXCHARS)0040   INTEGER I, J, SLEN, LEN, K, SITOC0005#0018INCLUDE COUTLN0005#0017INCLUDE CUCLC0005#0018   I=SLEN(STR)0059   IF ((OUTP + I >= 72) & (OUTP > 6))		#FORCE IMMEDIATE0062      OUTP = -OUTP				#ADVANCE INSTEAD OF RUNNING OVER EOL0050   FOR (I = 1; STR(I) != EOS; INCREMENT (I)) [0020      C = STR(I)0026      IF (C != DQUOTE)0026         CALL OUTCH(C)0016      ELSE [0026         INCREMENT (I)0063         FOR (J = I; STR(J) != C; INCREMENT (J))	# FIND END^^^^^0018             ;0044         LEN=SITOC(J-I, CHARS, MAXCHARS)0046         FOR (K=1; K <= LEN; INCREMENT(K))0034         CALL OUTCH (CHARS(K))0027         IF (LC == YES)0032            CALL OUTCH(LETH)0017         ELSE0032            CALL OUTCH(BIGH)0042         FOR ( ; I < J; INCREMENT (I))0034            CALL OUTCH(STR(I))0015         ] 0012      ] 0005#0013   RETURN0010   END00050024   SUBROUTINE OUTTAB0005#0058# OUTTAB - GENERATE A TAB AT BEGINNING OF FORTRAN LINE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0065# PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0005#0005#0018INCLUDE COUTLN0005#0028INCLUDE CLINE				#PCN#750005#0023   WHILE (OUTP < 6)0027      CALL OUTCH(BLANK)0005#0064   IF (OUTP == 6)		#PCN #75, MAY BE CALLED IN MIDDLE OF LINE0069      INCREMENT (FTNLN)	#PCN75, COUNT THIS FTN LINE, IF A NEW ONE0005#0013   RETURN0010   END00050024    SUBROUTINE PARSE0005#0073# PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0076# PCN # 93, 17 FEB 80, MOVE FINDING PROCESSOR FEATURES HERE FROM GETTOK.0050# PCN #92, 20 FEB 80, ADD RETURN (EXPRESSION).0005#0005#0037   CHARACTER LEXSTR(MAXTOK), LAST0026   INTEGER LEX, STRNGS0063   INTEGER LAB, LABVAL(MAXSTACK), LEXTYP(MAXSTACK), SP, TOK0025   DATA STRNGS / NO /0005#0013   SP = 10022   LEXTYP(1) = EOF0067   FOR ( TOK = LEX(LEXSTR);  TOK != EOF;  TOK = LEX(LEXSTR) ) [0074      IF (STRNGS == YES & TOK != LEXSTRNG & TOK != SEMICOL) [	#PCN #930024         CALL ENDSTR^^^^^^^^^^^^^^^^^^^^0022         STRNGS=NO0014         ]0027      IF (TOK == LEXIF)0029         CALL IFCODE(LAB)0055      ELSE IF (TOK == LEXDEFINE \ TOK == LEXMACRO) 0052         CALL ADDDEF (LEXSTR, MAXTOK)			#PCN #930032      ELSE IF (TOK == LEXDO)0029         CALL DOCODE(LAB)0036      ELSE IF (TOK == LEXDIGITS)0032         CALL LABELC(LEXSTR)0033      ELSE IF (TOK == LEXEND)0038          CALL ENDCOD (LEXSTR, SP)0048      ELSE IF (TOK == LEXENDIF) 			#PCN # 930040            ;						#NO ACTION NEEDED^^^^^^^^^^^^^^^^^^^^^^^^^0047      ELSE IF (TOK == LEXIFDEF) 			#PCN #930030         CALL IFDEFC (YES)0047      ELSE IF (TOK == LEXIFNOT) 			#PCN #930029         CALL IFDEFC (NO)0047      ELSE IF (TOK == LEXINCLUD)			#PCN #930050         CALL OPENI					#OPEN THE INCLUDE FILE0033      ELSE IF (TOK == LEXFOR)0033         CALL FORCOD(LAB, SP)0036      ELSE IF (TOK == LEXREPEAT)0033         CALL REPCOD(LAB, SP)0048      ELSE IF (TOK == LEXSTRNG) [			#PCN #930060         STRNGS=YES				#AT LEAST 1 STRING HAS BEEN FOUND^^^^^^^^^^^^^^^^^^^0024         CALL STRNGC0014         ]0036      ELSE IF (TOK == LEXELSE) [0037         IF (LEXTYP(SP) == LEXIF)0054            CALL ELSEIF(LABVAL(SP), LAST)		#PCN#100017         ELSE0044            CALL SYNERR("ILLEGAL ELSE.")0015         ] 0035      ELSE IF (TOK == LEXWHILE)0051         CALL WHILEC(LAB, SP)			#SYKES 6 OCT 760005#0064#PCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR)0028      IF (TOK != RBRACE)0021         LAST=TOK0005#0055      IF (TOK==LEXIF \ TOK==LEXELSE \ TOK==LEXWHILE^^^^^^^0055                     \ TOK==LEXFOR \ TOK==LEXREPEAT0071                     \ TOK==LEXDO \ TOK==LEXDIGITS \ TOK==LBRACE) [0057         INCREMENT (SP)     				 	#START OF STATEMENT0031         IF (SP > MAXSTACK)0066            CALL ERROR("STACK OVERFLOW IN PARSER.")	#TERMINATE0055         LEXTYP(SP) = TOK   				# STACK TYPE  VALUE0029         LABVAL(SP) = LAB0015         ] 0062      ELSE [  			   	# END OF STATEMENT-PREPARE TO UNSTACK0033         IF (TOK == RBRACE) [^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0041            IF (LEXTYP(SP) == LBRACE)0033               DECREMENT (SP)0020            ELSE0044               CALL SYNERR("ILLEGAL ].")0017            ]0055         ELSE IF (TOK == LEXOTHER \ TOK == LEXSTOP)0036            CALL OTHERC (LEXSTR)0051         ELSE IF (TOK == LEXRETURN)				#PCN #920036            CALL RETCOD (LEXSTR)0055         ELSE IF (TOK == LEXBREAK \ TOK == LEXNEXT)0052            CALL BRKNXT(SP, LEXTYP, LABVAL, TOK)0005#0055         TOK = LEX(LEXSTR)  			 	# PEEK AT NEXT TOK^^^^^^^^^^^^0031         CALL PBSTR(LEXSTR)0055         CALL UNSTAK(SP, LEXTYP, LABVAL, TOK, LAST)0015         ] 0012      ] 0005#0013   RETURN0010   END00050027   SUBROUTINE PBSTR(IN)0005#0060# PBSTR - PUSH STRING BACK ONTO INPUT FOR LATER RE-INPUT0005#0005#0030   CHARACTER IN(DUMMYSIZE)0022   INTEGER I, SLEN0005#0044   FOR (I=SLEN(IN); I > 0; DECREMENT(I))0028      CALL PUTBAK(IN(I))0005#0013   RETURN0010   END00050027   SUBROUTINE PUTBAK(C)0005#0067# PUTBAK - PUSH CHARACTER BACK ONTO INPUT FOR LATER RE-RETRIVAL^^^0005#0005#0018   CHARACTER C0005#0018INCLUDE CDEFIO0005#0021   INCREMENT (BP)0024   IF (BP > BUFSIZE)0060      CALL ERROR("PUSHBACK STACK OVERFLOW.")		#TERMINATE0011   ELSE0021      BUF(BP) = C0005#0013   RETURN0010   END00050032   SUBROUTINE RATGO (SWITCH)0005#0043# RATGO - RATFOR INITIALIZATION ROUTINE0021# SYKES 26 SEP 760005#0005#0038   INTEGER SWITCH, JUNK, I, LABGEN0005#0018INCLUDE CDEFIO0005#0016INCLUDE CFOR0005#0017INCLUDE CFUNC0005#0017INCLUDE CLINE0005#0017INCLUDE CLIST0005#0017INCLUDE CLOOK0005#0018INCLUDE COUTLN0005#0018INCLUDE CPRTLN0005#0016INCLUDE CSTR0005#0005#0013###COUTLN0016      OUTP=00005#0013### CLINE0017      LEVEL=10019      LINECT=1 0025      INFILE(1)=STDIN0029      FTNLN=0				#PCN #750005#0014### CDEFIO0014      BP=00005#0012### CFOR0018      FORDEP=00018      FORLEN=10005#0013### CFUNC0030      INFUNC=NO			#PCN #920005#0013### CLOOK0030      IF (SWITCH == YES) [0061         LASTP=0		#INITIALIZE DEFINITION TABLE PARAMETERS0020         LASTT=00019         TWOS=10014         ]0005#^^0013### CLIST0016      PAGE=00051      PLINE=9999		#FORCE HEADER UPON FIRST PAGE0018      ERRORS=00017      INIF=NO0005#0014### CPRTLN0050      READY=NO		#MUSTN'T PRINT VERY FIRST TIME0005#0012### CSTR0017      LASTS=00017      LASTR=00005#0050   I=LABGEN(0)		#RESET STARTING LABEL TO 200000027   JUNK=LABGEN(20000-I)0005#0013   RETURN0010   END00050048   SUBROUTINE RELATE (TOKEN, LAST)		#PCN #940005#0059# RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG FORM0021#SYKES, 20 NOV 76^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0067# PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD  && FOR .EQV.0071# PCN #77, 5 JAN 80, USE FOLD TO GET LOWER CASE VERSIONS, IF NEEDED0054# PCN #87, 10 FEB 80, ALLOW << AND >> FOR < AND >.0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0005#0005#0069   CHARACTER NGETCH, DOTS(6,11), TOKEN(DUMMYSIZE), NEXTCH, THISCH0038   INTEGER LAST, LINE, JUNK, SCOPY0005#0017INCLUDE CUCLC0005#0055   DATA DOTS/ PERIOD, BIGG, BIGE, PERIOD, EOS, EOS,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055              PERIOD, BIGG, BIGT, PERIOD, EOS, EOS,0055              PERIOD, BIGL, BIGE, PERIOD, EOS, EOS,0055              PERIOD, BIGL, BIGT, PERIOD, EOS, EOS,0055              PERIOD, BIGN, BIGE, PERIOD, EOS, EOS,0056              PERIOD, BIGN, BIGO, BIGT, PERIOD, EOS,0055              PERIOD, BIGE, BIGQ, PERIOD, EOS, EOS,0056              PERIOD, BIGA, BIGN, BIGD, PERIOD, EOS,0055              PERIOD, BIGO, BIGR, PERIOD, EOS, EOS,0056              PERIOD, BIGX, BIGO, BIGR, PERIOD, EOS,^^^^^^^^^^^^^^0089              PERIOD, BIGE, BIGQ, BIGV, PERIOD, EOS/	#PCN #73, DEC 79, PCN#77, JAN 800005#0013   LINE=00022   THISCH=TOKEN(1)0075   NEXTCH=NGETCH(NEXTCH)		#PCN 73, DEC 79, WE NEED TO LOOK AT NEXT CHAR0029   IF (THISCH == GREATER)0036      IF (NEXTCH == EQUALS)		#>=0027         LINE=1			#.GE.0038      ELSE IF (NEXTCH == LESS)	#><0034         LINE=5			#.NE. PCN#730050      ELSE IF (NEXTCH == GREATER)	#>> PCN # 870027         LINE=2			#.GT.0016      ELSE [0027         LINE=2			#.GT.^^^^^^^^^^^^^^^^^^^^^^^^0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0014         ]0031   ELSE IF (THISCH == LESS)0036      IF (NEXTCH == EQUALS)		#<=0027         LINE=3			#.LE.0041      ELSE IF (NEXTCH == GREATER)	#<>0035         LINE=5			#.NE.  PCN#730047      ELSE IF (NEXTCH == LESS)	#<<, PCN #870027         LINE=4			#.LT.0016      ELSE [0027         LINE=4			#.LT.0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0014         ]0030   ELSE IF (THISCH == NOT)0036      IF (NEXTCH == EQUALS)		#!=^^^^^^^^^^^^^^^^^^^^^0027         LINE=5			#.NE.0016      ELSE [0028         LINE=6			#.NOT.0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0014         ]0033   ELSE IF (THISCH == EQUALS)0036      IF (NEXTCH == EQUALS)		#==0027         LINE=7			#.EQ.0014      ELSE0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0032   ELSE IF (THISCH == AMPER)0054      IF (NEXTCH == AMPER)		#PCN#73, DEC 79, .EQV.0029         LINE=11			#.EQV.0016      ELSE [0028         LINE=8			#.AND.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0014         ]0030   ELSE IF (THISCH == BAR)0063      IF (NEXTCH == BAR \ NEXTCH == BACKSLASH)	#***DPS9MAR70029         LINE=10			#.XOR.0016      ELSE [0027         LINE=9			#.OR.0055         CALL PUTBAK(NEXTCH)		#NEXT CHAR NOT NEEDED0014         ]0005#0022   IF (LINE > 0) [0052      LAST=SCOPY (DOTS(1,LINE), TOKEN, 10, JUNK)0024      IF (LC == YES)0062         CALL FOLD (TOKEN)		#CONVERT TO LOWER CASE, PCN#770011      ]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0044   ELSE [				# CAN'T HAPPEN EXCEPT FOR =0024      TOKEN(2) = EOS0018      LAST = 10011      ]0013   RETURN0010   END00050033   SUBROUTINE REPCOD(LAB, SP)0005#0054# REPCOD - GENERATE CODE FOR BEGINNING OF 'REPEAT'0005#0005#0030   INTEGER LAB, SP, LABGEN0005#0069   IF (SP > 1)		#SYKES 6 OCT 76, ONLY IF THERE MIGHT BE SOMETHING0053      CALL OUTCON(0)		# IN CASE THERE WAS A LABEL0022   LAB = LABGEN(3)0023   CALL OUTCON(LAB)0047   INCREMENT (LAB)		# LABEL TO GO ON NEXT'S0005#0013   RETURN0010   END0005^^^0033   SUBROUTINE RETCOD (LEXSTR)0005#0043# RETCOD - PROCESS RETURN (EXPRESSION).0025# PCN #92, 20 FEB 80,0005#0005#0052   CHARACTER LEXSTR(MAXTOK), TOKEN(MAXTOK), GTOK0005#0017INCLUDE CFUNC0005#0017INCLUDE CUCLC0005#0058   IF (INFUNC == YES & GTOK(TOKEN,MAXTOK) == LPAREN) [0050      CALL PBSTR (TOKEN)					#PUT THE '(' BACK0021      CALL OUTTAB0024      IF (LC == YES)0056         CALL FOLD (FNAM)			#FUNC NAME TO LOWER CASE0052      CALL OUTSTR (FNAM)			#OUTPUT FUNCTION NAME0027      IF (COMPRS == NO)^^^^^^^0031         CALL OUTCH (BLANK)0041      CALL OUTCH (EQUALS)			#OUTPUT =0027      IF (COMPRS == NO)0031         CALL OUTCH (BLANK)0045      CALL BALPAR				#OUTPUT (EXPRESSION)0041      CALL OUTDON				#FINISH OFF LINE0024      IF (LC == YES)0057         CALL FOLD (LEXSTR)			#CONVERT 'RETURN' TO LC0049      CALL OTHERC (LEXSTR)			#OUTPUT 'RETURN'0011      ]0013   ELSE [0058      CALL PBSTR (TOKEN)			#FALSE ALARM, DON'T NEED IT0054      CALL OTHERC (LEXSTR)			#JUST OUTPUT 'RETURN'0011      ]0005#0013   RETURN^0010   END00050036   SUBROUTINE STRNGC 				#PCN 930005#0063# STRNGC - GENERATE FIRST PART OF CODE FOR 'STRING' KEYWORD0027#SYKES 15OCT76, 12MAR770025# PCN # 21, 10 DEC 770066# PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS0063# PCN # 93, 17 FEB 80, CALL FROM PARSE, CHANGE CALLING SEQ.0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0075#ASSUMES THAT THE TARGET COMPILER ALLOWS MULTIPLE ELEMENT SPECIFICATION0026# IN DATA STATEMENTS .^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0067#THE STRING KEYWORDS MUST BE POSITIONED AFTER ALL OTHER FORTRAN0064#  SPECIFICATION STATEMENTS, EXCEPT FOR ANY DATA STATEMENTS.0064#EACH "STRING FOO "BLATS"" LINE CAUSES IMMEDIATE OUTPUT OF A0070# "CHARACTER FOO(4)" LINE AND A "DATA FOO/.../" LINE IS HELD UNTIL0068# ALL STRING LINES HAVE BEEN PROCESSED, THEN INSERTED BEFORE THE0067# FIRST NON-STRING LINE, SO THAT ALL DATA STATEMENTS ARE AT THE0045# BOTTOM OF THE SPECIFICATION STATEMENTS.0005#0005#0019IFDEF (STRINGS)0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0044   CHARACTER TOKEN(MAXTOK), NAME(MAXTOK)0023   CHARACTER DEFTOK0035   INTEGER J, LEN, JUNK, INSTAL0005#0016INCLUDE CSTR0005#0017INCLUDE CUCLC0005#0030   STRING CHAR "CHARACTER"0005#0048   CALL PUTBAK (FORMFEED)		#SOME UNIQUE FLAG0023   CALL PBSTR(CHAR)0018   CALL OUTTAB0059   WHILE (DEFTOK(TOKEN,MAXTOK) != FORMFEED) [		#PCN #930051      CALL OUTSTR (TOKEN)			#COMES BACK DEFINED0042      IF (COMPRS == NO)			#***PCN # 210031         CALL OUTCH (BLANK)0011      ]0043   IF ((DEFTOK(NAME,MAXTOK) != ALPHA) \^0047       (DEFTOK(TOKEN,MAXTOK) != DQUOTE))  [0041      CALL SYNERR ("ILLEGAL STRING.")0016      RETURN0011      ]0025   CALL OUTSTR (NAME)0039   IF (COMPRS == NO)			#***PCN # 210029      CALL OUTCH  (BLANK)0027   CALL OUTCH  (LPAREN)0056   FOR (LEN=2; TOKEN(LEN) != DQUOTE; INCREMENT(LEN))0011      ;0026   CALL OUTNUM (LEN-1)0027   CALL OUTCH  (RPAREN)0041   CALL OUTDON			#'CHARACTER NAME(N)'0043   TOKEN(LEN)=EOS			#CLOBBER TRAILING "0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0075# FILE THE ARRAY NAME AND THE STRING DEFINITION AWAY FOR FUTURE DUMPING0088   IF (INSTAL(NAME,TOKEN(2),LASTS,LASTR,STRPTR,MAXSTR,NUMSTR,TABLES) == BAD)	#PCN#620043      CALL SYNERR ("TOO MANY STRINGS.")0005#0012ENDIFDEF0005#0022IFNOTDEF (STRINGS)0050   CALL SYNERR ("STRING KEYWORD NOT ALLOWED.")0012ENDIFDEF0005#0013   RETURN0010   END00050066   CHARFUNC FUNCTION TOKDEF FUNCSIZE (TOKEN, TOKSIZ)		#PCN #940005#0071# TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH'0019#SYKES, APR77, ^^^^^^0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0079#  USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH' BECAUSE 'MATH'0076#  IS CALLED BY DEFTOK AND THEREFORE CANNOT CALL DEFTOK. THIS MAKES SURE0066#  THAT SYMBOLS  WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING0077#  MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLIC0070#  CONSTANTS DEFINED AS NEGATIVE INTEGERS, WHICH ARE RETURNED AS A0042#  SINGLE TOKEN INSTEAD OF TWO TOKENS.0005#0005#^^^^^^^^^^^^^^^^^^^^^^0034   INTEGER TOKSIZ, LOOKFR, SUB0059   CHARACTER DEFN(MAXDEF), T, TOKEN(TOKSIZ), GTOK, TYPE0005#0012   SUB=10049   FOR (T=GTOK(TOKEN(SUB), TOKSIZ); T != EOF;0061                           T=GTOK(TOKEN(SUB), TOKSIZE)) [0054      IF (T != ALPHA \ TYPE(TOKEN(SUB)) != LETTER)0067         IF (T == MINUS) [			#IF A '-', ASSUME A NUMBER FOLLOWS0065            SUB=2				#SO GO GET IT INTO 'TOKEN' AFTER THE '-'0020            NEXT0017            ]0017         ELSE0051            BREAK				#DONE WHEN WE GET A NUMBER^0063      CALL UNFOLD (TOKEN)			#FORCE TO UPPER CASE FOR LOOKUP0055      IF (LOOKFR(TOKEN, DEFN) == NO) [		# UNDEFINED0058         CALL SYNERR ("UNDEFINED SYMBOLIC IN <MATH>.")0025         RETURN (BAD)0014         ]0014      ELSE0080         CALL PBSTR (DEFN)		#TRY REDEFINING DEFINITION UNTIL WE GET A NUMBER0011      ]0019   RETURN (YES)0005#0010   END00050057   SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN, LAST)0005#0055# UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT0025# PCN # 16, 14 NOV 77^^^^^^^^^^^0070# PCN 93, 16 FEB 80, MOVE FEATURE FINDING FROM GETTOK TO PARSE/LEX0005#0005#0060   INTEGER LABVAL(MAXSTACK), LEXTYP(MAXSTACK), SP, TOKEN0021   CHARACTER LAST0005#0069   IF (TOKEN != LEXIFNOT & TOKEN != LEXIFDEF  & TOKEN != LEXENDIF0084                                               & TOKEN != LEXINCLUD ) [	#PCN #930042      FOR ( ; SP > 1; DECREMENT(SP)) [0038         IF (LEXTYP(SP) == LBRACE)0021            BREAK0069         ELSE IF (LEXTYP(SP) == LEXIF & TOKEN == LEXELSE)	#PCN#200021            BREAK^^0055         ELSE IF  (LEXTYP(SP) == LEXIF) [			#PCN#200039            CALL OUTCON(LABVAL(SP))0041            LAST = BLANK					#PCN #160017            ]0046         ELSE IF (LEXTYP(SP) == LEXELSE) [0027            IF (SP > 2)0033               DECREMENT (SP)0041            CALL OUTCON(LABVAL(SP)+1)0080            LAST = BLANK		#PCN 16, DON'T NEED TO IT ANYMORE WE CAN GET THERE0017            ]0044         ELSE IF (LEXTYP(SP) == LEXDO) [0059            CALL OUTCON(LABVAL(SP))		#DOSTAT, END OF DO^^^^^^^^^^^^^0041            CALL OUTCON(LABVAL(SP)+1)0017            ]0047         ELSE IF (LEXTYP(SP) == LEXWHILE) [0061            CALL OUTGO(LABVAL(SP))		#WHILES, END OF WHILE0041            CALL OUTCON(LABVAL(SP)+1)0017            ]0043         ELSE IF (LEXTYP(SP) == LEXFOR)0037            CALL FORS(LABVAL(SP))0046         ELSE IF (LEXTYP(SP) == LEXREPEAT)0046            CALL UNTILS(LABVAL(SP), TOKEN)0014         ]0011      ]0005#0013   RETURN0010   END00050036   SUBROUTINE UNTILS(LAB, TOKEN)0005#^^^^^^^^^^^^^^^^^0070# UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS0061# PCN #75, DEC 79, ADD FTN LINE NUMBERS TO RATFOR LISTING0005#0005#0031   CHARACTER PTOKEN(MAXTOK)0036   INTEGER JUNK, LAB, TOKEN, LEX0005#0018INCLUDE CPRTLN0005#0028INCLUDE CUCLC			#PCN #750005#0023   CALL OUTNUM(LAB)0031   IF (TOKEN == LEXUNTIL) [0028      JUNK = LEX(PTOKEN)0026      CALL IFGO(LAB-1)0067      FORTYP=YES		#PCN #75, HAVE PRTLIN SUBTRACT 1 FTN LINE NUM0010     ]0011   ELSE0027      CALL OUTGO(LAB-1)^^^^^^^^^^^^^^^^^^^^0025   CALL OUTCON(LAB+1)0005#0013   RETURN0010   END00050033   SUBROUTINE WHILEC(LAB, SP)0005#0064# WHILEC - GENERATE CODE FOR BEGINNING OF 'WHILE' STATEMENTS0005#0005#0030   INTEGER LAB, SP, LABGEN0005#0038   IF (SP > 1)		#SYKES, 6 OCT 76, 0072      CALL OUTCON(0)		#UNLABELED CONTINUE, IN CASE THERE WAS A LABEL0022   LAB = LABGEN(2)0023   CALL OUTNUM(LAB)0023   CALL IFGO(LAB+1)0005#0013   RETURN0010   END^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^