
C				FILE= RAT2.RAT
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 GETDEF ( TOKEN, TOKSIZ, DEFN, DEFSIZ )
C GETDEF  - GET SYMBOLIC CONSTANTS AND DEFINITIONS
C SYKES, DEC76, ALLOW SINGLE ARGUMENT MACRO DEFINITIONS.  STORE "MAXTYPE" AS
C  FIRST CHAR OF MACRO DEFINITIONS, SO 'DEFMAC' CAN TELL MACROS FROM SYMBOLS.
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C   BLANKS ARE PRESERVED IN A DEFINITION
C
C
      LOGICAL * 1 GTOK, NGETCH, TEMP ( 5 )
      INTEGER DEFSIZ, I, NLPAR, TOKSIZ, INDEX, JUNK, SCOPY
      LOGICAL * 1 C, DEFN ( DEFSIZ ), TOKEN ( TOKSIZ )
C
      DEFN ( 1 ) = 0
      IF (.NOT.( GTOK ( TOKEN, TOKSIZ ) .NE. 40 )) GOTO 20000
      CALL SYNERR ( 15HNO ( IN DEFINE. )
      RETURN
20000 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, TOKSIZ ) .NE. - 100 )) GOTO 20002
      CALL SYNERR ( 22HNON-ALPHANUMERIC NAME. )
      RETURN
20002 CONTINUE
      IF (.NOT.( GTOK ( TEMP, 5 ) .NE. 44 .AND. TEMP ( 1 ) .NE. 61 )) 
     $GOTO 20004
      CALL SYNERR ( 20HNO , OR = IN DEFINE. )
      RETURN
C ELSE GOT '(NAME,'	NOW GET THE DEFINITION...
20004 CONTINUE
20003 CONTINUE
      NLPAR = 1
       I = 2
20006 IF (.NOT.( NLPAR .GT. 0)) GOTO 20008
      IF (.NOT.( I .GT. DEFSIZ )) GOTO 20009
      CALL SYNERR ( 20HDEFINITION TOO LONG. )
      RETURN
20009 CONTINUE
      IF (.NOT.( NGETCH ( DEFN ( I ) ) .EQ. - 3 )) GOTO 20011
      CALL SYNERR ( 15HNO ) IN DEFINE. )
      RETURN
20011 CONTINUE
      IF (.NOT.( DEFN ( I ) .EQ. 60 )) GOTO 20013
      CALL MATH
      I = I - 1
      GOTO 20014
20013 CONTINUE
      CALL LRPAR ( DEFN ( I ), NLPAR )
20014 CONTINUE
20012 CONTINUE
20007 I = I + 1 
      GOTO 20006
20008 CONTINUE
      DEFN ( I - 1 ) = 0
      DEFN ( 1 ) = - 9
      IF (.NOT.( INDEX ( DEFN, 36 ) .EQ. 0 )) GOTO 20015
      JUNK = SCOPY ( DEFN ( 2 ), DEFN ( 1 ), 80, JUNK )
C
20015 CONTINUE
      RETURN
      END

      SUBROUTINE GTFUNC
C
C GTFUNC - GET AND SAVE THE FUNCTION NAME FOR RETURN(EXPRESSION).
CPCN #92, 20 FEB 80
C
C
      LOGICAL * 1 GTOK, T, TYPE
