C FILE= RAT2.RAT C$ ***** SECOND PART OF NON-SYSTEM-SPECIFIC PARTS OF RATFOR CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT. 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. 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 SUBROUTINE GETDEF ( TOKEN, TOKSIZ, DEFN, DEFSIZ ) 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 C C$ GTFUNC - GET AND SAVE THE FUNCTION NAME FOR RETURN(EXPRESSION) CPCN #92, 20 FEB 80 C SUBROUTINE GTFUNC 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 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 PCN 102, 29 MAR 80, ALLOW UNDERLINE EMBEDDED IN TOKENS C LOGICAL FUNCTION GTOK * 1 ( TOKEN, TOKSIZ ) 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 .AND. GTOK .NE. 95 $ )) 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 C C$ IFFORTRAN CODE - 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, 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 CENDIFDEF C SUBROUTINE IFDEFC ( CTRL ) 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 ( 4 ), 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 C C$ IFGO - GENERATE CODE: "IF(NOT.(...))GOTO LAB" C ***PCN # 21 C SUBROUTINE IFGO ( LAB ) 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 C C C$ INSTAL - ADD SYMBOLIC'S 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 ( 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 C C$ LABELC - OUTPUT FORTRAN STATEMENT NUMBERS THAT WERE IN RATFOR SOURCE C PCN #75, ADD FTN LINE NUMBERS TO LISTING. REPLACE CALL TO OUTTAB. C SUBROUTINE LABELC ( LEXSTR ) 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 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 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 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 PCN 98, 27 MAR 80, REORGANIZE SCAN WITH MOST COMMON KEYWORDS FIRST. C INTEGER FUNCTION LEX ( TOKEN ) 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, SIF ) .EQ. 1 )) GOTO 20094 LEX = - 116 GOTO 20095 20094 CONTINUE IF (.NOT.( SEQL ( TOKEN, SELSE ) .EQ. 1 )) GOTO 20096 LEX = - 113 GOTO 20097 20096 CONTINUE IF (.NOT.( SEQL ( TOKEN, SFOR ) .EQ. 1 )) GOTO 20098 LEX = - 115 GOTO 20099 20098 CONTINUE IF (.NOT.( SEQL ( TOKEN, SWHILE ) .EQ. 1 )) GOTO 20100 LEX = - 121 GOTO 20101 20100 CONTINUE IF (.NOT.( SEQL ( TOKEN, SREPT ) .EQ. 1 )) GOTO 20102 LEX = - 119 GOTO 20103 20102 CONTINUE IF (.NOT.( SEQL ( TOKEN, SDO ) .EQ. 1 )) GOTO 20104 LEX = - 112 GOTO 20105 20104 CONTINUE IF (.NOT.( SEQL ( TOKEN, SUNTIL ) .EQ. 1 )) GOTO 20106 LEX = - 120 GOTO 20107 20106 CONTINUE IF (.NOT.( SEQL ( TOKEN, SBREAK ) .EQ. 1 )) GOTO 20108 LEX = - 110 GOTO 20109 20108 CONTINUE IF (.NOT.( SEQL ( TOKEN, SNEXT ) .EQ. 1 )) GOTO 20110 LEX = - 117 GOTO 20111 20110 CONTINUE IF (.NOT.( SEQL ( TOKEN, SDEFIN ) .EQ. 1 )) GOTO 20112 LEX = - 124 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, SENDIF ) .EQ. 1 )) GOTO 20118 LEX = - 128 GOTO 20119 20118 CONTINUE IF (.NOT.( SEQL ( TOKEN, SIFDEF ) .EQ. 1 )) GOTO 20120 LEX = - 126 GOTO 20121 20120 CONTINUE IF (.NOT.( SEQL ( TOKEN, SIFNOT ) .EQ. 1 )) GOTO 20122 LEX = - 127 GOTO 20123 20122 CONTINUE IF (.NOT.( SEQL ( TOKEN, SSTRNG ) .EQ. 1 )) GOTO 20124 LEX = - 130 GOTO 20125 20124 CONTINUE IF (.NOT.( SEQL ( TOKEN, SEND ) .EQ. 1 )) GOTO 20126 LEX = - 114 GOTO 20127 20126 CONTINUE IF (.NOT.( SEQL ( TOKEN, SRETRN ) .EQ. 1 )) GOTO 20128 LEX = - 122 GOTO 20129 20128 CONTINUE IF (.NOT.( SEQL ( TOKEN, SSTOP ) .EQ. 1 )) GOTO 20130 LEX = - 123 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 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 ( 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 ( 2400 $ ) 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 C C$ MATH - 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 SUBROUTINE MATH 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 C C$ NGETCH - GET A (POSSIBLY PUSHED BACK) CHARACTER C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER. C LOGICAL FUNCTION NGETCH * 1 ( 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 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 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