#				FILE= RAT2.RAT
#$ ***** SECOND PART OF NON-SYSTEM-SPECIFIC PARTS OF RATFOR
IFNOTDEF (ALPHA)
INCLUDE/NL DEFIN
INCLUDE RATDEF
ENDIFDEF
#

#$ GETDEF 	- GET SYMBOLIC CONSTANTS AND DEFINITIONS
# SYKES, DEC76, ALLOW SINGLE ARGUMENT MACRO DEFINITIONS.  STORE "MAXTYPE" AS
#  FIRST CHAR OF MACRO DEFINITIONS, SO 'DEFMAC' CAN TELL MACROS FROM SYMBOLS.
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
#   BLANKS ARE PRESERVED IN A DEFINITION
#
   SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ)		#PCN 94
#
   CHARACTER GTOK, NGETCH, TEMP(5)
   INTEGER DEFSIZ, I, NLPAR, TOKSIZ, INDEX, JUNK, SCOPY
   CHARACTER C, DEFN(DEFSIZ), TOKEN(TOKSIZ)
#
   DEFN(1)=EOS			#ERROR RETURNS GIVE NULL DEFIN.
   IF (GTOK(TOKEN,TOKSIZ) != LPAREN) [
      CALL SYNERR("NO ( IN DEFINE.")
      RETURN
      ]
   IF (GTOK(TOKEN,TOKSIZ) != ALPHA) [
      CALL SYNERR ("NON-ALPHANUMERIC NAME.")
      RETURN
      ]
   ELSE IF (GTOK(TEMP,5) != COMMA & TEMP(1) != EQUALS) [
      CALL SYNERR ("NO , OR = IN DEFINE.")
      RETURN
      ]
# ELSE GOT '(NAME,'	NOW GET THE DEFINITION...
   NLPAR = 1
   FOR (I = 2; NLPAR > 0; INCREMENT (I)) [
      IF (I > DEFSIZ) [
         CALL SYNERR("DEFINITION TOO LONG.")
         RETURN
         ]
      IF (NGETCH(DEFN(I)) == EOF) [
         CALL SYNERR("NO ) IN DEFINE.")
         RETURN
         ]
      ELSE
         IF (DEFN(I) == LESS) [		#LOOK FOR A '<'
            CALL MATH  			#IF SO, DO THE <...> PART
            DECREMENT (I)			#KILL THE '<'
            ]					#RESULT IS ON INPUT
         ELSE
            CALL LRPAR (DEFN(I), NLPAR)	#COUNT ( & )
      ]
   DEFN(I-1) = EOS
   DEFN(1)=MACTYPE				#ASSUME MACRO
   IF (INDEX(DEFN, PASSCHAR) == 0)			#ARGUMENT PASS FLAGS?
      JUNK=SCOPY(DEFN(2), DEFN(1), MAXDEF, JUNK)	#SHIFT LEFT TO KILL MACRO FLAG
#
   RETURN
   END
#
#$ GTFUNC	- GET AND SAVE THE FUNCTION NAME FOR RETURN(EXPRESSION)
#PCN #92, 20 FEB 80
# NOTE: FNAM(12) LIMITS FUNCTION NAMES TO 11 CHARACTERS, WHICH MEANS
#   THEY CAN'T BE LONG SYMBOLIC CONSTANTS. IF YOU REALLY WANT LONGER
#   FUNCTION NAMES, CHANGE "12" TO "MAXTOK".
#
   SUBROUTINE GTFUNC
#
?  INTEGER STRPUT, JUNK
   CHARACTER GTOK, T, TYPE
#
INCLUDE CFUNC
#
   T=GTOK (FNAM, 12)			#1ST THING AFTER 'FUNCTION' IS FUNCTION'S NAME
   CALL PBSTR (FNAM)			#PUT IT BACK FOR NEXT DEFTOK
   IF (INFUNC == YES \ T != ALPHA \ TYPE(FNAM(1)) != LETTER)	#IS IT LEGAL?
      CALL SYNERR ("ILLEGAL FUNCTION KEYWORD.")
   ELSE
      INFUNC=YES			#NOTE THAT WE ARE IN A VALID FUNCTION
?  JUNK=STRPUT (USEROUT, FNAM, BLANK)
#
   RETURN
   END