C
C				FILE=CFUNC.RAT  FOR RATFOR
      COMMON / CFUNC / INFUNC, FNAM ( 12 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
C
      T = GTOK ( FNAM, 12 )
      CALL PBSTR ( FNAM )
      IF (.NOT.( INFUNC .EQ. 1 .OR. T .NE. - 100 .OR. TYPE ( FNAM ( 1 )
     $ ) .NE. - 30 )) GOTO 20017
      CALL SYNERR ( 25HILLEGAL FUNCTION KEYWORD. )
      GOTO 20018
20017 CONTINUE
      INFUNC = 1
C
20018 CONTINUE
      RETURN
      END

      LOGICAL FUNCTION GTOK * 1 ( TOKEN, TOKSIZ )
C
C GTOK - GET TOKEN; INTERPRET SPECIAL CHAR, DELETE BLANKS,TABS
C PCN #73, DEC 79, ADD TILDE,CARET FOR .NOT.
C PCN #87, 12 FEB 80, PASS '...' STRINGS WITHOUT PROCESSING.
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C
C
      INTEGER I, TOKSIZ
      LOGICAL * 1 C, TOKEN ( TOKSIZ ), NGETCH, TYPE
C
20019 IF (.NOT.( NGETCH ( C ) .NE. - 3 )) GOTO 20020
      IF (.NOT.( C .NE. 32 .AND. C .NE. 9 )) GOTO 20021
      GOTO 20020
20021 CONTINUE
      GOTO 20019
20020 CONTINUE
      CALL PUTBAK ( C )
C
       I = 1
20023 IF (.NOT.( I .LT. TOKSIZ - 1)) GOTO 20025
      GTOK = TYPE ( NGETCH ( TOKEN ( I ) ) )
      IF (.NOT.( GTOK .NE. - 30 .AND. GTOK .NE. - 20 )) GOTO 20026
      GOTO 20025
20026 CONTINUE
C
20024 I = I + 1 
      GOTO 20023
20025 CONTINUE
      IF (.NOT.( I .GE. TOKSIZ - 1 )) GOTO 20028
      CALL SYNERR ( 15HTOKEN TOO LONG. )
20028 CONTINUE
      IF (.NOT.( I .GT. 1 )) GOTO 20030
      CALL PUTBAK ( TOKEN ( I ) )
      TOKEN ( I ) = 0
      GTOK = - 100
C
C DO SOME CHARACTER CONVERSIONS TO MAKE THINGS EASIER LATER
      GOTO 20031
20030 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 92 )) GOTO 20032
      TOKEN ( 1 ) = 124
      GTOK = 124
      GOTO 20033
20032 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 91 )) GOTO 20034
      TOKEN ( 1 ) = 123
      GTOK = 123
      GOTO 20035
20034 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 93 )) GOTO 20036
      TOKEN ( 1 ) = 125
      GTOK = 125
      GOTO 20037
20036 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 126 .OR. TOKEN ( 1 ) .EQ. 94 )) GOTO 
     $20038
      TOKEN ( 1 ) = 33
      GTOK = 33
C# ELSE IF (TOKEN(1) == DOLLAR) [  		# ALLOW $( AND $) FOR BRACES
C#    IF (NGETCH(TOKEN(2)) == LPAREN) [
C#       TOKEN(1) = LBRACE
C#       GTOK = LBRACE
C#       ]
C#    ELSE IF (TOKEN(2) == RPAREN) [
C#       TOKEN(1) = RBRACE
C#       GTOK = RBRACE		##SYKES, 22NOV76
C#       ]
C#    ELSE
C#       CALL PUTBAK(TOKEN(2))
C#    ]
      GOTO 20039
20038 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 34 .OR. TOKEN ( 1 ) .EQ. 39 )) GOTO 
     $20040
C COLLECT QUOTED STRINGS AS SINGLE TOKENS WITHOUT PROCESSING.
      CONTINUE
       I = 2
20042 IF (.NOT.( NGETCH ( TOKEN ( I ) ) .NE. TOKEN ( 1 ))) GOTO 20044
      IF (.NOT.( TOKEN ( I ) .EQ. 10 .OR. I .GE. TOKSIZ - 1 )) GOTO 
     $20045
      CALL SYNERR ( 14HMISSING QUOTE. )
      TOKEN ( I ) = TOKEN ( 1 )
      CALL PUTBAK ( 10 )
      GOTO 20044
20045 CONTINUE
20043 I = I + 1 
      GOTO 20042
20044 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 39 .AND. I .EQ. 2 )) GOTO 20047
      I = 1
20047 CONTINUE
      GOTO 20041
20040 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 35 )) GOTO 20049
      CONTINUE
20051 IF (.NOT.( NGETCH ( TOKEN ( 1 ) ) .NE. 10 )) GOTO 20052
      GOTO 20051
20052 CONTINUE
      GTOK = 10
