C FILE= RATFOR2.RAT CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C C C FILE=RATDEF.RAT CDEFINE (DECWRITER,) #DEFINED FOR DECWRITER OUTPUT C C C GETDEF - GET SYMBOLIC CONSTANTS AND DEFINITIONS C SYKES, DEC76, ALLOW SINGLE ARGUMENT MACRO DEFINITIONS C BLANKS ARE PRESERVED IN A DEFINITION C SUBROUTINE GETDEF ( TOKEN, TOKSIZ, DEFN, DEFSIZ, FD ) C LOGICAL * 1 GTOK, NGETCH, TEMP ( 5 ) INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ, INDEX, JUNK, SCOPY LOGICAL * 1 C, DEFN ( DEFSIZ ), TOKEN ( TOKSIZ ) C DEFN ( 1 ) = 0 IF(.NOT.( GTOK ( TOKEN, TOKSIZ, FD ) .NE. 40 )) GOTO 20000 CALL SYNERR ( 15HNO ( IN DEFINE. ) RETURN 20000 CONTINUE IF(.NOT.( GTOK ( TOKEN, TOKSIZ, FD ) .NE. - 100 )) GOTO 20002 CALL SYNERR ( 22HNON-ALPHANUMERIC NAME. ) RETURN 20002 CONTINUE IF(.NOT.( GTOK ( TEMP, 5, FD ) .NE. 44 .AND. TEMP ( 1 ) .NE. 61 ) $) GOTO 20004 CALL SYNERR ( 20HNO , OR = IN DEFINE. ) RETURN C ELSE GOT (NAME, CNOW 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 ), FD ) .EQ. - 3 )) GOTO 20011 CALL SYNERR ( 15HNO ) IN DEFINE. ) RETURN 20011 CONTINUE IF(.NOT.( DEFN ( I ) .EQ. 60 )) GOTO 20013 CALL MATH ( FD ) 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 ), 70, JUNK ) C 20015 CONTINUE RETURN END C C GETTOK - GET TOKEN. HANDLES PRE-PROCESSOR FEATURES C SYKES 18FEB77,15JUN77 C LOGICAL FUNCTION GETTOK * 1 ( TOKEN, TOKSIZ ) C INTEGER TOKSIZ, ALF, SEQL, OPENI, STRNGS LOGICAL * 1 TOKEN ( TOKSIZ ), DEFTOK C C CFILE = CLINE.RAT FOR RATFOR.RAT COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF C LOGICAL * 1 INCL (8) LOGICAL * 1 ENDIF (9) LOGICAL * 1 IFDEFS (6) LOGICAL * 1 IFNOT (9) LOGICAL * 1 STRNG (7) LOGICAL * 1 DEF (7) LOGICAL * 1 MAC (6) DATA INCL/1HI,1HN,1HC,1HL,1HU,1HD,1HE,0/ 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/ DATA STRNG/1HS,1HT,1HR,1HI,1HN,1HG,0/ DATA DEF/1HD,1HE,1HF,1HI,1HN,1HE,0/ DATA MAC/1HM,1HA,1HC,1HR,1HO,0/ DATA STRNGS / 0 / C 20017 IF(.NOT.( LEVEL .GT. 0)) GOTO 20019 CONTINUE GETTOK = DEFTOK ( TOKEN, TOKSIZ, INFILE ( LEVEL ), ALF ) 20020 IF(.NOT.( GETTOK .NE. - 3)) GOTO 20022 IF(.NOT.( ALF .NE. 1 )) GOTO 20023 IF(.NOT.( STRNGS .EQ. 1 .AND. GETTOK .NE. 10 )) GOTO 20025 CALL ENDSTR STRNGS = N0 20025 CONTINUE RETURN C C#LOOK FOR AND PROCESS ENDIFDEFS,IFDEFS,STRINGS,INCLUDES,DEFINES,MACROS C 20023 CONTINUE IF(.NOT.( SEQL ( TOKEN, DEF ) .EQ. 1 .OR. SEQL ( TOKEN, MAC ) $.EQ. 1 )) GOTO 20027 CALL ADDDEF ( TOKEN, TOKSIZ, INFILE ( LEVEL ) ) GOTO 20028 20027 CONTINUE IF(.NOT.( SEQL ( TOKEN, IFDEFS ) .EQ. 1 )) GOTO 20029 CALL IFDEFC ( 1 ) GOTO 20030 20029 CONTINUE IF(.NOT.( SEQL ( TOKEN, IFNOT ) .EQ. 1 )) GOTO 20031 CALL IFDEFC ( 0 ) GOTO 20032 20031 CONTINUE IF(.NOT.( SEQL ( TOKEN, STRNG ) .EQ. 1 )) GOTO 20033 CALL STRNGC ( STRNGS, INFILE ( LEVEL ) ) GOTO 20034 20033 CONTINUE IF(.NOT.( SEQL ( TOKEN, ENDIF ) .EQ. 1 )) GOTO 20035 GOTO 20021 20035 CONTINUE IF(.NOT.( SEQL ( TOKEN, INCL ) .EQ. 1 )) GOTO 20037 IF(.NOT.( LEVEL .GE. 4 )) GOTO 20039 CALL ERROR ( 27HINCLUDES NESTED TOO DEEPLY. ) GOTO 20040 20039 CONTINUE INFILE ( LEVEL + 1 ) = OPENI ( ) IF(.NOT.( INFILE ( LEVEL + 1 ) .EQ. - 1 )) GOTO 20041 CALL ERROR ( 19HCAN'T OPEN INCLUDE. ) GOTO 20042 20041 CONTINUE LEVEL = LEVEL + 1 20042 CONTINUE 20040 CONTINUE GOTO 20038 20037 CONTINUE IF(.NOT.( STRNGS .EQ. 1 .AND. GETTOK .NE. 10 )) GOTO 20043 CALL ENDSTR STRNGS = 0 20043 CONTINUE RETURN 20038 CONTINUE 20036 CONTINUE 20034 CONTINUE 20032 CONTINUE 20030 CONTINUE 20028 CONTINUE 20024 CONTINUE 20021 GETTOK = DEFTOK ( TOKEN , TOKSIZ , INFILE ( LEVEL ) , ALF ) GOTO 20020 20022 CONTINUE IF(.NOT.( LEVEL .EQ. 1 )) GOTO 20045 GOTO 20019 20045 CONTINUE CALL CLOSE ( INFILE ( LEVEL ) ) 20046 CONTINUE 20018 LEVEL = LEVEL - 1 GOTO 20017 20019 CONTINUE GETTOK = - 3 C RETURN END C C GTOK - GET TOKEN; INTERPRET SPECIAL CHAR, DELETE BLANKS,TABS C LOGICAL FUNCTION GTOK * 1 ( LEXSTR, TOKSIZ, FD ) C INTEGER FD, I, TOKSIZ LOGICAL * 1 C, LEXSTR ( TOKSIZ ), NGETCH, TYPE C 20047 IF(.NOT.( NGETCH ( C, FD ) .NE. - 3 )) GOTO 20048 IF(.NOT.( C .NE. 32 .AND. C .NE. 9 )) GOTO 20049 GOTO 20048 20049 CONTINUE GOTO 20047 20048 CONTINUE CALL PUTBAK ( C ) I = 1 20051 IF(.NOT.( I .LT. TOKSIZ - 1)) GOTO 20053 GTOK = TYPE ( NGETCH ( LEXSTR ( I ), FD ) ) IF(.NOT.( GTOK .NE. - 30 .AND. GTOK .NE. - 20 )) GOTO 20054 GOTO 20053 20054 CONTINUE 20052 I = I + 1 GOTO 20051 20053 CONTINUE IF(.NOT.( I .GE. TOKSIZ - 1 )) GOTO 20056 CALL SYNERR ( 15HTOKEN TOO LONG. ) 20056 CONTINUE IF(.NOT.( I .GT. 1 )) GOTO 20058 CALL PUTBAK ( LEXSTR ( I ) ) LEXSTR ( I ) = 0 GTOK = - 100 GOTO 20059 20058 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 92 )) GOTO 20060 LEXSTR ( 1 ) = 124 GTOK = 124 GOTO 20061 20060 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 91 )) GOTO 20062 LEXSTR ( 1 ) = 123 GTOK = 123 GOTO 20063 20062 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 93 )) GOTO 20064 LEXSTR ( 1 ) = 125 GTOK = 125 C# ELSE IF (LEXSTR(1) == DOLLAR) [ # ALLOW $( AND $) FOR BRACES C# IF (NGETCH(LEXSTR(2), FD) == LPAREN) [ C# LEXSTR(1) = LBRACE C# GTOK = LBRACE C# ] C# ELSE IF (LEXSTR(2) == RPAREN) [ C# LEXSTR(1) = RBRACE C# GTOK = RBRACE ##SYKES, 22NOV76 C# ] C# ELSE C# CALL PUTBAK(LEXSTR(2)) C# ] GOTO 20065 20064 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 34 )) GOTO 20066 CONTINUE I = 2 20068 IF(.NOT.( NGETCH ( LEXSTR ( I ), FD ) .NE. LEXSTR ( 1 ))) GOTO $20070 IF(.NOT.( LEXSTR ( I ) .EQ. 10 .OR. I .GE. TOKSIZ - 1 )) GOTO $20071 CALL SYNERR ( 14HMISSING QUOTE. ) LEXSTR ( I ) = LEXSTR ( 1 ) CALL PUTBAK ( 10 ) GOTO 20070 20071 CONTINUE 20069 I = I + 1 GOTO 20068 20070 CONTINUE GOTO 20067 20066 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 35 )) GOTO 20073 CONTINUE 20075 IF(.NOT.( NGETCH ( LEXSTR ( 1 ), FD ) .NE. 10 )) GOTO 20076 GOTO 20075 20076 CONTINUE GTOK = 10 20073 CONTINUE 20067 CONTINUE 20065 CONTINUE 20063 CONTINUE 20061 CONTINUE 20059 CONTINUE IF(.NOT.( LEXSTR ( 1 ) .EQ. 62 .OR. LEXSTR ( 1 ) .EQ. 60 .OR. $LEXSTR ( 1 ) .EQ. 33 .OR. LEXSTR ( 1 ) .EQ. 61 .OR. LEXSTR ( 1 ) $ .EQ. 38 .OR. LEXSTR ( 1 ) .EQ. 124 )) GOTO 20077 CALL RELATE ( LEXSTR, I, FD ) 20077 CONTINUE LEXSTR ( I + 1 ) = 0 C RETURN END C C IFCODE - GENERATE INITIAL CODE FOR 'IF' STATEMENTS C SUBROUTINE IFCODE ( LAB ) C INTEGER LAB, LABGEN C LAB = LABGEN ( 2 ) CALL IFGO ( LAB ) C RETURN END C C IFDEFC - PROCESS IFDEF AND IFNOTDEF CONDITIONALS CSYKES, FEB77,APR77, CCTRL='YES' FOR IFDEF; 'NO' FOR IFNOTDEF CIFDEF (SYMBOL) OR IFNOTDEF (SYMBOL) C CENDIFDEF C SUBROUTINE IFDEFC ( CTRL ) C INTEGER LOOKFR, SEQL, LAYER, CTRL LOGICAL * 1 TOKEN ( 70 ), JUNK ( 70 ), GTOK, TYPE C C CFILE = CLINE.RAT FOR RATFOR.RAT COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF C C CFILE = CKEYWD.RAT FOR RATFOR.RAT C PCN #10, 21 OCT 77, ADD SSTOP AND SRETRN COMMON / CKEYWD / SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, $SREPT, SUNTIL, SEND, SSTOP, SRETRN LOGICAL * 1 SDO ( 3 ), SIF ( 3 ), SELSE ( 5 ), SWHILE ( 6 ), $SBREAK ( 6 ), SNEXT ( 5 ), SFOR ( 4 ), SREPT ( 7 ), SUNTIL ( 6 ), $ SEND ( 4 ), SSTOP ( 5 ), SRETRN ( 7 ) 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, INFILE ( LEVEL ) ) .NE. 40 )) GOTO $20079 CALL SYNERR ( 19HMISSING ( IN IFDEF. ) CALL PBSTR ( TOKEN ) RETURN 20079 CONTINUE IF(.NOT.( GTOK ( TOKEN, 70, INFILE ( LEVEL ) ) .NE. - 100 .OR. $TYPE ( TOKEN ( 1 ) ) .NE. - 30 )) GOTO 20081 CALL SYNERR ( 26HILLEGAL SYMBOLIC IN IFDEF. ) CALL PBSTR ( TOKEN ) RETURN C 20081 CONTINUE IF(.NOT.( LOOKFR ( TOKEN, JUNK ) .EQ. CTRL )) GOTO 20083 IF(.NOT.( GTOK ( TOKEN, 70, INFILE ( LEVEL ) ) .NE. 41 )) GOTO $20085 CALL SYNERR ( 19HMISSING ) IN IFDEF. ) CALL PBSTR ( TOKEN ) RETURN 20085 CONTINUE RETURN C 20083 CONTINUE INIF = 1 LAYER = 1 CONTINUE 20087 CONTINUE IF(.NOT.( GTOK ( TOKEN, 70, INFILE ( LEVEL ) ) .NE. - 3 )) GOTO $20090 IF(.NOT.( SEQL ( TOKEN, ENDIF ) .EQ. 1 )) GOTO 20092 IF(.NOT.( LAYER .EQ. 1 )) GOTO 20094 GOTO 20089 20094 CONTINUE LAYER = LAYER - 1 20095 CONTINUE GOTO 20093 20092 CONTINUE IF(.NOT.( SEQL ( TOKEN, IFDEFS ) .EQ. 1 .OR. SEQL ( TOKEN, IFNOT $) .EQ. 1 )) GOTO 20096 LAYER = LAYER + 1 20096 CONTINUE 20093 CONTINUE GOTO 20091 20090 CONTINUE CALL SYNERR ( 19HUNTERMINATED IFDEF. ) CALL PUTBAK ( TOKEN ) GOTO 20089 20091 CONTINUE 20088 GOTO 20087 20089 CONTINUE INIF = 0 RETURN C 20084 CONTINUE END C C IFGO - GENERATE "IF(.NOT.(...))GOTO LAB" C ***PCN # 21 C SUBROUTINE IFGO ( LAB ) C INTEGER LAB C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C CALL OUTIF CALL BALPAR CALL OUTCH ( 41 ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20098 CALL OUTCH ( 32 ) 20098 CONTINUE CALL OUTGO ( LAB ) C RETURN END C C C INSTAL - ADD NAME AND DEFINITION TO TABLE C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS C INTEGER FUNCTION INSTAL ( NAME, DEFN, LASTP, LASTT, NAMPTR, $MAXTAB, MAXPOI, TABLE ) C LOGICAL * 1 DEFN ( 70 ), 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 20100 LASTP = LASTP + 1 NAMPTR ( LASTP ) = LASTT + 1 JUNK = SCOPY ( NAME, TABLE ( LASTT + 1 ), 70, JUNK ) JUNK = SCOPY ( DEFN, TABLE ( LASTT + NLEN + 1 ), 70, JUNK ) LASTT = LASTT + NLEN + DLEN INSTAL = 1 GOTO 20101 20100 CONTINUE INSTAL = - 1 C 20101 CONTINUE RETURN END C C LABELC - OUTPUT FORTRAN STATEMENT NUMBERS C SUBROUTINE LABELC ( LEXSTR ) C LOGICAL * 1 LEXSTR ( 1 ) INTEGER SLEN C IF(.NOT.( SLEN ( LEXSTR ) .EQ. 5 )) GOTO 20102 IF(.NOT.( LEXSTR ( 1 ) .EQ. 50 .AND. LEXSTR ( 2 ) .EQ. 48 )) GOTO $ 20104 CALL SYNERR ( 35HPOSSIBLE STATEMENT NUMBER CONFLICT. ) 20104 CONTINUE 20102 CONTINUE CALL OUTSTR ( LEXSTR ) CALL OUTTAB RETURN END C C LABGEN - GENERATE N CONSECUTIVE LABELS, RETURN FIRST ONE C INTEGER FUNCTION LABGEN ( N ) C INTEGER LABEL, N DATA LABEL / 20000 / C LABGEN = LABEL LABEL = LABEL + N C RETURN END C C LRPAR - COUNT LEFT & RIGHT PARENTHESES C SYKES,18FEB77 C SUBROUTINE LRPAR ( TOK, NLPAR ) C INTEGER NLPAR LOGICAL * 1 TOK C IF(.NOT.( TOK .EQ. 40 )) GOTO 20106 NLPAR = NLPAR + 1 GOTO 20107 20106 CONTINUE IF(.NOT.( TOK .EQ. 41 )) GOTO 20108 NLPAR = NLPAR - 1 C 20108 CONTINUE 20107 CONTINUE RETURN END C C LEX - RETURN LEXICAL TYPE OF NEXT VALID TOKEN TO 'PARSE' C INTEGER FUNCTION LEX ( LEXSTR ) C LOGICAL * 1 LEXSTR ( 70 ), GETTOK INTEGER ALLDIG, SEQL C C CFILE = CKEYWD.RAT FOR RATFOR.RAT C PCN #10, 21 OCT 77, ADD SSTOP AND SRETRN COMMON / CKEYWD / SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, $SREPT, SUNTIL, SEND, SSTOP, SRETRN LOGICAL * 1 SDO ( 3 ), SIF ( 3 ), SELSE ( 5 ), SWHILE ( 6 ), $SBREAK ( 6 ), SNEXT ( 5 ), SFOR ( 4 ), SREPT ( 7 ), SUNTIL ( 6 ), $ SEND ( 4 ), SSTOP ( 5 ), SRETRN ( 7 ) C 20110 IF(.NOT.( GETTOK ( LEXSTR, 70 ) .EQ. 10 )) GOTO 20111 GOTO 20110 20111 CONTINUE LEX = LEXSTR ( 1 ) IF(.NOT.( LEX .EQ. - 3 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. $LEX .EQ. 125 )) GOTO 20112 RETURN 20112 CONTINUE IF(.NOT.( ALLDIG ( LEXSTR ) .EQ. 1 )) GOTO 20114 LEX = - 111 GOTO 20115 20114 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SIF ) .EQ. 1 )) GOTO 20116 LEX = - 116 GOTO 20117 20116 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SELSE ) .EQ. 1 )) GOTO 20118 LEX = - 113 GOTO 20119 20118 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SWHILE ) .EQ. 1 )) GOTO 20120 LEX = - 121 GOTO 20121 20120 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SDO ) .EQ. 1 )) GOTO 20122 LEX = - 112 GOTO 20123 20122 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SBREAK ) .EQ. 1 )) GOTO 20124 LEX = - 110 GOTO 20125 20124 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SNEXT ) .EQ. 1 )) GOTO 20126 LEX = - 117 GOTO 20127 20126 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SFOR ) .EQ. 1 )) GOTO 20128 LEX = - 115 GOTO 20129 20128 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SREPT ) .EQ. 1 )) GOTO 20130 LEX = - 119 GOTO 20131 20130 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SUNTIL ) .EQ. 1 )) GOTO 20132 LEX = - 120 GOTO 20133 20132 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SEND ) .EQ. 1 )) GOTO 20134 LEX = - 114 GOTO 20135 20134 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SSTOP ) .EQ. 1 )) GOTO 20136 LEX = - 123 GOTO 20137 20136 CONTINUE IF(.NOT.( SEQL ( LEXSTR, SRETRN ) .EQ. 1 )) GOTO 20138 LEX = - 122 GOTO 20139 20138 CONTINUE LEX = - 118 C 20139 CONTINUE 20137 CONTINUE 20135 CONTINUE 20133 CONTINUE 20131 CONTINUE 20129 CONTINUE 20127 CONTINUE 20125 CONTINUE 20123 CONTINUE 20121 CONTINUE 20119 CONTINUE 20117 CONTINUE 20115 CONTINUE RETURN END 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 INTEGER FUNCTION LOOKFR ( NAME, DEFN ) C LOGICAL * 1 NAME ( 70 ), DEFN ( 70 ) INTEGER I, J, INDX, IT, INC, JUNK, SCOPY C C CFILE = CLOOK.RAT FOR RATFOR.RAT COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 200 ), TABLE ( 1900 $ ) INTEGER LASTP INTEGER TWOS INTEGER LASTT INTEGER NAMPTR LOGICAL * 1 TABLE C INDX = 0 INC = TWOS C IF(.NOT.( LASTP .GT. 0 )) GOTO 20140 CONTINUE 20142 CONTINUE IT = INC + INDX IF(.NOT.( IT .GT. LASTP )) GOTO 20145 IT = LASTP 20145 CONTINUE I = 1 J = NAMPTR ( IT ) CONTINUE 20147 IF(.NOT.( NAME ( I ) .EQ. TABLE ( J ) )) GOTO 20148 IF(.NOT.( NAME ( I ) .EQ. 0 )) GOTO 20149 JUNK = SCOPY ( TABLE ( J + 1 ), DEFN, 70, JUNK ) LOOKFR = 1 RETURN 20149 CONTINUE I = I + 1 J = J + 1 20150 CONTINUE GOTO 20147 20148 CONTINUE IF(.NOT.( NAME ( I ) .GT. TABLE ( J ) )) GOTO 20151 IF(.NOT.( IT .EQ. LASTP )) GOTO 20153 GOTO 20144 20153 CONTINUE INDX = IT 20154 CONTINUE 20151 CONTINUE INC = INC / 2 20143 IF(.NOT.( INC .LE. 0 )) GOTO 20142 20144 CONTINUE 20140 CONTINUE LOOKFR = 0 C RETURN END C C MATH - SUBROUTINE TO DO MATH IN MACRO DEFINITIONS C SYKES APR 77 C + AND - INTEGER NUMBERS AND DEFINITIONS ARE ALLOWED C SUBROUTINE MATH ( FILE ) C INTEGER SCTOI, SITOC, NUM1, NUM2, JUNK, FILE LOGICAL * 1 TOKDEF, OPR, NGETCH, TOKEN ( 70 ) C IF(.NOT.( TOKDEF ( TOKEN, 70, FILE ) .NE. - 1 )) GOTO 20155 JUNK = 1 NUM1 = SCTOI ( TOKEN, JUNK ) CONTINUE 20157 IF(.NOT.( NGETCH ( OPR, FILE ) .NE. 62 )) GOTO 20158 JUNK = TOKDEF ( TOKEN, 70, FILE ) JUNK = 1 NUM2 = SCTOI ( TOKEN, JUNK ) IF(.NOT.( OPR .EQ. 43 )) GOTO 20159 NUM1 = NUM1 + NUM2 GOTO 20160 20159 CONTINUE IF(.NOT.( OPR .EQ. 45 )) GOTO 20161 NUM1 = NUM1 - NUM2 GOTO 20162 20161 CONTINUE IF(.NOT.( OPR .EQ. 42 )) GOTO 20163 NUM1 = NUM1 * NUM2 GOTO 20164 20163 CONTINUE IF(.NOT.( OPR .EQ. 47 .AND. NUM2 .NE. 0 )) GOTO 20165 NUM1 = NUM1 / NUM2 GOTO 20166 20165 CONTINUE CALL SYNERR ( 23HILLEGAL MATH OPERATION. ) CALL PBSTR ( TOKEN ) RETURN 20166 CONTINUE 20164 CONTINUE 20162 CONTINUE 20160 CONTINUE GOTO 20157 20158 CONTINUE JUNK = SITOC ( NUM1, TOKEN, 70 ) CALL PBSTR ( TOKEN ) C 20155 CONTINUE RETURN END C C NGETCH - GET A (POSSIBLY PUSHED BACK) CHARACTER C LOGICAL FUNCTION NGETCH * 1 ( C, F ) C LOGICAL * 1 BUFR ( 91 ), C, GETLIN INTEGER F, LASTC C C CFILE = CDEFIO.RAT FOR RATFOR.RAT COMMON / CDEFIO / BP, BUF ( 160 ) INTEGER BP LOGICAL * 1 BUF C C CFILE = CLINE.RAT FOR RATFOR.RAT COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF C DATA LASTC / 91 /, BUFR ( 91 ) / 10 / C IF(.NOT.( BP .GT. 0 )) GOTO 20167 C = BUF ( BP ) GOTO 20168 20167 CONTINUE BP = 1 IF(.NOT.( BUFR ( LASTC ) .EQ. 10 .OR. LASTC .GE. 91 )) GOTO 20169 LASTC = 0 IF(.NOT.( GETLIN ( BUFR, F ) .EQ. - 3 )) GOTO 20171 C = - 3 NGETCH = - 3 LASTC = 91 BP = 0 RETURN 20171 CONTINUE 20169 CONTINUE LASTC = LASTC + 1 IF(.NOT.( BUFR ( LASTC ) .EQ. 0 )) GOTO 20173 BUFR ( LASTC ) = 10 20173 CONTINUE C = BUFR ( LASTC ) 20168 CONTINUE BP = BP - 1 NGETCH = C C RETURN END C C OTHERC - OUTPUT ORDINARY FORTRAN STATEMENT C SUBROUTINE OTHERC ( LEXSTR ) C LOGICAL * 1 LEXSTR ( 1 ) C CALL OUTTAB CALL OUTSTR ( LEXSTR ) CALL EATUP CALL OUTDON C RETURN END C C OUTCH - PUT ONE CHARACTER INTO OUTPUT BUFFER, CREATE CONTINUATION LINES C SUBROUTINE OUTCH ( C ) C LOGICAL * 1 C INTEGER I C C CFILE= 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 20175 CALL OUTDON CONTINUE I = 1 20177 IF(.NOT.( I .LT. 6)) GOTO 20179 OUTBUF ( I ) = 32 20178 I = I + 1 GOTO 20177 20179 CONTINUE OUTBUF ( 6 ) = 36 OUTP = 6 20175 CONTINUE OUTP = OUTP + 1 OUTBUF ( OUTP ) = C C RETURN END