0023#				FILE= RAT2.RAT0073# 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#0020IFNOTDEF (ALPHA)0020INCLUDE/NL DEFIN0018INCLUDE RATDEF0012ENDIFDEF0005#00050062   SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ)		#PCN 940054# GETDEF  - GET SYMBOLIC CONSTANTS AND DEFINITIONS0080# SYKES, DEC76, ALLOW SINGLE ARGUMENT MACRO DEFINITIONS.  STORE "MAXTYPE" AS^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0081#  FIRST CHAR OF MACRO DEFINITIONS, SO 'DEFMAC' CAN TELL MACROS FROM SYMBOLS.0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0044#   BLANKS ARE PRESERVED IN A DEFINITION0005#0005#0038   CHARACTER GTOK, NGETCH, TEMP(5)0059   INTEGER DEFSIZ, I, NLPAR, TOKSIZ, INDEX, JUNK, SCOPY0047   CHARACTER C, DEFN(DEFSIZ), TOKEN(TOKSIZ)0005#0052   DEFN(1)=EOS			#ERROR RETURNS GIVE NULL DEFIN.0042   IF (GTOK(TOKEN,TOKSIZ) != LPAREN) [0040      CALL SYNERR("NO ( IN DEFINE.")0016      RETURN^^^^^^^^0011      ]0041   IF (GTOK(TOKEN,TOKSIZ) != ALPHA) [0048      CALL SYNERR ("NON-ALPHANUMERIC NAME.")0016      RETURN0011      ]0060   ELSE IF (GTOK(TEMP,5) != COMMA & TEMP(1) != EQUALS) [0046      CALL SYNERR ("NO , OR = IN DEFINE.")0016      RETURN0011      ]0049# ELSE GOT '(NAME,'	NOW GET THE DEFINITION...0016   NLPAR = 10046   FOR (I = 2; NLPAR > 0; INCREMENT (I)) [0027      IF (I > DEFSIZ) [0048         CALL SYNERR("DEFINITION TOO LONG.")0019         RETURN0014         ]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0039      IF (NGETCH(DEFN(I)) == EOF) [0043         CALL SYNERR("NO ) IN DEFINE.")0019         RETURN0014         ]0014      ELSE0052         IF (DEFN(I) == LESS) [		#LOOK FOR A '<'0055            CALL MATH  			#IF SO, DO THE <...> PART0045            DECREMENT (I)			#KILL THE '<'0041            ]					#RESULT IS ON INPUT0017         ELSE0056            CALL LRPAR (DEFN(I), NLPAR)	#COUNT ( & )0011      ]0022   DEFN(I-1) = EOS0039   DEFN(1)=MACTYPE				#ASSUME MACRO^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0062   IF (INDEX(DEFN, PASSCHAR) == 0)			#ARGUMENT PASS FLAGS?0083      JUNK=SCOPY(DEFN(2), DEFN(1), MAXDEF, JUNK)	#SHIFT LEFT TO KILL MACRO FLAG0005#0013   RETURN0010   END00050024   SUBROUTINE GTFUNC0005#0069# GTFUNC - GET AND SAVE THE FUNCTION NAME FOR RETURN(EXPRESSION).0023#PCN #92, 20 FEB 800005#0005#0027?  INTEGER STRPUT, JUNK0030   CHARACTER GTOK, T, TYPE0005#0017INCLUDE CFUNC0005#0073   T=GTOK (FNAM, 12)			#1ST THING AFTER 'FUNCTION' IS FUNCTION'S NAME^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055   CALL PBSTR (FNAM)			#PUT IT BACK FOR NEXT DEFTOK0078   IF (INFUNC == YES \ T != ALPHA \ TYPE(FNAM(1)) != LETTER)	#IS IT LEGAL?0051      CALL SYNERR ("ILLEGAL FUNCTION KEYWORD.")0011   ELSE0060      INFUNC=YES			#NOTE THAT WE ARE IN A VALID FUNCTION0041?  JUNK=STRPUT (USEROUT, FNAM, BLANK)0005#0013   RETURN0010   END00050062   CHARFUNC FUNCTION GTOK FUNCSIZE(TOKEN, TOKSIZ)		#PCN 940005#0066# GTOK - GET TOKEN; INTERPRET SPECIAL CHAR, DELETE BLANKS,TABS0048# PCN #73, DEC 79, ADD TILDE,CARET FOR .NOT.^^0064# PCN #87, 12 FEB 80, PASS '...' STRINGS WITHOUT PROCESSING.0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0005#0005#0024   INTEGER I, TOKSIZ0047   CHARACTER C, TOKEN(TOKSIZ), NGETCH, TYPE0005#0031   WHILE (NGETCH(C) != EOF)0063      IF (C != BLANK & C != TAB)		#DELETE TABS  AND HEADERS0018         BREAK0021   CALL PUTBAK(C)0005#0049   FOR (I = 1; I < TOKSIZ-1; INCREMENT (I)) [0059      GTOK = TYPE(NGETCH(TOKEN(I)))		#CONSTRUCT A TOKEN0045      IF (GTOK != LETTER & GTOK != DIGIT)^0018         BREAK0012      ] 0005#0025   IF (I >= TOKSIZ-1)0040      CALL SYNERR("TOKEN TOO LONG.")0049   IF (I > 1) [          			# SOME ALPHA SEEN0054      CALL PUTBAK(TOKEN(I))   		# WENT ONE TOO FAR0024      TOKEN(I) = EOS0022      GTOK = ALPHA0011      ]0005#0063# DO SOME CHARACTER CONVERSIONS TO MAKE THINGS EASIER LATER0058   ELSE IF (TOKEN(1) == BACKSLASH) [		#SYKES 15 OCT 760050      TOKEN(1)=BAR				#MAKE BACKSLASH=BAR (OR)0018      GTOK=BAR0011      ]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055   ELSE IF (TOKEN(1) == LBRACK) [		#SYKES 26 SEP 760050      TOKEN(1)=LBRACE				#MAKE BRACKETS=BRACES0021      GTOK=LBRACE0011      ]0037   ELSE IF (TOKEN(1) == RBRACK) [0027      TOKEN(1) = RBRACE0023      GTOK = RBRACE0011      ]0072   ELSE IF (TOKEN(1) == TILDE \ TOKEN(1) == CARET) [	#PCN#73, DEC 790022      TOKEN(1)=NOT0018      GTOK=NOT0011      ]0069## ELSE IF (TOKEN(1) == DOLLAR) [  		# ALLOW $( AND $) FOR BRACES0043##    IF (NGETCH(TOKEN(2)) == LPAREN) [0030##       TOKEN(1) = LBRACE^^^^^^^^^^^^0026##       GTOK = LBRACE0015##       ] 0040##    ELSE IF (TOKEN(2) == RPAREN) [0030##       TOKEN(1) = RBRACE0044##       GTOK = RBRACE		##SYKES, 22NOV760015##       ] 0014##    ELSE0034##       CALL PUTBAK(TOKEN(2))0012##    ] 0070   ELSE IF (TOKEN(1) == DQUOTE \ TOKEN(1) == SQUOTE) [	#***PCN #870065# COLLECT QUOTED STRINGS AS SINGLE TOKENS WITHOUT PROCESSING.0066      FOR (I = 2; NGETCH(TOKEN(I)) != TOKEN(1); INCREMENT (I))0054         IF (TOKEN(I) == NEWLINE \ I >= TOKSIZ-1)[^^^^^^^^^^^^^^^^^^^^^^^^^^^0045            CALL SYNERR("MISSING QUOTE.")0068            TOKEN(I) = TOKEN(1)			#ADD A QUOTE TO TRY TO RECOVER0036            CALL PUTBAK(NEWLINE)0021            BREAK0018            ] 0072      IF (TOKEN(1) == SQUOTE & I == 2)		#***PCN #87, CONVERT '' TO '0039         I=1						# FOR WRITE (?'?)0012      ] 0055   ELSE IF (TOKEN(1) == SHARP) [			# STRIP COMMENTS0045      WHILE (NGETCH(TOKEN(1)) != NEWLINE)0017           ; 0024      GTOK = NEWLINE0012      ] ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0067   IF (TOKEN(1) == GREATER \ TOKEN(1) == LESS \ TOKEN(1) == NOT0069      \ TOKEN(1) == EQUALS \ TOKEN(1) == AMPER \ TOKEN(1) == BAR)0065      CALL RELATE(TOKEN, I)			#CONVERT RELATIONAL EXPRESSIONS0023   TOKEN(I+1) = EOS0005#0013   RETURN0010   END00050029   SUBROUTINE IFCODE(LAB)0005#0056# IFCODE - GENERATE INITIAL CODE FOR 'IF' STATEMENTS0005#0005#0026   INTEGER LAB, LABGEN0005#0022   LAB = LABGEN(2)0021   CALL IFGO(LAB)0005#0013   RETURN0010   END00050032   SUBROUTINE IFDEFC  (CTRL)0005#^^^^^^^^^^^0054# IFDEFC - PROCESS IFDEF AND IFNOTDEF CONDITIONALS0024#SYKES, FEB77,APR77,0069# PCN 77, 5 JAN 80, ADD UNFOLD, SO 'IFDEF' ETC CAN BE LOWER CASE.0044#CTRL='YES' FOR IFDEF; 'NO' FOR IFNOTDEF0041#IFDEF (SYMBOL)		OR IFNOTDEF (SYMBOL)0019#   <STATEMENT>0013#ENDIFDEF0005#0005#0040   INTEGER LOOKFR, SEQL, LAYER, CTRL0056   CHARACTER TOKEN(MAXTOK), JUNK(MAXDEF), GTOK, TYPE0005#0017INCLUDE CLINE0005#0030   STRING ENDIF "ENDIFDEF"0028   STRING IFDEFS "IFDEF"0030   STRING IFNOT "IFNOTDEF"0005#^^^^^^^^^^^^^^^^^^^^^^0042   IF (GTOK(TOKEN,MAXTOK) != LPAREN) [0045      CALL SYNERR ("MISSING ( IN IFDEF.")0028      CALL PBSTR (TOKEN)0016      RETURN0011      ]0040   IF (GTOK(TOKEN,MAXTOK) != ALPHA \0057                          TYPE(TOKEN(1)) != LETTER) [0052      CALL SYNERR ("ILLEGAL SYMBOLIC IN IFDEF.")0028      CALL PBSTR (TOKEN)0016      RETURN0011      ]0005#0071   IF (LOOKFR(TOKEN,JUNK) == CTRL)[			#RIGHT FOR IFDEF AND IFNOTDEF0060      IF (GTOK(TOKEN,MAXTOK) != RPAREN) [		#IT'S DEFINED^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0048         CALL SYNERR ("MISSING ) IN IFDEF.")0031         CALL PBSTR (TOKEN)0019         RETURN0014         ]0033      RETURN				#IT'S DEFINED0011      ]0005#0034   ELSE [				#IT'S NOT DEFINED0050      INIF=YES			#WE ARE IN AN UNDEFINED IFDEF0017      LAYER=10049      REPEAT [					#SEARCH FOR 'ENDIFDEF' AND0075         IF (GTOK (TOKEN,MAXTOK) != EOF) [		#THROW STUFF AWAY MEANWHILE0068            CALL UNFOLD (TOKEN)			#PCN#77, CONVERT TO UPPER CASE0047            IF (SEQL(TOKEN,ENDIF) == YES) [^^^^^^^^^^^0034               IF (LAYER == 1)0042                  BREAK				#WE'RE DONE0023               ELSE0039                  DECREMENT (LAYER)0020               ]0078            ELSE IF (SEQL(TOKEN,IFDEFS) == YES \ SEQL(TOKEN,IFNOT) == YES)0036               INCREMENT (LAYER)0017            ]0019         ELSE [0051            CALL SYNERR ("UNTERMINATED IFDEF.")0035            CALL PUTBAK (TOKEN)0021            BREAK0017            ]0014         ]0053      INIF=NO		#FINISHED WITH OUR UNDEFINED IFDEF^^^^^^^^^^^^^0016      RETURN0011      ]0005#0010   END00050027   SUBROUTINE IFGO(LAB)0005#0046# IFGO - GENERATE "IF(.NOT.(...))GOTO LAB"0017# ***PCN # 210005#0005#0018   INTEGER LAB0005#0017INCLUDE CUCLC0005#0039   CALL OUTIF			#OUTPUT "IF (.NOT."0056   CALL BALPAR      		# COLLECT AND OUTPUT CONDITION0034   CALL OUTCH(RPAREN)		# " ) "0036   IF (COMPRS == NO)		#***PCN#210043      CALL OUTCH(BLANK)	#SYKES 6 OCT 760041   CALL OUTGO(LAB)   		# " GOTO LAB "0005#0013   RETURN0010   END00050020IFNOTDEF (ASCII)^^^^^^^^^^^^^0048   CHARFUNC FUNCTION INMAP FUNCSIZE (INCHAR)0005#0067# INMAP - CONVERT LEFT ADJUSTED EXTERNAL REP TO RIGHT ADJ ASCII0005#0005#0023   CHARACTER INCHAR0016   INTEGER I0005#0017INCLUDE CCHAR0005#0029   IF (INCHAR == EXTBLK) 0025      RETURN (INTBLK)0019   DO I = 1, 100035      IF (INCHAR == EXTDIG(I)) 0031         RETURN (INTDIG(I))0020    DO I = 1, 260035      IF (INCHAR == EXTLET(I)) 0031         RETURN (INTLET(I))0019   DO I = 1, 260035      IF (INCHAR == EXTBIG(I)) 0031         RETURN (INTBIG(I))^^^^^^0023   DO I = 1, NCHARS0035      IF (INCHAR == EXTCHR(I)) 0031         RETURN (INTCHR(I))0022   RETURN (INCHAR)0010   END0012ENDIFDEF0081   INTEGER FUNCTION INSTAL (NAME,DEFN,LASTP,LASTT,NAMPTR,MAXTAB,MAXPOI,TABLE)0005#0047# INSTAL - ADD NAME AND DEFINITION TO TABLE0066# PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS0005#0005#0061   CHARACTER DEFN(MAXDEF), NAME(MAXTOK), TABLE(DUMMYSIZE)0052   INTEGER SLEN, LASTP, LASTT, NAMPTR(DUMMYSIZE)0054   INTEGER DLEN, NLEN, SCOPY, JUNK, MAXTAB, MAXPOI^^^0005#0028   NLEN = SLEN(NAME) + 10028   DLEN = SLEN(DEFN) + 10061   IF ((LASTT + NLEN + DLEN < MAXTAB) & LASTP < MAXPOI) [0027      INCREMENT (LASTP)0035      NAMPTR(LASTP) = LASTT + 10056      JUNK=SCOPY(NAME, TABLE(LASTT+1), MAXTOK, JUNK)0061      JUNK=SCOPY(DEFN, TABLE(LASTT+NLEN+1), MAXDEF, JUNK)0037      LASTT = LASTT + NLEN + DLEN0022      RETURN (YES)0011      ]0011   ELSE0022      RETURN (BAD)0005#0010   END00050032   SUBROUTINE LABELC(LEXSTR)0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0075# LABELC -  OUTPUT FORTRAN STATEMENT NUMBERS THAT WERE IN RATFOR SOURCE0069# PCN #75, ADD FTN LINE NUMBERS TO LISTING. REPLACE CALL TO OUTTA0005#0034   CHARACTER LEXSTR(DUMMYSIZE)0019   INTEGER SLEN0005#0018INCLUDE COUTLN0005#0058   IF (SLEN(LEXSTR) == 5)				# WARN ABOUT 20XXX LABELS0052      IF (LEXSTR(1) == DIG2 & LEXSTR(2) == DIG0)0064         CALL SYNERR ("POSSIBLE STATEMENT NUMBER CONFLICT.")0026   CALL OUTSTR(LEXSTR)0035   WHILE (OUTP < 6)				#PCN #75^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0051      CALL OUTCH (BLANK)			#FILL OUT TO 6TH COL0013   RETURN0010   END00050033   INTEGER FUNCTION LABGEN(N)0005#0064# LABGEN - GENERATE  N  CONSECUTIVE LABELS, RETURN FIRST ONE0005#0005#0023   INTEGER LABEL, N0025   DATA LABEL /20000/0005#0021   LABGEN = LABEL0024   LABEL = LABEL + N0005#0013   RETURN0010   END00050036   SUBROUTINE LRPAR (TOK, NLPAR)0005#0044# LRPAR - COUNT LEFT & RIGHT PARENTHESES0019# SYKES,18FEB770005#0005#0020   INTEGER NLPAR0020   CHARACTER TOK0005#0025   IF (TOK == LPAREN)^^^^^^0027      INCREMENT (NLPAR)0030   ELSE IF (TOK == RPAREN)0027      DECREMENT (NLPAR)0005#0013   RETURN0010   END00050034   INTEGER FUNCTION LEX(TOKEN)0005#0062# LEX - RETURN LEXICAL TYPE OF NEXT VALID TOKEN TO 'PARSE'0069# PCN 93, 16 FEB 80, DELETE CKEYWD, USE STRINGS IN 'LEX' INSTEAD.0048#			ALSO DO PROCESSOR FEATURE KEYWORDS HERE.0005#0005#0038   CHARACTER TOKEN(MAXTOK), DEFTOK0027   INTEGER ALLDIG, SEQL0005#0054   STRING SBREAK "BREAK"	;	STRING SINCL  "INCLUDE"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0054   STRING SDEFIN "DEFINE"	;	STRING SMACRO  "MACRO"0049   STRING SDO    "DO"		;	STRING SNEXT  "NEXT"0052   STRING SELSE  "ELSE"	;	STRING SREPT  "REPEAT"0051   STRING SEND   "END"	;	STRING SRETRN "RETURN"0054   STRING SENDIF "ENDIFDEF"	;	STRING SSTOP  "STOP"0051   STRING SFOR   "FOR"	;	STRING SSTRNG "STRING"0050   STRING SIF    "IF"		;	STRING SUNTIL "UNTIL"0052   STRING SIFDEF "IFDEF"	;	STRING SWHILE "WHILE"0031   STRING SIFNOT "IFNOTDEF"0005#0048   WHILE (DEFTOK(TOKEN, MAXTOK) ==  NEWLINE)0012      ; ^^^0021   LEX = TOKEN(1)0063   IF (LEX==EOF \ LEX==SEMICOL \ LEX==LBRACE \ LEX==RBRACE)0016      RETURN0048   IF (ALLDIG(TOKEN) == YES)			LEX=LEXDIGITS0056   ELSE IF (SEQL(TOKEN, SBREAK) == YES)	LEX=LEXBREAK0051   ELSE IF (SEQL(TOKEN, SDO) == YES)		LEX=LEXDO0057   ELSE IF (SEQL(TOKEN, SDEFIN) == YES)	LEX=LEXDEFINE0054   ELSE IF (SEQL(TOKEN, SELSE) == YES)	LEX=LEXELSE0053   ELSE IF (SEQL(TOKEN, SEND) == YES)		LEX=LEXEND0056   ELSE IF (SEQL(TOKEN, SENDIF) == YES)	LEX=LEXENDIF^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0053   ELSE IF (SEQL(TOKEN, SFOR) == YES)		LEX=LEXFOR0056   ELSE IF (SEQL(TOKEN, SIFDEF) == YES)	LEX=LEXIFDEF0056   ELSE IF (SEQL(TOKEN, SIFNOT) == YES)	LEX=LEXIFNOT0051   ELSE IF (SEQL(TOKEN, SIF) == YES)		LEX=LEXIF0056   ELSE IF (SEQL(TOKEN, SINCL) == YES)	LEX=LEXINCLUD0056   ELSE IF (SEQL(TOKEN, SMACRO) == YES)	LEX=LEXMACRO0054   ELSE IF (SEQL(TOKEN, SNEXT) == YES)	LEX=LEXNEXT0056   ELSE IF (SEQL(TOKEN, SREPT) == YES)	LEX=LEXREPEAT0057   ELSE IF (SEQL(TOKEN, SRETRN) == YES)	LEX=LEXRETURN^^^^^^^^^^^^^^^^^0054   ELSE IF (SEQL(TOKEN, SSTOP) == YES)	LEX=LEXSTOP0056   ELSE IF (SEQL(TOKEN, SSTRNG) == YES)	LEX=LEXSTRNG0056   ELSE IF (SEQL(TOKEN, SUNTIL) == YES)	LEX=LEXUNTIL0056   ELSE IF (SEQL(TOKEN, SWHILE) == YES)	LEX=LEXWHILE0011   ELSE0022      LEX=LEXOTHER0005#0013   RETURN0010   END00050043   INTEGER FUNCTION LOOKFR (NAME, DEFN)0005#0065# LOOKFR - BINARY SEARCH TO LOCATE DEFINED SYMBOLIC CONSTANTS0018# SYKES,NOV76;0072# PCN # 67, 6 OCT 79, PREVENT 0 SUBSCRIPTING IF LASTP=0 [NAMPTR(IT)]0005#0005#^^^^^^^^^^^0043   CHARACTER NAME(MAXTOK), DEFN(MAXDEF)0047   INTEGER I, J, INDX, IT, INC, JUNK, SCOPY0005#0017INCLUDE CLOOK0005#0013   INDX=00015   INC=TWOS0036   IF (LASTP > 0) [			#***PCN#670018      REPEAT [0024         IT=INC+INDX0058         IF (IT > LASTP)		#CAN'T GO PAST END OF TABLE!0024            IT=LASTP0016         I=10025         J=NAMPTR(IT)0040         WHILE (NAME(I) == TABLE(J))0037            IF (NAME(I) == EOS) [0062               JUNK=SCOPY (TABLE(J+1), DEFN, MAXDEF, JUNK)^^^^^^^^^^^^^^^^^^^^^^^^^^^0031               RETURN (YES)0020               ]0022            ELSE [0032               INCREMENT (I)0032               INCREMENT (J)0020               ]0036         IF (NAME(I) > TABLE(J))0069            IF (IT == LASTP)		#SPECIAL CASE, MEANS IT'S NOT THERE0041               BREAK			#SO QUIT EARLY0020            ELSE0046               INDX=IT		#MOVE UP THE TABLE0034         INC=INC/2			#***PCN670031         ] UNTIL (INC <= 0)0011      ]0018   RETURN (NO)0005#0010   END0005^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0034   SUBROUTINE MATH 			#PCN #940005#0055# MATH - SUBROUTINE TO DO MATH IN MACRO DEFINITIONS0018# SYKES APR 770070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0057# + AND - INTEGER NUMBERS AND DEFINITIONS ARE ALLOWED0005#0005#0045   INTEGER SCTOI, SITOC, NUM1, NUM2, JUNK0051   CHARACTER TOKDEF, OPR, NGETCH, TOKEN(MAXTOK)0005#0058   IF (TOKDEF (TOKEN, MAXTOK) != BAD) [		#FIRST NUMBER0016      JUNK=10034      NUM1=SCTOI (TOKEN, JUNK)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0058      WHILE (NGETCH(OPR) != GREATER) [		#MATH OPERATOR0055         JUNK=TOKDEF (TOKEN, MAXTOK)			#NEXT NUMBER0019         JUNK=10036         NUM2=SCTOI (TOKEN,JUNK)0029         IF (OPR == PLUS)0030            NUM1=NUM1+NUM20035         ELSE IF (OPR == MINUS)0030            NUM1=NUM1-NUM20034         ELSE IF (OPR == STAR)0030            NUM1=NUM1*NUM20047         ELSE IF (OPR == SLASH & NUM2 != 0)0045            NUM1=NUM1/NUM2				#TRUNCATION0019         ELSE [^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055            CALL SYNERR ("ILLEGAL MATH OPERATION.")0034            CALL PBSTR (TOKEN)0022            RETURN0017            ]0014         ]0060      JUNK=SITOC (NUM1, TOKEN, MAXTOK)	#PUSH BACK RESULT0065      CALL PBSTR (TOKEN)			#RESULT IS RETURNED ON INPUT STACK0011      ]0005#0013   RETURN0010   END00050054   CHARFUNC FUNCTION NGETCH FUNCSIZE (C)		#PCN #940005#0053# NGETCH - GET A (POSSIBLY PUSHED BACK) CHARACTER0070# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0005#0005#^^^^^^^^^0033   CHARACTER BUFR(MAXLINE), C0028   INTEGER LASTC, GETLIN0005#0018INCLUDE CDEFIO0005#0049  DATA LASTC/MAXLINE/, BUFR(MAXLINE)/NEWLINE/0005#0018   IF (BP > 0)0021      C = BUF(BP)0013   ELSE [0016      BP = 10058      IF (BUFR(LASTC) == NEWLINE \ LASTC >= MAXLINE) [0020         LASTC=00056         IF (GETLIN(BUFR) == EOF) [		#READ A LINE IN0021            C=EOF0067            LASTC=MAXLINE		#FOR REINITIALIZATION SYKES 5 OCT 760020            BP=00028            RETURN (EOF)0017            ]0014         ]0026      INCREMENT(LASTC)0033      IF (BUFR(LASTC) == EOS)0069         BUFR(LASTC) = NEWLINE		#EOS FROM GETLIN REALLY MEANS EOL0023      C=BUFR(LASTC)0012      ] 0020   DECREMENT(BP)0017   RETURN (C)0005#0010   END00050032   SUBROUTINE OTHERC(LEXSTR)0005#0048# OTHERC - OUTPUT ORDINARY FORTRAN STATEMENT0005#0005#0034   CHARACTER LEXSTR(DUMMYSIZE)0005#0018   CALL OUTTAB0057   CALL OUTSTR(LEXSTR)		#OUTPUT TOKEN WE ALREADY HAVE0050   CALL EATUP				#OUTPUT REST OF THE STATEMENT^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0037   CALL OUTDON			#FINISH OFF LINE0005#0013   RETURN0010   END00050026   SUBROUTINE OUTCH(C)0005#0077# OUTCH - PUT ONE CHARACTER INTO OUTPUT BUFFER, CREATE CONTINUATION LINES0005#0005#0018   CHARACTER C0005#0018INCLUDE COUTLN0005#0074   IF (OUTP > 70 \ OUTP < 0) [  	# CONTINUATION CARD,  SYKES 26 SEP 760021      CALL OUTDON0061      FOR (OUTP = 1; OUTP < 6; INCREMENT (OUTP))	#PCN #770033         OUTBUF(OUTP) = BLANK0074      OUTBUF(OUTP) = CONTINCHAR		#THE CONTINUATION FLAG CHAR. IN COL 60012      ] ^^^0023   INCREMENT (OUTP)0023   OUTBUF(OUTP) = C0005#0013   RETURN0010   END^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^