20049 CONTINUE
20041 CONTINUE
20039 CONTINUE
20037 CONTINUE
20035 CONTINUE
20033 CONTINUE
20031 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 62 .OR. TOKEN ( 1 ) .EQ. 60 .OR. 
     $TOKEN ( 1 ) .EQ. 33  .OR. TOKEN ( 1 ) .EQ. 61 .OR. TOKEN ( 1 ) 
     $.EQ. 38 .OR. TOKEN ( 1 ) .EQ. 124 )) GOTO 20053
      CALL RELATE ( TOKEN, I )
20053 CONTINUE
      TOKEN ( I + 1 ) = 0
C
      RETURN
      END

      SUBROUTINE IFCODE ( LAB )
C
C IFCODE - GENERATE INITIAL CODE FOR 'IF' STATEMENTS
C
C
      INTEGER LAB, LABGEN
C
      LAB = LABGEN ( 2 )
      CALL IFGO ( LAB )
C
      RETURN
      END

      SUBROUTINE IFDEFC ( CTRL )
C
C IFDEFC - PROCESS IFDEF AND IFNOTDEF CONDITIONALS
CSYKES, FEB77,APR77,
C PCN 77, 5 JAN 80, ADD UNFOLD, SO 'IFDEF' ETC CAN BE LOWER CASE.
CCTRL='YES' FOR IFDEF; 'NO' FOR IFNOTDEF
CIFDEF (SYMBOL)		OR IFNOTDEF (SYMBOL)
C   <STATEMENT>
CENDIFDEF
C
C
      INTEGER LOOKFR, SEQL, LAYER, CTRL
      LOGICAL * 1 TOKEN ( 70 ), JUNK ( 80 ), 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 ENDIF (9)
      LOGICAL * 1 IFDEFS (6)
      LOGICAL * 1 IFNOT (9)
C
      DATA ENDIF/1HE,1HN,1HD,1HI,1HF,1HD,1HE,1HF,0/
      DATA IFDEFS/1HI,1HF,1HD,1HE,1HF,0/
      DATA IFNOT/1HI,1HF,1HN,1HO,1HT,1HD,1HE,1HF,0/
      IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20055
      CALL SYNERR ( 19HMISSING ( IN IFDEF. )
      CALL PBSTR ( TOKEN )
      RETURN
20055 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. - 100 .OR.  TYPE ( TOKEN ( 1 )
     $ ) .NE. - 30 )) GOTO 20057
      CALL SYNERR ( 26HILLEGAL SYMBOLIC IN IFDEF. )
      CALL PBSTR ( TOKEN )
      RETURN
C
20057 CONTINUE
      IF (.NOT.( LOOKFR ( TOKEN, JUNK ) .EQ. CTRL )) GOTO 20059
      IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. 41 )) GOTO 20061
      CALL SYNERR ( 19HMISSING ) IN IFDEF. )
      CALL PBSTR ( TOKEN )
      RETURN
20061 CONTINUE
      RETURN
C
20059 CONTINUE
      INIF = 1
      LAYER = 1
      CONTINUE
20063 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. - 3 )) GOTO 20066
      CALL UNFOLD ( TOKEN )
      IF (.NOT.( SEQL ( TOKEN, ENDIF ) .EQ. 1 )) GOTO 20068
      IF (.NOT.( LAYER .EQ. 1 )) GOTO 20070
      GOTO 20065
20070 CONTINUE
      LAYER = LAYER - 1
20071 CONTINUE
      GOTO 20069
20068 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, IFDEFS ) .EQ. 1 .OR. SEQL ( TOKEN, IFNOT
     $ ) .EQ. 1 )) GOTO 20072
      LAYER = LAYER + 1
20072 CONTINUE
20069 CONTINUE
      GOTO 20067
20066 CONTINUE
      CALL SYNERR ( 19HUNTERMINATED IFDEF. )
      CALL PUTBAK ( TOKEN )
      GOTO 20065
20067 CONTINUE
20064 GOTO 20063
20065 CONTINUE
      INIF = 0
      RETURN
C
20060 CONTINUE
      END

      SUBROUTINE IFGO ( LAB )
C
C IFGO - GENERATE "IF(.NOT.(...))GOTO LAB"
C ***PCN # 21
C
C
      INTEGER LAB
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS
      INTEGER LC
      INTEGER COMPRS
