
C				FILE= RAT3.RAT
C
C EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT
C SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.
C BOB DENNY
C 25-MAR-80
C
CFILE=DEFIN.RAT  ===== GENERAL CHARACTER SET DEFINITIONS ===============
C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT.
C
C                      ******************
C                        FILE=RATDEF.RT
C                      ******************
C
C==============DEFINITIONS FOR RT-11 RATFOR PREPROCESSOR===============
C
CLINK LIBRARY FOR COMPILE/LINK/GO OPTION
C
C===========================================================================
C
      SUBROUTINE OUTCON ( N )
C OUTCON - GENERATE  "N   CONTINUE" CODE
C
C
      INTEGER N
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      LOGICAL * 1 CONU (9)
      LOGICAL * 1 CONL (9)
C
      DATA CONU/1HC,1HO,1HN,1HT,1HI,1HN,1HU,1HE,0/
      DATA CONL/1Hc,1Ho,1Hn,1Ht,1Hi,1Hn,1Hu,1He,0/
      IF (.NOT.( N .GT. 0 )) GOTO 20000
      CALL OUTNUM ( N )
20000 CONTINUE
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20002
      CALL OUTSTR ( CONL )
      GOTO 20003
20002 CONTINUE
      CALL OUTSTR ( CONU )
20003 CONTINUE
      CALL OUTDON
C
      RETURN
      END

      SUBROUTINE OUTDON
C
C OUTDON - FINISH OFF A FORTRAN CODE (OUTPUT) LINE
C PCN #77, 5 JAN 80, DELETE 'NEWLINE' CHARACTER AT END OF LINE.
C
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
      IF (.NOT.( OUTP .LT. 0 )) GOTO 20004
      OUTP = IABS ( OUTP )
C# OUTBUF(OUTP+1) = NEWLINE		#PCN #77
20004 CONTINUE
      OUTBUF ( OUTP + 1 ) = 0
      CALL PUTLIN ( OUTBUF, 8, 0 )
      OUTP = 0
C
      RETURN
      END

      SUBROUTINE OUTGO ( N )
C
C OUTGO - GENERATE "GOTO  N" CODE
C PCN#56, 14 APR 79, DROP BLANK AFTER 'GOTO' IF COMPRESSING
C
C
      INTEGER N
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      LOGICAL * 1 GOTOU (5)
      LOGICAL * 1 GOTOL (5)
C
      DATA GOTOU/1HG,1HO,1HT,1HO,0/
      DATA GOTOL/1Hg,1Ho,1Ht,1Ho,0/
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20006
      CALL OUTSTR ( GOTOL )
      GOTO 20007
20006 CONTINUE
      CALL OUTSTR ( GOTOU )
20007 CONTINUE
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20008
      CALL OUTCH ( 32 )
20008 CONTINUE
      CALL OUTNUM ( N )
      CALL OUTDON
C
      RETURN
      END

      SUBROUTINE OUTIF
C
C OUTIF - GENERATE "IF (.NOT." CODE FOR 'FOR' AND 'IF' STATEMENTS
C SYKES,18FEB77
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
C PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT
C
C
C				FILE=CPRTLN.RAT FOR RATFOR
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )
      INTEGER FORTYP
      INTEGER IFTYP
      INTEGER READY
      LOGICAL * 1 PRTBUF
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
C
      LOGICAL * 1 IFNOTU (10)
      LOGICAL * 1 IFNOTL (10)
