C======== FILE=RAT1.RAT ======================= RATFOR IN RATFOR ==========
C THIS FILE CONTAINS THE NON-SYSTEM SPECIFIC PARTS OF RATFOR
CNOTE:THE COMPILER MUST CORRECTLY HANDLE NUMBERIC COMPARES OF BYTES AND INTEGERS
C EDITED TO PLACE SUBPROGRAM DECLARATIONS AHEAD OF COMMENTS FOR THAT
C SUBPROGRAM, SO F4 V2.2 KEEPS COMMENTS WITH IT.
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===========================================================================
      SUBROUTINE ADDDEF ( TOKEN, TOKSIZ )
C
C ADDDEF - GET DEFINITION, INSTALL SYMBOLIC CONSTANT AND SORT THE TABLE
C SYKES, 18FEB77
C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
C PCN # 68, 10 OCT 79, FIX BUG IF LASTP=1,TESTING NAMPTR(0).
C PCN # 84, 18 JAN 80, FIX BUG IN PCN # 68, CHANGE > TO >= SO 2ND SYMBOL FOUND
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C
C
      INTEGER TOKSIZ, LOOKFR, INSTAL, SCOMPR, I, J
      LOGICAL * 1 TOKEN ( TOKSIZ ), DEFN ( 80 )
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
      CALL GETDEF ( TOKEN, TOKSIZ, DEFN, 80 )
      CALL UNFOLD ( TOKEN )
      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 1 )) GOTO 20000
      CALL SYNERR ( 23HATTEMPTED REDEFINITION. )
      GOTO 20001
20000 CONTINUE
      IF (.NOT.( INSTAL ( TOKEN, DEFN, LASTP, LASTT, NAMPTR, 2200, 200,
     $ TABLE ) .EQ. - 1 )) GOTO 20002
      CALL SYNERR ( 21HTOO MANY DEFINITIONS. )
      GOTO 20003
20002 CONTINUE
      IF (.NOT.( LASTP .GE. 2 )) GOTO 20004
      IF (.NOT.( TWOS * 2 .LE. LASTP )) GOTO 20006
      TWOS = TWOS * 2
20006 CONTINUE
      I = NAMPTR ( LASTP - 1 )
      J = NAMPTR ( LASTP )
      IF (.NOT.( SCOMPR ( TABLE ( I ), TABLE ( J ) ) .GT. 0 )) GOTO 
     $20008
      CALL SHELL ( LASTP, NAMPTR, TABLE )
20008 CONTINUE
C
20004 CONTINUE
20003 CONTINUE
20001 CONTINUE
      RETURN
      END

      SUBROUTINE BALPAR
