C FILE= RAT3.RAT C$ **** THIRD PART OF NON-SYSTEM SPECIFIC PARTS OF RATFOR C 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$ OUTCON - GENERATE "N CONTINUE" CODE C SUBROUTINE OUTCON ( N ) C INTEGER N C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS 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 .GT. 0 )) GOTO 20000 CALL OUTNUM ( N ) 20000 CONTINUE CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20002 CALL OUTSTR ( CONL ) GOTO 20003 20002 CONTINUE CALL OUTSTR ( CONU ) 20003 CONTINUE CALL OUTDON C 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 ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C IF (.NOT.( OUTP .LT. 0 )) GOTO 20004 OUTP = IABS ( OUTP ) C# OUTBUF(OUTP+1) = NEWLINE #PCN #77 20004 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 20006 CALL OUTSTR ( GOTOL ) GOTO 20007 20006 CONTINUE CALL OUTSTR ( GOTOU ) 20007 CONTINUE IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20008 CALL OUTCH ( 32 ) 20008 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 ( 91 ) 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 20010 CALL OUTSTR ( IFNOTL ) GOTO 20011 20010 CONTINUE CALL OUTSTR ( IFNOTU ) C 20011 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 ( 91 ) 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 $20012 OUTP = - OUTP 20012 CONTINUE I = 1 20014 IF (.NOT.( STR ( I ) .NE. 0)) GOTO 20016 C = STR ( I ) IF (.NOT.( C .NE. 34 )) GOTO 20017 CALL OUTCH ( C ) GOTO 20018 20017 CONTINUE I = I + 1 CONTINUE J = I 20019 IF (.NOT.( STR ( J ) .NE. C)) GOTO 20021 20020 J = J + 1 GOTO 20019 20021 CONTINUE LEN = SITOC ( J - I, CHARS, 8 ) CONTINUE K = 1 20022 IF (.NOT.( K .LE. LEN)) GOTO 20024 CALL OUTCH ( CHARS ( K ) ) 20023 K = K + 1 GOTO 20022 20024 CONTINUE IF (.NOT.( LC .EQ. 1 )) GOTO 20025 CALL OUTCH ( 104 ) GOTO 20026 20025 CONTINUE CALL OUTCH ( 72 ) 20026 CONTINUE CONTINUE 20027 IF (.NOT.( I .LT. J)) GOTO 20029 CALL OUTCH ( STR ( I ) ) 20028 I = I + 1 GOTO 20027 20029 CONTINUE 20018 CONTINUE C 20015 I = I + 1 GOTO 20014 20016 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 ( 91 ) 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 20030 IF (.NOT.( OUTP .LT. 6 )) GOTO 20031 CALL OUTCH ( 32 ) C GOTO 20030 20031 CONTINUE IF (.NOT.( OUTP .EQ. 6 )) GOTO 20032 FTNLN = FTNLN + 1 C 20032 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 SUBROUTINE PARSE C LOGICAL * 1 LEXSTR ( 70 ), LAST INTEGER LEX, STRNGS INTEGER LAB, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOK DATA STRNGS / 0 / C SP = 1 LEXTYP ( 1 ) = - 3 TOK = LEX ( LEXSTR ) 20034 IF (.NOT.( TOK .NE. - 3)) GOTO 20036 IF (.NOT.( STRNGS .EQ. 1 .AND. TOK .NE. - 130 .AND. TOK .NE. 59 ) $) GOTO 20037 CALL ENDSTR STRNGS = 0 20037 CONTINUE IF (.NOT.( TOK .EQ. - 116 )) GOTO 20039 CALL IFCODE ( LAB ) GOTO 20040 20039 CONTINUE IF (.NOT.( TOK .EQ. - 115 )) GOTO 20041 CALL FORCOD ( LAB, SP ) GOTO 20042 20041 CONTINUE IF (.NOT.( TOK .EQ. - 119 )) GOTO 20043 CALL REPCOD ( LAB, SP ) GOTO 20044 20043 CONTINUE IF (.NOT.( TOK .EQ. - 124 .OR. TOK .EQ. - 125 )) GOTO 20045 CALL ADDDEF ( LEXSTR, 70 ) GOTO 20046 20045 CONTINUE IF (.NOT.( TOK .EQ. - 112 )) GOTO 20047 CALL DOCODE ( LAB ) GOTO 20048 20047 CONTINUE IF (.NOT.( TOK .EQ. - 121 )) GOTO 20049 CALL WHILEC ( LAB, SP ) GOTO 20050 20049 CONTINUE IF (.NOT.( TOK .EQ. - 111 )) GOTO 20051 CALL LABELC ( LEXSTR ) GOTO 20052 20051 CONTINUE IF (.NOT.( TOK .EQ. - 114 )) GOTO 20053 CALL ENDCOD ( LEXSTR, SP ) GOTO 20054 20053 CONTINUE IF (.NOT.( TOK .EQ. - 128 )) GOTO 20055 GOTO 20056 20055 CONTINUE IF (.NOT.( TOK .EQ. - 126 )) GOTO 20057 CALL IFDEFC ( 1 ) GOTO 20058 20057 CONTINUE IF (.NOT.( TOK .EQ. - 127 )) GOTO 20059 CALL IFDEFC ( 0 ) GOTO 20060 20059 CONTINUE IF (.NOT.( TOK .EQ. - 129 )) GOTO 20061 CALL OPENI GOTO 20062 20061 CONTINUE IF (.NOT.( TOK .EQ. - 130 )) GOTO 20063 STRNGS = 1 CALL STRNGC GOTO 20064 20063 CONTINUE IF (.NOT.( TOK .EQ. - 113 )) GOTO 20065 IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20067 CALL ELSEIF ( LABVAL ( SP ), LAST ) GOTO 20068 20067 CONTINUE CALL SYNERR ( 13HILLEGAL ELSE. ) 20068 CONTINUE C CPCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR) 20065 CONTINUE 20064 CONTINUE 20062 CONTINUE 20060 CONTINUE 20058 CONTINUE 20056 CONTINUE 20054 CONTINUE 20052 CONTINUE 20050 CONTINUE 20048 CONTINUE 20046 CONTINUE 20044 CONTINUE 20042 CONTINUE 20040 CONTINUE IF (.NOT.( TOK .NE. 125 )) GOTO 20069 LAST = TOK C 20069 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 20071 SP = SP + 1 IF (.NOT.( SP .GT. 100 )) GOTO 20073 CALL ERROR ( 25HSTACK OVERFLOW IN PARSER. ) 20073 CONTINUE LEXTYP ( SP ) = TOK LABVAL ( SP ) = LAB GOTO 20072 20071 CONTINUE IF (.NOT.( TOK .EQ. 125 )) GOTO 20075 IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20077 SP = SP - 1 GOTO 20078 20077 CONTINUE CALL SYNERR ( 10HILLEGAL ]. ) 20078 CONTINUE GOTO 20076 20075 CONTINUE IF (.NOT.( TOK .EQ. - 118 .OR. TOK .EQ. - 123 )) GOTO 20079 CALL OTHERC ( LEXSTR ) GOTO 20080 20079 CONTINUE IF (.NOT.( TOK .EQ. - 122 )) GOTO 20081 CALL RETCOD ( LEXSTR ) GOTO 20082 20081 CONTINUE IF (.NOT.( TOK .EQ. - 110 .OR. TOK .EQ. - 117 )) GOTO 20083 CALL BRKNXT ( SP, LEXTYP, LABVAL, TOK ) C 20083 CONTINUE 20082 CONTINUE 20080 CONTINUE 20076 CONTINUE TOK = LEX ( LEXSTR ) CALL PBSTR ( LEXSTR ) CALL UNSTAK ( SP, LEXTYP, LABVAL, TOK, LAST ) 20072 CONTINUE C 20035 TOK = LEX ( LEXSTR ) GOTO 20034 20036 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 ) 20085 IF (.NOT.( I .GT. 0)) GOTO 20087 CALL PUTBAK ( IN ( I ) ) C 20086 I = I - 1 GOTO 20085 20087 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 20088 CALL ERROR ( 24HPUSHBACK STACK OVERFLOW. ) GOTO 20089 20088 CONTINUE BUF ( BP ) = C C 20089 CONTINUE RETURN END C C$ RATGO - RATFOR INITIALIZATION ROUTINE C SYKES 26 SEP 76 C PCN # 97, 22 MAR 80, DEFINE DEFAULTS FOR SWITCHES, PROCESS IN RATGO C SUBROUTINE RATGO ( SWITCH, SWTFO, SWTSC, SWTSP, SWTGO ) C INTEGER SWITCH ( 4, 12 ), JUNK, I, LABGEN, SWTFO, SWTSC, SWTSP, $SWTGO C C FILE = CDEFIO.RAT FOR RATFOR.RAT COMMON / CDEFIO / BP, BUF ( 160 ) INTEGER BP LOGICAL * 1 BUF C C FILE = CFOR.RAT FOR RATFOR.RAT COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN INTEGER FORDEP LOGICAL * 1 FORSTK INTEGER FORLEN C C FILE=CFUNC.RAT FOR RATFOR COMMON / CFUNC / INFUNC, FNAM ( 12 ) INTEGER INFUNC LOGICAL * 1 FNAM 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 C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT 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 C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE= CSTR.RAT FOR RATFOR COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 ) 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 COMPRS = 0 IF (.NOT.( SWITCH ( 2, 2 ) .LT. 0 )) GOTO 20090 COMPRS = 0 GOTO 20091 20090 CONTINUE IF (.NOT.( SWITCH ( 2, 2 ) .GT. 0 )) GOTO 20092 COMPRS = 1 20092 CONTINUE 20091 CONTINUE LC = 0 IF (.NOT.( SWITCH ( 2, 5 ) .LT. 0 )) GOTO 20094 LC = 0 GOTO 20095 20094 CONTINUE IF (.NOT.( SWITCH ( 2, 5 ) .GT. 0 )) GOTO 20096 LC = 1 20096 CONTINUE 20095 CONTINUE IFPNT = 1 IF (.NOT.( SWITCH ( 2, 9 ) .LT. 0 )) GOTO 20098 IFPNT = 0 GOTO 20099 20098 CONTINUE IF (.NOT.( SWITCH ( 2, 9 ) .GT. 0 )) GOTO 20100 IFPNT = 1 20100 CONTINUE 20099 CONTINUE INDXIT = 1 IF (.NOT.( SWITCH ( 2, 12 ) .LT. 0 )) GOTO 20102 INDXIT = 0 GOTO 20103 20102 CONTINUE IF (.NOT.( SWITCH ( 2, 12 ) .GT. 0 )) GOTO 20104 INDXIT = 1 20104 CONTINUE 20103 CONTINUE SWTFO = 0 IF (.NOT.( SWITCH ( 2, 3 ) .LT. 0 )) GOTO 20106 SWTFO = 0 GOTO 20107 20106 CONTINUE IF (.NOT.( SWITCH ( 2, 3 ) .GT. 0 )) GOTO 20108 SWTFO = 1 20108 CONTINUE 20107 CONTINUE SWTSC = 1 IF (.NOT.( SWITCH ( 2, 4 ) .LT. 0 )) GOTO 20110 SWTSC = 0 GOTO 20111 20110 CONTINUE IF (.NOT.( SWITCH ( 2, 4 ) .GT. 0 )) GOTO 20112 SWTSC = 1 20112 CONTINUE 20111 CONTINUE SWTSP = 0 IF (.NOT.( SWITCH ( 2, 10 ) .LT. 0 )) GOTO 20114 SWTSP = 0 GOTO 20115 20114 CONTINUE IF (.NOT.( SWITCH ( 2, 10 ) .GT. 0 )) GOTO 20116 SWTSP = 1 20116 CONTINUE 20115 CONTINUE SWTGO = 0 IF (.NOT.( SWITCH ( 2, 11 ) .LT. 0 )) GOTO 20118 SWTGO = 0 GOTO 20119 20118 CONTINUE IF (.NOT.( SWITCH ( 2, 11 ) .GT. 0 )) GOTO 20120 SWTGO = 1 20120 CONTINUE 20119 CONTINUE IF (.NOT.( SWITCH ( 2, 7 ) .LE. 0 )) GOTO 20122 DEBUG = 9999 GOTO 20123 20122 CONTINUE IF (.NOT.( SWITCH ( 2, 7 ) .EQ. 2 )) GOTO 20124 DEBUG = SWITCH ( 4, 7 ) GOTO 20125 20124 CONTINUE DEBUG = 1 C C##COUTLN 20125 CONTINUE 20123 CONTINUE OUTP = 0 C C## CLINE LEVEL = 1 LINECT = 1 INFILE ( 1 ) = 1 FTNLN = 0 C C## CDEFIO BP = 0 C C## CFOR FORDEP = 0 FORLEN = 1 C C## CFUNC INFUNC = 0 C C## CLOOK IF (.NOT.( SWITCH ( 2, 1 ) .LE. 0 )) GOTO 20126 LASTP = 0 LASTT = 0 TWOS = 1 C C## CLIST 20126 CONTINUE PAGE = 0 PLINE = 9999 ERRORS = 0 INIF = 0 C C## CPRTLN READY = 0 C C## CSTR LASTS = 0 LASTR = 0 C I = LABGEN ( 0 ) JUNK = LABGEN ( 20000 - I ) C 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 20128 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20130 LINE = 1 GOTO 20131 20130 CONTINUE IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20132 LINE = 5 GOTO 20133 20132 CONTINUE IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20134 LINE = 2 GOTO 20135 20134 CONTINUE LINE = 2 CALL PUTBAK ( NEXTCH ) 20135 CONTINUE 20133 CONTINUE 20131 CONTINUE GOTO 20129 20128 CONTINUE IF (.NOT.( THISCH .EQ. 60 )) GOTO 20136 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20138 LINE = 3 GOTO 20139 20138 CONTINUE IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 20140 LINE = 5 GOTO 20141 20140 CONTINUE IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 20142 LINE = 4 GOTO 20143 20142 CONTINUE LINE = 4 CALL PUTBAK ( NEXTCH ) 20143 CONTINUE 20141 CONTINUE 20139 CONTINUE GOTO 20137 20136 CONTINUE IF (.NOT.( THISCH .EQ. 33 )) GOTO 20144 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20146 LINE = 5 GOTO 20147 20146 CONTINUE LINE = 6 CALL PUTBAK ( NEXTCH ) 20147 CONTINUE GOTO 20145 20144 CONTINUE IF (.NOT.( THISCH .EQ. 61 )) GOTO 20148 IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 20150 LINE = 7 GOTO 20151 20150 CONTINUE CALL PUTBAK ( NEXTCH ) 20151 CONTINUE GOTO 20149 20148 CONTINUE IF (.NOT.( THISCH .EQ. 38 )) GOTO 20152 IF (.NOT.( NEXTCH .EQ. 38 )) GOTO 20154 LINE = 11 GOTO 20155 20154 CONTINUE LINE = 8 CALL PUTBAK ( NEXTCH ) 20155 CONTINUE GOTO 20153 20152 CONTINUE IF (.NOT.( THISCH .EQ. 124 )) GOTO 20156 IF (.NOT.( NEXTCH .EQ. 124 .OR. NEXTCH .EQ. 92 )) GOTO 20158 LINE = 10 GOTO 20159 20158 CONTINUE LINE = 9 CALL PUTBAK ( NEXTCH ) C 20159 CONTINUE 20156 CONTINUE 20153 CONTINUE 20149 CONTINUE 20145 CONTINUE 20137 CONTINUE 20129 CONTINUE IF (.NOT.( LINE .GT. 0 )) GOTO 20160 LAST = SCOPY ( DOTS ( 1, LINE ), TOKEN, 10, JUNK ) IF (.NOT.( LC .EQ. 1 )) GOTO 20162 CALL FOLD ( TOKEN ) 20162 CONTINUE GOTO 20161 20160 CONTINUE TOKEN ( 2 ) = 0 LAST = 1 20161 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 20164 CALL OUTCON ( 0 ) 20164 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 ( 70 ), TOKEN ( 70 ), GTOK C C FILE=CFUNC.RAT FOR RATFOR COMMON / CFUNC / INFUNC, FNAM ( 12 ) 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, 70 ) .EQ. 40 )) GOTO $ 20166 CALL PBSTR ( TOKEN ) CALL OUTTAB IF (.NOT.( LC .EQ. 1 )) GOTO 20168 CALL FOLD ( FNAM ) 20168 CONTINUE CALL OUTSTR ( FNAM ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20170 CALL OUTCH ( 32 ) 20170 CONTINUE CALL OUTCH ( 61 ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20172 CALL OUTCH ( 32 ) 20172 CONTINUE CALL BALPAR CALL OUTDON IF (.NOT.( LC .EQ. 1 )) GOTO 20174 CALL FOLD ( LEXSTR ) 20174 CONTINUE CALL OTHERC ( LEXSTR ) GOTO 20167 20166 CONTINUE CALL PBSTR ( TOKEN ) CALL OTHERC ( LEXSTR ) C 20167 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 ( 70 ), NAME ( 70 ) LOGICAL * 1 DEFTOK INTEGER J, LEN, JUNK, INSTAL C C FILE= CSTR.RAT FOR RATFOR COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 ) 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 20176 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 12 )) GOTO 20177 CALL OUTSTR ( TOKEN ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20178 CALL OUTCH ( 32 ) 20178 CONTINUE GOTO 20176 20177 CONTINUE IF (.NOT.( ( DEFTOK ( NAME, 70 ) .NE. - 100 ) .OR. ( DEFTOK ( $TOKEN, 70 ) .NE. 34 ) )) GOTO 20180 CALL SYNERR ( 15HILLEGAL STRING. ) RETURN 20180 CONTINUE CALL OUTSTR ( NAME ) IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20182 CALL OUTCH ( 32 ) 20182 CONTINUE CALL OUTCH ( 40 ) LEN = 2 20184 IF (.NOT.( TOKEN ( LEN ) .NE. 34)) GOTO 20186 20185 LEN = LEN + 1 GOTO 20184 20186 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, 300, $ 20, TABLES ) .EQ. - 1 )) GOTO 20187 CALL SYNERR ( 17HTOO MANY STRINGS. ) C C C 20187 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 USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH' BECAUSE 'MATH' C IS CALLED BY DEFTOK AND THEREFORE CANNOT CALL DEFTOK. THIS MAKES SURE C THAT SYMBOLS WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING C MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLIC 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 ( 80 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE C SUB = 1 T = GTOK ( TOKEN ( SUB ), TOKSIZ ) 20189 IF (.NOT.( T .NE. - 3)) GOTO 20191 IF (.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( SUB ) ) .NE. - 30 )) $GOTO 20192 IF (.NOT.( T .EQ. 45 )) GOTO 20194 SUB = 2 GOTO 20190 20194 CONTINUE GOTO 20191 20195 CONTINUE 20192 CONTINUE CALL UNFOLD ( TOKEN ) IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20196 CALL SYNERR ( 29HUNDEFINED SYMBOLIC IN . ) TOKDEF = ( - 1 ) RETURN 20196 CONTINUE CALL PBSTR ( DEFN ) 20197 CONTINUE 20190 T = GTOK ( TOKEN ( SUB ) , TOKSIZE ) GOTO 20189 20191 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 SUBROUTINE UNSTAK ( SP, LEXTYP, LABVAL, TOKEN, LAST ) C INTEGER LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN LOGICAL * 1 LAST C IF (.NOT.( TOKEN .NE. - 127 .AND. TOKEN .NE. - 126 .AND. TOKEN $.NE. - 128 .AND. TOKEN .NE. - 129 )) GOTO 20198 CONTINUE 20200 IF (.NOT.( SP .GT. 1)) GOTO 20202 IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20203 GOTO 20202 20203 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 .AND. TOKEN .EQ. - 113 )) $GOTO 20205 GOTO 20202 20205 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20207 CALL OUTCON ( LABVAL ( SP ) ) LAST = 32 GOTO 20208 20207 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 113 )) GOTO 20209 IF (.NOT.( SP .GT. 2 )) GOTO 20211 SP = SP - 1 20211 CONTINUE CALL OUTCON ( LABVAL ( SP ) + 1 ) LAST = 32 GOTO 20210 20209 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 112 )) GOTO 20213 CALL OUTCON ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20214 20213 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 121 )) GOTO 20215 CALL OUTGO ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20216 20215 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 115 )) GOTO 20217 CALL FORS ( LABVAL ( SP ) ) GOTO 20218 20217 CONTINUE IF (.NOT.( LEXTYP ( SP ) .EQ. - 119 )) GOTO 20219 CALL UNTILS ( LABVAL ( SP ), TOKEN ) 20219 CONTINUE 20218 CONTINUE 20216 CONTINUE 20214 CONTINUE 20210 CONTINUE 20208 CONTINUE 20206 CONTINUE 20204 CONTINUE 20201 SP = SP - 1 GOTO 20200 20202 CONTINUE C 20198 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 ( 70 ) INTEGER JUNK, LAB, TOKEN, LEX C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 ) 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 20221 JUNK = LEX ( PTOKEN ) CALL IFGO ( LAB - 1 ) FORTYP = 1 GOTO 20222 20221 CONTINUE CALL OUTGO ( LAB - 1 ) 20222 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 20223 CALL OUTCON ( 0 ) 20223 CONTINUE LAB = LABGEN ( 2 ) CALL OUTNUM ( LAB ) CALL IFGO ( LAB + 1 ) C RETURN END