C
      DATA IFNOTU/1HI,1HF,1H ,1H(,1H.,1HN,1HO,1HT,1H.,0/
      DATA IFNOTL/1Hi,1Hf,1H ,1H(,1H.,1Hn,1Ho,1Ht,1H.,0/
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20010
      CALL OUTSTR ( IFNOTL )
      GOTO 20011
20010 CONTINUE
      CALL OUTSTR ( IFNOTU )
C
20011 CONTINUE
      IFTYP = 1
C
      RETURN
      END

      SUBROUTINE OUTNUM ( N )
C
C OUTNUM - OUTPUT DECIMAL NUMBER TO FORTRAN CODE FILE
C
C
      LOGICAL * 1 CHARS ( 8 )
      INTEGER JUNK, LEN, N, SITOC
C
      JUNK = SITOC ( N, CHARS, 8 )
      CALL OUTSTR ( CHARS )
C
      RETURN
      END

      SUBROUTINE OUTSTR ( STR )
C
C OUTSTR - OUTPUT A STRING TO FORTRAN CODE FILE
C  ALSO CONVERT DOUBLE QUOTED STRINGS TO HOLLERITH.
C   PASS SINGLE QUOTED STRINGS UNPROCESSED.
C
C
      LOGICAL * 1 C, STR ( 1 ), CHARS ( 8 )
      INTEGER I, J, SLEN, LEN, K, SITOC
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      I = SLEN ( STR )
      IF (.NOT.( ( OUTP + I .GE. 72 ) .AND. ( OUTP .GT. 6 ) )) GOTO 
     $20012
      OUTP = - OUTP
20012 CONTINUE
       I = 1
20014 IF (.NOT.( STR ( I ) .NE. 0)) GOTO 20016
      C = STR ( I )
      IF (.NOT.( C .NE. 34 )) GOTO 20017
      CALL OUTCH ( C )
      GOTO 20018
20017 CONTINUE
      I = I + 1
      CONTINUE
       J = I
20019 IF (.NOT.( STR ( J ) .NE. C)) GOTO 20021
20020 J = J + 1 
      GOTO 20019
20021 CONTINUE
      LEN = SITOC ( J - I, CHARS, 8 )
      CONTINUE
       K = 1
20022 IF (.NOT.( K .LE. LEN)) GOTO 20024
      CALL OUTCH ( CHARS ( K ) )
20023 K = K + 1 
      GOTO 20022
20024 CONTINUE
      IF (.NOT.( LC .EQ. 1 )) GOTO 20025
      CALL OUTCH ( 104 )
      GOTO 20026
20025 CONTINUE
      CALL OUTCH ( 72 )
20026 CONTINUE
      CONTINUE
20027 IF (.NOT.( I .LT. J)) GOTO 20029
      CALL OUTCH ( STR ( I ) )
20028 I = I + 1 
      GOTO 20027
20029 CONTINUE
20018 CONTINUE
C
20015 I = I + 1 
      GOTO 20014
20016 CONTINUE
      RETURN
      END

      SUBROUTINE OUTTAB
C
C OUTTAB - GENERATE A TAB AT BEGINNING OF FORTRAN LINE
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
C
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
C				FILE = CLINE.RAT  FOR RATFOR.RAT
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
      COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN
      INTEGER LEVEL
      INTEGER INFILE
      INTEGER LINECT
      INTEGER INIF
      INTEGER FTNLN
C
20030 IF (.NOT.( OUTP .LT. 6 )) GOTO 20031
      CALL OUTCH ( 32 )
C
      GOTO 20030
20031 CONTINUE
      IF (.NOT.( OUTP .EQ. 6 )) GOTO 20032
      FTNLN = FTNLN + 1
C
20032 CONTINUE
      RETURN
      END

      SUBROUTINE PARSE
C
C PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE
C PCN # 93, 17 FEB 80, MOVE FINDING PROCESSOR FEATURES HERE FROM GETTOK.
C PCN #92, 20 FEB 80, ADD RETURN (EXPRESSION).
C
C
      LOGICAL * 1 LEXSTR ( 70 ), LAST
      INTEGER LEX, STRNGS
      INTEGER LAB, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOK
      DATA STRNGS / 0 /
C
      SP = 1
      LEXTYP ( 1 ) = - 3
       TOK = LEX ( LEXSTR )
20034 IF (.NOT.( TOK .NE. - 3)) GOTO 20036
      IF (.NOT.( STRNGS .EQ. 1 .AND. TOK .NE. - 130 .AND. TOK .NE. 59 )
     $) GOTO 20037
      CALL ENDSTR
      STRNGS = 0
20037 CONTINUE
      IF (.NOT.( TOK .EQ. - 116 )) GOTO 20039
      CALL IFCODE ( LAB )
      GOTO 20040
20039 CONTINUE
      IF (.NOT.( TOK .EQ. - 124 .OR. TOK .EQ. - 125 )) GOTO 20041
      CALL ADDDEF ( LEXSTR, 70 )
      GOTO 20042
20041 CONTINUE
      IF (.NOT.( TOK .EQ. - 112 )) GOTO 20043
      CALL DOCODE ( LAB )
      GOTO 20044
20043 CONTINUE
      IF (.NOT.( TOK .EQ. - 111 )) GOTO 20045
      CALL LABELC ( LEXSTR )
      GOTO 20046
20045 CONTINUE
      IF (.NOT.( TOK .EQ. - 114 )) GOTO 20047
      CALL ENDCOD ( LEXSTR, SP )
      GOTO 20048
20047 CONTINUE
      IF (.NOT.( TOK .EQ. - 128 )) GOTO 20049
      GOTO 20050
20049 CONTINUE
      IF (.NOT.( TOK .EQ. - 126 )) GOTO 20051
      CALL IFDEFC ( 1 )
      GOTO 20052
20051 CONTINUE
      IF (.NOT.( TOK .EQ. - 127 )) GOTO 20053
      CALL IFDEFC ( 0 )
      GOTO 20054
20053 CONTINUE
      IF (.NOT.( TOK .EQ. - 129 )) GOTO 20055
      CALL OPENI
      GOTO 20056
20055 CONTINUE
      IF (.NOT.( TOK .EQ. - 115 )) GOTO 20057
      CALL FORCOD ( LAB, SP )
      GOTO 20058
20057 CONTINUE
      IF (.NOT.( TOK .EQ. - 119 )) GOTO 20059
      CALL REPCOD ( LAB, SP )
      GOTO 20060
20059 CONTINUE
      IF (.NOT.( TOK .EQ. - 130 )) GOTO 20061
      STRNGS = 1
      CALL STRNGC
      GOTO 20062
20061 CONTINUE
      IF (.NOT.( TOK .EQ. - 113 )) GOTO 20063
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20065
      CALL ELSEIF ( LABVAL ( SP ), LAST )
      GOTO 20066
20065 CONTINUE
      CALL SYNERR ( 13HILLEGAL ELSE. )
20066 CONTINUE
      GOTO 20064
20063 CONTINUE
      IF (.NOT.( TOK .EQ. - 121 )) GOTO 20067
      CALL WHILEC ( LAB, SP )
C
CPCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR)
20067 CONTINUE
20064 CONTINUE
20062 CONTINUE
20060 CONTINUE
20058 CONTINUE
20056 CONTINUE
20054 CONTINUE
20052 CONTINUE
20050 CONTINUE
20048 CONTINUE
20046 CONTINUE
20044 CONTINUE
20042 CONTINUE
20040 CONTINUE
      IF (.NOT.( TOK .NE. 125 )) GOTO 20069
      LAST = TOK
C
20069 CONTINUE
      IF (.NOT.( TOK .EQ. - 116 .OR. TOK .EQ. - 113 .OR. TOK .EQ. - 121
     $  .OR. TOK .EQ. - 115 .OR. TOK .EQ. - 119  .OR. TOK .EQ. - 112 
     $.OR. TOK .EQ. - 111 .OR. TOK .EQ. 123 )) GOTO 20071
      SP = SP + 1
      IF (.NOT.( SP .GT. 100 )) GOTO 20073
      CALL ERROR ( 25HSTACK OVERFLOW IN PARSER. )
20073 CONTINUE
      LEXTYP ( SP ) = TOK
      LABVAL ( SP ) = LAB
      GOTO 20072
20071 CONTINUE
      IF (.NOT.( TOK .EQ. 125 )) GOTO 20075
      IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20077
      SP = SP - 1
      GOTO 20078
20077 CONTINUE
      CALL SYNERR ( 10HILLEGAL ]. )
