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 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 ( 96 ), NAME ( 80 ), 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 20000 LASTP = LASTP + 1 NAMPTR ( LASTP ) = LASTT + 1 JUNK = SCOPY ( NAME, TABLE ( LASTT + 1 ), 80, JUNK ) JUNK = SCOPY ( DEFN, TABLE ( LASTT + NLEN + 1 ), 96, JUNK ) LASTT = LASTT + NLEN + DLEN INSTAL = ( 1 ) RETURN 20000 CONTINUE INSTAL = ( - 1 ) RETURN C 20001 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 ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C IF (.NOT.( SLEN ( LEXSTR ) .EQ. 5 )) GOTO 20002 IF (.NOT.( LEXSTR ( 1 ) .EQ. 50 .AND. LEXSTR ( 2 ) .EQ. 48 )) $GOTO 20004 CALL SYNERR ( 47HPOSSIBLE USER/RATFOR STATEMENT NUMBER CONFLICT. $) 20004 CONTINUE 20002 CONTINUE CALL OUTSTR ( LEXSTR ) 20006 IF (.NOT.( OUTP .LT. 6 )) GOTO 20007 CALL OUTCH ( 32 ) GOTO 20006 20007 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 20008 NLPAR = NLPAR + 1 GOTO 20009 20008 CONTINUE IF (.NOT.( TOK .EQ. 41 )) GOTO 20010 NLPAR = NLPAR - 1 C 20010 CONTINUE 20009 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 ( 80 ), 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/ 20012 IF (.NOT.( DEFTOK ( TOKEN, 80 ) .EQ. 10 )) GOTO 20013 GOTO 20012 20013 CONTINUE LEX = TOKEN ( 1 ) IF (.NOT.( LEX .EQ. - 3 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. $LEX .EQ. 125 )) GOTO 20014 RETURN 20014 CONTINUE IF (.NOT.( ALLDIG ( TOKEN ) .EQ. 1 )) GOTO 20016 LEX = - 111 GOTO 20017 20016 CONTINUE IF (.NOT.( SEQL ( TOKEN, SIF ) .EQ. 1 )) GOTO 20018 LEX = - 116 GOTO 20019 20018 CONTINUE IF (.NOT.( SEQL ( TOKEN, SELSE ) .EQ. 1 )) GOTO 20020 LEX = - 113 GOTO 20021 20020 CONTINUE IF (.NOT.( SEQL ( TOKEN, SFOR ) .EQ. 1 )) GOTO 20022 LEX = - 115 GOTO 20023 20022 CONTINUE IF (.NOT.( SEQL ( TOKEN, SWHILE ) .EQ. 1 )) GOTO 20024 LEX = - 121 GOTO 20025 20024 CONTINUE IF (.NOT.( SEQL ( TOKEN, SREPT ) .EQ. 1 )) GOTO 20026 LEX = - 119 GOTO 20027 20026 CONTINUE IF (.NOT.( SEQL ( TOKEN, SDO ) .EQ. 1 )) GOTO 20028 LEX = - 112 GOTO 20029 20028 CONTINUE IF (.NOT.( SEQL ( TOKEN, SUNTIL ) .EQ. 1 )) GOTO 20030 LEX = - 120 GOTO 20031 20030 CONTINUE IF (.NOT.( SEQL ( TOKEN, SBREAK ) .EQ. 1 )) GOTO 20032 LEX = - 110 GOTO 20033 20032 CONTINUE IF (.NOT.( SEQL ( TOKEN, SNEXT ) .EQ. 1 )) GOTO 20034 LEX = - 117 GOTO 20035 20034 CONTINUE IF (.NOT.( SEQL ( TOKEN, SDEFIN ) .EQ. 1 )) GOTO 20036 LEX = - 124 GOTO 20037 20036 CONTINUE IF (.NOT.( SEQL ( TOKEN, SINCL ) .EQ. 1 )) GOTO 20038 LEX = - 129 GOTO 20039 20038 CONTINUE IF (.NOT.( SEQL ( TOKEN, SMACRO ) .EQ. 1 )) GOTO 20040 LEX = - 125 GOTO 20041 20040 CONTINUE IF (.NOT.( SEQL ( TOKEN, SENDIF ) .EQ. 1 )) GOTO 20042 LEX = - 128 GOTO 20043 20042 CONTINUE IF (.NOT.( SEQL ( TOKEN, SIFDEF ) .EQ. 1 )) GOTO 20044 LEX = - 126 GOTO 20045 20044 CONTINUE IF (.NOT.( SEQL ( TOKEN, SIFNOT ) .EQ. 1 )) GOTO 20046 LEX = - 127 GOTO 20047 20046 CONTINUE IF (.NOT.( SEQL ( TOKEN, SSTRNG ) .EQ. 1 )) GOTO 20048 LEX = - 130 GOTO 20049 20048 CONTINUE IF (.NOT.( SEQL ( TOKEN, SEND ) .EQ. 1 )) GOTO 20050 LEX = - 114 GOTO 20051 20050 CONTINUE IF (.NOT.( SEQL ( TOKEN, SRETRN ) .EQ. 1 )) GOTO 20052 LEX = - 122 GOTO 20053 20052 CONTINUE IF (.NOT.( SEQL ( TOKEN, SSTOP ) .EQ. 1 )) GOTO 20054 LEX = - 123 GOTO 20055 20054 CONTINUE LEX = - 118 C 20055 CONTINUE 20053 CONTINUE 20051 CONTINUE 20049 CONTINUE 20047 CONTINUE 20045 CONTINUE 20043 CONTINUE 20041 CONTINUE 20039 CONTINUE 20037 CONTINUE 20035 CONTINUE 20033 CONTINUE 20031 CONTINUE 20029 CONTINUE 20027 CONTINUE 20025 CONTINUE 20023 CONTINUE 20021 CONTINUE 20019 CONTINUE 20017 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 ( 80 ), DEFN ( 96 ) INTEGER I, J, INDX, IT, INC, JUNK, SCOPY C C FILE = CLOOK.RAT FOR RATFOR.RAT COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 250 ), TABLE ( 3000 $) INTEGER LASTP INTEGER TWOS INTEGER LASTT INTEGER NAMPTR LOGICAL * 1 TABLE C INDX = 0 INC = TWOS IF (.NOT.( LASTP .GT. 0 )) GOTO 20056 20058 CONTINUE IT = INC + INDX IF (.NOT.( IT .GT. LASTP )) GOTO 20061 IT = LASTP 20061 CONTINUE I = 1 J = NAMPTR ( IT ) 20063 IF (.NOT.( NAME ( I ) .EQ. TABLE ( J ) )) GOTO 20064 IF (.NOT.( NAME ( I ) .EQ. 0 )) GOTO 20065 JUNK = SCOPY ( TABLE ( J + 1 ), DEFN, 96, JUNK ) LOOKFR = ( 1 ) RETURN 20065 CONTINUE I = I + 1 J = J + 1 20066 CONTINUE GOTO 20063 20064 CONTINUE IF (.NOT.( NAME ( I ) .GT. TABLE ( J ) )) GOTO 20067 IF (.NOT.( IT .EQ. LASTP )) GOTO 20069 GOTO 20060 20069 CONTINUE INDX = IT 20070 CONTINUE 20067 CONTINUE INC = INC / 2 20059 IF (.NOT.( INC .LE. 0 )) GOTO 20058 20060 CONTINUE 20056 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 ( 80 ) C IF (.NOT.( TOKDEF ( TOKEN, 80 ) .NE. - 1 )) GOTO 20071 JUNK = 1 NUM1 = SCTOI ( TOKEN, JUNK ) 20073 IF (.NOT.( NGETCH ( OPR ) .NE. 62 )) GOTO 20074 JUNK = TOKDEF ( TOKEN, 80 ) JUNK = 1 NUM2 = SCTOI ( TOKEN, JUNK ) IF (.NOT.( OPR .EQ. 43 )) GOTO 20075 NUM1 = NUM1 + NUM2 GOTO 20076 20075 CONTINUE IF (.NOT.( OPR .EQ. 45 )) GOTO 20077 NUM1 = NUM1 - NUM2 GOTO 20078 20077 CONTINUE IF (.NOT.( OPR .EQ. 42 )) GOTO 20079 NUM1 = NUM1 * NUM2 GOTO 20080 20079 CONTINUE IF (.NOT.( OPR .EQ. 47 .AND. NUM2 .NE. 0 )) GOTO 20081 NUM1 = NUM1 / NUM2 GOTO 20082 20081 CONTINUE CALL SYNERR ( 36HILLEGAL MATH OPERATOR (TRY + - / *). ) CALL PBSTR ( TOKEN ) RETURN 20082 CONTINUE 20080 CONTINUE 20078 CONTINUE 20076 CONTINUE GOTO 20073 20074 CONTINUE JUNK = SITOC ( NUM1, TOKEN, 80 ) CALL PBSTR ( TOKEN ) C 20071 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 ( 97 ), 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 / 97 /, BUFR ( 97 ) / 10 / C IF (.NOT.( BP .GT. 0 )) GOTO 20083 C = BUF ( BP ) GOTO 20084 20083 CONTINUE BP = 1 IF (.NOT.( BUFR ( LASTC ) .EQ. 10 .OR. LASTC .GE. 97 )) GOTO $20085 LASTC = 0 IF (.NOT.( GETLIN ( BUFR ) .EQ. - 3 )) GOTO 20087 C = - 3 LASTC = 97 BP = 0 NGETCH = ( - 3 ) RETURN 20087 CONTINUE 20085 CONTINUE LASTC = LASTC + 1 IF (.NOT.( BUFR ( LASTC ) .EQ. 0 )) GOTO 20089 BUFR ( LASTC ) = 10 20089 CONTINUE C = BUFR ( LASTC ) 20084 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 LIN C NOTE:AN EVEN NUMBER OF COLUMES (EG 72) OF CODE MUST BE OUTPUT TO KEEP C ADDING SPURIUS SPACES WITHIN QUOTED STRINGS WITH CONTINUATION LINES W C THE ALTERNATE HIGH SPEED VERSION OF STRPUT IS USED. C SUBROUTINE OUTCH ( C ) C LOGICAL * 1 C C C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C IF (.NOT.( OUTP .GE. 72 .OR. OUTP .LT. 0 )) GOTO 20091 CALL OUTDON OUTP = 1 20093 IF (.NOT.( OUTP .LT. 6)) GOTO 20095 OUTBUF ( OUTP ) = 32 20094 OUTP = OUTP + 1 GOTO 20093 20095 CONTINUE OUTBUF ( OUTP ) = 36 20091 CONTINUE OUTP = OUTP + 1 OUTBUF ( OUTP ) = C C RETURN END C$ OUTCON - GENERATE "N CONTINUE" CODE C PCN #106, SEP 80, SUPPRESS UNLABELED 'CONTINUE'S(NO LABEL THERE & NUM C SUBROUTINE OUTCON ( N ) C INTEGER N C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C LOGICAL * 1 CONU (9) LOGICAL * 1 CONL (9) C DATA CONU/1HC,1HO,1HN,1HT,1HI,1HN,1HU,1HE,0/ DATA CONL/1Hc,1Ho,1Hn,1Ht,1Hi,1Hn,1Hu,1He,0/ IF (.NOT.( N .LE. 0 .AND. OUTP .LE. 0 )) GOTO 20096 RETURN 20096 CONTINUE IF (.NOT.( N .GT. 0 )) GOTO 20098 CALL OUTNUM ( N ) 20098 CONTINUE CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20100 CALL OUTSTR ( CONL ) GOTO 20101 20100 CONTINUE CALL OUTSTR ( CONU ) 20101 CONTINUE CALL OUTDON C 20097 CONTINUE RETURN END C C$ OUTDON - FINISH OFF A FORTRAN CODE (OUTPUT) LINE C PCN #77, 5 JAN 80, DELETE 'NEWLINE' CHARACTER AT END OF LINE. C SUBROUTINE OUTDON C C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C IF (.NOT.( OUTP .LT. 0 )) GOTO 20102 OUTP = IABS ( OUTP ) C# OUTBUF(OUTP+1) = NEWLINE #PCN #77 20102 CONTINUE OUTBUF ( OUTP + 1 ) = 0 CALL PUTLIN ( OUTBUF, 7, 0 ) OUTP = 0 C RETURN END C C$ OUTGO - GENERATE "GOTO N" CODE C PCN#56, 14 APR 79, DROP BLANK AFTER 'GOTO' IF COMPRESSING C SUBROUTINE OUTGO ( N ) C INTEGER N C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 GOTOU (5) LOGICAL * 1 GOTOL (5) C DATA GOTOU/1HG,1HO,1HT,1HO,0/ DATA GOTOL/1Hg,1Ho,1Ht,1Ho,0/ CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20104 CALL OUTSTR ( GOTOL ) GOTO 20105 20104 CONTINUE CALL OUTSTR ( GOTOU ) 20105 CONTINUE IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20106 CALL OUTCH ( 32 ) 20106 CONTINUE CALL OUTNUM ( N ) CALL OUTDON C RETURN END C C$ OUTIF - GENERATE "IF (.NOT." CODE FOR 'FOR' AND 'IF' STATEMENTS C SYKES,18FEB77 C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING C PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT C SUBROUTINE OUTIF C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C C LOGICAL * 1 IFNOTU (10) LOGICAL * 1 IFNOTL (10) C DATA IFNOTU/1HI,1HF,1H ,1H(,1H.,1HN,1HO,1HT,1H.,0/ DATA IFNOTL/1Hi,1Hf,1H ,1H(,1H.,1Hn,1Ho,1Ht,1H.,0/ CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20108 CALL OUTSTR ( IFNOTL ) GOTO 20109 20108 CONTINUE CALL OUTSTR ( IFNOTU ) C 20109 CONTINUE IFTYP = 1 C RETURN END C C C$ OUTNUM - OUTPUT DECIMAL NUMBER TO FORTRAN CODE FILE C SUBROUTINE OUTNUM ( N ) C LOGICAL * 1 CHARS ( 8 ) INTEGER JUNK, LEN, N, SITOC C JUNK = SITOC ( N, CHARS, 8 ) CALL OUTSTR ( CHARS ) C RETURN END C C$ OUTSTR - OUTPUT A STRING TO FORTRAN CODE C ALSO CONVERT DOUBLE QUOTED STRINGS TO HOLLERITH. C PASS SINGLE QUOTED STRINGS UNPROCESSED. C SUBROUTINE OUTSTR ( STR ) C LOGICAL * 1 C, STR ( 1 ), CHARS ( 8 ) INTEGER I, J, SLEN, LEN, K, SITOC C C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C I = SLEN ( STR ) IF (.NOT.( ( OUTP + I .GE. 72 ) .AND. ( OUTP .GT. 6 ) )) GOTO $20110 OUTP = - OUTP 20110 CONTINUE I = 1 20112 IF (.NOT.( STR ( I ) .NE. 0)) GOTO 20114 C = STR ( I ) IF (.NOT.( C .NE. 34 )) GOTO 20115 CALL OUTCH ( C ) GOTO 20116 20115 CONTINUE I = I + 1 J = I 20117 IF (.NOT.( STR ( J ) .NE. C)) GOTO 20119 20118 J = J + 1 GOTO 20117 20119 CONTINUE LEN = SITOC ( J - I, CHARS, 8 ) K = 1 20120 IF (.NOT.( K .LE. LEN)) GOTO 20122 CALL OUTCH ( CHARS ( K ) ) 20121 K = K + 1 GOTO 20120 20122 CONTINUE IF (.NOT.( LC .EQ. 1 )) GOTO 20123 CALL OUTCH ( 104 ) GOTO 20124 20123 CONTINUE CALL OUTCH ( 72 ) 20124 CONTINUE 20125 IF (.NOT.( I .LT. J)) GOTO 20127 CALL OUTCH ( STR ( I ) ) 20126 I = I + 1 GOTO 20125 20127 CONTINUE 20116 CONTINUE C 20113 I = I + 1 GOTO 20112 20114 CONTINUE RETURN END C C$ OUTTAB - GENERATE A TAB AT BEGINNING OF FORTRAN LINE C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING C SUBROUTINE OUTTAB C C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF 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 20128 IF (.NOT.( OUTP .LT. 6 )) GOTO 20129 CALL OUTCH ( 32 ) C GOTO 20128 20129 CONTINUE IF (.NOT.( OUTP .EQ. 6 )) GOTO 20130 FTNLN = FTNLN + 1 C 20130 CONTINUE RETURN END C C$ PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE C PCN # 93, 17 FEB 80, MOVE FINDING PROCESSOR FEATURES HERE FROM GETTOK. C PCN #92, 20 FEB 80, ADD RETURN (EXPRESSION). C PCN #109, 1 OCT 80, CHANGE DATA TYPE OF 'LAST' TO INTEGER. C SUBROUTINE PARSE C LOGICAL * 1 LEXSTR ( 80 ) INTEGER LEX, STRNGS, LAST INTEGER LAB, LABVAL ( 120 ), LEXTYP ( 120 ), SP, TOK DATA STRNGS / 0 / C SP = 1 LEXTYP ( 1 ) = - 3 TOK = LEX ( LEXSTR ) 20132 IF (.NOT.( TOK .NE. - 3)) GOTO 20134 IF (.NOT.( STRNGS .EQ. 1 .AND. TOK .NE. - 130 .AND. TOK .NE. 59 )) $ GOTO 20135 CALL ENDSTR STRNGS = 0 20135 CONTINUE IF (.NOT.( TOK .EQ. - 116 )) GOTO 20137 CALL IFCODE ( LAB ) GOTO 20138 20137 CONTINUE IF (.NOT.( TOK .EQ. - 115 )) GOTO 20139 CALL FORCOD ( LAB, SP ) GOTO 20140 20139 CONTINUE IF (.NOT.( TOK .EQ. - 119 )) GOTO 20141 CALL REPCOD ( LAB, SP ) GOTO 20142 20141 CONTINUE IF (.NOT.( TOK .EQ. - 124 .OR. TOK .EQ. - 125 )) GOTO 20143 CALL ADDDEF ( LEXSTR, 80 ) GOTO 20144 20143 CONTINUE IF (.NOT.( TOK .EQ. - 112 )) GOTO 20145 CALL DOCODE ( LAB ) GOTO 20146 20145 CONTINUE IF (.NOT.( TOK .EQ. - 121 )) GOTO 20147 CALL WHILEC ( LAB, SP ) GOTO 20148 20147 CONTINUE IF (.NOT.( TOK .EQ. - 111 )) GOTO 20149 CALL LABELC ( LEXSTR ) GOTO 20150 20149 CONTINUE IF (.NOT.( TOK .EQ. - 114 )) GOTO 20151 CALL ENDCOD ( LEXSTR, SP ) GOTO 20152 20151 CONTINUE IF (.NOT.( TOK .EQ. - 128 )) GOTO 20153 GOTO 20154 20153 CONTINUE IF (.NOT.( TOK .EQ. - 126 )) GOTO 20155 CALL IFDEFC ( 1 ) GOTO 20156 20155 CONTINUE IF (.NOT.( TOK .EQ. - 127 )) GOTO 20157 CALL IFDEFC ( 0 ) GOTO 20158 20157 CONTINUE IF (.NOT.( TOK .EQ. - 129 )) GOTO 20159 CALL OPENI GOTO 20160 20159 CONTINUE IF (.NOT.( TOK .EQ. - 130 )) GOTO 20161 STRNGS = 1 CALL STRNGC GOTO 20162 20161 CONTINUE IF (.NOT.( TOK .EQ. - 113 )) GOTO 20163 IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20165 CALL ELSE IF ( LABVAL ( SP ), LAST ) GOTO 20166 20165 CONTINUE CALL SYNERR ( 13HILLEGAL ELSE. ) 20166 CONTINUE C CPCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR) 20163 CONTINUE 20162 CONTINUE 20160 CONTINUE 20158 CONTINUE 20156 CONTINUE 20154 CONTINUE 20152 CONTINUE 20150 CONTINUE 20148 CONTINUE 20146 CONTINUE 20144 CONTINUE 20142 CONTINUE 20140 CONTINUE 20138 CONTINUE IF (.NOT.( TOK .NE. 125 )) GOTO 20167 LAST = TOK C 20167 CONTINUE IF (.NOT.( TOK .EQ. - 116 .OR. TOK .EQ. - 113 .OR. TOK .EQ. - 121 $ .OR. TOK .EQ. - 115 .OR. TOK .EQ. - 119 .OR. TOK .EQ. - 112 $.OR. TOK .EQ. - 111 .OR. TOK .EQ. 123 )) GOTO 20169 SP = SP + 1 IF (.NOT.( SP .GT. 120 )) GOTO 20171 CALL ERROR ( 45HSTACK OVERFLOW IN PARSER (INCREASE MAXSTACK). ) 20171 CONTINUE LEXTYP ( SP ) = TOK LABVAL ( SP ) = LAB GOTO 20170 20169 CONTINUE IF (.NOT.( TOK .EQ. 125 )) GOTO 20173 IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20175 SP = SP - 1 GOTO 20176 20175 CONTINUE CALL SYNERR ( 10HILLEGAL ]. ) 20176 CONTINUE GOTO 20174 20173 CONTINUE IF (.NOT.( TOK .EQ. - 118 .OR. TOK .EQ. - 123 )) GOTO 20177 CALL OTHERC ( LEXSTR ) GOTO 20178 20177 CONTINUE IF (.NOT.( TOK .EQ. - 122 )) GOTO 20179 CALL RETCOD ( LEXSTR ) GOTO 20180 20179 CONTINUE IF (.NOT.( TOK .EQ. - 110 .OR. TOK .EQ. - 117 )) GOTO 20181 CALL BRKNXT ( SP, LEXTYP, LABVAL, TOK ) C 20181 CONTINUE 20180 CONTINUE 20178 CONTINUE 20174 CONTINUE TOK = LEX ( LEXSTR ) CALL PBSTR ( LEXSTR ) CALL UNSTAK ( SP, LEXTYP, LABVAL, TOK, LAST ) 20170 CONTINUE C 20133 TOK = LEX ( LEXSTR ) GOTO 20132 20134 CONTINUE RETURN END C C$ PBSTR - PUSH STRING BACK ONTO INPUT FOR LATER RE-INPUT C SUBROUTINE PBSTR ( IN ) C LOGICAL * 1 IN ( 1 ) INTEGER I, SLEN C I = SLEN ( IN ) 20183 IF (.NOT.( I .GT. 0)) GOTO 20185 CALL PUTBAK ( IN ( I ) ) C 20184 I = I - 1 GOTO 20183 20185 CONTINUE RETURN END C C$ PUTBAK - PUSH CHARACTER BACK ONTO INPUT FOR LATER RE-RETRIVAL C SUBROUTINE PUTBAK ( C ) C LOGICAL * 1 C C C FILE = CDEFIO.RAT FOR RATFOR.RAT COMMON / CDEFIO / BP, BUF ( 160 ) INTEGER BP LOGICAL * 1 BUF C BP = BP + 1 IF (.NOT.( BP .GT. 160 )) GOTO 20186 CALL ERROR ( 43HPUSHBACK STACK OVERFLOW (INCREASE BUFSIZE). ) GOTO 20187 20186 CONTINUE BUF ( BP ) = C C 20187 CONTINUE RETURN END C C$ RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG (FORTRAN) FORM CSYKES, 20 NOV 76 C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD && FOR .EQV. C PCN #77, 5 JAN 80, USE FOLD TO GET LOWER CASE VERSIONS, IF NEEDED C PCN #87, 10 FEB 80, ALLOW << AND >> FOR < AND >. C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER. C SUBROUTINE RELATE ( TOKEN, LAST ) C LOGICAL * 1 NGETCH, DOTS ( 6, 11 ), TOKEN ( 1 ), NEXTCH, THISCH INTEGER LAST, LINE, JUNK, SCOPY C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C DATA DOTS / 46, 71, 69, 46, 0, 0, 46, 71, 84, 46, 0, 0, 46, 76, $69, 46, 0, 0, 46, 76, 84, 46, 0, 0, 46, 78, 69, 46, 0, 0, 46, 78, $79, 84, 46, 0, 46, 69, 81, 46, 0, 0, 46, 65, 78, 68, 46, 0, 46, $79, 82, 46, 0, 0, 46, 88, 79, 82, 46, 0, 46, 69, 81, 86, 46, 0 / C LINE = 0 THISCH = TOKEN ( 1 ) NEXTCH = NGETCH ( NEXTCH ) IF (.NOT.( THISCH .EQ. 62 )) GOTO 20188 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20190 LINE = 1 GOTO 20191 20190 CONTINUE IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20192 LINE = 5 GOTO 20193 20192 CONTINUE IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20194 LINE = 2 GOTO 20195 20194 CONTINUE LINE = 2 CALL PUTBAK ( NEXTCH ) 20195 CONTINUE 20193 CONTINUE 20191 CONTINUE GOTO 20189 20188 CONTINUE IF (.NOT.( THISCH .EQ. 60 )) GOTO 20196 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20198 LINE = 3 GOTO 20199 20198 CONTINUE IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20200 LINE = 5 GOTO 20201 20200 CONTINUE IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20202 LINE = 4 GOTO 20203 20202 CONTINUE LINE = 4 CALL PUTBAK ( NEXTCH ) 20203 CONTINUE 20201 CONTINUE 20199 CONTINUE GOTO 20197 20196 CONTINUE IF (.NOT.( THISCH .EQ. 33 )) GOTO 20204 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20206 LINE = 5 GOTO 20207 20206 CONTINUE LINE = 6 CALL PUTBAK ( NEXTCH ) 20207 CONTINUE GOTO 20205 20204 CONTINUE IF (.NOT.( THISCH .EQ. 61 )) GOTO 20208 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20210 LINE = 7 GOTO 20211 20210 CONTINUE CALL PUTBAK ( NEXTCH ) 20211 CONTINUE GOTO 20209 20208 CONTINUE IF (.NOT.( THISCH .EQ. 38 )) GOTO 20212 IF (.NOT.( NEXTCH .EQ. 38 )) GOTO 20214 LINE = 11 GOTO 20215 20214 CONTINUE LINE = 8 CALL PUTBAK ( NEXTCH ) 20215 CONTINUE GOTO 20213 20212 CONTINUE IF (.NOT.( THISCH .EQ. 124 )) GOTO 20216 IF (.NOT.( NEXTCH .EQ. 124 .OR. NEXTCH .EQ. 92 )) GOTO 20218 LINE = 10 GOTO 20219 20218 CONTINUE LINE = 9 CALL PUTBAK ( NEXTCH ) C 20219 CONTINUE 20216 CONTINUE 20213 CONTINUE 20209 CONTINUE 20205 CONTINUE 20197 CONTINUE 20189 CONTINUE IF (.NOT.( LINE .GT. 0 )) GOTO 20220 LAST = SCOPY ( DOTS ( 1, LINE ), TOKEN, 10, JUNK ) IF (.NOT.( LC .EQ. 1 )) GOTO 20222 CALL FOLD ( TOKEN ) 20222 CONTINUE GOTO 20221 20220 CONTINUE TOKEN ( 2 ) = 0 LAST = 1 20221 CONTINUE RETURN END C C$ REPCOD - GENERATE CODE FOR BEGINNING OF 'REPEAT' C SUBROUTINE REPCOD ( LAB, SP ) C INTEGER LAB, SP, LABGEN C IF (.NOT.( SP .GT. 1 )) GOTO 20224 CALL OUTCON ( 0 ) 20224 CONTINUE LAB = LABGEN ( 3 ) CALL OUTCON ( LAB ) LAB = LAB + 1 C RETURN END C C$ RETCOD - PROCESS RETURN (EXPRESSION) C PCN #92, 20 FEB 80, C SUBROUTINE RETCOD ( LEXSTR ) C LOGICAL * 1 LEXSTR ( 80 ), TOKEN ( 80 ), GTOK C C FILE=CFUNC.RAT FOR RATFOR COMMON / CFUNC / INFUNC, FNAM ( 80 ) INTEGER INFUNC LOGICAL * 1 FNAM C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C IF (.NOT.( INFUNC .EQ. 1 .AND. GTOK ( TOKEN, 80 ) .EQ. 40 )) GOTO $20226 CALL PBSTR ( TOKEN ) CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20228 CALL FOLD ( FNAM ) 20228 CONTINUE CALL OUTSTR ( FNAM ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20230 CALL OUTCH ( 32 ) 20230 CONTINUE CALL OUTCH ( 61 ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20232 CALL OUTCH ( 32 ) 20232 CONTINUE CALL BALPAR CALL OUTDON IF (.NOT.( LC .EQ. 1 )) GOTO 20234 CALL FOLD ( LEXSTR ) 20234 CONTINUE CALL OTHERC ( LEXSTR ) GOTO 20227 20226 CONTINUE CALL PBSTR ( TOKEN ) CALL OTHERC ( LEXSTR ) C 20227 CONTINUE RETURN END C C$ STRNGC - GENERATE FIRST PART OF CODE FOR 'STRING' KEYWORD CSYKES 15OCT76, 12MAR77 C PCN # 21, 10 DEC 77 C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS C PCN # 93, 17 FEB 80, CALL FROM PARSE, CHANGE CALLING SEQ. C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER. CASSUMES THAT THE TARGET COMPILER ALLOWS MULTIPLE ELEMENT SPECIFICATION C IN DATA STATEMENTS . CTHE STRING KEYWORDS MUST BE POSITIONED AFTER ALL OTHER FORTRAN C SPECIFICATION STATEMENTS, EXCEPT FOR ANY DATA STATEMENTS. CEACH "STRING FOO "BLATS"" LINE CAUSES IMMEDIATE OUTPUT OF A C "CHARACTER FOO(4)" LINE AND A "DATA FOO/.../" LINE IS HELD UNTIL C ALL STRING LINES HAVE BEEN PROCESSED, THEN INSERTED BEFORE THE C FIRST NON-STRING LINE, SO THAT ALL DATA STATEMENTS ARE AT THE C BOTTOM OF THE SPECIFICATION STATEMENTS. C SUBROUTINE STRNGC C C LOGICAL * 1 TOKEN ( 80 ), NAME ( 80 ) LOGICAL * 1 DEFTOK INTEGER J, LEN, JUNK, INSTAL C C FILE= CSTR.RAT FOR RATFOR COMMON / CSTR / LASTS, LASTR, STRPTR ( 35 ), TABLES ( 400 ) INTEGER LASTS INTEGER LASTR INTEGER STRPTR LOGICAL * 1 TABLES C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 CHAR (10) C DATA CHAR/1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,0/ CALL PUTBAK ( 12 ) CALL PBSTR ( CHAR ) CALL OUTTAB 20236 IF (.NOT.( DEFTOK ( TOKEN, 80 ) .NE. 12 )) GOTO 20237 CALL OUTSTR ( TOKEN ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20238 CALL OUTCH ( 32 ) 20238 CONTINUE GOTO 20236 20237 CONTINUE IF (.NOT.( ( DEFTOK ( NAME, 80 ) .NE. - 100 ) .OR. ( DEFTOK ( $TOKEN, 80 ) .NE. 34 ) )) GOTO 20240 CALL SYNERR ( 22HILLEGAL STRING SYNTAX. ) RETURN 20240 CONTINUE CALL OUTSTR ( NAME ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20242 CALL OUTCH ( 32 ) 20242 CONTINUE CALL OUTCH ( 40 ) LEN = 2 20244 IF (.NOT.( TOKEN ( LEN ) .NE. 34)) GOTO 20246 20245 LEN = LEN + 1 GOTO 20244 20246 CONTINUE CALL OUTNUM ( LEN - 1 ) CALL OUTCH ( 41 ) CALL OUTDON TOKEN ( LEN ) = 0 C C FILE THE ARRAY NAME AND THE STRING DEFINITION AWAY FOR FUTURE DUMPING IF (.NOT.( INSTAL ( NAME, TOKEN ( 2 ), LASTS, LASTR, STRPTR, 400, $35, TABLES ) .EQ. - 1 )) GOTO 20247 CALL SYNERR ( 44HTOO MANY STRINGS (INCREASE MAXSTR & NUMSTR). ) C C C 20247 CONTINUE RETURN END C C$ TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH' CSYKES, APR77, C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER. C PCN 109, 1 OCT 80, FIX TYPO IN GTOK CALL C USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH'. THIS MAKE C SURE THAT SYMBOLS WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING C MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLI C CONSTANTS DEFINED AS NEGATIVE INTEGERS, WHICH ARE RETURNED AS A C SINGLE TOKEN INSTEAD OF TWO TOKENS. C LOGICAL FUNCTION TOKDEF * 1 ( TOKEN, TOKSIZ ) C INTEGER TOKSIZ, LOOKFR, SUB LOGICAL * 1 DEFN ( 96 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE C SUB = 1 T = GTOK ( TOKEN ( SUB ), TOKSIZ ) 20249 IF (.NOT.( T .NE. - 3)) GOTO 20251 IF (.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( SUB ) ) .NE. - 30 )) $GOTO 20252 IF (.NOT.( T .EQ. 45 )) GOTO 20254 SUB = 2 GOTO 20250 20254 CONTINUE GOTO 20251 20255 CONTINUE 20252 CONTINUE CALL UNFOLD ( TOKEN ) IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20256 CALL SYNERR ( 38HUNDEFINED SYMBOLIC CONSTANT IN . ) TOKDEF = ( - 1 ) RETURN 20256 CONTINUE CALL PBSTR ( DEFN ) 20257 CONTINUE 20250 T = GTOK ( TOKEN ( SUB ) , TOKSIZ ) GOTO 20249 20251 CONTINUE TOKDEF = ( 1 ) RETURN C END C C$ UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT C PCN # 16, 14 NOV 77 C PCN 93, 16 FEB 80, MOVE FEATURE FINDING FROM GETTOK TO PARSE/LEX C PCN 109, 1 OCT 80, CHANGE DATA TYPE OF LAST TO INTEGER. C SUBROUTINE UNSTAK ( SP, LEXTYP, LABVAL, TOKEN, LAST ) C INTEGER LABVAL ( 120 ), LEXTYP ( 120 ), SP, TOKEN, LAST C IF (.NOT.( TOKEN .NE. - 127 .AND. TOKEN .NE. - 126 .AND. TOKEN $.NE. - 128 .AND. TOKEN .NE. - 129 )) GOTO 20258 20260 IF (.NOT.( SP .GT. 1)) GOTO 20262 IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20263 GOTO 20262 20263 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 .AND. TOKEN .EQ. - 113 )) $GOTO 20265 GOTO 20262 20265 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20267 CALL OUTCON ( LABVAL ( SP ) ) LAST = 32 GOTO 20268 20267 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 113 )) GOTO 20269 IF (.NOT.( SP .GT. 2 )) GOTO 20271 SP = SP - 1 20271 CONTINUE CALL OUTCON ( LABVAL ( SP ) + 1 ) LAST = 32 GOTO 20270 20269 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 112 )) GOTO 20273 CALL OUTCON ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20274 20273 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 121 )) GOTO 20275 CALL OUTGO ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20276 20275 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 115 )) GOTO 20277 CALL FORS ( LABVAL ( SP ) ) GOTO 20278 20277 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 119 )) GOTO 20279 CALL UNTILS ( LABVAL ( SP ), TOKEN ) 20279 CONTINUE 20278 CONTINUE 20276 CONTINUE 20274 CONTINUE 20270 CONTINUE 20268 CONTINUE 20266 CONTINUE 20264 CONTINUE 20261 SP = SP - 1 GOTO 20260 20262 CONTINUE C 20258 CONTINUE RETURN END C C$ UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO RATFOR LISTING C SUBROUTINE UNTILS ( LAB, TOKEN ) C LOGICAL * 1 PTOKEN ( 80 ) INTEGER JUNK, LAB, TOKEN, LEX C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C CALL OUTNUM ( LAB ) IF (.NOT.( TOKEN .EQ. - 120 )) GOTO 20281 JUNK = LEX ( PTOKEN ) CALL IFGO ( LAB - 1 ) FORTYP = 1 GOTO 20282 20281 CONTINUE CALL OUTGO ( LAB - 1 ) 20282 CONTINUE CALL OUTCON ( LAB + 1 ) C RETURN END C C$ WHILEC - GENERATE CODE FOR BEGINNING OF 'WHILE' STATEMENTS C SUBROUTINE WHILEC ( LAB, SP ) C INTEGER LAB, SP, LABGEN C IF (.NOT.( SP .GT. 1 )) GOTO 20283 CALL OUTCON ( 0 ) 20283 CONTINUE LAB = LABGEN ( 2 ) CALL OUTNUM ( LAB ) CALL IFGO ( LAB + 1 ) C RETURN END