#
#$ GTOK	- GET TOKEN; INTERPRET SPECIAL CHAR, DELETE BLANKS,TABS
# PCN #73, DEC 79, ADD TILDE,CARET FOR .NOT.
# PCN #87, 12 FEB 80, PASS '...' STRINGS WITHOUT PROCESSING.
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
# PCN 102, 29 MAR 80, ALLOW UNDERLINE EMBEDDED IN TOKENS
#
   CHARFUNC FUNCTION GTOK FUNCSIZE(TOKEN, TOKSIZ)		#PCN 94
#
   INTEGER I, TOKSIZ
   CHARACTER C, TOKEN(TOKSIZ), NGETCH, TYPE
#
   WHILE (NGETCH(C) != EOF)
      IF (C != BLANK & C != TAB)		#DELETE TABS  AND HEADERS
         BREAK
   CALL PUTBAK(C)
#
   FOR (I = 1; I < TOKSIZ-1; INCREMENT (I)) [
      GTOK = TYPE(NGETCH(TOKEN(I)))		#CONSTRUCT A TOKEN
      IF (GTOK != LETTER & GTOK != DIGIT & GTOK != UNDERLINE)	#PCN 102
         BREAK
      ] 
#
   IF (I >= TOKSIZ-1)
      CALL SYNERR("TOKEN TOO LONG.")
   IF (I > 1) [          			# SOME ALPHA SEEN
      CALL PUTBAK(TOKEN(I))   		# WENT ONE TOO FAR
      TOKEN(I) = EOS
      GTOK = ALPHA
      ]
#
# DO SOME CHARACTER CONVERSIONS TO MAKE THINGS EASIER LATER
   ELSE IF (TOKEN(1) == BACKSLASH) [		#SYKES 15 OCT 76
      TOKEN(1)=BAR				#MAKE BACKSLASH=BAR (OR)
      GTOK=BAR
      ]
   ELSE IF (TOKEN(1) == LBRACK) [		#SYKES 26 SEP 76
      TOKEN(1)=LBRACE				#MAKE BRACKETS=BRACES
      GTOK=LBRACE
      ]
   ELSE IF (TOKEN(1) == RBRACK) [
      TOKEN(1) = RBRACE
      GTOK = RBRACE
      ]
   ELSE IF (TOKEN(1) == TILDE \ TOKEN(1) == CARET) [	#PCN#73, DEC 79
      TOKEN(1)=NOT
      GTOK=NOT
      ]
## ELSE IF (TOKEN(1) == DOLLAR) [  		# ALLOW $( AND $) FOR BRACES
##    IF (NGETCH(TOKEN(2)) == LPAREN) [
##       TOKEN(1) = LBRACE
##       GTOK = LBRACE
##       ] 
##    ELSE IF (TOKEN(2) == RPAREN) [
##       TOKEN(1) = RBRACE
##       GTOK = RBRACE		##SYKES, 22NOV76
##       ] 
##    ELSE
##       CALL PUTBAK(TOKEN(2))
##    ] 
   ELSE IF (TOKEN(1) == DQUOTE \ TOKEN(1) == SQUOTE) [	#***PCN #87
# COLLECT QUOTED STRINGS AS SINGLE TOKENS WITHOUT PROCESSING.
      FOR (I = 2; NGETCH(TOKEN(I)) != TOKEN(1); INCREMENT (I))
         IF (TOKEN(I) == NEWLINE \ I >= TOKSIZ-1)[
            CALL SYNERR("MISSING QUOTE.")
            TOKEN(I) = TOKEN(1)			#ADD A QUOTE TO TRY TO RECOVER
            CALL PUTBAK(NEWLINE)
            BREAK
            ] 
      IF (TOKEN(1) == SQUOTE & I == 2)		#***PCN #87, CONVERT '' TO '
         I=1						# FOR WRITE (?'?)
      ] 
   ELSE IF (TOKEN(1) == SHARP) [			# STRIP COMMENTS
      WHILE (NGETCH(TOKEN(1)) != NEWLINE)
           ; 
      GTOK = NEWLINE
      ] 
   IF (TOKEN(1) == GREATER \ TOKEN(1) == LESS \ TOKEN(1) == NOT
      \ TOKEN(1) == EQUALS \ TOKEN(1) == AMPER \ TOKEN(1) == BAR)
      CALL RELATE(TOKEN, I)			#CONVERT RELATIONAL EXPRESSIONS
   TOKEN(I+1) = EOS
#
   RETURN
   END