20078 CONTINUE
      GOTO 20076
20075 CONTINUE
      IF (.NOT.( TOK .EQ. - 118 .OR. TOK .EQ. - 123 )) GOTO 20079
      CALL OTHERC ( LEXSTR )
      GOTO 20080
20079 CONTINUE
      IF (.NOT.( TOK .EQ. - 122 )) GOTO 20081
      CALL RETCOD ( LEXSTR )
      GOTO 20082
20081 CONTINUE
      IF (.NOT.( TOK .EQ. - 110 .OR. TOK .EQ. - 117 )) GOTO 20083
      CALL BRKNXT ( SP, LEXTYP, LABVAL, TOK )
C
20083 CONTINUE
20082 CONTINUE
20080 CONTINUE
20076 CONTINUE
      TOK = LEX ( LEXSTR )
      CALL PBSTR ( LEXSTR )
      CALL UNSTAK ( SP, LEXTYP, LABVAL, TOK, LAST )
20072 CONTINUE
C
20035 TOK = LEX ( LEXSTR ) 
      GOTO 20034
20036 CONTINUE
      RETURN
      END

      SUBROUTINE PBSTR ( IN )
C
C PBSTR - PUSH STRING BACK ONTO INPUT FOR LATER RE-INPUT
C
C
      LOGICAL * 1 IN ( 1 )
      INTEGER I, SLEN