C
      CALL OUTIF
      CALL BALPAR
      CALL OUTCH ( 41 )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20074
      CALL OUTCH ( 32 )
20074 CONTINUE
      CALL OUTGO ( LAB )
C
      RETURN
      END

      INTEGER FUNCTION INSTAL ( NAME, DEFN, LASTP, LASTT, NAMPTR, 
     $MAXTAB, MAXPOI, TABLE )
C
C INSTAL - ADD NAME AND DEFINITION TO TABLE
C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
C
C
      LOGICAL * 1 DEFN ( 80 ), NAME ( 70 ), TABLE ( 1 )
      INTEGER SLEN, LASTP, LASTT, NAMPTR ( 1 )
      INTEGER DLEN, NLEN, SCOPY, JUNK, MAXTAB, MAXPOI
C
      NLEN = SLEN ( NAME ) + 1
      DLEN = SLEN ( DEFN ) + 1
      IF (.NOT.( ( LASTT + NLEN + DLEN .LT. MAXTAB ) .AND. LASTP .LT. 
     $MAXPOI )) GOTO 20076
      LASTP = LASTP + 1
      NAMPTR ( LASTP ) = LASTT + 1
      JUNK = SCOPY ( NAME, TABLE ( LASTT + 1 ), 70, JUNK )
      JUNK = SCOPY ( DEFN, TABLE ( LASTT + NLEN + 1 ), 80, JUNK )
      LASTT = LASTT + NLEN + DLEN
      INSTAL = ( 1 )
      RETURN
20076 CONTINUE
      INSTAL = ( - 1 )
      RETURN
C
20077 CONTINUE
      END

      SUBROUTINE LABELC ( LEXSTR )
C
C LABELC -  OUTPUT FORTRAN STATEMENT NUMBERS THAT WERE IN RATFOR SOURCE
C PCN #75, ADD FTN LINE NUMBERS TO LISTING. REPLACE CALL TO OUTTA
C
      LOGICAL * 1 LEXSTR ( 1 )
      INTEGER SLEN
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
      IF (.NOT.( SLEN ( LEXSTR ) .EQ. 5 )) GOTO 20078
      IF (.NOT.( LEXSTR ( 1 ) .EQ. 50 .AND. LEXSTR ( 2 ) .EQ. 48 )) 
     $GOTO 20080
      CALL SYNERR ( 35HPOSSIBLE STATEMENT NUMBER CONFLICT. )
20080 CONTINUE
20078 CONTINUE
      CALL OUTSTR ( LEXSTR )
20082 IF (.NOT.( OUTP .LT. 6 )) GOTO 20083
      CALL OUTCH ( 32 )
      GOTO 20082
20083 CONTINUE
      RETURN
      END

      INTEGER FUNCTION LABGEN ( N )
C
C LABGEN - GENERATE  N  CONSECUTIVE LABELS, RETURN FIRST ONE
C
C
      INTEGER LABEL, N
      DATA LABEL / 20000 /
C
      LABGEN = LABEL
      LABEL = LABEL + N
C
      RETURN
      END

      SUBROUTINE LRPAR ( TOK, NLPAR )
C
C LRPAR - COUNT LEFT & RIGHT PARENTHESES
C SYKES,18FEB77
C
C
      INTEGER NLPAR
      LOGICAL * 1 TOK
C
      IF (.NOT.( TOK .EQ. 40 )) GOTO 20084
      NLPAR = NLPAR + 1
      GOTO 20085
20084 CONTINUE
      IF (.NOT.( TOK .EQ. 41 )) GOTO 20086
      NLPAR = NLPAR - 1
C
20086 CONTINUE
20085 CONTINUE
      RETURN
      END

      INTEGER FUNCTION LEX ( TOKEN )
C
C LEX - RETURN LEXICAL TYPE OF NEXT VALID TOKEN TO 'PARSE'
C PCN 93, 16 FEB 80, DELETE CKEYWD, USE STRINGS IN 'LEX' INSTEAD.
C			ALSO DO PROCESSOR FEATURE KEYWORDS HERE.
C
C
      LOGICAL * 1 TOKEN ( 70 ), DEFTOK
      INTEGER ALLDIG, SEQL