#
#$ IFFORTRAN CODE	- GENERATE INITIAL CODE FOR 'IF' STATEMENTS
#
   SUBROUTINE IFCODE(LAB)
#
   INTEGER LAB, LABGEN
#
   LAB = LABGEN(2)
   CALL IFGO(LAB)
#
   RETURN
   END
#
#$ IFDEFC	- PROCESS 'IFDEF' AND 'IFNOTDEF' CONDITIONALS
#SYKES, FEB77,APR77,
# PCN 77, 5 JAN 80, ADD UNFOLD, SO 'IFDEF' ETC CAN BE LOWER CASE.
#CTRL='YES' FOR IFDEF; 'NO' FOR IFNOTDEF
#IFDEF (SYMBOL)		OR IFNOTDEF (SYMBOL)
#   <STATEMENT>
#ENDIFDEF
#
   SUBROUTINE IFDEFC  (CTRL)
#
   INTEGER LOOKFR, SEQL, LAYER, CTRL
   CHARACTER TOKEN(MAXTOK), JUNK(MAXDEF), GTOK, TYPE
#
INCLUDE CLINE
#
   STRING ENDIF "ENDIFDEF"
   STRING IFDEFS "IFDEF"
   STRING IFNOT "IFNOTDEF"
#
   IF (GTOK(TOKEN,MAXTOK) != LPAREN) [
      CALL SYNERR ("MISSING ( IN IFDEF.")
      CALL PBSTR (TOKEN)
      RETURN
      ]
   IF (GTOK(TOKEN,MAXTOK) != ALPHA \
                          TYPE(TOKEN(1)) != LETTER) [
      CALL SYNERR ("ILLEGAL SYMBOLIC IN IFDEF.")
      CALL PBSTR (TOKEN)
      RETURN
      ]
#
   IF (LOOKFR(TOKEN,JUNK) == CTRL)[			#RIGHT FOR IFDEF AND IFNOTDEF
      IF (GTOK(TOKEN,MAXTOK) != RPAREN) [		#IT'S DEFINED
         CALL SYNERR ("MISSING ) IN IFDEF.")
         CALL PBSTR (TOKEN)
         RETURN
         ]
      RETURN				#IT'S DEFINED
      ]
#
   ELSE [				#IT'S NOT DEFINED
      INIF=YES			#WE ARE IN AN UNDEFINED IFDEF
      LAYER=1
      REPEAT [					#SEARCH FOR 'ENDIFDEF' AND
         IF (GTOK (TOKEN,MAXTOK) != EOF) [		#THROW STUFF AWAY MEANWHILE
            CALL UNFOLD (TOKEN)			#PCN#77, CONVERT TO UPPER CASE
            IF (SEQL(TOKEN,ENDIF) == YES) [
               IF (LAYER == 1)
                  BREAK				#WE'RE DONE
               ELSE
                  DECREMENT (LAYER)
               ]
            ELSE IF (SEQL(TOKEN,IFDEFS) == YES \ SEQL(TOKEN,IFNOT) == YES)
               INCREMENT (LAYER)
            ]
         ELSE [
            CALL SYNERR ("UNTERMINATED IFDEF.")
            CALL PUTBAK (TOKEN)
            BREAK
            ]
         ]
      INIF=NO		#FINISHED WITH OUR UNDEFINED IFDEF
      RETURN
      ]
#
   END
#
#$ IFGO	- GENERATE CODE:  "IF(NOT.(...))GOTO LAB"
# ***PCN # 21
#
   SUBROUTINE IFGO(LAB)
#
   INTEGER LAB
#
INCLUDE CUCLC
#
   CALL OUTIF			#OUTPUT "IF (.NOT."
   CALL BALPAR      		# COLLECT AND OUTPUT CONDITION
   CALL OUTCH(RPAREN)		# " ) "
   IF (COMPRS == NO)		#***PCN#21
      CALL OUTCH(BLANK)	#SYKES 6 OCT 76
   CALL OUTGO(LAB)   		# " GOTO LAB "
#
   RETURN
   END
#
IFNOTDEF (ASCII)
#$ INMAP	- CONVERT EXTERNAL CHAR TO INTERNAL ASCII
#
   CHARFUNC FUNCTION INMAP FUNCSIZE (INCHAR)
#
   CHARACTER INCHAR
   INTEGER I