C
       I = SLEN ( IN )
20085 IF (.NOT.( I .GT. 0)) GOTO 20087
      CALL PUTBAK ( IN ( I ) )
C
20086 I = I - 1 
      GOTO 20085
20087 CONTINUE
      RETURN
      END

      SUBROUTINE PUTBAK ( C )
C
C PUTBAK - PUSH CHARACTER BACK ONTO INPUT FOR LATER RE-RETRIVAL
C
C
      LOGICAL * 1 C
C
C					FILE = CDEFIO.RAT  FOR RATFOR.RAT
      COMMON / CDEFIO / BP, BUF ( 160 )
      INTEGER BP
      LOGICAL * 1 BUF
C
      BP = BP + 1
      IF (.NOT.( BP .GT. 160 )) GOTO 20088
      CALL ERROR ( 24HPUSHBACK STACK OVERFLOW. )
      GOTO 20089
20088 CONTINUE
      BUF ( BP ) = C
C
20089 CONTINUE
      RETURN
      END

      SUBROUTINE RATGO ( SWITCH )
C
C RATGO - RATFOR INITIALIZATION ROUTINE
C SYKES 26 SEP 76
C
C
      INTEGER SWITCH, JUNK, I, LABGEN
C
C					FILE = CDEFIO.RAT  FOR RATFOR.RAT
      COMMON / CDEFIO / BP, BUF ( 160 )
      INTEGER BP
      LOGICAL * 1 BUF
C
C					FILE = CFOR.RAT FOR RATFOR.RAT
      COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN
      INTEGER FORDEP
      LOGICAL * 1 FORSTK
      INTEGER FORLEN
C
C				FILE=CFUNC.RAT  FOR RATFOR
      COMMON / CFUNC / INFUNC, FNAM ( 12 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
C
C				FILE = CLINE.RAT  FOR RATFOR.RAT
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
      COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN
      INTEGER LEVEL
      INTEGER INFILE
      INTEGER LINECT
      INTEGER INIF
      INTEGER FTNLN
C
C				FILE = CLIST. RAT   FOR RATFOR.RAT ; SYKES,26SEP76
      COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 
     $DEBUG
      INTEGER LST
      INTEGER PLINE
      INTEGER PAGE
      INTEGER ERRORS
      INTEGER OUTPUT
      INTEGER IFPNT
      INTEGER DEBUG
C
C					FILE = CLOOK.RAT  FOR RATFOR.RAT
      COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 200 ), TABLE ( 2200
     $ )
      INTEGER LASTP
      INTEGER TWOS
      INTEGER LASTT
      INTEGER NAMPTR
      LOGICAL * 1 TABLE
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
C				FILE=CPRTLN.RAT FOR RATFOR
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )
      INTEGER FORTYP
      INTEGER IFTYP
      INTEGER READY
      LOGICAL * 1 PRTBUF