C
      LOGICAL * 1 SBREAK (6)
      LOGICAL * 1 SINCL (8)
      LOGICAL * 1 SDEFIN (7)
      LOGICAL * 1 SMACRO (6)
      LOGICAL * 1 SDO (3)
      LOGICAL * 1 SNEXT (5)
      LOGICAL * 1 SELSE (5)
      LOGICAL * 1 SREPT (7)
      LOGICAL * 1 SEND (4)
      LOGICAL * 1 SRETRN (7)
      LOGICAL * 1 SENDIF (9)
      LOGICAL * 1 SSTOP (5)
      LOGICAL * 1 SFOR (4)
      LOGICAL * 1 SSTRNG (7)
      LOGICAL * 1 SIF (3)
      LOGICAL * 1 SUNTIL (6)
      LOGICAL * 1 SIFDEF (6)
      LOGICAL * 1 SWHILE (6)
      LOGICAL * 1 SIFNOT (9)
C
      DATA SBREAK/1HB,1HR,1HE,1HA,1HK,0/
      DATA SINCL/1HI,1HN,1HC,1HL,1HU,1HD,1HE,0/
      DATA SDEFIN/1HD,1HE,1HF,1HI,1HN,1HE,0/
      DATA SMACRO/1HM,1HA,1HC,1HR,1HO,0/
      DATA SDO/1HD,1HO,0/
      DATA SNEXT/1HN,1HE,1HX,1HT,0/
      DATA SELSE/1HE,1HL,1HS,1HE,0/
      DATA SREPT/1HR,1HE,1HP,1HE,1HA,1HT,0/
      DATA SEND/1HE,1HN,1HD,0/
      DATA SRETRN/1HR,1HE,1HT,1HU,1HR,1HN,0/
      DATA SENDIF/1HE,1HN,1HD,1HI,1HF,1HD,1HE,1HF,0/
      DATA SSTOP/1HS,1HT,1HO,1HP,0/
      DATA SFOR/1HF,1HO,1HR,0/
      DATA SSTRNG/1HS,1HT,1HR,1HI,1HN,1HG,0/
      DATA SIF/1HI,1HF,0/
      DATA SUNTIL/1HU,1HN,1HT,1HI,1HL,0/
      DATA SIFDEF/1HI,1HF,1HD,1HE,1HF,0/
      DATA SWHILE/1HW,1HH,1HI,1HL,1HE,0/
      DATA SIFNOT/1HI,1HF,1HN,1HO,1HT,1HD,1HE,1HF,0/
20088 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .EQ. 10 )) GOTO 20089
      GOTO 20088
20089 CONTINUE
      LEX = TOKEN ( 1 )
      IF (.NOT.( LEX .EQ. - 3 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. 
     $LEX .EQ. 125 )) GOTO 20090
      RETURN
20090 CONTINUE
      IF (.NOT.( ALLDIG ( TOKEN ) .EQ. 1 )) GOTO 20092
      LEX = - 111
      GOTO 20093
20092 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SBREAK ) .EQ. 1 )) GOTO 20094
      LEX = - 110
      GOTO 20095
20094 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SDO ) .EQ. 1 )) GOTO 20096
      LEX = - 112
      GOTO 20097
20096 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SDEFIN ) .EQ. 1 )) GOTO 20098
      LEX = - 124
      GOTO 20099
20098 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SELSE ) .EQ. 1 )) GOTO 20100
      LEX = - 113
      GOTO 20101
20100 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SEND ) .EQ. 1 )) GOTO 20102
      LEX = - 114
      GOTO 20103
20102 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SENDIF ) .EQ. 1 )) GOTO 20104
      LEX = - 128
      GOTO 20105
20104 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SFOR ) .EQ. 1 )) GOTO 20106
      LEX = - 115
      GOTO 20107
20106 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SIFDEF ) .EQ. 1 )) GOTO 20108
      LEX = - 126
      GOTO 20109
20108 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SIFNOT ) .EQ. 1 )) GOTO 20110
      LEX = - 127
      GOTO 20111
20110 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SIF ) .EQ. 1 )) GOTO 20112
      LEX = - 116
      GOTO 20113
20112 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SINCL ) .EQ. 1 )) GOTO 20114
      LEX = - 129
      GOTO 20115
