00040023C				FILE= RAT3.RAT0005C0073C EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT0075C SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.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                      ******************0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0075C==============DEFINITIONS FOR RT-11 RATFOR PREPROCESSOR===============0005C0044CLINK LIBRARY FOR COMPILE/LINK/GO OPTION0005C0080C===========================================================================0005C0033      SUBROUTINE OUTCON ( N )0044C OUTCON - GENERATE  "N   CONTINUE" CODE0005C0005C0019      INTEGER N0005C0036C				FILE= CUCLC.RAT  FOR RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C0030      LOGICAL * 1 CONU (9)0030      LOGICAL * 1 CONL (9)0005C0054      DATA CONU/1HC,1HO,1HN,1HT,1HI,1HN,1HU,1HE,0/0054      DATA CONL/1Hc,1Ho,1Hn,1Ht,1Hi,1Hn,1Hu,1He,0/0043      IF (.NOT.( N .GT. 0 )) GOTO 200000027      CALL OUTNUM ( N )001820000 CONTINUE0021      CALL OUTTAB0044      IF (.NOT.( LC .EQ. 1 )) GOTO 200020030      CALL OUTSTR ( CONL )0020      GOTO 20003001820002 CONTINUE0030      CALL OUTSTR ( CONU )001820003 CONTINUE0021      CALL OUTDON0005C0016      RETURN0013      END000500040027      SUBROUTINE OUTDON0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0054C OUTDON - FINISH OFF A FORTRAN CODE (OUTPUT) LINE0067C PCN #77, 5 JAN 80, DELETE 'NEWLINE' CHARACTER AT END OF LINE.0005C0005C0041C				FILE= COUTLN.RAT  FOR RATFOR.RAT0047      COMMON / COUTLN / OUTP, OUTBUF ( 91 )0022      INTEGER OUTP0028      LOGICAL * 1 OUTBUF0005C0046      IF (.NOT.( OUTP .LT. 0 )) GOTO 200040030      OUTP = IABS ( OUTP )0041C# OUTBUF(OUTP+1) = NEWLINE		#PCN #77001820004 CONTINUE0033      OUTBUF ( OUTP + 1 ) = 00038      CALL PUTLIN ( OUTBUF, 8, 0 )0018      OUTP = 00005C^^^^^^^^^0016      RETURN0013      END000500040032      SUBROUTINE OUTGO ( N )0005C0037C OUTGO - GENERATE "GOTO  N" CODE0063C PCN#56, 14 APR 79, DROP BLANK AFTER 'GOTO' IF COMPRESSING0005C0005C0019      INTEGER N0005C0036C				FILE= CUCLC.RAT  FOR RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C0031      LOGICAL * 1 GOTOU (5)0031      LOGICAL * 1 GOTOL (5)0005C0039      DATA GOTOU/1HG,1HO,1HT,1HO,0/0039      DATA GOTOL/1Hg,1Ho,1Ht,1Ho,0/0021      CALL OUTTAB^^^^^^^^^^^^^^^0044      IF (.NOT.( LC .EQ. 1 )) GOTO 200060031      CALL OUTSTR ( GOTOL )0020      GOTO 20007001820006 CONTINUE0031      CALL OUTSTR ( GOTOU )001820007 CONTINUE0048      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 200080027      CALL OUTCH ( 32 )001820008 CONTINUE0027      CALL OUTNUM ( N )0021      CALL OUTDON0005C0016      RETURN0013      END000500040026      SUBROUTINE OUTIF0005C0069C OUTIF - GENERATE "IF (.NOT." CODE FOR 'FOR' AND 'IF' STATEMENTS0019C SYKES,18FEB77^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0072C PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT0005C0005C0035C				FILE=CPRTLN.RAT FOR RATFOR0063      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 COMPRS0005C0005C0033      LOGICAL * 1 IFNOTU (10)^^^^0033      LOGICAL * 1 IFNOTL (10)0005C0060      DATA IFNOTU/1HI,1HF,1H ,1H(,1H.,1HN,1HO,1HT,1H.,0/0060      DATA IFNOTL/1Hi,1Hf,1H ,1H(,1H.,1Hn,1Ho,1Ht,1H.,0/0021      CALL OUTTAB0044      IF (.NOT.( LC .EQ. 1 )) GOTO 200100032      CALL OUTSTR ( IFNOTL )0020      GOTO 20011001820010 CONTINUE0032      CALL OUTSTR ( IFNOTU )0005C001820011 CONTINUE0019      IFTYP = 10005C0016      RETURN0013      END000500040033      SUBROUTINE OUTNUM ( N )0005C0057C OUTNUM - OUTPUT DECIMAL NUMBER TO FORTRAN CODE FILE0005C^^0005C0033      LOGICAL * 1 CHARS ( 8 )0037      INTEGER JUNK, LEN, N, SITOC0005C0038      JUNK = SITOC ( N, CHARS, 8 )0031      CALL OUTSTR ( CHARS )0005C0016      RETURN0013      END000500040035      SUBROUTINE OUTSTR ( STR )0005C0051C OUTSTR - OUTPUT A STRING TO FORTRAN CODE FILE0055C  ALSO CONVERT DOUBLE QUOTED STRINGS TO HOLLERITH.0047C   PASS SINGLE QUOTED STRINGS UNPROCESSED.0005C0005C0047      LOGICAL * 1 C, STR ( 1 ), CHARS ( 8 )0043      INTEGER I, J, SLEN, LEN, K, SITOC0005C^^^^^^^^^^^^^^^^^^^^^^0041C				FILE= COUTLN.RAT  FOR RATFOR.RAT0047      COMMON / COUTLN / OUTP, OUTBUF ( 91 )0022      INTEGER OUTP0028      LOGICAL * 1 OUTBUF0005C0036C				FILE= CUCLC.RAT  FOR RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C0026      I = SLEN ( STR )0072      IF (.NOT.( ( OUTP + I .GE. 72 ) .AND. ( OUTP .GT. 6 ) )) GOTO 0015     $200120023      OUTP = - OUTP001820012 CONTINUE0016       I = 1005020014 IF (.NOT.( STR ( I ) .NE. 0)) GOTO 200160023      C = STR ( I )^^^^0044      IF (.NOT.( C .NE. 34 )) GOTO 200170026      CALL OUTCH ( C )0020      GOTO 20018001820017 CONTINUE0019      I = I + 10018      CONTINUE0016       J = I005020019 IF (.NOT.( STR ( J ) .NE. C)) GOTO 20021002020020 J = J + 1 0020      GOTO 20019001820021 CONTINUE0041      LEN = SITOC ( J - I, CHARS, 8 )0018      CONTINUE0016       K = 1004420022 IF (.NOT.( K .LE. LEN)) GOTO 200240036      CALL OUTCH ( CHARS ( K ) )002020023 K = K + 1 0020      GOTO 20022001820024 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0044      IF (.NOT.( LC .EQ. 1 )) GOTO 200250028      CALL OUTCH ( 104 )0020      GOTO 20026001820025 CONTINUE0027      CALL OUTCH ( 72 )001820026 CONTINUE0018      CONTINUE004220027 IF (.NOT.( I .LT. J)) GOTO 200290034      CALL OUTCH ( STR ( I ) )002020028 I = I + 1 0020      GOTO 20027001820029 CONTINUE001820018 CONTINUE0005C002020015 I = I + 1 0020      GOTO 20014001820016 CONTINUE0016      RETURN0013      END000500040027      SUBROUTINE OUTTAB0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0058C OUTTAB - GENERATE A TAB AT BEGINNING OF FORTRAN LINE0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0005C0005C0041C				FILE= COUTLN.RAT  FOR RATFOR.RAT0047      COMMON / COUTLN / OUTP, OUTBUF ( 91 )0022      INTEGER OUTP0028      LOGICAL * 1 OUTBUF0005C0041C				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 INFILE^^^^^^^^^^^^^^^^0024      INTEGER LINECT0022      INTEGER INIF0023      INTEGER FTNLN0005C004620030 IF (.NOT.( OUTP .LT. 6 )) GOTO 200310027      CALL OUTCH ( 32 )0005C0020      GOTO 20030001820031 CONTINUE0046      IF (.NOT.( OUTP .EQ. 6 )) GOTO 200320027      FTNLN = FTNLN + 10005C001820032 CONTINUE0016      RETURN0013      END000500040026      SUBROUTINE PARSE0005C0073C PARSE - PARSE RATFOR SOURCE PROGRAM, CALL ROUTINES TO GENERATE CODE0076C PCN # 93, 17 FEB 80, MOVE FINDING PROCESSOR FEATURES HERE FROM GETTOK.^^^^^^^^0050C PCN #92, 20 FEB 80, ADD RETURN (EXPRESSION).0005C0005C0041      LOGICAL * 1 LEXSTR ( 70 ), LAST0029      INTEGER LEX, STRNGS0062      INTEGER LAB, LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOK0027      DATA STRNGS / 0 /0005C0016      SP = 10028      LEXTYP ( 1 ) = - 30031       TOK = LEX ( LEXSTR )004620034 IF (.NOT.( TOK .NE. - 3)) GOTO 200360075      IF (.NOT.( STRNGS .EQ. 1 .AND. TOK .NE. - 130 .AND. TOK .NE. 59 )0022     $) GOTO 200370021      CALL ENDSTR0020      STRNGS = 0001820037 CONTINUE^^^^^^^^^^^0049      IF (.NOT.( TOK .EQ. - 116 )) GOTO 200390029      CALL IFCODE ( LAB )0020      GOTO 20040001820039 CONTINUE0069      IF (.NOT.( TOK .EQ. - 124 .OR. TOK .EQ. - 125 )) GOTO 200410036      CALL ADDDEF ( LEXSTR, 70 )0020      GOTO 20042001820041 CONTINUE0049      IF (.NOT.( TOK .EQ. - 112 )) GOTO 200430029      CALL DOCODE ( LAB )0020      GOTO 20044001820043 CONTINUE0049      IF (.NOT.( TOK .EQ. - 111 )) GOTO 200450032      CALL LABELC ( LEXSTR )0020      GOTO 20046001820045 CONTINUE^^^^^^^^^^^^^^^^^^0049      IF (.NOT.( TOK .EQ. - 114 )) GOTO 200470036      CALL ENDCOD ( LEXSTR, SP )0020      GOTO 20048001820047 CONTINUE0049      IF (.NOT.( TOK .EQ. - 128 )) GOTO 200490020      GOTO 20050001820049 CONTINUE0049      IF (.NOT.( TOK .EQ. - 126 )) GOTO 200510027      CALL IFDEFC ( 1 )0020      GOTO 20052001820051 CONTINUE0049      IF (.NOT.( TOK .EQ. - 127 )) GOTO 200530027      CALL IFDEFC ( 0 )0020      GOTO 20054001820053 CONTINUE0049      IF (.NOT.( TOK .EQ. - 129 )) GOTO 200550020      CALL OPENI^^^^^0020      GOTO 20056001820055 CONTINUE0049      IF (.NOT.( TOK .EQ. - 115 )) GOTO 200570033      CALL FORCOD ( LAB, SP )0020      GOTO 20058001820057 CONTINUE0049      IF (.NOT.( TOK .EQ. - 119 )) GOTO 200590033      CALL REPCOD ( LAB, SP )0020      GOTO 20060001820059 CONTINUE0049      IF (.NOT.( TOK .EQ. - 130 )) GOTO 200610020      STRNGS = 10021      CALL STRNGC0020      GOTO 20062001820061 CONTINUE0049      IF (.NOT.( TOK .EQ. - 113 )) GOTO 20063^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 200650045      CALL ELSEIF ( LABVAL ( SP ), LAST )0020      GOTO 20066001820065 CONTINUE0042      CALL SYNERR ( 13HILLEGAL ELSE. )001820066 CONTINUE0020      GOTO 20064001820063 CONTINUE0049      IF (.NOT.( TOK .EQ. - 121 )) GOTO 200670033      CALL WHILEC ( LAB, SP )0005C0064CPCN#10, REMEMBER LAST STATEMENT (BUT DON'T LET ] INTERFEAR)001820067 CONTINUE001820064 CONTINUE001820062 CONTINUE001820060 CONTINUE001820058 CONTINUE001820056 CONTINUE^^^^^^^^^^^^^001820054 CONTINUE001820052 CONTINUE001820050 CONTINUE001820048 CONTINUE001820046 CONTINUE001820044 CONTINUE001820042 CONTINUE001820040 CONTINUE0047      IF (.NOT.( TOK .NE. 125 )) GOTO 200690020      LAST = TOK0005C001820069 CONTINUE0075      IF (.NOT.( TOK .EQ. - 116 .OR. TOK .EQ. - 113 .OR. TOK .EQ. - 1210073     $  .OR. TOK .EQ. - 115 .OR. TOK .EQ. - 119  .OR. TOK .EQ. - 112 0061     $.OR. TOK .EQ. - 111 .OR. TOK .EQ. 123 )) GOTO 200710021      SP = SP + 10046      IF (.NOT.( SP .GT. 100 )) GOTO 20073^^0053      CALL ERROR ( 25HSTACK OVERFLOW IN PARSER. )001820073 CONTINUE0029      LEXTYP ( SP ) = TOK0029      LABVAL ( SP ) = LAB0020      GOTO 20072001820071 CONTINUE0047      IF (.NOT.( TOK .EQ. 125 )) GOTO 200750057      IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 200770021      SP = SP - 10020      GOTO 20078001820077 CONTINUE0039      CALL SYNERR ( 10HILLEGAL ]. )001820078 CONTINUE0020      GOTO 20076001820075 CONTINUE0069      IF (.NOT.( TOK .EQ. - 118 .OR. TOK .EQ. - 123 )) GOTO 20079^^^^^^^^^^^^^^^^^^0032      CALL OTHERC ( LEXSTR )0020      GOTO 20080001820079 CONTINUE0049      IF (.NOT.( TOK .EQ. - 122 )) GOTO 200810032      CALL RETCOD ( LEXSTR )0020      GOTO 20082001820081 CONTINUE0069      IF (.NOT.( TOK .EQ. - 110 .OR. TOK .EQ. - 117 )) GOTO 200830049      CALL BRKNXT ( SP, LEXTYP, LABVAL, TOK )0005C001820083 CONTINUE001820082 CONTINUE001820080 CONTINUE001820076 CONTINUE0030      TOK = LEX ( LEXSTR )0031      CALL PBSTR ( LEXSTR )0055      CALL UNSTAK ( SP, LEXTYP, LABVAL, TOK, LAST )^^^^^^^^^^^^001820072 CONTINUE0005C003120035 TOK = LEX ( LEXSTR ) 0020      GOTO 20034001820036 CONTINUE0016      RETURN0013      END000500040033      SUBROUTINE PBSTR ( IN )0005C0060C PBSTR - PUSH STRING BACK ONTO INPUT FOR LATER RE-INPUT0005C0005C0030      LOGICAL * 1 IN ( 1 )0025      INTEGER I, SLEN0005C0026       I = SLEN ( IN )004220085 IF (.NOT.( I .GT. 0)) GOTO 200870034      CALL PUTBAK ( IN ( I ) )0005C002020086 I = I - 1 0020      GOTO 20085001820087 CONTINUE0016      RETURN0013      END00050004^^^^^^^^^^^0033      SUBROUTINE PUTBAK ( C )0005C0067C PUTBAK - PUSH CHARACTER BACK ONTO INPUT FOR LATER RE-RETRIVAL0005C0005C0023      LOGICAL * 1 C0005C0043C					FILE = CDEFIO.RAT  FOR RATFOR.RAT0043      COMMON / CDEFIO / BP, BUF ( 160 )0020      INTEGER BP0025      LOGICAL * 1 BUF0005C0021      BP = BP + 10046      IF (.NOT.( BP .GT. 160 )) GOTO 200880052      CALL ERROR ( 24HPUSHBACK STACK OVERFLOW. )0020      GOTO 20089001820088 CONTINUE0024      BUF ( BP ) = C0005C001820089 CONTINUE0016      RETURN0013      END000500040037      SUBROUTINE RATGO ( SWITCH )0005C0043C RATGO - RATFOR INITIALIZATION ROUTINE0021C SYKES 26 SEP 760005C0005C0041      INTEGER SWITCH, JUNK, I, LABGEN0005C0043C					FILE = CDEFIO.RAT  FOR RATFOR.RAT0043      COMMON / CDEFIO / BP, BUF ( 160 )0020      INTEGER BP0025      LOGICAL * 1 BUF0005C0040C					FILE = CFOR.RAT FOR RATFOR.RAT0056      COMMON / CFOR / FORDEP, FORSTK ( 120 ), FORLEN0024      INTEGER FORDEP0028      LOGICAL * 1 FORSTK0024      INTEGER FORLEN0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^0035C				FILE=CFUNC.RAT  FOR RATFOR0046      COMMON / CFUNC / INFUNC, FNAM ( 12 )0024      INTEGER INFUNC0026      LOGICAL * 1 FNAM0005C0041C				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 FTNLN0005C0059C				FILE = CLIST. RAT   FOR RATFOR.RAT ; SYKES,26SEP76^^^^^^^^^^^^^^^^^^^^^^^0074      COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015     $DEBUG0021      INTEGER LST0023      INTEGER PLINE0022      INTEGER PAGE0024      INTEGER ERRORS0024      INTEGER OUTPUT0023      INTEGER IFPNT0023      INTEGER DEBUG0005C0042C					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 TABLE0005C^^^^^0041C				FILE= COUTLN.RAT  FOR RATFOR.RAT0047      COMMON / COUTLN / OUTP, OUTBUF ( 91 )0022      INTEGER OUTP0028      LOGICAL * 1 OUTBUF0005C0035C				FILE=CPRTLN.RAT FOR RATFOR0063      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024      INTEGER FORTYP0023      INTEGER IFTYP0023      INTEGER READY0028      LOGICAL * 1 PRTBUF0005C0036C					FILE= CSTR.RAT  FOR RATFOR0069      COMMON / CSTR / LASTS, LASTR, STRPTR ( 20 ), TABLES ( 300 )0023      INTEGER LASTS0023      INTEGER LASTR^^^^^^^^^^^^^^^^^0024      INTEGER STRPTR0028      LOGICAL * 1 TABLES0005C0005C0013C##COUTLN0018      OUTP = 00005C0013C## CLINE0019      LEVEL = 10020      LINECT = 10026      INFILE ( 1 ) = 10019      FTNLN = 00005C0014C## CDEFIO0016      BP = 00005C0012C## CFOR0020      FORDEP = 00020      FORLEN = 10005C0013C## CFUNC0020      INFUNC = 00005C0013C## CLOOK0048      IF (.NOT.( SWITCH .EQ. 1 )) GOTO 200900019      LASTP = 00019      LASTT = 00018      TWOS = 10005C0013C## CLIST001820090 CONTINUE0018      PAGE = 0^^^^^^^^^^^0022      PLINE = 99990020      ERRORS = 00018      INIF = 00005C0014C## CPRTLN0019      READY = 00005C0012C## CSTR0019      LASTS = 00019      LASTR = 00005C0026      I = LABGEN ( 0 )0037      JUNK = LABGEN ( 20000 - I )0005C0016      RETURN0013      END000500040043      SUBROUTINE RELATE ( TOKEN, LAST )0005C0059C RELATE - CONVERT RELATIONAL SHORTHANDS INTO LONG FORM0021CSYKES, 20 NOV 760067C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD  && FOR .EQV.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0071C PCN #77, 5 JAN 80, USE FOLD TO GET LOWER CASE VERSIONS, IF NEEDED0054C PCN #87, 10 FEB 80, ALLOW << AND >> FOR < AND >.0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0005C0005C0073      LOGICAL * 1 NGETCH, DOTS ( 6, 11 ), TOKEN ( 1 ), NEXTCH, THISCH0041      INTEGER LAST, LINE, JUNK, SCOPY0005C0036C				FILE= CUCLC.RAT  FOR RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0074      DATA DOTS / 46, 71, 69, 46, 0, 0, 46, 71, 84, 46, 0, 0, 46, 76, 0075     $69, 46, 0, 0, 46, 76, 84, 46, 0, 0, 46, 78, 69, 46, 0, 0, 46, 78,0075     $ 79, 84, 46, 0, 46, 69, 81, 46, 0, 0, 46, 65, 78, 68, 46, 0, 46, 0074     $79, 82, 46, 0, 0, 46, 88, 79, 82, 46, 0, 46, 69, 81, 86, 46, 0 /0005C0018      LINE = 00030      THISCH = TOKEN ( 1 )0036      NEXTCH = NGETCH ( NEXTCH )0049      IF (.NOT.( THISCH .EQ. 62 )) GOTO 200920049      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 200940018      LINE = 1^^^^^^^^^0020      GOTO 20095001820094 CONTINUE0049      IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 200960018      LINE = 50020      GOTO 20097001820096 CONTINUE0049      IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 200980018      LINE = 20020      GOTO 20099001820098 CONTINUE0018      LINE = 20032      CALL PUTBAK ( NEXTCH )001820099 CONTINUE001820097 CONTINUE001820095 CONTINUE0020      GOTO 20093001820092 CONTINUE0049      IF (.NOT.( THISCH .EQ. 60 )) GOTO 201000049      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 201020018      LINE = 3^^^^^^0020      GOTO 20103001820102 CONTINUE0049      IF (.NOT.( NEXTCH .EQ. 62 )) GOTO 201040018      LINE = 50020      GOTO 20105001820104 CONTINUE0049      IF (.NOT.( NEXTCH .EQ. 60 )) GOTO 201060018      LINE = 40020      GOTO 20107001820106 CONTINUE0018      LINE = 40032      CALL PUTBAK ( NEXTCH )001820107 CONTINUE001820105 CONTINUE001820103 CONTINUE0020      GOTO 20101001820100 CONTINUE0049      IF (.NOT.( THISCH .EQ. 33 )) GOTO 201080049      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 201100018      LINE = 5^^^^^^0020      GOTO 20111001820110 CONTINUE0018      LINE = 60032      CALL PUTBAK ( NEXTCH )001820111 CONTINUE0020      GOTO 20109001820108 CONTINUE0049      IF (.NOT.( THISCH .EQ. 61 )) GOTO 201120049      IF (.NOT.( NEXTCH .EQ. 61 )) GOTO 201140018      LINE = 70020      GOTO 20115001820114 CONTINUE0032      CALL PUTBAK ( NEXTCH )001820115 CONTINUE0020      GOTO 20113001820112 CONTINUE0049      IF (.NOT.( THISCH .EQ. 38 )) GOTO 201160049      IF (.NOT.( NEXTCH .EQ. 38 )) GOTO 201180019      LINE = 11^^^^^^^^^0020      GOTO 20119001820118 CONTINUE0018      LINE = 80032      CALL PUTBAK ( NEXTCH )001820119 CONTINUE0020      GOTO 20117001820116 CONTINUE0050      IF (.NOT.( THISCH .EQ. 124 )) GOTO 201200070      IF (.NOT.( NEXTCH .EQ. 124 .OR. NEXTCH .EQ. 92 )) GOTO 201220019      LINE = 100020      GOTO 20123001820122 CONTINUE0018      LINE = 90032      CALL PUTBAK ( NEXTCH )0005C001820123 CONTINUE001820120 CONTINUE001820117 CONTINUE001820113 CONTINUE001820109 CONTINUE001820101 CONTINUE001820093 CONTINUE^^^^^^^^^^0046      IF (.NOT.( LINE .GT. 0 )) GOTO 201240060      LAST = SCOPY ( DOTS ( 1, LINE ), TOKEN, 10, JUNK )0044      IF (.NOT.( LC .EQ. 1 )) GOTO 201260029      CALL FOLD ( TOKEN )001820126 CONTINUE0020      GOTO 20125001820124 CONTINUE0025      TOKEN ( 2 ) = 00018      LAST = 1001820125 CONTINUE0016      RETURN0013      END000500040039      SUBROUTINE REPCOD ( LAB, SP )0005C0054C REPCOD - GENERATE CODE FOR BEGINNING OF 'REPEAT'0005C0005C0033      INTEGER LAB, SP, LABGEN0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0044      IF (.NOT.( SP .GT. 1 )) GOTO 201280027      CALL OUTCON ( 0 )001820128 CONTINUE0028      LAB = LABGEN ( 3 )0029      CALL OUTCON ( LAB )0023      LAB = LAB + 10005C0016      RETURN0013      END000500040038      SUBROUTINE RETCOD ( LEXSTR )0005C0043C RETCOD - PROCESS RETURN (EXPRESSION).0025C PCN #92, 20 FEB 80,0005C0005C0055      LOGICAL * 1 LEXSTR ( 70 ), TOKEN ( 70 ), GTOK0005C0035C				FILE=CFUNC.RAT  FOR RATFOR0046      COMMON / CFUNC / INFUNC, FNAM ( 12 )0024      INTEGER INFUNC^^^^^^^^^^^^^^0026      LOGICAL * 1 FNAM0005C0036C				FILE= CUCLC.RAT  FOR RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C0075      IF (.NOT.( INFUNC .EQ. 1 .AND. GTOK ( TOKEN, 70 ) .EQ. 40 )) GOTO0016     $ 201300030      CALL PBSTR ( TOKEN )0021      CALL OUTTAB0044      IF (.NOT.( LC .EQ. 1 )) GOTO 201320028      CALL FOLD ( FNAM )001820132 CONTINUE0030      CALL OUTSTR ( FNAM )0048      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 201340027      CALL OUTCH ( 32 )001820134 CONTINUE^^^^0027      CALL OUTCH ( 61 )0048      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 201360027      CALL OUTCH ( 32 )001820136 CONTINUE0021      CALL BALPAR0021      CALL OUTDON0044      IF (.NOT.( LC .EQ. 1 )) GOTO 201380030      CALL FOLD ( LEXSTR )001820138 CONTINUE0032      CALL OTHERC ( LEXSTR )0020      GOTO 20131001820130 CONTINUE0030      CALL PBSTR ( TOKEN )0032      CALL OTHERC ( LEXSTR )0005C001820131 CONTINUE0016      RETURN0013      END000500040027      SUBROUTINE STRNGC0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0063C STRNGC - GENERATE FIRST PART OF CODE FOR 'STRING' KEYWORD0027CSYKES 15OCT76, 12MAR770025C PCN # 21, 10 DEC 770066C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS0063C PCN # 93, 17 FEB 80, CALL FROM PARSE, CHANGE CALLING SEQ.0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0075CASSUMES THAT THE TARGET COMPILER ALLOWS MULTIPLE ELEMENT SPECIFICATION0026C IN DATA STATEMENTS .0067CTHE STRING KEYWORDS MUST BE POSITIONED AFTER ALL OTHER FORTRAN^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0064C  SPECIFICATION STATEMENTS, EXCEPT FOR ANY DATA STATEMENTS.0064CEACH "STRING FOO "BLATS"" LINE CAUSES IMMEDIATE OUTPUT OF A0070C "CHARACTER FOO(4)" LINE AND A "DATA FOO/.../" LINE IS HELD UNTIL0068C ALL STRING LINES HAVE BEEN PROCESSED, THEN INSERTED BEFORE THE0067C FIRST NON-STRING LINE, SO THAT ALL DATA STATEMENTS ARE AT THE0045C BOTTOM OF THE SPECIFICATION STATEMENTS.0005C0005C0005C0047      LOGICAL * 1 TOKEN ( 70 ), NAME ( 70 )0028      LOGICAL * 1 DEFTOK0038      INTEGER J, LEN, JUNK, INSTAL0005C^0036C					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 RATFOR0037      COMMON / CUCLC / LC, COMPRS0020      INTEGER LC0024      INTEGER COMPRS0005C0031      LOGICAL * 1 CHAR (10)0005C0058      DATA CHAR/1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,0/0028      CALL PUTBAK ( 12 )0029      CALL PBSTR ( CHAR )0021      CALL OUTTAB^^^^^^^^^^006320140 IF (.NOT.( DEFTOK ( TOKEN, 70 ) .NE. 12 )) GOTO 201410031      CALL OUTSTR ( TOKEN )0048      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 201420027      CALL OUTCH ( 32 )001820142 CONTINUE0020      GOTO 20140001820141 CONTINUE0073      IF (.NOT.( ( DEFTOK ( NAME, 70 ) .NE. - 100 ) .OR.  ( DEFTOK ( 0045     $TOKEN, 70 ) .NE. 34 ) )) GOTO 201440044      CALL SYNERR ( 15HILLEGAL STRING. )0016      RETURN001820144 CONTINUE0030      CALL OUTSTR ( NAME )0048      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20146^^^^^^^^^^^^^0027      CALL OUTCH ( 32 )001820146 CONTINUE0027      CALL OUTCH ( 40 )0018       LEN = 2005520148 IF (.NOT.( TOKEN ( LEN ) .NE. 34)) GOTO 20150002420149 LEN = LEN + 1 0020      GOTO 20148001820150 CONTINUE0033      CALL OUTNUM ( LEN - 1 )0027      CALL OUTCH ( 41 )0021      CALL OUTDON0027      TOKEN ( LEN ) = 00005C0075C FILE THE ARRAY NAME AND THE STRING DEFINITION AWAY FOR FUTURE DUMPING0075      IF (.NOT.( INSTAL ( NAME, TOKEN ( 2 ), LASTS, LASTR, STRPTR, 300,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0046     $ 20, TABLES ) .EQ. - 1 )) GOTO 201510046      CALL SYNERR ( 17HTOO MANY STRINGS. )0005C0005C0005C001820151 CONTINUE0016      RETURN0013      END000500040055      LOGICAL FUNCTION TOKDEF * 1 ( TOKEN, TOKSIZ )0005C0071C TOKDEF - GET TOKEN; SPECIAL VERSION OF 'DEFTOK' FOR USE BY 'MATH'0018CSYKES, APR77,0070C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.0079C  USED TO GET DEFINED TOKENS (SYMBOLIC CONSTANTS) BY 'MATH' BECAUSE 'MATH'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0076C  IS CALLED BY DEFTOK AND THEREFORE CANNOT CALL DEFTOK. THIS MAKES SURE0066C  THAT SYMBOLS  WITHIN <> ARE REDUCED TO NUMBERS BEFORE BEING0077C  MATH-ED UPON. SPECIAL PROCESSING ALLOWS NEGATIVE INTEGERS AND SYMBOLIC0070C  CONSTANTS DEFINED AS NEGATIVE INTEGERS, WHICH ARE RETURNED AS A0042C  SINGLE TOKEN INSTEAD OF TWO TOKENS.0005C0005C0037      INTEGER TOKSIZ, LOOKFR, SUB0066      LOGICAL * 1 DEFN ( 80 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE0005C0017      SUB = 10045       T = GTOK ( TOKEN ( SUB ), TOKSIZ )^004420153 IF (.NOT.( T .NE. - 3)) GOTO 201550075      IF (.NOT.( T .NE. - 100 .OR. TYPE ( TOKEN ( SUB ) ) .NE. - 30 )) 0020     $GOTO 201560044      IF (.NOT.( T .EQ. 45 )) GOTO 201580017      SUB = 20020      GOTO 20154001820158 CONTINUE0020      GOTO 20155001820159 CONTINUE001820156 CONTINUE0031      CALL UNFOLD ( TOKEN )0064      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 201600058      CALL SYNERR ( 29HUNDEFINED SYMBOLIC IN <MATH>. )0026      TOKDEF = ( - 1 )0016      RETURN001820160 CONTINUE^^^^^0029      CALL PBSTR ( DEFN )001820161 CONTINUE004720154 T = GTOK ( TOKEN ( SUB ) , TOKSIZE ) 0020      GOTO 20153001820155 CONTINUE0024      TOKDEF = ( 1 )0016      RETURN0005C0013      END000500040063      SUBROUTINE UNSTAK ( SP, LEXTYP, LABVAL, TOKEN, LAST )0005C0055C UNSTAK - CLEAN UP PARSE STACK AT END OF STATEMENT0025C PCN # 16, 14 NOV 770070C PCN 93, 16 FEB 80, MOVE FEATURE FINDING FROM GETTOK TO PARSE/LEX0005C0005C0059      INTEGER LABVAL ( 100 ), LEXTYP ( 100 ), SP, TOKEN0026      LOGICAL * 1 LAST0005C0073      IF (.NOT.( TOKEN .NE. - 127 .AND. TOKEN .NE. - 126 .AND. TOKEN 0058     $.NE. - 128  .AND. TOKEN .NE. - 129 )) GOTO 201620018      CONTINUE004320164 IF (.NOT.( SP .GT. 1)) GOTO 201660057      IF (.NOT.( LEXTYP ( SP ) .EQ. 123 )) GOTO 201670020      GOTO 20166001820167 CONTINUE0072      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 .AND. TOKEN .EQ. - 113 )) 0020     $GOTO 201690020      GOTO 20166001820169 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 116 )) GOTO 20171^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0039      CALL OUTCON ( LABVAL ( SP ) )0019      LAST = 320020      GOTO 20172001820171 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 113 )) GOTO 201730044      IF (.NOT.( SP .GT. 2 )) GOTO 201750021      SP = SP - 1001820175 CONTINUE0043      CALL OUTCON ( LABVAL ( SP ) + 1 )0019      LAST = 320020      GOTO 20174001820173 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 112 )) GOTO 201770039      CALL OUTCON ( LABVAL ( SP ) )0043      CALL OUTCON ( LABVAL ( SP ) + 1 )0020      GOTO 20178^^^^^^^^^^^^^001820177 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 121 )) GOTO 201790038      CALL OUTGO ( LABVAL ( SP ) )0043      CALL OUTCON ( LABVAL ( SP ) + 1 )0020      GOTO 20180001820179 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 115 )) GOTO 201810037      CALL FORS ( LABVAL ( SP ) )0020      GOTO 20182001820181 CONTINUE0059      IF (.NOT.( LEXTYP ( SP ) .EQ. - 119 )) GOTO 201830046      CALL UNTILS ( LABVAL ( SP ), TOKEN )001820183 CONTINUE001820182 CONTINUE001820180 CONTINUE001820178 CONTINUE^^^^^001820174 CONTINUE001820172 CONTINUE001820170 CONTINUE001820168 CONTINUE002220165 SP = SP - 1 0020      GOTO 20164001820166 CONTINUE0005C001820162 CONTINUE0016      RETURN0013      END000500040042      SUBROUTINE UNTILS ( LAB, TOKEN )0005C0070C UNTILS - GENERATE CODE FOR 'UNTIL' OR END OF 'REPEAT' STATEMENTS0061C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO RATFOR LISTING0005C0005C0035      LOGICAL * 1 PTOKEN ( 70 )0039      INTEGER JUNK, LAB, TOKEN, LEX0005C0035C				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 COMPRS0005C0029      CALL OUTNUM ( LAB )0051      IF (.NOT.( TOKEN .EQ. - 120 )) GOTO 201850031      JUNK = LEX ( PTOKEN )0031      CALL IFGO ( LAB - 1 )0020      FORTYP = 10020      GOTO 20186001820185 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^0032      CALL OUTGO ( LAB - 1 )001820186 CONTINUE0033      CALL OUTCON ( LAB + 1 )0005C0016      RETURN0013      END000500040039      SUBROUTINE WHILEC ( LAB, SP )0005C0064C WHILEC - GENERATE CODE FOR BEGINNING OF 'WHILE' STATEMENTS0005C0005C0033      INTEGER LAB, SP, LABGEN0005C0044      IF (.NOT.( SP .GT. 1 )) GOTO 201870027      CALL OUTCON ( 0 )001820187 CONTINUE0028      LAB = LABGEN ( 2 )0029      CALL OUTNUM ( LAB )0031      CALL IFGO ( LAB + 1 )0005C0016      RETURN0013      END00050004^^^^^^^^^^