C
C					FILE= CSTR.RAT  FOR RATFOR
      COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 )
      INTEGER LASTS
      INTEGER LASTR
      INTEGER STRPTR
      LOGICAL * 1 TABLES
C
C
C##COUTLN
      OUTP = 0
C
C## CLINE
      LEVEL = 1
      LINECT = 1
      INFILE ( 1 ) = 1
      FTNLN = 0
C
C## CDEFIO
      BP = 0
C
C## CFOR
      FORDEP = 0
      FORLEN = 1
C
C## CFUNC
      INFUNC = 0
C
C## CLOOK
      IF (.NOT.( SWITCH .EQ. 1 )) GOTO 20090
      LASTP = 0
      LASTT = 0
      TWOS = 1
C
C## CLIST
20090 CONTINUE
      PAGE = 0
      PLINE = 9999
      ERRORS = 0
      INIF = 0
C
C## CPRTLN
      READY = 0
C
C## CSTR
      LASTS = 0
      LASTR = 0
C
      I = LABGEN ( 0 )
      JUNK = LABGEN ( 20000 - I )
C
      RETURN
      END

      SUBROUTINE RELATE ( TOKEN, LAST )
C
C RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG FORM
CSYKES, 20 NOV 76
C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD  && FOR .EQV.
C PCN #77, 5 JAN 80, USE FOLD TO GET LOWER CASE VERSIONS, IF NEEDED
C PCN #87, 10 FEB 80, ALLOW << AND >> FOR < AND >.
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C
C
      LOGICAL * 1 NGETCH, DOTS ( 6, 11 ), TOKEN ( 1 ), NEXTCH, THISCH
      INTEGER LAST, LINE, JUNK, SCOPY
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      DATA DOTS / 46, 71, 69, 46, 0, 0, 46, 71, 84, 46, 0, 0, 46, 76, 
     $69, 46, 0, 0, 46, 76, 84, 46, 0, 0, 46, 78, 69, 46, 0, 0, 46, 78,
     $ 79, 84, 46, 0, 46, 69, 81, 46, 0, 0, 46, 65, 78, 68, 46, 0, 46, 
     $79, 82, 46, 0, 0, 46, 88, 79, 82, 46, 0, 46, 69, 81, 86, 46, 0 /
C
      LINE = 0
      THISCH = TOKEN ( 1 )
      NEXTCH = NGETCH ( NEXTCH )
      IF (.NOT.( THISCH .EQ. 62 )) GOTO 20092
      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20094
      LINE = 1
      GOTO 20095
20094 CONTINUE
      IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20096
      LINE = 5
      GOTO 20097
20096 CONTINUE
      IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20098
      LINE = 2
      GOTO 20099
20098 CONTINUE
      LINE = 2
      CALL PUTBAK ( NEXTCH )
20099 CONTINUE
20097 CONTINUE
20095 CONTINUE
      GOTO 20093
20092 CONTINUE
      IF (.NOT.( THISCH .EQ. 60 )) GOTO 20100
      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20102
      LINE = 3
      GOTO 20103
20102 CONTINUE
      IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20104
      LINE = 5
      GOTO 20105
20104 CONTINUE
      IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20106
      LINE = 4
      GOTO 20107
20106 CONTINUE
      LINE = 4
      CALL PUTBAK ( NEXTCH )
20107 CONTINUE
20105 CONTINUE
20103 CONTINUE
      GOTO 20101
20100 CONTINUE
      IF (.NOT.( THISCH .EQ. 33 )) GOTO 20108
      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20110
      LINE = 5
      GOTO 20111
20110 CONTINUE
      LINE = 6
      CALL PUTBAK ( NEXTCH )
20111 CONTINUE
      GOTO 20109
20108 CONTINUE
      IF (.NOT.( THISCH .EQ. 61 )) GOTO 20112
      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20114
      LINE = 7
      GOTO 20115
20114 CONTINUE
      CALL PUTBAK ( NEXTCH )