20114 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SMACRO ) .EQ. 1 )) GOTO 20116
      LEX = - 125
      GOTO 20117
20116 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SNEXT ) .EQ. 1 )) GOTO 20118
      LEX = - 117
      GOTO 20119
20118 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SREPT ) .EQ. 1 )) GOTO 20120
      LEX = - 119
      GOTO 20121
20120 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SRETRN ) .EQ. 1 )) GOTO 20122
      LEX = - 122
      GOTO 20123
20122 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SSTOP ) .EQ. 1 )) GOTO 20124
      LEX = - 123
      GOTO 20125
20124 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SSTRNG ) .EQ. 1 )) GOTO 20126
      LEX = - 130
      GOTO 20127
20126 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SUNTIL ) .EQ. 1 )) GOTO 20128
      LEX = - 120
      GOTO 20129
20128 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, SWHILE ) .EQ. 1 )) GOTO 20130
      LEX = - 121
      GOTO 20131
20130 CONTINUE
      LEX = - 118
C
20131 CONTINUE
20129 CONTINUE
20127 CONTINUE
20125 CONTINUE
20123 CONTINUE
20121 CONTINUE
20119 CONTINUE
20117 CONTINUE
20115 CONTINUE
20113 CONTINUE
20111 CONTINUE
20109 CONTINUE
20107 CONTINUE
20105 CONTINUE
20103 CONTINUE
20101 CONTINUE
20099 CONTINUE
20097 CONTINUE
20095 CONTINUE
20093 CONTINUE
      RETURN
      END

      INTEGER FUNCTION LOOKFR ( NAME, DEFN )
C
C LOOKFR - BINARY SEARCH TO LOCATE DEFINED SYMBOLIC CONSTANTS
C SYKES,NOV76;
C PCN # 67, 6 OCT 79, PREVENT 0 SUBSCRIPTING IF LASTP=0 [NAMPTR(IT)]
C
C
      LOGICAL * 1 NAME ( 70 ), DEFN ( 80 )
      INTEGER I, J, INDX, IT, INC, JUNK, 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
      INDX = 0
      INC = TWOS
      IF (.NOT.( LASTP .GT. 0 )) GOTO 20132
      CONTINUE
20134 CONTINUE
      IT = INC + INDX
      IF (.NOT.( IT .GT. LASTP )) GOTO 20137
      IT = LASTP
20137 CONTINUE
      I = 1
      J = NAMPTR ( IT )
      CONTINUE
20139 IF (.NOT.( NAME ( I ) .EQ. TABLE ( J ) )) GOTO 20140
      IF (.NOT.( NAME ( I ) .EQ. 0 )) GOTO 20141
      JUNK = SCOPY ( TABLE ( J + 1 ), DEFN, 80, JUNK )
      LOOKFR = ( 1 )
      RETURN
20141 CONTINUE
      I = I + 1
      J = J + 1
20142 CONTINUE
      GOTO 20139
20140 CONTINUE
      IF (.NOT.( NAME ( I ) .GT. TABLE ( J ) )) GOTO 20143
      IF (.NOT.( IT .EQ. LASTP )) GOTO 20145
      GOTO 20136
20145 CONTINUE
      INDX = IT
20146 CONTINUE
20143 CONTINUE
      INC = INC / 2
20135 IF (.NOT.( INC .LE. 0 )) GOTO 20134
20136 CONTINUE
20132 CONTINUE
      LOOKFR = ( 0 )
      RETURN
C
      END

      SUBROUTINE MATH
C
C MATH - SUBROUTINE TO DO MATH IN MACRO DEFINITIONS
C SYKES APR 77
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C + AND - INTEGER NUMBERS AND DEFINITIONS ARE ALLOWED
C
C
      INTEGER SCTOI, SITOC, NUM1, NUM2, JUNK
      LOGICAL * 1 TOKDEF, OPR, NGETCH, TOKEN ( 70 )
C
      IF (.NOT.( TOKDEF ( TOKEN, 70 ) .NE. - 1 )) GOTO 20147
      JUNK = 1
      NUM1 = SCTOI ( TOKEN, JUNK )
      CONTINUE