C
C BALPAR - COPY BALANCED PARTHENTHESES STRING INTO FORTRAN CODE
C PCN # 21
C
C
      LOGICAL * 1 T, TOKEN ( 70 ), DEFTOK
      INTEGER NLPAR
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20010
      CALL SYNERR ( 10HMISSING (. )
      RETURN
20010 CONTINUE
      CALL OUTSTR ( TOKEN )
      NLPAR = 1
20012 CONTINUE
      T = DEFTOK ( TOKEN, 70 )
      IF (.NOT.( T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ. 
     $- 3 )) GOTO 20015
      CALL PBSTR ( TOKEN )
      GOTO 20014
20015 CONTINUE
      IF (.NOT.( T .EQ. 10 )) GOTO 20017
      TOKEN ( 1 ) = 0
      GOTO 20018
20017 CONTINUE
      CALL LRPAR ( T, NLPAR )
20018 CONTINUE
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20019
      CALL OUTCH ( 32 )
20019 CONTINUE
      CALL OUTSTR ( TOKEN )
20013 IF (.NOT.( NLPAR .LE. 0 )) GOTO 20012
20014 CONTINUE
      IF (.NOT.( NLPAR .NE. 0 )) GOTO 20021
      CALL SYNERR ( 28HMISSING ( OR ) IN CONDITION. )
C
20021 CONTINUE
      RETURN
      END

      SUBROUTINE BRKNXT ( SP, LEXTYP, LABVAL, TOKEN )
C
C BRKNXT - GENERATE CODE FOR 'BREAK' AND 'NEXT' STATEMENTS
C
C
      INTEGER I, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN
C
       I = SP
20023 IF (.NOT.( I .GT. 0)) GOTO 20025
      IF (.NOT.( LEXTYP ( I ) .EQ. - 121 .OR. LEXTYP ( I ) .EQ. - 112  
     $.OR. LEXTYP ( I ) .EQ. - 115 .OR. LEXTYP ( I ) .EQ. - 119 )) GOTO
     $ 20026
      IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 20028
      CALL OUTGO ( LABVAL ( I ) + 1 )
      GOTO 20029
20028 CONTINUE
      CALL OUTGO ( LABVAL ( I ) )
20029 CONTINUE
      RETURN
20026 CONTINUE
20024 I = I - 1 
      GOTO 20023
20025 CONTINUE
      IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 20030
      CALL SYNERR ( 14HILLEGAL BREAK. )
      GOTO 20031
20030 CONTINUE
      CALL SYNERR ( 13HILLEGAL NEXT. )
C
20031 CONTINUE
      RETURN
      END

      SUBROUTINE DEFLST
C
C DEFLST - TO LIST CURRENT DEFINE TABLE CONTENTS
C SYKES,OCT76
C PCN # 61, 3 SEP 79, ADD SYMBOLIC CONSTANT USAGE DATA AT END OF LISTING
C PCN # 66, 6 OCT 79, DELETE LASTP<2 TEST, NOLONGER VALID
C PCN # 75, DEC 79, ADD FTN LINE NUMBERS TO LISTING
C PCN # 77, 5 JAN 80, INCLUDE CPRTLN AND USE 'PRTBUF' JUST TO SAVE SPACE.
C		(INSTEAD OF SEPERATE INTERNAL BUFFER)
C
C
      LOGICAL * 1 FF ( 2 )
      INTEGER I, J, K, LEN1, LEN2, CENTER, LINE, JUNK
      INTEGER SJOIN, SITOC, SLEN, SCOPY
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=CPRTLN.RAT FOR RATFOR
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )
      INTEGER FORTYP
      INTEGER IFTYP
      INTEGER READY
      LOGICAL * 1 PRTBUF
C
      LOGICAL * 1 TITLE (31)
      LOGICAL * 1 BL (2)
      LOGICAL * 1 HOW (7)
      LOGICAL * 1 MUCH (14)
      LOGICAL * 1 CHARS (12)
      LOGICAL * 1 ANDIT (5)
      LOGICAL * 1 SYMB (9)
C
      DATA TITLE/1HS,1HY,1HM,1HB,1HO,1HL,1HI,1HC,1H ,1HC,1HO,1HN,1HS,1H
     $T,1HA,1HN,1HT,1H ,1H=,1H ,1HD,1HE,1HF,1HI,1HN,1HI,1HT,1HI,1HO,1HN
     $,0/
      DATA BL/1H ,0/
      DATA HOW/1H ,1HU,1HS,1HE,1HD,1H ,0/
      DATA MUCH/1H ,1HO,1HF,1H ,1HP,1HO,1HS,1HS,1HI,1HB,1HL,1HE,1H ,0/
      DATA CHARS/1H ,1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,1HS,0/
      DATA ANDIT/1H ,1H ,1H&,1H ,0/
      DATA SYMB/1H ,1HS,1HY,1HM,1HB,1HO,1HL,1HS,0/
      DATA FF / 12, 0 /
C
      IF (.NOT.( LASTP .GT. 0 )) GOTO 20032
      CALL RATLST ( FF, 0, 0 )
      CENTER = ( 90 / 2 ) - 16
      IF (.NOT.( CENTER .GT. 30 )) GOTO 20034
      CENTER = 30
20034 CONTINUE
      PRTBUF ( 1 ) = 0
      CALL SPAD ( PRTBUF, 60 )
      JUNK = SCOPY ( TITLE, PRTBUF ( CENTER - 18 ), 40, JUNK )
      CALL RATLST ( PRTBUF, 0, 0 )
      CALL RATLST ( BL, 0, 0 )
      CONTINUE
       I = 1