#
INCLUDE CCHAR
#
   IF (INCHAR == EXTBLK) 
      RETURN (INTBLK)
   DO I = 1, 10
      IF (INCHAR == EXTDIG(I)) 
         RETURN (INTDIG(I))
    DO I = 1, 26
      IF (INCHAR == EXTLET(I)) 
         RETURN (INTLET(I))
   DO I = 1, 26
      IF (INCHAR == EXTBIG(I)) 
         RETURN (INTBIG(I))
   DO I = 1, NCHARS
      IF (INCHAR == EXTCHR(I)) 
         RETURN (INTCHR(I))
   RETURN (INCHAR)
   END
ENDIFDEF

#
#$ INSTAL	- ADD SYMBOLIC'S NAME AND DEFINITION TO TABLE
# PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
#
   INTEGER FUNCTION INSTAL (NAME,DEFN,LASTP,LASTT,NAMPTR,MAXTAB,MAXPOI,TABLE)
#
   CHARACTER DEFN(MAXDEF), NAME(MAXTOK), TABLE(DUMMYSIZE)
   INTEGER SLEN, LASTP, LASTT, NAMPTR(DUMMYSIZE)
   INTEGER DLEN, NLEN, SCOPY, JUNK, MAXTAB, MAXPOI
#
   NLEN = SLEN(NAME) + 1
   DLEN = SLEN(DEFN) + 1
   IF ((LASTT + NLEN + DLEN < MAXTAB) & LASTP < MAXPOI) [
      INCREMENT (LASTP)
      NAMPTR(LASTP) = LASTT + 1
      JUNK=SCOPY(NAME, TABLE(LASTT+1), MAXTOK, JUNK)
      JUNK=SCOPY(DEFN, TABLE(LASTT+NLEN+1), MAXDEF, JUNK)
      LASTT = LASTT + NLEN + DLEN
      RETURN (YES)
      ]
   ELSE
      RETURN (BAD)
#
   END
#
#$ LABELC	-  OUTPUT FORTRAN STATEMENT NUMBERS THAT WERE IN RATFOR SOURCE
# PCN #75, ADD FTN LINE NUMBERS TO LISTING. REPLACE CALL TO OUTTAB.
#
   SUBROUTINE LABELC(LEXSTR)
#
   CHARACTER LEXSTR(DUMMYSIZE)
   INTEGER SLEN
#
INCLUDE COUTLN
#
   IF (SLEN(LEXSTR) == 5)				# WARN ABOUT 20XXX LABELS
      IF (LEXSTR(1) == DIG2 & LEXSTR(2) == DIG0)
         CALL SYNERR ("POSSIBLE STATEMENT NUMBER CONFLICT.")
   CALL OUTSTR(LEXSTR)
   WHILE (OUTP < 6)				#PCN #75
      CALL OUTCH (BLANK)			#FILL OUT TO 6TH COL
   RETURN
   END
#
#$ LABGEN	- GENERATE  N  CONSECUTIVE LABELS, RETURN FIRST ONE
#
   INTEGER FUNCTION LABGEN(N)
#
   INTEGER LABEL, N
   DATA LABEL /20000/
#
   LABGEN = LABEL
   LABEL = LABEL + N
#
   RETURN
   END
#
#$ LRPAR	- COUNT LEFT & RIGHT PARENTHESES
# SYKES,18FEB77
#
   SUBROUTINE LRPAR (TOK, NLPAR)
#
   INTEGER NLPAR
   CHARACTER TOK
#
   IF (TOK == LPAREN)
      INCREMENT (NLPAR)
   ELSE IF (TOK == RPAREN)
      DECREMENT (NLPAR)
#
   RETURN
   END
#
#$ LEX	- RETURN LEXICAL TYPE OF NEXT VALID TOKEN TO 'PARSE'
# PCN 93, 16 FEB 80, DELETE CKEYWD, USE STRINGS IN 'LEX' INSTEAD.
#			ALSO DO PROCESSOR FEATURE KEYWORDS HERE.
# PCN 98, 27 MAR 80, REORGANIZE SCAN WITH MOST COMMON KEYWORDS FIRST.
#
   INTEGER FUNCTION LEX(TOKEN)
#
   CHARACTER TOKEN(MAXTOK), DEFTOK
   INTEGER ALLDIG, SEQL