20149 IF (.NOT.( NGETCH ( OPR ) .NE. 62 )) GOTO 20150
      JUNK = TOKDEF ( TOKEN, 70 )
      JUNK = 1
      NUM2 = SCTOI ( TOKEN, JUNK )
      IF (.NOT.( OPR .EQ. 43 )) GOTO 20151
      NUM1 = NUM1 + NUM2
      GOTO 20152
20151 CONTINUE
      IF (.NOT.( OPR .EQ. 45 )) GOTO 20153
      NUM1 = NUM1 - NUM2
      GOTO 20154
20153 CONTINUE
      IF (.NOT.( OPR .EQ. 42 )) GOTO 20155
      NUM1 = NUM1 * NUM2
      GOTO 20156
20155 CONTINUE
      IF (.NOT.( OPR .EQ. 47 .AND. NUM2 .NE. 0 )) GOTO 20157
      NUM1 = NUM1 / NUM2
      GOTO 20158
20157 CONTINUE
      CALL SYNERR ( 23HILLEGAL MATH OPERATION. )
      CALL PBSTR ( TOKEN )
      RETURN
20158 CONTINUE
20156 CONTINUE
20154 CONTINUE
20152 CONTINUE
      GOTO 20149
20150 CONTINUE
      JUNK = SITOC ( NUM1, TOKEN, 70 )
      CALL PBSTR ( TOKEN )
C
20147 CONTINUE
      RETURN
      END

      LOGICAL FUNCTION NGETCH * 1 ( C )
C
C NGETCH - GET A (POSSIBLY PUSHED BACK) CHARACTER
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C
C
      LOGICAL * 1 BUFR ( 91 ), C
      INTEGER LASTC, GETLIN
C
C					FILE = CDEFIO.RAT  FOR RATFOR.RAT
      COMMON / CDEFIO / BP, BUF ( 160 )
      INTEGER BP
      LOGICAL * 1 BUF
C
      DATA LASTC / 91 /, BUFR ( 91 ) / 10 /
C
      IF (.NOT.( BP .GT. 0 )) GOTO 20159
      C = BUF ( BP )
      GOTO 20160
20159 CONTINUE
      BP = 1
      IF (.NOT.( BUFR ( LASTC ) .EQ. 10 .OR. LASTC .GE. 91 )) GOTO 
     $20161
      LASTC = 0
      IF (.NOT.( GETLIN ( BUFR ) .EQ. - 3 )) GOTO 20163
      C = - 3
      LASTC = 91
      BP = 0
      NGETCH = ( - 3 )
      RETURN
20163 CONTINUE
20161 CONTINUE
      LASTC = LASTC + 1
      IF (.NOT.( BUFR ( LASTC ) .EQ. 0 )) GOTO 20165
      BUFR ( LASTC ) = 10
20165 CONTINUE
      C = BUFR ( LASTC )
20160 CONTINUE
      BP = BP - 1
      NGETCH = ( C )
      RETURN
C
      END

      SUBROUTINE OTHERC ( LEXSTR )
C
C OTHERC - OUTPUT ORDINARY FORTRAN STATEMENT
C
C
      LOGICAL * 1 LEXSTR ( 1 )
C
      CALL OUTTAB
      CALL OUTSTR ( LEXSTR )
      CALL EATUP
      CALL OUTDON
C
      RETURN
      END

      SUBROUTINE OUTCH ( C )
C
C OUTCH - PUT ONE CHARACTER INTO OUTPUT BUFFER, CREATE CONTINUATION LINES
C
C
      LOGICAL * 1 C
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT
      COMMON / COUTLN / OUTP, OUTBUF ( 91 )
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
      IF (.NOT.( OUTP .GT. 70 .OR. OUTP .LT. 0 )) GOTO 20167
      CALL OUTDON
      CONTINUE
       OUTP = 1
20169 IF (.NOT.( OUTP .LT. 6)) GOTO 20171
      OUTBUF ( OUTP ) = 32
20170 OUTP = OUTP + 1 
      GOTO 20169
20171 CONTINUE
      OUTBUF ( OUTP ) = 36
20167 CONTINUE
      OUTP = OUTP + 1
      OUTBUF ( OUTP ) = C
C
      RETURN
      END

