00040079C======== FILE=RAT1.RAT ======================= RATFOR IN RATFOR ==========0064C THIS FILE CONTAINS THE NON-SYSTEM SPECIFIC PARTS OF RATFOR0084CNOTE:THE COMPILER MUST CORRECTLY HANDLE NUMBERIC COMPARES OF BYTES AND INTEGERS0072C EDITED TO PLACE SUBPROGRAM DECLARATIONS AHEAD OF COMMENTS FOR THAT0052C SUBPROGRAM, SO F4 V2.2 KEEPS COMMENTS WITH IT.0015C BOB DENNY0015C 25-MAR-800005C0076CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS ===============^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0048C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT.0005C0045C ******************0043C FILE=RATDEF.RT0045C ******************0005C0075C==============DEFINITIONS FOR RT-11 RATFOR PREPROCESSOR===============0005C0044CLINK LIBRARY FOR COMPILE/LINK/GO OPTION0005C0080C===========================================================================0045 SUBROUTINE ADDDEF ( TOKEN, TOKSIZ )0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0075C ADDDEF - GET DEFINITION, INSTALL SYMBOLIC CONSTANT AND SORT THE TABLE0020C SYKES, 18FEB770066C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS0064C PCN # 68, 10 OCT 79, FIX BUG IF LASTP=1,TESTING NAMPTR(0).0082C PCN # 84, 18 JAN 80, FIX BUG IN PCN # 68, CHANGE > TO >= SO 2ND SYMBOL FOUND0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0005C0005C0054 INTEGER TOKSIZ, LOOKFR, INSTAL, SCOMPR, I, J0051 LOGICAL * 1 TOKEN ( TOKSIZ ), DEFN ( 80 )0005C^^^^^^^^^^^^^^^0042C FILE = CLOOK.RAT FOR RATFOR.RAT0075 COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 200 ), TABLE ( 22000012 $ )0023 INTEGER LASTP0022 INTEGER TWOS0023 INTEGER LASTT0024 INTEGER NAMPTR0027 LOGICAL * 1 TABLE0005C0049 CALL GETDEF ( TOKEN, TOKSIZ, DEFN, 80 )0031 CALL UNFOLD ( TOKEN )0064 IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 1 )) GOTO 200000052 CALL SYNERR ( 23HATTEMPTED REDEFINITION. )0020 GOTO 20001001820000 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^^0075 IF (.NOT.( INSTAL ( TOKEN, DEFN, LASTP, LASTT, NAMPTR, 2200, 200,0041 $ TABLE ) .EQ. - 1 )) GOTO 200020050 CALL SYNERR ( 21HTOO MANY DEFINITIONS. )0020 GOTO 20003001820002 CONTINUE0047 IF (.NOT.( LASTP .GE. 2 )) GOTO 200040054 IF (.NOT.( TWOS * 2 .LE. LASTP )) GOTO 200060025 TWOS = TWOS * 2001820006 CONTINUE0034 I = NAMPTR ( LASTP - 1 )0030 J = NAMPTR ( LASTP )0072 IF (.NOT.( SCOMPR ( TABLE ( I ), TABLE ( J ) ) .GT. 0 )) GOTO 0015 $20008^^^^^^^^^^^^^0045 CALL SHELL ( LASTP, NAMPTR, TABLE )001820008 CONTINUE0005C001820004 CONTINUE001820003 CONTINUE001820001 CONTINUE0016 RETURN0013 END0005 00040027 SUBROUTINE BALPAR0005C0067C BALPAR - COPY BALANCED PARTHENTHESES STRING INTO FORTRAN CODE0014C PCN # 210005C0005C0045 LOGICAL * 1 T, TOKEN ( 70 ), DEFTOK0023 INTEGER NLPAR0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0063 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 200100039 CALL SYNERR ( 10HMISSING (. )0016 RETURN001820010 CONTINUE0031 CALL OUTSTR ( TOKEN )0019 NLPAR = 1001820012 CONTINUE0034 T = DEFTOK ( TOKEN, 70 )0075 IF (.NOT.( T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ. 0027 $- 3 )) GOTO 200150030 CALL PBSTR ( TOKEN )0020 GOTO 20014001820015 CONTINUE0044 IF (.NOT.( T .EQ. 10 )) GOTO 200170025 TOKEN ( 1 ) = 00020 GOTO 20018^^^^^^^^^^^^^^^001820017 CONTINUE0033 CALL LRPAR ( T, NLPAR )001820018 CONTINUE0064 IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 200190027 CALL OUTCH ( 32 )001820019 CONTINUE0031 CALL OUTSTR ( TOKEN )004720013 IF (.NOT.( NLPAR .LE. 0 )) GOTO 20012001820014 CONTINUE0047 IF (.NOT.( NLPAR .NE. 0 )) GOTO 200210057 CALL SYNERR ( 28HMISSING ( OR ) IN CONDITION. )0005C001820021 CONTINUE0016 RETURN0013 END0005 00040057 SUBROUTINE BRKNXT ( SP, LEXTYP, LABVAL, TOKEN )0005C^^^^^^^^^^^0062C BRKNXT - GENERATE CODE FOR 'BREAK' AND 'NEXT' STATEMENTS0005C0005C0062 INTEGER I, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN0005C0017 I = SP004220023 IF (.NOT.( I .GT. 0)) GOTO 200250075 IF (.NOT.( LEXTYP ( I ) .EQ. - 121 .OR. LEXTYP ( I ) .EQ. - 112 0075 $.OR. LEXTYP ( I ) .EQ. - 115 .OR. LEXTYP ( I ) .EQ. - 119 )) GOTO0016 $ 200260051 IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 200280041 CALL OUTGO ( LABVAL ( I ) + 1 )0020 GOTO 20029001820028 CONTINUE^^^^^^^^^^^^^^^^^^0037 CALL OUTGO ( LABVAL ( I ) )001820029 CONTINUE0016 RETURN001820026 CONTINUE002020024 I = I - 1 0020 GOTO 20023001820025 CONTINUE0051 IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 200300043 CALL SYNERR ( 14HILLEGAL BREAK. )0020 GOTO 20031001820030 CONTINUE0042 CALL SYNERR ( 13HILLEGAL NEXT. )0005C001820031 CONTINUE0016 RETURN0013 END0005 00040027 SUBROUTINE DEFLST0005C0052C DEFLST - TO LIST CURRENT DEFINE TABLE CONTENTS0017C SYKES,OCT76^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0076C PCN # 61, 3 SEP 79, ADD SYMBOLIC CONSTANT USAGE DATA AT END OF LISTING0061C PCN # 66, 6 OCT 79, DELETE LASTP<2 TEST, NOLONGER VALID0055C PCN # 75, DEC 79, ADD FTN LINE NUMBERS TO LISTING0077C PCN # 77, 5 JAN 80, INCLUDE CPRTLN AND USE 'PRTBUF' JUST TO SAVE SPACE.0044C (INSTEAD OF SEPERATE INTERNAL BUFFER)0005C0005C0030 LOGICAL * 1 FF ( 2 )0057 INTEGER I, J, K, LEN1, LEN2, CENTER, LINE, JUNK0043 INTEGER SJOIN, SITOC, SLEN, SCOPY0005C0042C FILE = CLOOK.RAT FOR RATFOR.RAT^^^^^^^^^^^^0075 COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 200 ), TABLE ( 22000012 $ )0023 INTEGER LASTP0022 INTEGER TWOS0023 INTEGER LASTT0024 INTEGER NAMPTR0027 LOGICAL * 1 TABLE0005C0035C FILE=CPRTLN.RAT FOR RATFOR0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0032 LOGICAL * 1 TITLE (31)0028 LOGICAL * 1 BL (2)0029 LOGICAL * 1 HOW (7)^^^^^^^^^^^0031 LOGICAL * 1 MUCH (14)0032 LOGICAL * 1 CHARS (12)0031 LOGICAL * 1 ANDIT (5)0030 LOGICAL * 1 SYMB (9)0005C0075 DATA TITLE/1HS,1HY,1HM,1HB,1HO,1HL,1HI,1HC,1H ,1HC,1HO,1HN,1HS,1H0075 $T,1HA,1HN,1HT,1H ,1H=,1H ,1HD,1HE,1HF,1HI,1HN,1HI,1HT,1HI,1HO,1HN0013 $,0/0024 DATA BL/1H ,0/0045 DATA HOW/1H ,1HU,1HS,1HE,1HD,1H ,0/0074 DATA MUCH/1H ,1HO,1HF,1H ,1HP,1HO,1HS,1HS,1HI,1HB,1HL,1HE,1H ,0/0067 DATA CHARS/1H ,1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,1HS,0/^^^^^^^^^^0039 DATA ANDIT/1H ,1H ,1H&,1H ,0/0054 DATA SYMB/1H ,1HS,1HY,1HM,1HB,1HO,1HL,1HS,0/0027 DATA FF / 12, 0 /0005C0047 IF (.NOT.( LASTP .GT. 0 )) GOTO 200320034 CALL RATLST ( FF, 0, 0 )0034 CENTER = ( 90 / 2 ) - 160049 IF (.NOT.( CENTER .GT. 30 )) GOTO 200340021 CENTER = 30001820034 CONTINUE0026 PRTBUF ( 1 ) = 00034 CALL SPAD ( PRTBUF, 60 )0066 JUNK = SCOPY ( TITLE, PRTBUF ( CENTER - 18 ), 40, JUNK )0038 CALL RATLST ( PRTBUF, 0, 0 )^^^^^^^^^^^^^^^^^^^^0034 CALL RATLST ( BL, 0, 0 )0018 CONTINUE0016 I = 1004620036 IF (.NOT.( I .LE. LASTP)) GOTO 200380026 J = NAMPTR ( I )0018 LINE = I0037 LEN1 = SLEN ( TABLE ( J ) )0048 LEN2 = SLEN ( TABLE ( J + 1 + LEN1 ) )0035 K = ( CENTER - 1 ) - LEN10075 IF (.NOT.( LEN1 .GT. ( CENTER - 2 ) .OR. LEN2 .GT. ( CENTER - 2 )0024 $ )) GOTO 200390015 K = 1001820039 CONTINUE0066 IF (.NOT.( ( LEN1 + LEN2 ) .GT. ( 90 - 3 ) )) GOTO 200410022 LINE = 32767^^^^^^^^^^^^^^001820041 CONTINUE0018 CONTINUE0016 L = 1004220043 IF (.NOT.( L .LT. K)) GOTO 200450027 PRTBUF ( L ) = 32002020044 L = L + 1 0020 GOTO 20043001820045 CONTINUE0062 JUNK = SCOPY ( TABLE ( J ), PRTBUF ( K ), 70, JUNK )0046 IF (.NOT.( LINE .EQ. I )) GOTO 200460026 L = K + LEN1 + 30020 GOTO 20047001820046 CONTINUE0023 L = 90 - LEN2001820047 CONTINUE0066 IF (.NOT.( TABLE ( J + 1 + LEN1 ) .EQ. - 9 )) GOTO 200480019 J = J + 1001820048 CONTINUE^^^^^^^^^^^^^^^^^0073 JUNK = SCOPY ( TABLE ( J + 1 + LEN1 ), PRTBUF ( L ), 80, JUNK )0034 PRTBUF ( K + LEN1 ) = 320038 PRTBUF ( K + LEN1 + 1 ) = 610038 PRTBUF ( K + LEN1 + 2 ) = 320041 CALL RATLST ( PRTBUF, LINE, 0 )002020037 I = I + 1 0020 GOTO 20036001820038 CONTINUE0048 LEN1 = SCOPY ( HOW, PRTBUF, 30, JUNK )0056 JUNK = SITOC ( LASTP, PRTBUF ( LEN1 + 1 ), 5 )0049 LEN1 = SJOIN ( PRTBUF, SYMB, 90, JUNK )0049 LEN1 = SJOIN ( PRTBUF, MUCH, 90, JUNK )^^^^^^^^^^^^^^^^^^^^^^^^^^^^0054 JUNK = SITOC ( 200, PRTBUF ( LEN1 + 1 ), 6 )0050 LEN1 = SJOIN ( PRTBUF, ANDIT, 90, JUNK )0056 JUNK = SITOC ( LASTT, PRTBUF ( LEN1 + 1 ), 6 )0050 LEN1 = SJOIN ( PRTBUF, CHARS, 90, JUNK )0049 LEN1 = SJOIN ( PRTBUF, MUCH, 90, JUNK )0055 JUNK = SITOC ( 2200, PRTBUF ( LEN1 + 1 ), 6 )0038 CALL RATLST ( PRTBUF, 0, 0 )0005C001820032 CONTINUE0016 RETURN0013 END0005 00040036 SUBROUTINE DEFMAC ( DEFN )0005C0053C DEFMAC - TO PROCESS MACRO CALLS (WITH ARGUMENT)^^^^^0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0053CTHE 'MACRO' AND 'DEFINE' KEYWORDS ARE SYNOMIMUS.0063CA MACRO CAN BE DEFINED WITH A DEFINITION CONTAINING ONE OR0067C MORE 'PASSCHARACTERS' IN IT. WHEN THE MACRO IS INVOKED, EACH0067C OCCURANCE OF THE PASSCHARACTER IN THE DEFINITION IS REPLACED0074C WITH THE CURRENT ARGUMENT OF THE MACRO, WHICH IS CONTAINED IN PAREN0032C FOLLOWING THE MACRO NAME.0051CDEFINE(FOO,($=$+1)) OR MACRO(FOO,($=$+1)) THEN^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0049C UNTIL (I) IS PROCESSED INTO UNTIL (I=I+1)0067C NO PROCESSING OF THE MACRO DEFINITION IS DONE UNTIL THE MACRO0074C IS RESOLVED. SPECIAL CHAR. AND BLANKS IN DEFINITION ARE PRESERVED.0005C0005C0032 INTEGER I, NLPAR, SLEN0053 LOGICAL * 1 DEFN ( 80 ), TOKEN ( 70 ), GTOK0005C0054 IF (.NOT.( DEFN ( 1 ) .EQ. - 9 )) GOTO 200500061 IF (.NOT.( GTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 200520043 CALL SYNERR ( 14HNO ( IN MACRO. )0030 CALL PBSTR ( TOKEN )0016 RETURN001820052 CONTINUE0019 NLPAR = 10018 CONTINUE0016 I = 1004620054 IF (.NOT.( NLPAR .GT. 0)) GOTO 200560044 IF (.NOT.( I .GT. 70 )) GOTO 200570053 CALL SYNERR ( 24HMACRO ARGUMENT TOO LONG. )0016 RETURN001820057 CONTINUE0075 IF (.NOT.( NGETCH ( TOKEN ( I ) ) .EQ. - 3 .OR. TOKEN ( I ) .EQ. 0026 $10 )) GOTO 200590044 CALL SYNERR ( 15HMACRO > 1 LINE. )0037 CALL PUTBAK ( TOKEN ( I ) )0016 RETURN001820059 CONTINUE0043 CALL LRPAR ( TOKEN ( I ), NLPAR )002020055 I = I + 1 ^^^0020 GOTO 20054001820056 CONTINUE0029 TOKEN ( I - 1 ) = 00064C PUSH BACK 'DEFINITION' WITH 'TOKEN' IN PLACE OF 'PASSCHAR'0037C BUT NOT THE FIRST CHAR--MACTYPE0018 CONTINUE0028 I = SLEN ( DEFN )004220061 IF (.NOT.( I .GT. 1)) GOTO 200630053 IF (.NOT.( DEFN ( I ) .EQ. 36 )) GOTO 200640030 CALL PBSTR ( TOKEN )0020 GOTO 20065001820064 CONTINUE0036 CALL PUTBAK ( DEFN ( I ) )001820065 CONTINUE002020062 I = I - 1 0020 GOTO 20061001820063 CONTINUE0020 GOTO 20051^^^001820050 CONTINUE0029 CALL PBSTR ( DEFN )001820051 CONTINUE0016 RETURN0013 END0005 00040055 LOGICAL FUNCTION DEFTOK * 1 ( TOKEN, TOKSIZ )0005C0061C DEFTOK - GET TOKEN; PROCESS MACRO CALLS AND INVOCATIONS0052C PCN 93, 18 FEB 80, HANDLE EOF OF INCLUDE FILES0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0068C PCN 92, 20 FEB 80, ADD GTFUNC TO SET UP FOR RETURN(EXPRESSION)0054C IMPOSSES THE RESTRICTION THAT SYMBOLIC CONSTANTS^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0065C MUST START WITH A LETTER. ALSO THAT SYMBOLIC CONSTANTS ARE0065C ALWAYS CONVERTED TO UPPER CASE BEFORE LOOKUP, THEREFOR CASE0047C IS NOT SIGNIFICANT TO SYMBOLIC CONSTANTS.0057C SYKES, DEC76, ADD MACRO (WITH ARGUMENTS) CAPABILITY0005C0005C0038 INTEGER TOKSIZ, LOOKFR, SEQL0066 LOGICAL * 1 DEFN ( 80 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C0030 LOGICAL * 1 FUNC (9)0005C0054 DATA FUNC/1HF,1HU,1HN,1HC,1HT,1HI,1HO,1HN,0/004720066 IF (.NOT.( LEVEL .GT. 0 )) GOTO 200670018 CONTINUE0042 DEFTOK = GTOK ( TOKEN, TOKSIZ )004920068 IF (.NOT.( DEFTOK .NE. - 3)) GOTO 200700075 IF (.NOT.( DEFTOK .NE. - 100 .OR. TYPE ( TOKEN ( 1 ) ) .NE. - 30 ^^^^0023 $)) GOTO 200710016 RETURN001820071 CONTINUE0031 CALL UNFOLD ( TOKEN )0064 IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 200730062 IF (.NOT.( SEQL ( FUNC, TOKEN ) .EQ. 1 )) GOTO 200750021 CALL GTFUNC001820075 CONTINUE0016 RETURN001820073 CONTINUE0030 CALL DEFMAC ( DEFN )001820074 CONTINUE004320069 DEFTOK = GTOK ( TOKEN , TOKSIZ ) 0020 GOTO 20068001820070 CONTINUE0047 IF (.NOT.( LEVEL .EQ. 1 )) GOTO 200770016 RETURN001820077 CONTINUE^^^^^^^^^^^^^^^0041 CALL CLOSE ( INFILE ( LEVEL ) )0027 LEVEL = LEVEL - 1001820078 CONTINUE0005C0020 GOTO 20066001820067 CONTINUE0013 END0005 00040035 SUBROUTINE DOCODE ( LAB )0005C0060C DOCODE - GENERATE CODE FOR BEGINNING OF 'DO' STATEMENT0005C0005C0029 INTEGER LABGEN, LAB0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0032 LOGICAL * 1 DOSTRU (4)0032 LOGICAL * 1 DOSTRL (4)0005C^^^^^^^^^^^^^^^^^^^^^^^^^^0036 DATA DOSTRU/1HD,1HO,1H ,0/0036 DATA DOSTRL/1Hd,1Ho,1H ,0/0021 CALL OUTTAB0044 IF (.NOT.( LC .EQ. 1 )) GOTO 200790032 CALL OUTSTR ( DOSTRL )0020 GOTO 20080001820079 CONTINUE0032 CALL OUTSTR ( DOSTRU )001820080 CONTINUE0028 LAB = LABGEN ( 2 )0029 CALL OUTNUM ( LAB )0048 IF (.NOT.( COMPRS .EQ. 0 )) GOTO 200810027 CALL OUTCH ( 32 )001820081 CONTINUE0020 CALL EATUP0021 CALL OUTDON0005C0016 RETURN0013 END0005 0004^^^^^^^^^^^^^^^^^^^^^0026 SUBROUTINE EATUP0005C0066C EATUP - PROCESS REST OF A STATEMENT; INTERPRET CONTINUATIONS0005C0005C0060 LOGICAL * 1 PTOKEN ( 70 ), T, TOKEN ( 70 ), DEFTOK0023 INTEGER NLPAR0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0019 NLPAR = 0001820083 CONTINUE0034 T = DEFTOK ( TOKEN, 70 )0059 IF (.NOT.( T .EQ. 59 .OR. T .EQ. 10 )) GOTO 200860020 GOTO 20085001820086 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^^^^0045 IF (.NOT.( T .EQ. 125 )) GOTO 200880030 CALL PBSTR ( TOKEN )0020 GOTO 20085001820088 CONTINUE0061 IF (.NOT.( T .EQ. 123 .OR. T .EQ. - 3 )) GOTO 200900047 IF (.NOT.( NLPAR .GT. 0 )) GOTO 200920053 CALL SYNERR ( 24HUNEXPECTED BRACE OR EOF. )001820092 CONTINUE0030 CALL PBSTR ( TOKEN )0020 GOTO 20085001820090 CONTINUE0059 IF (.NOT.( T .EQ. 44 .OR. T .EQ. 95 )) GOTO 200940064 IF (.NOT.( DEFTOK ( PTOKEN, 70 ) .NE. 10 )) GOTO 20096^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0031 CALL PBSTR ( PTOKEN )001820096 CONTINUE0044 IF (.NOT.( T .EQ. 95 )) GOTO 200980025 TOKEN ( 1 ) = 0001820098 CONTINUE0020 GOTO 20095001820094 CONTINUE0033 CALL LRPAR ( T, NLPAR )001820095 CONTINUE0064 IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 201000027 CALL OUTCH ( 32 )001820100 CONTINUE0031 CALL OUTSTR ( TOKEN )004720084 IF (.NOT.( NLPAR .LT. 0 )) GOTO 20083001820085 CONTINUE0047 IF (.NOT.( NLPAR .NE. 0 )) GOTO 20102^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0044 CALL SYNERR ( 15HUNBALANCED ( ). )0005C001820102 CONTINUE0016 RETURN0013 END0005 00040041 SUBROUTINE ELSEIF ( LAB, LAST )0005C0056C ELSEIF - GENERATE CODE FOR END OF 'IF' BEFORE ELSE0082C PCN#10, 21 OCT 77 DON'T GENERATE THE 'GOTO' IF THE PRECEEDING LINE GENERATED0078C A 'GOTO', MAKING THIS ONE UNREACHABLE, WHICH SOME COMPILERS DON'T LIKE.0005C0005C0021 INTEGER LAB0026 LOGICAL * 1 LAST0005C0075 IF (.NOT.( LAST .NE. - 110 .AND. LAST .NE. - 117 .AND. LAST .NE.^^^^^^^^0052 $ - 123 .AND. LAST .NE. - 122 )) GOTO 201040032 CALL OUTGO ( LAB + 1 )001820104 CONTINUE0029 CALL OUTCON ( LAB )0005C0016 RETURN0013 END0005 00040042 SUBROUTINE ENDCOD ( LEXSTR, SP )0005C0071C ENDCOD - FORCE LISTING PAGE ADVANCE AFTER FORTRAN 'END' STATEMENT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0056C PCN #92, 20 FEB 80, RESET IN-FUNCTION STATUS FLAG.0005C0005C0026 INTEGER SLEN, SP0055 LOGICAL * 1 LEXSTR ( 1 ), PTOK ( 70 ), DEFTOK0005C^^^0035C FILE=CFUNC.RAT FOR RATFOR0046 COMMON / CFUNC / INFUNC, FNAM ( 12 )0024 INTEGER INFUNC0026 LOGICAL * 1 FNAM0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0035C FILE=CPRTLN.RAT FOR RATFOR^^^^^^^^^^^^^^^^^^^^^^^^^^^^0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0075 IF (.NOT.( 3 .EQ. SLEN ( LEXSTR ) .AND. DEFTOK ( PTOK, 70 ) .EQ. 0026 $10 )) GOTO 201060021 CALL OUTTAB0032 CALL OUTSTR ( LEXSTR )0021 CALL OUTDON0021 CALL PRTLIN0044 IF (.NOT.( SP .NE. 1 )) GOTO 201080067 CALL SYNERR ( 38HMISSING CLAUSE OR BRACE IN ABOVE PROG. )0016 SP = 1001820108 CONTINUE0022 PLINE = 99990027 CALL OUTCH ( 12 )0021 CALL OUTDON0019 FTNLN = 00020 INFUNC = 00020 GOTO 20107001820106 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^0032 CALL OTHERC ( LEXSTR )001820107 CONTINUE0029 CALL PBSTR ( PTOK )0016 RETURN0013 END0005 00040027 SUBROUTINE ENDSTR0005C0046C ENDSTR - DUMP PENDING STRING DEFINITIONS0005C0005C0028 INTEGER J, K, SLEN0005C0036C FILE= CSTR.RAT FOR RATFOR0069 COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 )0023 INTEGER LASTS0023 INTEGER LASTR0024 INTEGER STRPTR0028 LOGICAL * 1 TABLES0005C0036C FILE= CUCLC.RAT FOR RATFOR^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0031 LOGICAL * 1 DATAU (6)0031 LOGICAL * 1 DATAL (6)0005C0043 DATA DATAU/1HD,1HA,1HT,1HA,1H ,0/0043 DATA DATAL/1Hd,1Ha,1Ht,1Ha,1H ,0/0016 K = 1004620110 IF (.NOT.( K .LE. LASTS)) GOTO 201120021 CALL OUTTAB0044 IF (.NOT.( LC .EQ. 1 )) GOTO 201130031 CALL OUTSTR ( DATAL )0020 GOTO 20114001820113 CONTINUE0031 CALL OUTSTR ( DATAU )001820114 CONTINUE0026 J = STRPTR ( K )^^0038 CALL OUTSTR ( TABLES ( J ) )0027 CALL OUTCH ( 47 )0018 CONTINUE0044 J = J + SLEN ( TABLES ( J ) ) + 1005320115 IF (.NOT.( TABLES ( J ) .NE. 0)) GOTO 201170027 CALL OUTCH ( 49 )0044 IF (.NOT.( LC .EQ. 1 )) GOTO 201180028 CALL OUTCH ( 104 )0020 GOTO 20119001820118 CONTINUE0027 CALL OUTCH ( 72 )001820119 CONTINUE0037 CALL OUTCH ( TABLES ( J ) )0027 CALL OUTCH ( 44 )002020116 J = J + 1 0020 GOTO 20115001820117 CONTINUE0027 CALL OUTNUM ( 0 )^0027 CALL OUTCH ( 47 )0021 CALL OUTDON002020111 K = K + 1 0020 GOTO 20110001820112 CONTINUE0019 LASTS = 00019 LASTR = 00016 RETURN0013 END0005 00040034 SUBROUTINE ERROR ( BUF )0005C0049C ERROR - PRINT FATAL ERROR MESSAGE, THEN DIE0020CSYKES 28 SEP 760005C0005C0031 LOGICAL * 1 BUF ( 1 )0005C0029 CALL SYNERR ( BUF )0039 CALL SYNERR ( 10H**ABORT**. )0019 CALL EXIT0013 END0005 00040039 SUBROUTINE FORCOD ( LAB, SP )0005C^^^^^^^^^^^^^^^^^^^^^^^0065C FORCOD - GENERATE CODE FOR THE BEGINNING OF 'FOR' STATEMENT0017C ***PCN # 210054C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING0005C0005C0045 LOGICAL * 1 T, TOKEN ( 70 ), DEFTOK0030 INTEGER SLEN, LABGEN0051 INTEGER I, J, LAB, NLPAR, SP, JUNK, SCOPY0005C0040C FILE = CFOR.RAT FOR RATFOR.RAT0056 COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN0024 INTEGER FORDEP0028 LOGICAL * 1 FORSTK0024 INTEGER FORLEN0005C0035C FILE=CPRTLN.RAT FOR RATFOR^^^^^^^^^^^^^^^^^^^^^^^0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0028 LAB = LABGEN ( 3 )0044 IF (.NOT.( SP .GT. 1 )) GOTO 201200027 CALL OUTCON ( 0 )0005C001820120 CONTINUE0063 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20122^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0047 CALL SYNERR ( 18HMISSING ( IN FOR. )0016 RETURN001820122 CONTINUE0063 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 59 )) GOTO 201240030 CALL PBSTR ( TOKEN )0021 CALL OUTTAB0020 CALL EATUP0021 CALL OUTDON0020 FORTYP = 1001820124 CONTINUE0063 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .EQ. 59 )) GOTO 201260029 CALL OUTCON ( LAB )0020 GOTO 20127001820126 CONTINUE0030 CALL PBSTR ( TOKEN )0029 CALL OUTNUM ( LAB )0020 CALL OUTIF0027 CALL OUTCH ( 40 )^^0019 NLPAR = 00018 CONTINUE004720128 IF (.NOT.( NLPAR .GE. 0 )) GOTO 201290034 T = DEFTOK ( TOKEN, 70 )0044 IF (.NOT.( T .EQ. 59 )) GOTO 201300020 GOTO 20129001820130 CONTINUE0033 CALL LRPAR ( T, NLPAR )001820131 CONTINUE0060 IF (.NOT.( T .NE. 10 .AND. T .NE. 95 )) GOTO 201320064 IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 201340027 CALL OUTCH ( 32 )001820134 CONTINUE0031 CALL OUTSTR ( TOKEN )001820132 CONTINUE0020 GOTO 20128001820129 CONTINUE^^^^^0027 CALL OUTCH ( 41 )0027 CALL OUTCH ( 41 )0048 IF (.NOT.( COMPRS .EQ. 0 )) GOTO 201360027 CALL OUTCH ( 32 )001820136 CONTINUE0032 CALL OUTGO ( LAB + 2 )0047 IF (.NOT.( NLPAR .LT. 0 )) GOTO 201380048 CALL SYNERR ( 19HINVALID FOR CLAUSE. )001820138 CONTINUE001820127 CONTINUE0029 FORDEP = FORDEP + 10020 J = FORLEN0026 FORSTK ( J ) = 00019 NLPAR = 0004720140 IF (.NOT.( NLPAR .GE. 0 )) GOTO 201410034 T = DEFTOK ( TOKEN, 70 )^^^^^^^^^^^^^^^^^^^^^^^^^^^0033 CALL LRPAR ( T, NLPAR )0074 IF (.NOT.( NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95 )) GOTO 0015 $201420032 J = J + SLEN ( TOKEN )0049 IF (.NOT.( J + 2 .GT. 120 )) GOTO 201440054 CALL ERROR ( 26HREINIT CLAUSE(S) TOO LONG. )0020 GOTO 20145001820144 CONTINUE0064 JUNK = SCOPY ( TOKEN, FORSTK ( FORLEN ), 32767, JUNK )0048 IF (.NOT.( COMPRS .EQ. 0 )) GOTO 201460027 FORSTK ( J ) = 320019 J = J + 1001820146 CONTINUE0026 FORSTK ( J ) = 0^^^^^^^^^^^^^^^0020 FORLEN = J001820145 CONTINUE001820142 CONTINUE0020 GOTO 20140001820141 CONTINUE0029 FORLEN = FORLEN + 10023 LAB = LAB + 10005C0016 RETURN0013 END0005 00040033 SUBROUTINE FORS ( LAB )0005C0053C FORS - GENERATE CODE FOR END OF 'FOR' STATEMENT0005C0005C0033 INTEGER I, J, LAB, SLEN0005C0040C FILE = CFOR.RAT FOR RATFOR.RAT0056 COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN0024 INTEGER FORDEP0028 LOGICAL * 1 FORSTK0024 INTEGER FORLEN0005C^^^^^^^0029 CALL OUTNUM ( LAB )0015 J = 10016 I = 1004720148 IF (.NOT.( I .LT. FORDEP)) GOTO 201500043 J = J + SLEN ( FORSTK ( J ) ) + 1002020149 I = I + 1 0020 GOTO 20148001820150 CONTINUE0063 IF (.NOT.( SLEN ( FORSTK ( J ) ) .GT. 0 )) GOTO 201510021 CALL OUTTAB0038 CALL OUTSTR ( FORSTK ( J ) )0021 CALL OUTDON001820151 CONTINUE0032 CALL OUTGO ( LAB - 1 )0033 CALL OUTCON ( LAB + 1 )0029 FORDEP = FORDEP - 10020 FORLEN = J0005C0016 RETURN^^^^^^^^0013 END0005 0004^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^