20115 CONTINUE
      GOTO 20113
20112 CONTINUE
      IF (.NOT.( THISCH .EQ. 38 )) GOTO 20116
      IF (.NOT.( NEXTCH .EQ. 38 )) GOTO 20118
      LINE = 11
      GOTO 20119
20118 CONTINUE
      LINE = 8
      CALL PUTBAK ( NEXTCH )
20119 CONTINUE
      GOTO 20117
20116 CONTINUE
      IF (.NOT.( THISCH .EQ. 124 )) GOTO 20120
      IF (.NOT.( NEXTCH .EQ. 124 .OR. NEXTCH .EQ. 92 )) GOTO 20122
      LINE = 10
      GOTO 20123
20122 CONTINUE
      LINE = 9
      CALL PUTBAK ( NEXTCH )
C
20123 CONTINUE
20120 CONTINUE
20117 CONTINUE
20113 CONTINUE
20109 CONTINUE
20101 CONTINUE
20093 CONTINUE
      IF (.NOT.( LINE .GT. 0 )) GOTO 20124
      LAST = SCOPY ( DOTS ( 1, LINE ), TOKEN, 10, JUNK )
      IF (.NOT.( LC .EQ. 1 )) GOTO 20126
      CALL FOLD ( TOKEN )
20126 CONTINUE
      GOTO 20125
20124 CONTINUE
      TOKEN ( 2 ) = 0
      LAST = 1
20125 CONTINUE
      RETURN
      END

      SUBROUTINE REPCOD ( LAB, SP )
C
C REPCOD - GENERATE CODE FOR BEGINNING OF 'REPEAT'
C
C
      INTEGER LAB, SP, LABGEN
C
      IF (.NOT.( SP .GT. 1 )) GOTO 20128
      CALL OUTCON ( 0 )
20128 CONTINUE
      LAB = LABGEN ( 3 )
      CALL OUTCON ( LAB )
      LAB = LAB + 1
C
      RETURN
      END

      SUBROUTINE RETCOD ( LEXSTR )
C
C RETCOD - PROCESS RETURN (EXPRESSION).
C PCN #92, 20 FEB 80,
C
C
      LOGICAL * 1 LEXSTR ( 70 ), TOKEN ( 70 ), GTOK
C
C				FILE=CFUNC.RAT  FOR RATFOR
      COMMON / CFUNC / INFUNC, FNAM ( 12 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      IF (.NOT.( INFUNC .EQ. 1 .AND. GTOK ( TOKEN, 70 ) .EQ. 40 )) GOTO
     $ 20130
      CALL PBSTR ( TOKEN )
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20132
      CALL FOLD ( FNAM )
20132 CONTINUE
      CALL OUTSTR ( FNAM )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20134
      CALL OUTCH ( 32 )
20134 CONTINUE
      CALL OUTCH ( 61 )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20136
      CALL OUTCH ( 32 )
20136 CONTINUE
      CALL BALPAR
      CALL OUTDON
      IF (.NOT.( LC .EQ. 1 )) GOTO 20138
      CALL FOLD ( LEXSTR )
20138 CONTINUE
      CALL OTHERC ( LEXSTR )
      GOTO 20131
20130 CONTINUE
      CALL PBSTR ( TOKEN )
      CALL OTHERC ( LEXSTR )
C
20131 CONTINUE
      RETURN
      END

      SUBROUTINE STRNGC
C
C STRNGC - GENERATE FIRST PART OF CODE FOR 'STRING' KEYWORD
CSYKES 15OCT76, 12MAR77
C PCN # 21, 10 DEC 77
C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
C PCN # 93, 17 FEB 80, CALL FROM PARSE, CHANGE CALLING SEQ.
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
CASSUMES THAT THE TARGET COMPILER ALLOWS MULTIPLE ELEMENT SPECIFICATION
C IN DATA STATEMENTS .
CTHE STRING KEYWORDS MUST BE POSITIONED AFTER ALL OTHER FORTRAN
C  SPECIFICATION STATEMENTS, EXCEPT FOR ANY DATA STATEMENTS.
CEACH "STRING FOO "BLATS"" LINE CAUSES IMMEDIATE OUTPUT OF A
C "CHARACTER FOO(4)" LINE AND A "DATA FOO/.../" LINE IS HELD UNTIL
C ALL STRING LINES HAVE BEEN PROCESSED, THEN INSERTED BEFORE THE
C FIRST NON-STRING LINE, SO THAT ALL DATA STATEMENTS ARE AT THE
C BOTTOM OF THE SPECIFICATION STATEMENTS.
C
C
C
      LOGICAL * 1 TOKEN ( 70 ), NAME ( 70 )
      LOGICAL * 1 DEFTOK
      INTEGER J, LEN, JUNK, INSTAL
C
C					FILE= CSTR.RAT  FOR RATFOR
      COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 )
      INTEGER LASTS
      INTEGER LASTR
      INTEGER STRPTR
      LOGICAL * 1 TABLES
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      LOGICAL * 1 CHAR (10)
C
      DATA CHAR/1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,0/
      CALL PUTBAK ( 12 )
      CALL PBSTR ( CHAR )
      CALL OUTTAB
