C FILE=RATFOR1.RAT C============================================= RATFOR IN RATFOR ========== C THIS FILE CONTAINS THE NON-SYSTEM SPECIFIC PARTS OF RATFOR C CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C C C FILE=RATDEF.RAT CDEFINE (DECWRITER,) #DEFINED FOR DECWRITER OUTPUT C C 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 SUBROUTINE ADDDEF ( TOKEN, TOKSIZ, FD ) C INTEGER TOKSIZ, FD, LOOKFR, INSTAL, SCOMPR, I, J LOGICAL * 1 TOKEN ( TOKSIZ ), DEFN ( 70 ) 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 CALL GETDEF ( TOKEN, TOKSIZ, DEFN, 70, FD ) 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, 1900, 200, $TABLE ) .EQ. - 1 )) GOTO 20002 CALL SYNERR ( 21HTOO MANY DEFINITIONS. ) GOTO 20003 20002 CONTINUE IF(.NOT.( LASTP .GT. 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 C C BALPAR - COPY BALANCED PARTHENTHESES STRING INTO FORTRAN CODE C PCN # 21 C SUBROUTINE BALPAR C LOGICAL * 1 T, TOKEN ( 70 ), GETTOK INTEGER NLPAR C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C IF(.NOT.( GETTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20010 CALL SYNERR ( 10HMISSING (. ) RETURN 20010 CONTINUE CALL OUTSTR ( TOKEN ) NLPAR = 1 20012 CONTINUE T = GETTOK ( 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 C C BRKNXT - GENERATE CODE FOR 'BREAK' AND 'NEXT' STATEMENTS C SUBROUTINE BRKNXT ( SP, LEXTYP, LABVAL, TOKEN ) 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 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 SUBROUTINE DEFLST C LOGICAL * 1 BUFR ( 90 ), HEAD ( 90 ), FF ( 2 ) INTEGER I, J, K, LEN1, LEN2, CENTER, LINE, JUNK INTEGER SJOIN, SITOC, SLEN, 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 LOGICAL * 1 TITLE (31) LOGICAL * 1 BL (2) LOGICAL * 1 HOW (14) LOGICAL * 1 MUCH (20) LOGICAL * 1 ANDIT (7) LOGICAL * 1 SYMB (9) LOGICAL * 1 CHARS (12) 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/1HP,1HR,1HO,1HG,1HR,1HA,1HM,1H ,1HU,1HS,1HE,1HD,1H ,0/ DATA MUCH/1H ,1HO,1HU,1HT,1H ,1HO,1HF,1H ,1HA,1H ,1HP,1HO,1HS,1HS $,1HI,1HB,1HL,1HE,1H ,0/ DATA ANDIT/1H ,1H ,1HA,1HN,1HD,1H ,0/ DATA SYMB/1H ,1HS,1HY,1HM,1HB,1HO,1HL,1HS,0/ DATA CHARS/1H ,1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,1HS,0/ DATA HEAD / 90 * 32 / DATA FF / 12, 0 / C C IF (LASTP <= 2) #DON'T LIST 'MACRO' AND 'DEFINE'***PCN66 C RETURN #NOTHING TO DO, SINCE NO DEFINED SYMBOLS***PCN66 C ELSE [ #***PCN#66 CALL RATLST ( FF, 0 ) CENTER = ( 90 / 2 ) - 6 JUNK = SCOPY ( TITLE, HEAD ( CENTER - 18 ), 40, JUNK ) CALL RATLST ( HEAD, 0 ) CALL RATLST ( BL, 0 ) I = 1 20032 IF(.NOT.( I .LE. LASTP)) GOTO 20034 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 20035 K = 1 20035 CONTINUE IF(.NOT.( ( LEN1 + LEN2 ) .GT. ( 90 - 3 ) )) GOTO 20037 LINE = 32767 20037 CONTINUE CONTINUE L = 1 20039 IF(.NOT.( L .LT. K)) GOTO 20041 BUFR ( L ) = 32 20040 L = L + 1 GOTO 20039 20041 CONTINUE JUNK = SCOPY ( TABLE ( J ), BUFR ( K ), 70, JUNK ) IF(.NOT.( LINE .EQ. I )) GOTO 20042 L = K + LEN1 + 3 GOTO 20043 20042 CONTINUE L = 90 - LEN2 20043 CONTINUE IF(.NOT.( TABLE ( J + 1 + LEN1 ) .EQ. - 9 )) GOTO 20044 J = J + 1 20044 CONTINUE JUNK = SCOPY ( TABLE ( J + 1 + LEN1 ), BUFR ( L ), 70, JUNK ) BUFR ( K + LEN1 ) = 32 BUFR ( K + LEN1 + 1 ) = 61 BUFR ( K + LEN1 + 2 ) = 32 CALL RATLST ( BUFR, LINE ) C ] #***PCN66 20033 I = I + 1 GOTO 20032 20034 CONTINUE LEN1 = SCOPY ( HOW, BUFR, 30, JUNK ) JUNK = SITOC ( LASTP, BUFR ( LEN1 + 1 ), 5 ) LEN1 = SJOIN ( BUFR, SYMB, 90, JUNK ) LEN1 = SJOIN ( BUFR, MUCH, 90, JUNK ) JUNK = SITOC ( 200, BUFR ( LEN1 + 1 ), 6 ) LEN1 = SJOIN ( BUFR, ANDIT, 90, JUNK ) JUNK = SITOC ( LASTT, BUFR ( LEN1 + 1 ), 6 ) LEN1 = SJOIN ( BUFR, CHARS, 90, JUNK ) LEN1 = SJOIN ( BUFR, MUCH, 90, JUNK ) JUNK = SITOC ( 1900, BUFR ( LEN1 + 1 ), 6 ) CALL RATLST ( BUFR, 0 ) C RETURN END C C DEFMAC - TO PROCESS MACRO CALLS (WITH ARGUMENT) C SYKES DEC76 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 C 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 SUBROUTINE DEFMAC ( DEFN, FD ) C INTEGER FD, I, NLPAR, SLEN LOGICAL * 1 DEFN ( 70 ), TOKEN ( 70 ), GTOK C IF(.NOT.( DEFN ( 1 ) .EQ. - 9 )) GOTO 20046 IF(.NOT.( GTOK ( TOKEN, 70, FD ) .NE. 40 )) GOTO 20048 CALL SYNERR ( 14HNO ( IN MACRO. ) CALL PBSTR ( TOKEN ) RETURN 20048 CONTINUE NLPAR = 1 CONTINUE I = 1 20050 IF(.NOT.( NLPAR .GT. 0)) GOTO 20052 IF(.NOT.( I .GT. 70 )) GOTO 20053 CALL SYNERR ( 24HMACRO ARGUMENT TOO LONG. ) RETURN 20053 CONTINUE IF(.NOT.( NGETCH ( TOKEN ( I ), FD ) .EQ. - 3 .OR. TOKEN ( I ) $.EQ. 10 )) GOTO 20055 CALL SYNERR ( 15HMACRO > 1 LINE. ) CALL PUTBAK ( TOKEN ( I ) ) RETURN 20055 CONTINUE CALL LRPAR ( TOKEN ( I ), NLPAR ) 20051 I = I + 1 GOTO 20050 20052 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 ) 20057 IF(.NOT.( I .GT. 1)) GOTO 20059 IF(.NOT.( DEFN ( I ) .EQ. 36 )) GOTO 20060 CALL PBSTR ( TOKEN ) GOTO 20061 20060 CONTINUE CALL PUTBAK ( DEFN ( I ) ) 20061 CONTINUE 20058 I = I - 1 GOTO 20057 20059 CONTINUE GOTO 20047 20046 CONTINUE CALL PBSTR ( DEFN ) 20047 CONTINUE RETURN END C C DEFTOK - GET TOKEN; PROCESS MACRO CALLS AND INVOCATIONS C SYKES,OCT76; 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 LOGICAL FUNCTION DEFTOK * 1 ( TOKEN, TOKSIZ, FD, ALF ) C INTEGER FD, TOKSIZ, ALF, LOOKFR LOGICAL * 1 DEFN ( 70 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE C ALF = 0 T = GTOK ( TOKEN, TOKSIZ, FD ) 20062 IF(.NOT.( T .NE. - 3)) GOTO 20064 IF(.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( 1 ) ) .NE. - 30 )) $GOTO 20065 GOTO 20064 20065 CONTINUE CALL UNFOLD ( TOKEN ) ALF = 1 IF(.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20067 GOTO 20064 20067 CONTINUE CALL DEFMAC ( DEFN, FD ) 20068 CONTINUE 20063 T = GTOK ( TOKEN , TOKSIZ , FD ) GOTO 20062 20064 CONTINUE DEFTOK = T C RETURN END C C DOCODE - GENERATE CODE FOR BEGINNING OF 'DO' STATEMENT C SUBROUTINE DOCODE ( LAB ) C INTEGER LABGEN, LAB C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 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 20069 CALL OUTSTR ( DOSTRL ) GOTO 20070 20069 CONTINUE CALL OUTSTR ( DOSTRU ) 20070 CONTINUE LAB = LABGEN ( 2 ) CALL OUTNUM ( LAB ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20071 CALL OUTCH ( 32 ) 20071 CONTINUE CALL EATUP CALL OUTDON C RETURN END C C EATUP - PROCESS REST OF A STATEMENT; INTERPRET CONTINUATIONS C ***PCN # 21 C SUBROUTINE EATUP C LOGICAL * 1 PTOKEN ( 70 ), T, TOKEN ( 70 ), GETTOK INTEGER NLPAR C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C NLPAR = 0 20073 CONTINUE T = GETTOK ( TOKEN, 70 ) IF(.NOT.( T .EQ. 59 .OR. T .EQ. 10 )) GOTO 20076 GOTO 20075 20076 CONTINUE IF(.NOT.( T .EQ. 125 )) GOTO 20078 CALL PBSTR ( TOKEN ) GOTO 20075 20078 CONTINUE IF(.NOT.( T .EQ. 123 .OR. T .EQ. - 3 )) GOTO 20080 IF(.NOT.( NLPAR .GT. 0 )) GOTO 20082 CALL SYNERR ( 24HUNEXPECTED BRACE OR EOF. ) 20082 CONTINUE CALL PBSTR ( TOKEN ) GOTO 20075 20080 CONTINUE IF(.NOT.( T .EQ. 44 .OR. T .EQ. 95 )) GOTO 20084 IF(.NOT.( GETTOK ( PTOKEN, 70 ) .NE. 10 )) GOTO 20086 CALL PBSTR ( PTOKEN ) 20086 CONTINUE IF(.NOT.( T .EQ. 95 )) GOTO 20088 TOKEN ( 1 ) = 0 20088 CONTINUE GOTO 20085 20084 CONTINUE CALL LRPAR ( T, NLPAR ) 20085 CONTINUE IF(.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20090 CALL OUTCH ( 32 ) 20090 CONTINUE CALL OUTSTR ( TOKEN ) 20074 IF(.NOT.( NLPAR .LT. 0 )) GOTO 20073 20075 CONTINUE C IF(.NOT.( NLPAR .NE. 0 )) GOTO 20092 CALL SYNERR ( 15HUNBALANCED ( ). ) C 20092 CONTINUE RETURN END 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 SUBROUTINE ELSEIF ( LAB, LAST ) 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 20094 CALL OUTGO ( LAB + 1 ) 20094 CONTINUE CALL OUTCON ( LAB ) C RETURN END C C ENDCOD - FORCE LISTING PAGE ADVANCE AFTER FORTRAN 'END' STATEMENT C SYKES,OCT76 C SUBROUTINE ENDCOD ( LEXSTR, SP ) C INTEGER SLEN, SP LOGICAL * 1 LEXSTR ( 1 ), PTOK ( 70 ), GETTOK C C CFILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG C IF(.NOT.( 3 .EQ. SLEN ( LEXSTR ) .AND. GETTOK ( PTOK, 70 ) .EQ. $10 )) GOTO 20096 CALL OUTTAB CALL OUTSTR ( LEXSTR ) CALL OUTDON C IF(.NOT.( SP .NE. 1 )) GOTO 20098 CALL SYNERR ( 38HMISSING CLAUSE OR BRACE IN ABOVE PROG. ) SP = 1 C 20098 CONTINUE PLINE = 9999 CALL OUTCH ( 12 ) CALL OUTDON GOTO 20097 20096 CONTINUE CALL OTHERC ( LEXSTR ) 20097 CONTINUE CALL PBSTR ( PTOK ) C RETURN END C C ENDSTR - DUMP PENDING STRING DEFINITIONS C SYKES,MAR77 C SUBROUTINE ENDSTR C INTEGER J, K, SLEN C C CFILE= CSTR.RAT FOR RATFOR COMMON / CSTR / LASTS, LASTR, STRPTR ( 12 ), TABLES ( 150 ) INTEGER LASTS INTEGER LASTR INTEGER STRPTR LOGICAL * 1 TABLES C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 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 20100 IF(.NOT.( K .LE. LASTS)) GOTO 20102 CALL OUTTAB IF(.NOT.( LC .EQ. 1 )) GOTO 20103 CALL OUTSTR ( DATAL ) GOTO 20104 20103 CONTINUE CALL OUTSTR ( DATAU ) 20104 CONTINUE J = STRPTR ( K ) CALL OUTSTR ( TABLES ( J ) ) CALL OUTCH ( 47 ) CONTINUE J = J + SLEN ( TABLES ( J ) ) + 1 20105 IF(.NOT.( TABLES ( J ) .NE. 0)) GOTO 20107 CALL OUTCH ( 49 ) IF(.NOT.( LC .EQ. 1 )) GOTO 20108 CALL OUTCH ( 104 ) GOTO 20109 20108 CONTINUE CALL OUTCH ( 72 ) 20109 CONTINUE CALL OUTCH ( TABLES ( J ) ) CALL OUTCH ( 44 ) 20106 J = J + 1 GOTO 20105 20107 CONTINUE CALL OUTNUM ( 0 ) CALL OUTCH ( 47 ) CALL OUTDON 20101 K = K + 1 GOTO 20100 20102 CONTINUE LASTS = 0 LASTR = 0 C RETURN END C C FORCOD - GENERATE CODE FOR THE BEGINNING OF 'FOR' STATEMENT C ***PCN # 21 C SUBROUTINE FORCOD ( LAB, SP ) C LOGICAL * 1 T, TOKEN ( 70 ), GETTOK INTEGER SLEN, LABGEN INTEGER I, J, LAB, NLPAR, SP, JUNK, SCOPY C C CFILE = CFOR.RAT FOR RATFOR.RAT COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN INTEGER FORDEP LOGICAL * 1 FORSTK INTEGER FORLEN C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LAB = LABGEN ( 3 ) IF(.NOT.( SP .GT. 1 )) GOTO 20110 CALL OUTCON ( 0 ) C 20110 CONTINUE IF(.NOT.( GETTOK ( TOKEN, 70 ) .NE. 40 )) GOTO 20112 CALL SYNERR ( 18HMISSING ( IN FOR. ) RETURN 20112 CONTINUE IF(.NOT.( GETTOK ( TOKEN, 70 ) .NE. 59 )) GOTO 20114 CALL PBSTR ( TOKEN ) CALL OUTTAB CALL EATUP CALL OUTDON 20114 CONTINUE IF(.NOT.( GETTOK ( TOKEN, 70 ) .EQ. 59 )) GOTO 20116 CALL OUTCON ( LAB ) GOTO 20117 20116 CONTINUE CALL PBSTR ( TOKEN ) CALL OUTNUM ( LAB ) CALL OUTIF CALL OUTCH ( 40 ) NLPAR = 0 CONTINUE 20118 IF(.NOT.( NLPAR .GE. 0 )) GOTO 20119 T = GETTOK ( TOKEN, 70 ) IF(.NOT.( T .EQ. 59 )) GOTO 20120 GOTO 20119 20120 CONTINUE CALL LRPAR ( T, NLPAR ) 20121 CONTINUE IF(.NOT.( T .NE. 10 .AND. T .NE. 95 )) GOTO 20122 IF(.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20124 CALL OUTCH ( 32 ) 20124 CONTINUE CALL OUTSTR ( TOKEN ) 20122 CONTINUE GOTO 20118 20119 CONTINUE CALL OUTCH ( 41 ) CALL OUTCH ( 41 ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20126 CALL OUTCH ( 32 ) 20126 CONTINUE CALL OUTGO ( LAB + 2 ) IF(.NOT.( NLPAR .LT. 0 )) GOTO 20128 CALL SYNERR ( 19HINVALID FOR CLAUSE. ) 20128 CONTINUE 20117 CONTINUE FORDEP = FORDEP + 1 J = FORLEN FORSTK ( J ) = 0 NLPAR = 0 20130 IF(.NOT.( NLPAR .GE. 0 )) GOTO 20131 T = GETTOK ( TOKEN, 70 ) CALL LRPAR ( T, NLPAR ) IF(.NOT.( NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95 )) GOTO $20132 J = J + SLEN ( TOKEN ) IF(.NOT.( J + 2 .GT. 120 )) GOTO 20134 CALL ERROR ( 26HREINIT CLAUSE(S) TOO LONG. ) GOTO 20135 20134 CONTINUE JUNK = SCOPY ( TOKEN, FORSTK ( FORLEN ), 32767, JUNK ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20136 FORSTK ( J ) = 32 J = J + 1 20136 CONTINUE FORSTK ( J ) = 0 FORLEN = J 20135 CONTINUE 20132 CONTINUE GOTO 20130 20131 CONTINUE FORLEN = FORLEN + 1 LAB = LAB + 1 C RETURN END C C FORS - GENERATE CODE FOR END OF 'FOR' STATEMENT C SUBROUTINE FORS ( LAB ) C INTEGER I, J, LAB, SLEN C C CFILE = 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 20138 IF(.NOT.( I .LT. FORDEP)) GOTO 20140 J = J + SLEN ( FORSTK ( J ) ) + 1 20139 I = I + 1 GOTO 20138 20140 CONTINUE IF(.NOT.( SLEN ( FORSTK ( J ) ) .GT. 0 )) GOTO 20141 CALL OUTTAB CALL OUTSTR ( FORSTK ( J ) ) CALL OUTDON 20141 CONTINUE CALL OUTGO ( LAB - 1 ) CALL OUTCON ( LAB + 1 ) FORDEP = FORDEP - 1 FORLEN = J C RETURN END