C FILE= RATFOR3.RAT C CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C 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 CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 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 SUBROUTINE OUTDON C C CFILE= 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 ) 20004 CONTINUE OUTBUF ( OUTP + 1 ) = 10 OUTBUF ( OUTP + 2 ) = 0 CALL PUTLIN ( OUTBUF, 7 ) 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 CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 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 SUBROUTINE OUTIF C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 IFNOTU (9) LOGICAL * 1 IFNOTL (9) C DATA IFNOTU/1HI,1HF,1H(,1H.,1HN,1HO,1HT,1H.,0/ DATA IFNOTL/1Hi,1Hf,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 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 FILE C SUBROUTINE OUTSTR ( STR ) C LOGICAL * 1 C, STR ( 1 ), CHARS ( 8 ) INTEGER I, J, SLEN, LEN, K, SITOC C C CFILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 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 SUBROUTINE OUTTAB C C CFILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C 20030 IF(.NOT.( OUTP .LT. 6 )) GOTO 20031 CALL OUTCH ( 32 ) C GOTO 20030 20031 CONTINUE RETURN END C C PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE C PCN#10, 21 OCT 77 C SUBROUTINE PARSE C LOGICAL * 1 LEXSTR ( 70 ), LAST INTEGER LEX INTEGER LAB, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOK C SP = 1 LEXTYP ( 1 ) = - 3 TOK = LEX ( LEXSTR ) 20032 IF(.NOT.( TOK .NE. - 3)) GOTO 20034 IF(.NOT.( TOK .EQ. - 116 )) GOTO 20035 CALL IFCODE ( LAB ) GOTO 20036 20035 CONTINUE IF(.NOT.( TOK .EQ. - 112 )) GOTO 20037 CALL DOCODE ( LAB ) GOTO 20038 20037 CONTINUE IF(.NOT.( TOK .EQ. - 121 )) GOTO 20039 CALL WHILEC ( LAB, SP ) 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. - 111 )) GOTO 20045 CALL LABELC ( LEXSTR ) GOTO 20046 20045 CONTINUE IF(.NOT.( TOK .EQ. - 114 )) GOTO 20047 CALL ENDCOD ( LEXSTR, SP ) GOTO 20048 20047 CONTINUE IF(.NOT.( TOK .EQ. - 113 )) GOTO 20049 IF(.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20051 CALL ELSEIF ( LABVAL ( SP ), LAST ) GOTO 20052 20051 CONTINUE CALL SYNERR ( 13HILLEGAL ELSE. ) 20052 CONTINUE C CPCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR) 20049 CONTINUE 20048 CONTINUE 20046 CONTINUE 20044 CONTINUE 20042 CONTINUE 20040 CONTINUE 20038 CONTINUE 20036 CONTINUE IF(.NOT.( TOK .NE. 125 )) GOTO 20053 LAST = TOK C 20053 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 20055 SP = SP + 1 IF(.NOT.( SP .GT. 100 )) GOTO 20057 CALL ERROR ( 25HSTACK OVERFLOW IN PARSER. ) 20057 CONTINUE LEXTYP ( SP ) = TOK LABVAL ( SP ) = LAB GOTO 20056 20055 CONTINUE IF(.NOT.( TOK .EQ. 125 )) GOTO 20059 IF(.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20061 SP = SP - 1 GOTO 20062 20061 CONTINUE CALL SYNERR ( 10HILLEGAL ]. ) 20062 CONTINUE GOTO 20060 20059 CONTINUE IF(.NOT.( TOK .EQ. - 118 .OR. TOK .EQ. - 123 .OR. TOK .EQ. - 122 $)) GOTO 20063 CALL OTHERC ( LEXSTR ) GOTO 20064 20063 CONTINUE IF(.NOT.( TOK .EQ. - 110 .OR. TOK .EQ. - 117 )) GOTO 20065 CALL BRKNXT ( SP, LEXTYP, LABVAL, TOK ) 20065 CONTINUE 20064 CONTINUE 20060 CONTINUE TOK = LEX ( LEXSTR ) CALL PBSTR ( LEXSTR ) CALL UNSTAK ( SP, LEXTYP, LABVAL, TOK, LAST ) 20056 CONTINUE C 20033 TOK = LEX ( LEXSTR ) GOTO 20032 20034 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 ) 20067 IF(.NOT.( I .GT. 0)) GOTO 20069 CALL PUTBAK ( IN ( I ) ) C 20068 I = I - 1 GOTO 20067 20069 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 CFILE = 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 20070 CALL ERROR ( 24HPUSHBACK STACK OVERFLOW. ) GOTO 20071 20070 CONTINUE BUF ( BP ) = C C 20071 CONTINUE RETURN END C C RATGO - RATFOR INITIALIZATION ROUTINE C SYKES 26 SEP 76 C SUBROUTINE RATGO ( SWITCH ) C INTEGER SWITCH, JUNK, I, LABGEN C C CFILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C C CFILE = CLINE.RAT FOR RATFOR.RAT COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF C C CFILE = CDEFIO.RAT FOR RATFOR.RAT COMMON / CDEFIO / BP, BUF ( 160 ) INTEGER BP LOGICAL * 1 BUF C C CFILE = CFOR.RAT FOR RATFOR.RAT COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN INTEGER FORDEP LOGICAL * 1 FORSTK INTEGER FORLEN 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 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 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 C##COUTLN OUTP = 0 C C## CLINE LEVEL = 1 LINECT = 1 INFILE ( 1 ) = 1 C C## CDEFIO BP = 0 C C## CFOR FORDEP = 0 FORLEN = 1 C C## CLOOK IF(.NOT.( SWITCH .EQ. 1 )) GOTO 20072 LASTP = 0 LASTT = 0 TWOS = 1 C C## CLIST 20072 CONTINUE PAGE = 0 PLINE = 9999 ERRORS = 0 INIF = 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 FORM CSYKES, 20 NOV 76 C SUBROUTINE RELATE ( TOKEN, LAST, FD ) C LOGICAL * 1 NGETCH, DOTS ( 6, 20 ), TOKEN ( 1 ) INTEGER FD, LAST, LINE, JUNK, SCOPY C C CFILE= CUCLC.RAT FOR RATFOR C ***PCN # 22, 10 DEC 77 COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C C# STRING DOTGE ".GE." C# STRING DOTGT ".GT." C# STRING DOTLT ".LT." C# STRING DOTLE ".LE." C# STRING DOTNE ".NE." C# STRING DOTNOT ".NOT." C# STRING DOTEQ ".EQ." C# STRING DOTAND ".AND." C# STRING DOTOR ".OR." C# STRING DOTXOR ".XOR." DATA DOTS / 46, 71, 69, 46, 0, 0, 46, 103, 101, 46, 0, 0, 46, 71, $ 84, 46, 0, 0, 46, 103, 116, 46, 0, 0, 46, 76, 69, 46, 0, 0, 46, $108, 101, 46, 0, 0, 46, 76, 84, 46, 0, 0, 46, 108, 116, 46, 0, 0, $ 46, 78, 69, 46, 0, 0, 46, 110, 101, 46, 0, 0, 46, 78, 79, 84, 46 $, 0, 46, 110, 111, 116, 46, 0, 46, 69, 81, 46, 0, 0, 46, 101, 113 $, 46, 0, 0, 46, 65, 78, 68, 46, 0, 46, 97, 110, 100, 46, 0, 46, $79, 82, 46, 0, 0, 46, 111, 114, 46, 0, 0, 46, 88, 79, 82, 46, 0, $46, 120, 111, 114, 46, 0 / C LINE = 0 IF(.NOT.( NGETCH ( TOKEN ( 2 ), FD ) .NE. 61 .AND. TOKEN ( 2 ) $.NE. 124 .AND. TOKEN ( 2 ) .NE. 92 )) GOTO 20074 CALL PUTBAK ( TOKEN ( 2 ) ) 20074 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 62 )) GOTO 20076 IF(.NOT.( TOKEN ( 2 ) .EQ. 61 )) GOTO 20078 LINE = 1 GOTO 20079 20078 CONTINUE LINE = 3 20079 CONTINUE GOTO 20077 20076 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 60 )) GOTO 20080 IF(.NOT.( TOKEN ( 2 ) .EQ. 61 )) GOTO 20082 LINE = 5 GOTO 20083 20082 CONTINUE LINE = 7 20083 CONTINUE GOTO 20081 20080 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 33 )) GOTO 20084 IF(.NOT.( TOKEN ( 2 ) .EQ. 61 )) GOTO 20086 LINE = 9 GOTO 20087 20086 CONTINUE LINE = 11 20087 CONTINUE GOTO 20085 20084 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 61 )) GOTO 20088 IF(.NOT.( TOKEN ( 2 ) .EQ. 61 )) GOTO 20090 LINE = 13 C ELSE TOKEN(2)=EOS 20090 CONTINUE GOTO 20089 20088 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 38 )) GOTO 20092 LINE = 15 GOTO 20093 20092 CONTINUE IF(.NOT.( TOKEN ( 1 ) .EQ. 124 )) GOTO 20094 IF(.NOT.( TOKEN ( 2 ) .EQ. 124 .OR. TOKEN ( 2 ) .EQ. 92 )) GOTO $20096 LINE = 19 GOTO 20097 20096 CONTINUE LINE = 17 20097 CONTINUE C 20094 CONTINUE 20093 CONTINUE 20089 CONTINUE 20085 CONTINUE 20081 CONTINUE 20077 CONTINUE IF(.NOT.( LINE .GT. 0 )) GOTO 20098 IF(.NOT.( LC .EQ. 1 )) GOTO 20100 LINE = LINE + 1 20100 CONTINUE LAST = SCOPY ( DOTS ( 1, LINE ), TOKEN, 10, JUNK ) GOTO 20099 20098 CONTINUE TOKEN ( 2 ) = 0 LAST = 1 C 20099 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 20102 CALL OUTCON ( 0 ) 20102 CONTINUE LAB = LABGEN ( 3 ) CALL OUTCON ( LAB ) LAB = LAB + 1 C 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 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 ( STRNGS, FILE ) C C LOGICAL * 1 TOKEN ( 70 ), NAME ( 70 ) LOGICAL * 1 DEFTOK INTEGER J, LEN, JUNK, STRNGS, INSTAL, FILE 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 CHAR (10) C DATA CHAR/1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,0/ CALL PUTBAK ( 12 ) CALL PBSTR ( CHAR ) CALL OUTTAB 20104 IF(.NOT.( DEFTOK ( TOKEN, 70, FILE, JUNK ) .NE. 12 )) GOTO 20105 CALL OUTSTR ( TOKEN ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20106 CALL OUTCH ( 32 ) 20106 CONTINUE GOTO 20104 20105 CONTINUE IF(.NOT.( ( DEFTOK ( NAME, 70, FILE, JUNK ) .NE. - 100 ) .OR. ( $DEFTOK ( TOKEN, 70, FILE, JUNK ) .NE. 34 ) )) GOTO 20108 CALL SYNERR ( 15HILLEGAL STRING. ) RETURN 20108 CONTINUE CALL OUTSTR ( NAME ) IF(.NOT.( COMPRS .EQ. 0 )) GOTO 20110 CALL OUTCH ( 32 ) 20110 CONTINUE CALL OUTCH ( 40 ) LEN = 2 20112 IF(.NOT.( TOKEN ( LEN ) .NE. 34)) GOTO 20114 20113 LEN = LEN + 1 GOTO 20112 20114 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, 150, $12, TABLES ) .EQ. - 1 )) GOTO 20115 CALL SYNERR ( 17HTOO MANY STRINGS. ) GOTO 20116 20115 CONTINUE STRNGS = 1 C C C 20116 CONTINUE RETURN END C C TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH' CSYKES, APR77, 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, FD ) C INTEGER FD, TOKSIZ, LOOKFR, SUB LOGICAL * 1 DEFN ( 70 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE C SUB = 1 T = GTOK ( TOKEN ( SUB ), TOKSIZ, FD ) 20117 IF(.NOT.( T .NE. - 3)) GOTO 20119 IF(.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( SUB ) ) .NE. - 30 )) $GOTO 20120 IF(.NOT.( T .EQ. 45 )) GOTO 20122 SUB = 2 GOTO 20118 20122 CONTINUE GOTO 20119 20123 CONTINUE 20120 CONTINUE CALL UNFOLD ( TOKEN ) IF(.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20124 CALL SYNERR ( 29HUNDEFINED SYMBOLIC IN . ) TOKDEF = - 1 RETURN 20124 CONTINUE CALL PBSTR ( DEFN ) 20125 CONTINUE 20118 T = GTOK ( TOKEN ( SUB ) , TOKSIZE , FD ) GOTO 20117 20119 CONTINUE TOKDEF = 1 C RETURN END C C UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT C PCN # 16, 14 NOV 77 C SUBROUTINE UNSTAK ( SP, LEXTYP, LABVAL, TOKEN, LAST ) C INTEGER LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN LOGICAL * 1 LAST C 20126 IF(.NOT.( SP .GT. 1)) GOTO 20128 IF(.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 20129 GOTO 20128 20129 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 116 .AND. TOKEN .EQ. - 113 )) GOTO $ 20131 GOTO 20128 20131 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20133 CALL OUTCON ( LABVAL ( SP ) ) LAST = 32 GOTO 20134 20133 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 113 )) GOTO 20135 IF(.NOT.( SP .GT. 2 )) GOTO 20137 SP = SP - 1 20137 CONTINUE CALL OUTCON ( LABVAL ( SP ) + 1 ) LAST = 32 GOTO 20136 20135 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 112 )) GOTO 20139 CALL OUTCON ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20140 20139 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 121 )) GOTO 20141 CALL OUTGO ( LABVAL ( SP ) ) CALL OUTCON ( LABVAL ( SP ) + 1 ) GOTO 20142 20141 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 115 )) GOTO 20143 CALL FORS ( LABVAL ( SP ) ) GOTO 20144 20143 CONTINUE IF(.NOT.( LEXTYP ( SP ) .EQ. - 119 )) GOTO 20145 CALL UNTILS ( LABVAL ( SP ), TOKEN ) 20145 CONTINUE 20144 CONTINUE 20142 CONTINUE 20140 CONTINUE 20136 CONTINUE 20134 CONTINUE 20132 CONTINUE 20130 CONTINUE C 20127 SP = SP - 1 GOTO 20126 20128 CONTINUE RETURN END C C UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS C SUBROUTINE UNTILS ( LAB, TOKEN ) C LOGICAL * 1 PTOKEN ( 70 ) INTEGER JUNK, LAB, TOKEN, LEX C CALL OUTNUM ( LAB ) IF(.NOT.( TOKEN .EQ. - 120 )) GOTO 20147 JUNK = LEX ( PTOKEN ) CALL IFGO ( LAB - 1 ) GOTO 20148 20147 CONTINUE CALL OUTGO ( LAB - 1 ) 20148 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 20149 CALL OUTCON ( 0 ) 20149 CONTINUE LAB = LABGEN ( 2 ) CALL OUTNUM ( LAB ) CALL IFGO ( LAB + 1 ) C RETURN END