20036 IF (.NOT.( I .LE. LASTP)) GOTO 20038
      J = NAMPTR ( I )
      LINE = I
      LEN1 = SLEN ( TABLE ( J ) )
      LEN2 = SLEN ( TABLE ( J + 1 + LEN1 ) )
      K = ( CENTER - 1 ) - LEN1
      IF (.NOT.( LEN1 .GT. ( CENTER - 2 ) .OR. LEN2 .GT. ( CENTER - 2 )
     $ )) GOTO 20039
      K = 1
20039 CONTINUE
      IF (.NOT.( ( LEN1 + LEN2 ) .GT. ( 90 - 3 ) )) GOTO 20041
      LINE = 32767
20041 CONTINUE
      CONTINUE
       L = 1
20043 IF (.NOT.( L .LT. K)) GOTO 20045
      PRTBUF ( L ) = 32
20044 L = L + 1 
      GOTO 20043
20045 CONTINUE
      JUNK = SCOPY ( TABLE ( J ), PRTBUF ( K ), 70, JUNK )
      IF (.NOT.( LINE .EQ. I )) GOTO 20046
      L = K + LEN1 + 3
      GOTO 20047
20046 CONTINUE
      L = 90 - LEN2
20047 CONTINUE
      IF (.NOT.( TABLE ( J + 1 + LEN1 ) .EQ. - 9 )) GOTO 20048
      J = J + 1
20048 CONTINUE
      JUNK = SCOPY ( TABLE ( J + 1 + LEN1 ), PRTBUF ( L ), 80, JUNK )
      PRTBUF ( K + LEN1 ) = 32
      PRTBUF ( K + LEN1 + 1 ) = 61
      PRTBUF ( K + LEN1 + 2 ) = 32
      CALL RATLST ( PRTBUF, LINE, 0 )
20037 I = I + 1 
      GOTO 20036
20038 CONTINUE
      LEN1 = SCOPY ( HOW, PRTBUF, 30, JUNK )
      JUNK = SITOC ( LASTP, PRTBUF ( LEN1 + 1 ), 5 )
      LEN1 = SJOIN ( PRTBUF, SYMB, 90, JUNK )
      LEN1 = SJOIN ( PRTBUF, MUCH, 90, JUNK )
      JUNK = SITOC ( 200, PRTBUF ( LEN1 + 1 ), 6 )
      LEN1 = SJOIN ( PRTBUF, ANDIT, 90, JUNK )
      JUNK = SITOC ( LASTT, PRTBUF ( LEN1 + 1 ), 6 )
      LEN1 = SJOIN ( PRTBUF, CHARS, 90, JUNK )
      LEN1 = SJOIN ( PRTBUF, MUCH, 90, JUNK )
      JUNK = SITOC ( 2200, PRTBUF ( LEN1 + 1 ), 6 )
      CALL RATLST ( PRTBUF, 0, 0 )
C
20032 CONTINUE
      RETURN
      END

      SUBROUTINE DEFMAC ( DEFN )
C
C DEFMAC - TO PROCESS MACRO CALLS (WITH ARGUMENT)
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
CTHE 'MACRO' AND 'DEFINE' KEYWORDS ARE SYNOMIMUS.
CA MACRO CAN BE DEFINED WITH A DEFINITION CONTAINING ONE OR
C  MORE 'PASSCHARACTERS' IN IT. WHEN THE MACRO IS INVOKED, EACH
C  OCCURANCE OF THE PASSCHARACTER IN THE DEFINITION IS REPLACED
C  WITH THE CURRENT ARGUMENT OF THE MACRO, WHICH IS CONTAINED IN PAREN
C  FOLLOWING THE MACRO NAME.
CDEFINE(FOO,($=$+1)) OR MACRO(FOO,($=$+1))	THEN
C  UNTIL (I)		IS PROCESSED INTO	UNTIL (I=I+1)
C NO PROCESSING OF THE MACRO DEFINITION IS DONE UNTIL THE MACRO
C   IS RESOLVED. SPECIAL CHAR. AND BLANKS IN DEFINITION ARE PRESERVED.
C
C
      INTEGER I, NLPAR, SLEN
      LOGICAL * 1 DEFN ( 80 ), TOKEN ( 70 ), GTOK