20140 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 12 )) GOTO 20141
      CALL OUTSTR ( TOKEN )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20142
      CALL OUTCH ( 32 )
20142 CONTINUE
      GOTO 20140
20141 CONTINUE
      IF (.NOT.( ( DEFTOK ( NAME, 70 ) .NE. - 100 ) .OR.  ( DEFTOK ( 
     $TOKEN, 70 ) .NE. 34 ) )) GOTO 20144
      CALL SYNERR ( 15HILLEGAL STRING. )
      RETURN
20144 CONTINUE
      CALL OUTSTR ( NAME )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20146
      CALL OUTCH ( 32 )
20146 CONTINUE
      CALL OUTCH ( 40 )
       LEN = 2
20148 IF (.NOT.( TOKEN ( LEN ) .NE. 34)) GOTO 20150
20149 LEN = LEN + 1 
      GOTO 20148
20150 CONTINUE
      CALL OUTNUM ( LEN - 1 )
      CALL OUTCH ( 41 )
      CALL OUTDON
      TOKEN ( LEN ) = 0
C
C FILE THE ARRAY NAME AND THE STRING DEFINITION AWAY FOR FUTURE DUMPING
      IF (.NOT.( INSTAL ( NAME, TOKEN ( 2 ), LASTS, LASTR, STRPTR, 300,
     $ 20, TABLES ) .EQ. - 1 )) GOTO 20151
      CALL SYNERR ( 17HTOO MANY STRINGS. )
C
C
C
20151 CONTINUE
      RETURN
      END

      LOGICAL FUNCTION TOKDEF * 1 ( TOKEN, TOKSIZ )
C
C TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH'
CSYKES, APR77,
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C  USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH' BECAUSE 'MATH'
C  IS CALLED BY DEFTOK AND THEREFORE CANNOT CALL DEFTOK. THIS MAKES SURE
C  THAT SYMBOLS  WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING
C  MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLIC
C  CONSTANTS DEFINED AS NEGATIVE INTEGERS, WHICH ARE RETURNED AS A
C  SINGLE TOKEN INSTEAD OF TWO TOKENS.
C
C
      INTEGER TOKSIZ, LOOKFR, SUB
      LOGICAL * 1 DEFN ( 80 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE
C
      SUB = 1
       T = GTOK ( TOKEN ( SUB ), TOKSIZ )
20153 IF (.NOT.( T .NE. - 3)) GOTO 20155
      IF (.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( SUB ) ) .NE. - 30 )) 
     $GOTO 20156
      IF (.NOT.( T .EQ. 45 )) GOTO 20158
      SUB = 2
      GOTO 20154
20158 CONTINUE
      GOTO 20155
20159 CONTINUE
20156 CONTINUE
      CALL UNFOLD ( TOKEN )
      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20160
      CALL SYNERR ( 29HUNDEFINED SYMBOLIC IN <MATH>. )
      TOKDEF = ( - 1 )
      RETURN