#
   STRING SBREAK "BREAK"	;	STRING SINCL  "INCLUDE"
   STRING SDEFIN "DEFINE"	;	STRING SMACRO  "MACRO"
   STRING SDO    "DO"		;	STRING SNEXT  "NEXT"
   STRING SELSE  "ELSE"	;	STRING SREPT  "REPEAT"
   STRING SEND   "END"	;	STRING SRETRN "RETURN"
   STRING SENDIF "ENDIFDEF"	;	STRING SSTOP  "STOP"
   STRING SFOR   "FOR"	;	STRING SSTRNG "STRING"
   STRING SIF    "IF"		;	STRING SUNTIL "UNTIL"
   STRING SIFDEF "IFDEF"	;	STRING SWHILE "WHILE"
   STRING SIFNOT "IFNOTDEF"
#
   WHILE (DEFTOK(TOKEN, MAXTOK) ==  NEWLINE)
      ; 
   LEX = TOKEN(1)
   IF (LEX==EOF \ LEX==SEMICOL \ LEX==LBRACE \ LEX==RBRACE)
      RETURN
   IF (ALLDIG(TOKEN) == YES)			LEX=LEXDIGITS
   ELSE IF (SEQL(TOKEN, SIF) == YES)		LEX=LEXIF
   ELSE IF (SEQL(TOKEN, SELSE) == YES)	LEX=LEXELSE
   ELSE IF (SEQL(TOKEN, SFOR) == YES)		LEX=LEXFOR
   ELSE IF (SEQL(TOKEN, SWHILE) == YES)	LEX=LEXWHILE
   ELSE IF (SEQL(TOKEN, SREPT) == YES)	LEX=LEXREPEAT
   ELSE IF (SEQL(TOKEN, SDO) == YES)		LEX=LEXDO
   ELSE IF (SEQL(TOKEN, SUNTIL) == YES)	LEX=LEXUNTIL
   ELSE IF (SEQL(TOKEN, SBREAK) == YES)	LEX=LEXBREAK
   ELSE IF (SEQL(TOKEN, SNEXT) == YES)	LEX=LEXNEXT
   ELSE IF (SEQL(TOKEN, SDEFIN) == YES)	LEX=LEXDEFINE
   ELSE IF (SEQL(TOKEN, SINCL) == YES)	LEX=LEXINCLUD
   ELSE IF (SEQL(TOKEN, SMACRO) == YES)	LEX=LEXMACRO
   ELSE IF (SEQL(TOKEN, SENDIF) == YES)	LEX=LEXENDIF
   ELSE IF (SEQL(TOKEN, SIFDEF) == YES)	LEX=LEXIFDEF
   ELSE IF (SEQL(TOKEN, SIFNOT) == YES)	LEX=LEXIFNOT
   ELSE IF (SEQL(TOKEN, SSTRNG) == YES)	LEX=LEXSTRNG
   ELSE IF (SEQL(TOKEN, SEND) == YES)		LEX=LEXEND
   ELSE IF (SEQL(TOKEN, SRETRN) == YES)	LEX=LEXRETURN
   ELSE IF (SEQL(TOKEN, SSTOP) == YES)	LEX=LEXSTOP
   ELSE
      LEX=LEXOTHER
#
   RETURN
   END
#
#$ LOOKFR	- BINARY SEARCH TO LOCATE DEFINED SYMBOLIC CONSTANTS
# SYKES,NOV76;
# PCN # 67, 6 OCT 79, PREVENT 0 SUBSCRIPTING IF LASTP=0 [NAMPTR(IT)]
#
   INTEGER FUNCTION LOOKFR (NAME, DEFN)
#
   CHARACTER NAME(MAXTOK), DEFN(MAXDEF)
   INTEGER I, J, INDX, IT, INC, JUNK, SCOPY
#
INCLUDE CLOOK
#
   INDX=0
   INC=TWOS
   IF (LASTP > 0) [			#***PCN#67
      REPEAT [
         IT=INC+INDX
         IF (IT > LASTP)		#CAN'T GO PAST END OF TABLE!
            IT=LASTP
         I=1
         J=NAMPTR(IT)
         WHILE (NAME(I) == TABLE(J))
            IF (NAME(I) == EOS) [
               JUNK=SCOPY (TABLE(J+1), DEFN, MAXDEF, JUNK)
               RETURN (YES)
               ]
            ELSE [
               INCREMENT (I)
               INCREMENT (J)
               ]
         IF (NAME(I) > TABLE(J))
            IF (IT == LASTP)		#SPECIAL CASE, MEANS IT'S NOT THERE
               BREAK			#SO QUIT EARLY
            ELSE
               INDX=IT		#MOVE UP THE TABLE
         INC=INC/2			#***PCN67
         ] UNTIL (INC <= 0)
      ]
   RETURN (NO)