C
      IF (.NOT.( DEFN ( 1 ) .EQ. - 9 )) GOTO 20050
      IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20052
      CALL SYNERR ( 14HNO ( IN MACRO. )
      CALL PBSTR ( TOKEN )
      RETURN
20052 CONTINUE
      NLPAR = 1
      CONTINUE
       I = 1
20054 IF (.NOT.( NLPAR .GT. 0)) GOTO 20056
      IF (.NOT.( I .GT. 70 )) GOTO 20057
      CALL SYNERR ( 24HMACRO ARGUMENT TOO LONG. )
      RETURN
20057 CONTINUE
      IF (.NOT.( NGETCH ( TOKEN ( I ) ) .EQ. - 3 .OR. TOKEN ( I ) .EQ. 
     $10 )) GOTO 20059
      CALL SYNERR ( 15HMACRO > 1 LINE. )
      CALL PUTBAK ( TOKEN ( I ) )
      RETURN
20059 CONTINUE
      CALL LRPAR ( TOKEN ( I ), NLPAR )
20055 I = I + 1 
      GOTO 20054
20056 CONTINUE
      TOKEN ( I - 1 ) = 0
C PUSH BACK 'DEFINITION' WITH 'TOKEN' IN PLACE OF 'PASSCHAR'
C	BUT NOT THE FIRST CHAR--MACTYPE
      CONTINUE
       I = SLEN ( DEFN )
20061 IF (.NOT.( I .GT. 1)) GOTO 20063
      IF (.NOT.( DEFN ( I ) .EQ. 36 )) GOTO 20064
      CALL PBSTR ( TOKEN )
      GOTO 20065
20064 CONTINUE
      CALL PUTBAK ( DEFN ( I ) )
20065 CONTINUE
20062 I = I - 1 
      GOTO 20061
20063 CONTINUE
      GOTO 20051
20050 CONTINUE
      CALL PBSTR ( DEFN )
20051 CONTINUE
      RETURN
      END

      LOGICAL FUNCTION DEFTOK * 1 ( TOKEN, TOKSIZ )
C
C DEFTOK - GET TOKEN; PROCESS MACRO CALLS AND INVOCATIONS
C PCN 93, 18 FEB 80, HANDLE EOF OF INCLUDE FILES
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C PCN 92, 20 FEB 80, ADD GTFUNC TO SET UP FOR RETURN(EXPRESSION)
C IMPOSSES THE RESTRICTION THAT SYMBOLIC CONSTANTS
C MUST START WITH A LETTER.  ALSO THAT SYMBOLIC CONSTANTS ARE
C ALWAYS CONVERTED TO UPPER CASE BEFORE LOOKUP, THEREFOR CASE
C IS NOT SIGNIFICANT TO SYMBOLIC CONSTANTS.
C SYKES, DEC76, ADD MACRO (WITH ARGUMENTS) CAPABILITY
C
C
      INTEGER TOKSIZ, LOOKFR, SEQL
      LOGICAL * 1 DEFN ( 80 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE
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
      LOGICAL * 1 FUNC (9)
C
      DATA FUNC/1HF,1HU,1HN,1HC,1HT,1HI,1HO,1HN,0/
20066 IF (.NOT.( LEVEL .GT. 0 )) GOTO 20067
      CONTINUE
       DEFTOK = GTOK ( TOKEN, TOKSIZ )
20068 IF (.NOT.( DEFTOK .NE. - 3)) GOTO 20070
      IF (.NOT.( DEFTOK .NE. - 100 .OR. TYPE ( TOKEN ( 1 ) ) .NE. - 30 
     $)) GOTO 20071
      RETURN
20071 CONTINUE
      CALL UNFOLD ( TOKEN )
      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20073
      IF (.NOT.( SEQL ( FUNC, TOKEN ) .EQ. 1 )) GOTO 20075
      CALL GTFUNC
20075 CONTINUE
      RETURN
20073 CONTINUE
      CALL DEFMAC ( DEFN )
20074 CONTINUE
20069 DEFTOK = GTOK ( TOKEN , TOKSIZ ) 
      GOTO 20068
20070 CONTINUE
      IF (.NOT.( LEVEL .EQ. 1 )) GOTO 20077
      RETURN
20077 CONTINUE
      CALL CLOSE ( INFILE ( LEVEL ) )
      LEVEL = LEVEL - 1
20078 CONTINUE
C
      GOTO 20066
20067 CONTINUE
      END

      SUBROUTINE DOCODE ( LAB )
C
C DOCODE - GENERATE CODE FOR BEGINNING OF 'DO' STATEMENT
C
C
      INTEGER LABGEN, LAB
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      LOGICAL * 1 DOSTRU (4)
      LOGICAL * 1 DOSTRL (4)
C
      DATA DOSTRU/1HD,1HO,1H ,0/
      DATA DOSTRL/1Hd,1Ho,1H ,0/
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20079
      CALL OUTSTR ( DOSTRL )
      GOTO 20080
20079 CONTINUE
      CALL OUTSTR ( DOSTRU )
20080 CONTINUE
      LAB = LABGEN ( 2 )
      CALL OUTNUM ( LAB )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20081
      CALL OUTCH ( 32 )
20081 CONTINUE
      CALL EATUP
      CALL OUTDON
C
      RETURN
      END

      SUBROUTINE EATUP
C
C EATUP - PROCESS REST OF A STATEMENT; INTERPRET CONTINUATIONS
C
C
      LOGICAL * 1 PTOKEN ( 70 ), T, TOKEN ( 70 ), DEFTOK
      INTEGER NLPAR
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      NLPAR = 0
20083 CONTINUE
      T = DEFTOK ( TOKEN, 70 )
      IF (.NOT.( T .EQ. 59 .OR. T .EQ. 10 )) GOTO 20086
      GOTO 20085
20086 CONTINUE
      IF (.NOT.( T .EQ. 125 )) GOTO 20088
      CALL PBSTR ( TOKEN )
      GOTO 20085
20088 CONTINUE
      IF (.NOT.( T .EQ. 123 .OR. T .EQ. - 3 )) GOTO 20090
      IF (.NOT.( NLPAR .GT. 0 )) GOTO 20092
      CALL SYNERR ( 24HUNEXPECTED BRACE OR EOF. )
20092 CONTINUE
      CALL PBSTR ( TOKEN )
      GOTO 20085
20090 CONTINUE
      IF (.NOT.( T .EQ. 44 .OR. T .EQ. 95 )) GOTO 20094
      IF (.NOT.( DEFTOK ( PTOKEN, 70 ) .NE. 10 )) GOTO 20096
      CALL PBSTR ( PTOKEN )
20096 CONTINUE
      IF (.NOT.( T .EQ. 95 )) GOTO 20098
      TOKEN ( 1 ) = 0
20098 CONTINUE
      GOTO 20095
20094 CONTINUE
      CALL LRPAR ( T, NLPAR )
20095 CONTINUE
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20100
      CALL OUTCH ( 32 )
20100 CONTINUE
      CALL OUTSTR ( TOKEN )
20084 IF (.NOT.( NLPAR .LT. 0 )) GOTO 20083
20085 CONTINUE
      IF (.NOT.( NLPAR .NE. 0 )) GOTO 20102
      CALL SYNERR ( 15HUNBALANCED ( ). )
C
20102 CONTINUE
      RETURN
      END

      SUBROUTINE ELSEIF ( LAB, LAST )
C
C ELSEIF - GENERATE CODE FOR END OF 'IF' BEFORE ELSE
C PCN#10, 21 OCT 77 DON'T GENERATE THE 'GOTO' IF THE PRECEEDING LINE GENERATED
C  A 'GOTO', MAKING THIS ONE UNREACHABLE, WHICH SOME COMPILERS DON'T LIKE.
C
C
      INTEGER LAB
      LOGICAL * 1 LAST
C
      IF (.NOT.( LAST .NE. - 110 .AND. LAST .NE. - 117  .AND. LAST .NE.
     $ - 123 .AND. LAST .NE. - 122 )) GOTO 20104
      CALL OUTGO ( LAB + 1 )
20104 CONTINUE
      CALL OUTCON ( LAB )
C
      RETURN
      END

      SUBROUTINE ENDCOD ( LEXSTR, SP )
C
C ENDCOD - FORCE LISTING PAGE ADVANCE AFTER FORTRAN 'END' STATEMENT
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING
C PCN #92, 20 FEB 80, RESET IN-FUNCTION STATUS FLAG.
C
C
      INTEGER SLEN, SP
      LOGICAL * 1 LEXSTR ( 1 ), PTOK ( 70 ), DEFTOK
C
C				FILE=CFUNC.RAT  FOR RATFOR
      COMMON / CFUNC / INFUNC, FNAM ( 12 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
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=CPRTLN.RAT FOR RATFOR
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )
      INTEGER FORTYP
      INTEGER IFTYP
      INTEGER READY
      LOGICAL * 1 PRTBUF
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
      IF (.NOT.( 3 .EQ. SLEN ( LEXSTR ) .AND. DEFTOK ( PTOK, 70 ) .EQ. 
     $10 )) GOTO 20106
      CALL OUTTAB
      CALL OUTSTR ( LEXSTR )
      CALL OUTDON
      CALL PRTLIN
      IF (.NOT.( SP .NE. 1 )) GOTO 20108
      CALL SYNERR ( 38HMISSING CLAUSE OR BRACE IN ABOVE PROG. )
      SP = 1
20108 CONTINUE
      PLINE = 9999
      CALL OUTCH ( 12 )
      CALL OUTDON
      FTNLN = 0
      INFUNC = 0
      GOTO 20107
20106 CONTINUE
      CALL OTHERC ( LEXSTR )
20107 CONTINUE
      CALL PBSTR ( PTOK )
      RETURN
      END

      SUBROUTINE ENDSTR
C
C ENDSTR - DUMP PENDING STRING DEFINITIONS
C
C
      INTEGER J, K, SLEN
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 DATAU (6)
      LOGICAL * 1 DATAL (6)
C
      DATA DATAU/1HD,1HA,1HT,1HA,1H ,0/
      DATA DATAL/1Hd,1Ha,1Ht,1Ha,1H ,0/
       K = 1
20110 IF (.NOT.( K .LE. LASTS)) GOTO 20112
      CALL OUTTAB
      IF (.NOT.( LC .EQ. 1 )) GOTO 20113
      CALL OUTSTR ( DATAL )
      GOTO 20114
20113 CONTINUE
      CALL OUTSTR ( DATAU )
20114 CONTINUE
      J = STRPTR ( K )
      CALL OUTSTR ( TABLES ( J ) )
      CALL OUTCH ( 47 )
      CONTINUE
       J = J + SLEN ( TABLES ( J ) ) + 1
20115 IF (.NOT.( TABLES ( J ) .NE. 0)) GOTO 20117
      CALL OUTCH ( 49 )
      IF (.NOT.( LC .EQ. 1 )) GOTO 20118
      CALL OUTCH ( 104 )
      GOTO 20119
20118 CONTINUE
      CALL OUTCH ( 72 )
20119 CONTINUE
      CALL OUTCH ( TABLES ( J ) )
      CALL OUTCH ( 44 )
20116 J = J + 1 
      GOTO 20115
20117 CONTINUE
      CALL OUTNUM ( 0 )
      CALL OUTCH ( 47 )
      CALL OUTDON
20111 K = K + 1 
      GOTO 20110
20112 CONTINUE
      LASTS = 0
      LASTR = 0
      RETURN
      END

      SUBROUTINE ERROR ( BUF )
C
C ERROR - PRINT FATAL ERROR MESSAGE, THEN DIE
CSYKES 28 SEP 76
C
C
      LOGICAL * 1 BUF ( 1 )
C
      CALL SYNERR ( BUF )
      CALL SYNERR ( 10H**ABORT**. )
      CALL EXIT
      END

      SUBROUTINE FORCOD ( LAB, SP )
C
C FORCOD - GENERATE CODE FOR THE BEGINNING OF 'FOR' STATEMENT
C ***PCN # 21
C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING
C
C
      LOGICAL * 1 T, TOKEN ( 70 ), DEFTOK
      INTEGER SLEN, LABGEN
      INTEGER I, J, LAB, NLPAR, SP, JUNK, SCOPY
C
C					FILE = CFOR.RAT FOR RATFOR.RAT
      COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN
      INTEGER FORDEP
      LOGICAL * 1 FORSTK
      INTEGER FORLEN
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
      LAB = LABGEN ( 3 )
      IF (.NOT.( SP .GT. 1 )) GOTO 20120
      CALL OUTCON ( 0 )
C
20120 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20122
      CALL SYNERR ( 18HMISSING  ( IN FOR. )
      RETURN
20122 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 59 )) GOTO 20124
      CALL PBSTR ( TOKEN )
      CALL OUTTAB
      CALL EATUP
      CALL OUTDON
      FORTYP = 1
20124 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 70 ) .EQ. 59 )) GOTO 20126
      CALL OUTCON ( LAB )
      GOTO 20127