20160 CONTINUE
      CALL PBSTR ( DEFN )
20161 CONTINUE
20154 T = GTOK ( TOKEN ( SUB ) , TOKSIZE ) 
      GOTO 20153
20155 CONTINUE
      TOKDEF = ( 1 )
      RETURN
C
      END

      SUBROUTINE UNSTAK ( SP, LEXTYP, LABVAL, TOKEN, LAST )
C
C UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT
C PCN # 16, 14 NOV 77
C PCN 93, 16 FEB 80, MOVE FEATURE FINDING FROM GETTOK TO PARSE/LEX
C
C
      INTEGER LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN
      LOGICAL * 1 LAST
C
      IF (.NOT.( TOKEN .NE. - 127 .AND. TOKEN .NE. - 126 .AND. TOKEN 
     $.NE. - 128  .AND. TOKEN .NE. - 129 )) GOTO 20162
      CONTINUE
20164 IF (.NOT.( SP .GT. 1)) GOTO 20166
      IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20167
      GOTO 20166
20167 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 .AND. TOKEN .EQ. - 113 )) 
     $GOTO 20169
      GOTO 20166
20169 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20171
      CALL OUTCON ( LABVAL ( SP ) )
      LAST = 32
      GOTO 20172
20171 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 113 )) GOTO 20173
      IF (.NOT.( SP .GT. 2 )) GOTO 20175
      SP = SP - 1
20175 CONTINUE
      CALL OUTCON ( LABVAL ( SP ) + 1 )
      LAST = 32
      GOTO 20174
20173 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 112 )) GOTO 20177
      CALL OUTCON ( LABVAL ( SP ) )
      CALL OUTCON ( LABVAL ( SP ) + 1 )
      GOTO 20178
20177 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 121 )) GOTO 20179
      CALL OUTGO ( LABVAL ( SP ) )
      CALL OUTCON ( LABVAL ( SP ) + 1 )
      GOTO 20180
20179 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 115 )) GOTO 20181
      CALL FORS ( LABVAL ( SP ) )
      GOTO 20182
20181 CONTINUE
      IF (.NOT.( LEXTYP ( SP ) .EQ. - 119 )) GOTO 20183
      CALL UNTILS ( LABVAL ( SP ), TOKEN )
20183 CONTINUE
20182 CONTINUE
20180 CONTINUE
20178 CONTINUE
20174 CONTINUE
20172 CONTINUE
20170 CONTINUE
20168 CONTINUE
20165 SP = SP - 1 
      GOTO 20164
20166 CONTINUE
C
20162 CONTINUE
      RETURN
      END

      SUBROUTINE UNTILS ( LAB, TOKEN )
C
C UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS
C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO RATFOR LISTING
C
C
      LOGICAL * 1 PTOKEN ( 70 )
      INTEGER JUNK, LAB, TOKEN, LEX
C
C				FILE=CPRTLN.RAT FOR RATFOR
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )
      INTEGER FORTYP
      INTEGER IFTYP
      INTEGER READY
      LOGICAL * 1 PRTBUF
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      CALL OUTNUM ( LAB )
      IF (.NOT.( TOKEN .EQ. - 120 )) GOTO 20185
      JUNK = LEX ( PTOKEN )
      CALL IFGO ( LAB - 1 )
      FORTYP = 1
      GOTO 20186
20185 CONTINUE
      CALL OUTGO ( LAB - 1 )
20186 CONTINUE
      CALL OUTCON ( LAB + 1 )
C
      RETURN
      END

      SUBROUTINE WHILEC ( LAB, SP )
C
C WHILEC - GENERATE CODE FOR BEGINNING OF 'WHILE' STATEMENTS
C
C
      INTEGER LAB, SP, LABGEN
C
      IF (.NOT.( SP .GT. 1 )) GOTO 20187
      CALL OUTCON ( 0 )
20187 CONTINUE
      LAB = LABGEN ( 2 )
      CALL OUTNUM ( LAB )
      CALL IFGO ( LAB + 1 )
C
      RETURN
      END