#
   END
#
#$ MATH	- DO MATH IN MACRO DEFINITIONS
# SYKES APR 77
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
# + AND - INTEGER NUMBERS AND DEFINITIONS ARE ALLOWED
#
   SUBROUTINE MATH 			#PCN #94
#
   INTEGER SCTOI, SITOC, NUM1, NUM2, JUNK
   CHARACTER TOKDEF, OPR, NGETCH, TOKEN(MAXTOK)
#
   IF (TOKDEF (TOKEN, MAXTOK) != BAD) [		#FIRST NUMBER
      JUNK=1
      NUM1=SCTOI (TOKEN, JUNK)
      WHILE (NGETCH(OPR) != GREATER) [		#MATH OPERATOR
         JUNK=TOKDEF (TOKEN, MAXTOK)			#NEXT NUMBER
         JUNK=1
         NUM2=SCTOI (TOKEN,JUNK)
         IF (OPR == PLUS)
            NUM1=NUM1+NUM2
         ELSE IF (OPR == MINUS)
            NUM1=NUM1-NUM2
         ELSE IF (OPR == STAR)
            NUM1=NUM1*NUM2
         ELSE IF (OPR == SLASH & NUM2 != 0)
            NUM1=NUM1/NUM2				#TRUNCATION
         ELSE [
            CALL SYNERR ("ILLEGAL MATH OPERATION.")
            CALL PBSTR (TOKEN)
            RETURN
            ]
         ]
      JUNK=SITOC (NUM1, TOKEN, MAXTOK)	#PUSH BACK RESULT
      CALL PBSTR (TOKEN)			#RESULT IS RETURNED ON INPUT STACK
      ]
#
   RETURN
   END
#
#$ NGETCH	- GET A (POSSIBLY PUSHED BACK) CHARACTER
# PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
#
   CHARFUNC FUNCTION NGETCH FUNCSIZE (C)		#PCN #94
#
   CHARACTER BUFR(MAXLINE), C
   INTEGER LASTC, GETLIN
#
INCLUDE CDEFIO
#
  DATA LASTC/MAXLINE/, BUFR(MAXLINE)/NEWLINE/
#
   IF (BP > 0)
      C = BUF(BP)
   ELSE [
      BP = 1
      IF (BUFR(LASTC) == NEWLINE \ LASTC >= MAXLINE) [
         LASTC=0
         IF (GETLIN(BUFR) == EOF) [		#READ A LINE IN
            C=EOF
            LASTC=MAXLINE		#FOR REINITIALIZATION SYKES 5 OCT 76
            BP=0
            RETURN (EOF)
            ]
         ]
      INCREMENT(LASTC)
      IF (BUFR(LASTC) == EOS)
         BUFR(LASTC) = NEWLINE		#EOS FROM GETLIN REALLY MEANS EOL
      C=BUFR(LASTC)
      ] 
   DECREMENT(BP)
   RETURN (C)
#
   END
#
#$ OTHERC	- OUTPUT ORDINARY FORTRAN STATEMENT
#
   SUBROUTINE OTHERC(LEXSTR)
#
   CHARACTER LEXSTR(DUMMYSIZE)
#
   CALL OUTTAB
   CALL OUTSTR(LEXSTR)		#OUTPUT TOKEN WE ALREADY HAVE
   CALL EATUP				#OUTPUT REST OF THE STATEMENT
   CALL OUTDON			#FINISH OFF LINE
#
   RETURN
   END
#
#$ OUTCH	- PUT ONE CHARACTER INTO OUTPUT BUFFER, CREATE CONTINUATION LINES
#
   SUBROUTINE OUTCH(C)
#
   CHARACTER C
#
INCLUDE COUTLN
#
   IF (OUTP > 70 \ OUTP < 0) [  	# CONTINUATION CARD,  SYKES 26 SEP 76
      CALL OUTDON
      FOR (OUTP = 1; OUTP < 6; INCREMENT (OUTP))	#PCN #77
         OUTBUF(OUTP) = BLANK
      OUTBUF(OUTP) = CONTINCHAR		#THE CONTINUATION FLAG CHAR. IN COL 6
      ] 
   INCREMENT (OUTP)
   OUTBUF(OUTP) = C
#
   RETURN
   END