20126 CONTINUE
      CALL PBSTR ( TOKEN )
      CALL OUTNUM ( LAB )
      CALL OUTIF
      CALL OUTCH ( 40 )
      NLPAR = 0
      CONTINUE
20128 IF (.NOT.( NLPAR .GE. 0 )) GOTO 20129
      T = DEFTOK ( TOKEN, 70 )
      IF (.NOT.( T .EQ. 59 )) GOTO 20130
      GOTO 20129
20130 CONTINUE
      CALL LRPAR ( T, NLPAR )
20131 CONTINUE
      IF (.NOT.( T .NE. 10 .AND. T .NE. 95 )) GOTO 20132
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20134
      CALL OUTCH ( 32 )
20134 CONTINUE
      CALL OUTSTR ( TOKEN )
20132 CONTINUE
      GOTO 20128
20129 CONTINUE
      CALL OUTCH ( 41 )
      CALL OUTCH ( 41 )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20136
      CALL OUTCH ( 32 )
20136 CONTINUE
      CALL OUTGO ( LAB + 2 )
      IF (.NOT.( NLPAR .LT. 0 )) GOTO 20138
      CALL SYNERR ( 19HINVALID FOR CLAUSE. )
20138 CONTINUE
20127 CONTINUE
      FORDEP = FORDEP + 1
      J = FORLEN
      FORSTK ( J ) = 0
      NLPAR = 0
20140 IF (.NOT.( NLPAR .GE. 0 )) GOTO 20141
      T = DEFTOK ( TOKEN, 70 )
      CALL LRPAR ( T, NLPAR )
      IF (.NOT.( NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95 )) GOTO 
     $20142
      J = J + SLEN ( TOKEN )
      IF (.NOT.( J + 2 .GT. 120 )) GOTO 20144
      CALL ERROR ( 26HREINIT CLAUSE(S) TOO LONG. )
      GOTO 20145
20144 CONTINUE
      JUNK = SCOPY ( TOKEN, FORSTK ( FORLEN ), 32767, JUNK )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20146
      FORSTK ( J ) = 32
      J = J + 1
20146 CONTINUE
      FORSTK ( J ) = 0
      FORLEN = J
20145 CONTINUE
20142 CONTINUE
      GOTO 20140
20141 CONTINUE
      FORLEN = FORLEN + 1
      LAB = LAB + 1
C
      RETURN
      END

      SUBROUTINE FORS ( LAB )
C
C FORS - GENERATE CODE FOR END OF 'FOR' STATEMENT
C
C
      INTEGER I, J, LAB, SLEN
C
C					FILE = CFOR.RAT FOR RATFOR.RAT
      COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN
      INTEGER FORDEP
      LOGICAL * 1 FORSTK
      INTEGER FORLEN
C
      CALL OUTNUM ( LAB )
      J = 1
       I = 1
20148 IF (.NOT.( I .LT. FORDEP)) GOTO 20150
      J = J + SLEN ( FORSTK ( J ) ) + 1
20149 I = I + 1 
      GOTO 20148
20150 CONTINUE
      IF (.NOT.( SLEN ( FORSTK ( J ) ) .GT. 0 )) GOTO 20151
      CALL OUTTAB
      CALL OUTSTR ( FORSTK ( J ) )
      CALL OUTDON
20151 CONTINUE
      CALL OUTGO ( LAB - 1 )
      CALL OUTCON ( LAB + 1 )
      FORDEP = FORDEP - 1
      FORLEN = J
C
      RETURN
      END