C C C C C C maximum field for integer strings C max card size C must be 2 more than MAXCARD C C must be highest lu for standard files C C C C C ARCHIVE MAIN.RAT 24 27-MAR-80 17:53:31 C-------------------------------------------------------------------- Cinclude symbols definitions C include symbols C################################################################# C # C Part 1 - Symbols and common blocks for the # C ratfor preprocessor # C Extract each one and place it on a file # C with the name specified # C # C################################################################# C----------------------------------------------------------------------- C# definitions for the preprocessor (hashed version from Dave Hanson) C put on a file named 'rat4sym' C Used by ratfor preprocessor, macro, and form tools Cpushback buffer for ngetch and putbak C characters for outnum C (should be compatible with "putdec") Cmax chars in a definition Cmax files which can be open at a time Cmax depth of file inclusion C(should be max nbr open files allowed - 4) Cmax space for for reinit clauses Cfunction name size in gettok Cnumber of defines in lookup Cmax stack depth for parser Cmax chars in all definitions Cmax chars in a token Cmax length of format in read, write, encode, decode Cliteral toggle flag C-------------------------------------------------------------------- C# rat4 -- main program CBKY subroutine driver CALL INITR4 CALL RAT4 CALL ENDR4 END CBKY #assembly code main program (used to avoid loading fortran I/O) CBKY % CBKY ident main CBKY entry main CBKY vfd 42/0lmain,18/main CBKY ext driver CBKY rj uzero00 CBKY rj driver CBKY end main CBKY% C ARCHIVE RAT4S.RAT 83 12-JUN-80 16:52:32 C#rat4 - driver subroutine for ratfor compiler /*/sor/rat4r/rat4s SUBROUTINE RAT4 INTEGER GETARG, OPEN, PMATCH, INDEX BYTE BUF(134) Cfile containing general definitions BYTE SYM(34) Cstandard part of file spec for symbols BYTE SYMBLS(8) C /SYMBOLS flag BYTE SYMFLG(9) INTEGER I, ARG1 CBKY integer ovride, inbuf(OPTSIZE), outbf(OPTSIZE) Cneeded to set input file CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C initialize standard part of file specification DATA SYMBLS/83, 89, 77, 66, 79, 76, 83, 0/ DATA SYMFLG/47, 83, 89, 77, 66, 79, 76, 83, 0/ Cset STDOUT file type to that needed by fortran compiler CBKY if (ovride (STDOUT) == NO) CBKY call settyp (STDOUT, CDC) CExpand I/O buffers for BKY CBKY call xpdfet (STDOUT, outbf, OPTSIZE) Cinitialize variables CALL INITRT CALL XITSTA(1) ARG1 = 1 IF (.NOT.(GETARG(1, BUF, 134) .NE. -10)) GOTO 2000 IF (.NOT.(PMATCH(BUF, SYMFLG) .EQ. 1)) GOTO 2020 ARG1 = 2 C read file containing standard definitions INFILE(1) = OPEN(SYMBLS, 'R') IF (.NOT.(INFILE(1) .EQ. -1)) GOTO 2040 C get portion of file name for usr/bin CALL USRBIN(SYM) I = 1 2060 IF (.NOT.(SYM(I) .NE. 0)) GOTO 2080 C move pointer to end 2070 I = I + 1 GOTO 2060 2080 CONTINUE C copy remainder of name into sym CALL SCOPY(SYMBLS, 1, SYM, I) INFILE(1) = OPEN(SYM, 'R') 2040 CONTINUE IF (.NOT.(INFILE(1) .EQ. -1)) GOTO 2090 CALL XITSTA(4) CALL ERROR('can''t open symbols file.') GOTO 2100 2090 CONTINUE CALL PARSE CALL CLOSE(INFILE(1)) 2100 CONTINUE C loop through all input files 2020 CONTINUE 2000 CONTINUE I = ARG1 2110 CONTINUE IF (.NOT.(GETARG(I, BUF, 134) .EQ. -10)) GOTO 2140 IF (.NOT.(I .NE. ARG1)) GOTO 2160 GOTO 2130 2160 CONTINUE INFILE(1) = 5 GOTO 2150 2140 CONTINUE IF (.NOT.(BUF(1) .EQ. 63 .AND. BUF(2) .EQ. 0)) GOTO 2180 CALL ERROR('usage: rat4 [file ...] >outfile.') GOTO 2190 2180 CONTINUE IF (.NOT.(BUF(1) .EQ. 45 .AND. BUF(2) .EQ. 0)) GOTO 2200 INFILE(1) = 5 GOTO 2210 2200 CONTINUE INFILE(1) = OPEN(BUF, 'R') IF (.NOT.(INFILE(1) .EQ. -1)) GOTO 2220 CALL XITSTA(4) CALL CANT(BUF) 2220 CONTINUE CFor BKY, expand input buffer CBKY call xpdfet (infile(1), inbuf, OPTSIZE) 2210 CONTINUE 2190 CONTINUE 2150 CONTINUE CALL PARSE IF (.NOT.(INFILE(1) .NE. 5)) GOTO 2240 CALL CLOSE(INFILE(1)) 2240 CONTINUE 2120 I = I + 1 GOTO 2110 2130 CONTINUE RETURN END C ARCHIVE BALPAR.RAT 33 10-APR-80 23:43:44 C# balpar - copy balanced paren string SUBROUTINE BALPAR BYTE GETTOK BYTE T, TOKEN(200) INTEGER NLPAR IF (.NOT.(GETTOK(TOKEN, 200) .NE. 40)) GOTO 2260 CALL SYNERR('missing left paren.') RETURN 2260 CONTINUE CALL OUTSTR(TOKEN) NLPAR = 1 2280 CONTINUE T = GETTOK(TOKEN, 200) IF (.NOT.(T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ. *-10)) GOTO 2310 CALL PBSTR(TOKEN) GOTO 2300 2310 CONTINUE IF (.NOT.(T .EQ. 13)) GOTO 2330 C delete newlines TOKEN(1) = 0 GOTO 2340 2330 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 2350 NLPAR = NLPAR + 1 GOTO 2360 2350 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 2370 NLPAR = NLPAR - 1 C else nothing special 2370 CONTINUE 2360 CONTINUE 2340 CONTINUE CALL OUTSTR(TOKEN) IF (.NOT.(T .EQ. 44)) GOTO 2390 CALL OUTCH(32) 2390 CONTINUE 2290 IF (.NOT.(NLPAR .LE. 0)) GOTO 2280 2300 CONTINUE IF (.NOT.(NLPAR .NE. 0)) GOTO 2410 CALL SYNERR('missing parenthesis in condition.') 2410 CONTINUE RETURN END C ARCHIVE BRKNXT.RAT 36 25-MAR-80 01:22:57 C# brknxt - generate code for break n and next n; n = 1 is default SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN INTEGER I, N, ALLDIG, CTOI BYTE T, PTOKEN(200), GETTOK C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER N = 0 T = GETTOK(PTOKEN, 200) IF (.NOT.(ALLDIG(PTOKEN) .EQ. 1)) GOTO 2430 C have break n or next n I = 1 N = CTOI(PTOKEN, I) - 1 GOTO 2440 2430 CONTINUE IF (.NOT.(T .NE. 59)) GOTO 2450 C default case CALL PBSTR(PTOKEN) 2450 CONTINUE 2440 CONTINUE I = SP 2470 IF (.NOT.(I .GT. 0)) GOTO 2490 IF (.NOT.(LEXTYP(I) .EQ. -15 .OR. LEXTYP(I) .EQ. -7 .OR. LEXTYP( *I) .EQ. -16 .OR. LEXTYP(I) .EQ. -17)) GOTO 2500 IF (.NOT.(N .GT. 0)) GOTO 2520 N = N - 1 C seek proper level GOTO 2480 2520 CONTINUE IF (.NOT.(TOKEN .EQ. -8)) GOTO 2540 CALL OUTGO(LABVAL(I) + 10) GOTO 2550 2540 CONTINUE CALL OUTGO(LABVAL(I)) 2550 CONTINUE XFER = 1 RETURN 2500 CONTINUE 2480 I = I - 1 GOTO 2470 2490 CONTINUE IF (.NOT.(TOKEN .EQ. -8)) GOTO 2560 CALL SYNERR('illegal break.') GOTO 2570 2560 CONTINUE CALL SYNERR('illegal next.') 2570 CONTINUE RETURN END C ARCHIVE DEFTOK.RAT 24 25-MAR-80 01:22:58 C# deftok - get token; process macro calls and invocations BYTE FUNCTION DEFTOK(TOKEN, TOKSIZ, FD) BYTE GTOK INTEGER FD, TOKSIZ BYTE DEFN(200), T, TOKEN(200) INTEGER LOOKUP T = GTOK(TOKEN, TOKSIZ, FD) 2580 IF (.NOT.(T .NE. -10)) GOTO 2600 IF (.NOT.(T .NE. -100)) GOTO 2610 C non-alpha GOTO 2600 2610 CONTINUE IF (.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0)) GOTO 2630 C undefined GOTO 2600 2630 CONTINUE IF (.NOT.(DEFN(1) .EQ. -4)) GOTO 2650 C get definition CALL GETDEF(TOKEN, TOKSIZ, DEFN, 200, FD) CALL INSTAL(TOKEN, DEFN) GOTO 2660 2650 CONTINUE C push replacement onto input CALL PBSTR(DEFN) 2660 CONTINUE 2590 T = GTOK(TOKEN, TOKSIZ, FD) GOTO 2580 2600 CONTINUE DEFTOK = T IF (.NOT.(DEFTOK .EQ. -100)) GOTO 2670 C convert to single case CALL FOLD(TOKEN) 2670 CONTINUE RETURN END C ARCHIVE DOCODE.RAT 22 11-APR-80 02:36:43 C# docode - generate code for beginning of do SUBROUTINE DOCODE(LAB) INTEGER LABGEN INTEGER LAB C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C string dostr 'do' BYTE DOSTR(4) DATA DOSTR(1), DOSTR(2), DOSTR(3), DOSTR(4)/68, 79, 32, 0/ XFER = 0 CALL OUTTAB CALL OUTSTR(DOSTR) LAB = LABGEN(2) CALL OUTNUM(LAB) CALL OUTCH(32) CALL EATUP CALL OUTDON CALL INDEN(2) RETURN END C ARCHIVE DOSTAT.RAT 9 11-APR-80 02:36:44 C# dostat - generate code for end of do statement SUBROUTINE DOSTAT(LAB) INTEGER LAB CALL OUTDEN(2) CALL OUTCON(LAB) CALL OUTCON(LAB + 10) RETURN END C ARCHIVE EATUP.RAT 47 22-JUN-80 23:17:32 C# eatup - process rest of statement; interpret continuations SUBROUTINE EATUP BYTE GETTOK, TYPE BYTE PTOKEN(200), T, TOKEN(200) INTEGER NLPAR, LENGTH C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ NLPAR = 0 2690 CONTINUE T = GETTOK(TOKEN, 200) IF (.NOT.(T .EQ. 59 .OR. T .EQ. 13)) GOTO 2720 GOTO 2710 2720 CONTINUE IF (.NOT.(T .EQ. 125 .OR. T .EQ. 123)) GOTO 2740 CALL PBSTR(TOKEN) GOTO 2710 2740 CONTINUE IF (.NOT.(T .EQ. -10)) GOTO 2760 CALL SYNERR('unexpected EOF.') CALL PBSTR(TOKEN) GOTO 2710 2760 CONTINUE IF (.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 * .OR. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. * T .EQ. 61 .OR. T .EQ. 126 .OR. T .EQ. 94 .OR. T .EQ. 62 .OR. T .E *Q. 60 .OR. T .EQ. 92)) GOTO 2780 2800 IF (.NOT.(GETTOK(PTOKEN, 200) .EQ. 13)) GOTO 2810 GOTO 2800 2810 CONTINUE CALL PBSTR(PTOKEN) 2780 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 2820 NLPAR = NLPAR + 1 GOTO 2830 2820 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 2840 NLPAR = NLPAR - 1 2840 CONTINUE 2830 CONTINUE IF (.NOT.(T .EQ. 43 .OR. T .EQ. 45 .OR. TOKEN(1) .EQ. 61)) GOTO *2860 CALL OUTCH(32) CALL OUTSTR(TOKEN) CALL OUTCH(32) GOTO 2870 2860 CONTINUE IF (.NOT.((T .EQ. -100) .AND. (TYPE(OUTBUF(OUTP)) .EQ. 1))) GO *TO 2880 CALL OUTCH(32) CALL OUTSTR(TOKEN) GOTO 2890 2880 CONTINUE IF (.NOT.(T .EQ. 44)) GOTO 2900 CALL OUTSTR(TOKEN) CALL OUTSTR(32) GOTO 2910 2900 CONTINUE CALL OUTSTR(TOKEN) 2910 CONTINUE 2890 CONTINUE 2870 CONTINUE 2700 IF (.NOT.(NLPAR .LT. 0)) GOTO 2690 2710 CONTINUE IF (.NOT.(NLPAR .NE. 0)) GOTO 2920 CALL SYNERR('unbalanced parentheses.') 2920 CONTINUE RETURN END C ARCHIVE ELSEIF.RAT 10 11-APR-80 11:44:18 C# elseif - generate code for end of if before else SUBROUTINE ELSE IF(LAB) INTEGER LAB CALL OUTGO(LAB + 10) CALL OUTDEN(1) CALL OUTCON(LAB) CALL INDEN(1) RETURN END C ARCHIVE FORCOD.RAT 97 22-JUN-80 23:17:33 C# forcod - beginning of for statement SUBROUTINE FORCOD(LAB) BYTE GETTOK BYTE T, TOKEN(200) INTEGER LENGTH, LABGEN INTEGER I, J, LAB, NLPAR C-------------------------------------------------------------------------- C# preprocessor common block to hold info about 'for' statements C put on a file named 'cfor' C Used only by ratfor preprocessor COMMON/CFOR/FORDEP, FORSTK(200) C current depth of for statements INTEGER FORDEP C stack of reinit strings BYTE FORSTK C string ifnot 'if (.not.' BYTE IFNOT(10) DATA IFNOT(1)/73/ DATA IFNOT(2)/70/ DATA IFNOT(3)/32/ DATA IFNOT(4)/40/ DATA IFNOT(5)/46/ DATA IFNOT(6)/78/ DATA IFNOT(7)/79/ DATA IFNOT(8)/84/ DATA IFNOT(9)/46/ DATA IFNOT(10)/0/ LAB = LABGEN(3) CALL OUTCON(0) IF (.NOT.(GETTOK(TOKEN, 200) .NE. 40)) GOTO 2940 CALL SYNERR('missing left paren.') RETURN 2940 CONTINUE IF (.NOT.(GETTOK(TOKEN, 200) .NE. 59)) GOTO 2960 C real init clause CALL PBSTR(TOKEN) CALL OUTTAB CALL EATUP CALL OUTDON 2960 CONTINUE IF (.NOT.(GETTOK(TOKEN, 200) .EQ. 59)) GOTO 2980 C empty condition CALL OUTCON(LAB) GOTO 2990 2980 CONTINUE C non-empty condition CALL PBSTR(TOKEN) CALL OUTNUM(LAB) CALL OUTTAB CALL OUTSTR(IFNOT) CALL OUTCH(40) NLPAR = 0 3000 IF (.NOT.(NLPAR .GE. 0)) GOTO 3010 T = GETTOK(TOKEN, 200) IF (.NOT.(T .EQ. 59)) GOTO 3020 GOTO 3010 3020 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 3040 NLPAR = NLPAR + 1 GOTO 3050 3040 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 3060 NLPAR = NLPAR - 1 3060 CONTINUE 3050 CONTINUE IF (.NOT.(T .EQ. -10)) GOTO 3080 CALL PBSTR(TOKEN) RETURN 3080 CONTINUE IF (.NOT.(T .NE. 13)) GOTO 3100 CALL OUTSTR(TOKEN) 3100 CONTINUE GOTO 3000 3010 CONTINUE CALL OUTCH(41) CALL OUTCH(41) CALL OUTCH(32) CALL OUTGO(LAB + 20) IF (.NOT.(NLPAR .LT. 0)) GOTO 3120 CALL SYNERR('invalid for clause.') 3120 CONTINUE 2990 CONTINUE C stack reinit clause FORDEP = FORDEP + 1 J = 1 I = 1 3140 IF (.NOT.(I .LT. FORDEP)) GOTO 3160 C find end J = J + LENGTH(FORSTK(J)) + 1 3150 I = I + 1 GOTO 3140 3160 CONTINUE C null, in case no reinit FORSTK(J) = 0 NLPAR = 0 3170 IF (.NOT.(NLPAR .GE. 0)) GOTO 3180 T = GETTOK(TOKEN, 200) IF (.NOT.(T .EQ. 40)) GOTO 3190 NLPAR = NLPAR + 1 GOTO 3200 3190 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 3210 NLPAR = NLPAR - 1 3210 CONTINUE 3200 CONTINUE IF (.NOT.(T .EQ. -10)) GOTO 3230 CALL PBSTR(TOKEN) GOTO 3180 3230 CONTINUE IF (.NOT.(NLPAR .GE. 0 .AND. T .NE. 13)) GOTO 3250 IF (.NOT.(T .EQ. 43 .OR. T .EQ. 45 .OR. TOKEN(1) .EQ. 61)) GOT *O 3270 TOKEN(1) = 32 TOKEN(2) = T TOKEN(3) = 32 TOKEN(4) = 0 GOTO 3280 3270 CONTINUE IF (.NOT.(T .EQ. 44)) GOTO 3290 TOKEN(2) = 32 TOKEN(3) = 0 3290 CONTINUE 3280 CONTINUE IF (.NOT.(J+LENGTH(TOKEN) .GE. 200)) GOTO 3310 CALL ERROR('for clause too long.') 3310 CONTINUE CALL SCOPY(TOKEN, 1, FORSTK, J) J = J + LENGTH(TOKEN) 3250 CONTINUE GOTO 3170 3180 CONTINUE CALL INDEN(2) C label for next's LAB = LAB + 10 RETURN END C ARCHIVE FORS.RAT 24 11-APR-80 02:36:47 C# fors - process end of for statement SUBROUTINE FORS(LAB) INTEGER LENGTH INTEGER I, J, LAB C-------------------------------------------------------------------------- C# preprocessor common block to hold info about 'for' statements C put on a file named 'cfor' C Used only by ratfor preprocessor COMMON/CFOR/FORDEP, FORSTK(200) C current depth of for statements INTEGER FORDEP C stack of reinit strings BYTE FORSTK C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER XFER = 0 CALL OUTNUM(LAB) J = 1 I = 1 3330 IF (.NOT.(I .LT. FORDEP)) GOTO 3350 J = J + LENGTH(FORSTK(J)) + 1 3340 I = I + 1 GOTO 3330 3350 CONTINUE IF (.NOT.(LENGTH(FORSTK(J)) .GT. 0)) GOTO 3360 CALL OUTTAB CALL OUTSTR(FORSTK(J)) CALL OUTDON 3360 CONTINUE CALL OUTGO(LAB - 10) CALL OUTDEN(2) CALL OUTCON(LAB + 10) FORDEP = FORDEP - 1 RETURN END C ARCHIVE GETDEF.RAT 50 25-MAR-80 01:23:00 C# getdef (for no arguments) - get name and definition SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD) BYTE GTOK, NGETCH INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ BYTE C, DEFN(200), TOKEN(200), T, PTOKEN(200) C = GTOK(PTOKEN, 200, FD) IF (.NOT.(C .EQ. 40)) GOTO 3380 C define (name, defn) T = 40 GOTO 3390 3380 CONTINUE C define name defn T = 32 CALL PBSTR(PTOKEN) 3390 CONTINUE IF (.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. -100)) GOTO 3400 CALL ERROR('non-alphanumeric name.') 3400 CONTINUE C = GTOK(PTOKEN, 200, FD) IF (.NOT.(T .EQ. 32)) GOTO 3420 C define name defn CALL PBSTR(PTOKEN) I = 1 3440 CONTINUE C = NGETCH(C, FD) IF (.NOT.(I .GT. DEFSIZ)) GOTO 3470 CALL ERROR('definition too long.') 3470 CONTINUE DEFN(I) = C I = I + 1 3450 IF (.NOT.(C .EQ. 35 .OR. C .EQ. 13 .OR. C .EQ. -10)) GOTO 3440 3460 CONTINUE IF (.NOT.(C .EQ. 35)) GOTO 3490 CALL PUTBAK(C) 3490 CONTINUE GOTO 3430 3420 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 3510 C define (name, defn) IF (.NOT.(C .NE. 44)) GOTO 3530 CALL ERROR('missing comma in define.') C else got (name, 3530 CONTINUE NLPAR = 0 I = 1 3550 IF (.NOT.(NLPAR .GE. 0)) GOTO 3570 IF (.NOT.(I .GT. DEFSIZ)) GOTO 3580 CALL ERROR('definition too long.') GOTO 3590 3580 CONTINUE IF (.NOT.(NGETCH(DEFN(I), FD) .EQ. -10)) GOTO 3600 CALL ERROR('missing right paren.') GOTO 3610 3600 CONTINUE IF (.NOT.(DEFN(I) .EQ. 40)) GOTO 3620 NLPAR = NLPAR + 1 GOTO 3630 3620 CONTINUE IF (.NOT.(DEFN(I) .EQ. 41)) GOTO 3640 NLPAR = NLPAR - 1 C else normal character in defn(i) 3640 CONTINUE 3630 CONTINUE 3610 CONTINUE 3590 CONTINUE 3560 I = I + 1 GOTO 3550 3570 CONTINUE GOTO 3520 3510 CONTINUE CALL ERROR('getdef is confused.') 3520 CONTINUE 3430 CONTINUE DEFN(I - 1) = 0 RETURN END C ARCHIVE GETTOK.RAT 89 25-MAR-80 01:23:01 C# gettok - get token. handles file inclusion and line numbers BYTE FUNCTION GETTOK(TOKEN, TOKSIZ) INTEGER EQUAL, OPEN INTEGER T, I, J, TOKSIZ BYTE DEFTOK BYTE NAME(34), TOKEN(200), FILNAM(34) CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C-------------------------------------------------------------------------- C# preprocessor common block to hold current function name C put on a file named 'cfname' C Used only by ratfor preprocessor COMMON/CFNAME/FCNAME(20) Ctext of current function name BYTE FCNAME C string incl 'include' BYTE INCL(8) C string fncn 'function' BYTE FNCN(9) DATA INCL(1)/73/ DATA INCL(2)/78/ DATA INCL(3)/67/ DATA INCL(4)/76/ DATA INCL(5)/85/ DATA INCL(6)/68/ DATA INCL(7)/69/ DATA INCL(8)/0/ DATA FNCN(1)/70/ DATA FNCN(2)/85/ DATA FNCN(3)/78/ DATA FNCN(4)/67/ DATA FNCN(5)/84/ DATA FNCN(6)/73/ DATA FNCN(7)/79/ DATA FNCN(8)/78/ DATA FNCN(9)/0/ 3660 IF (.NOT.(LEVEL .GT. 0)) GOTO 3680 GETTOK = DEFTOK(TOKEN, TOKSIZ, INFILE(LEVEL)) 3690 IF (.NOT.(GETTOK .NE. -10)) GOTO 3710 IF (.NOT.(EQUAL(TOKEN, FNCN) .EQ. 1)) GOTO 3720 T = DEFTOK(FCNAME, 20, INFILE(LEVEL)) CALL PBSTR(FCNAME) RETURN 3720 CONTINUE IF (.NOT.(EQUAL(TOKEN, INCL) .EQ. 0)) GOTO 3740 RETURN 3740 CONTINUE I = 0 Cpick up file name -- watch out for characters that might Chave been processed by deftok 3760 CONTINUE T = DEFTOK(NAME, 34, INFILE(LEVEL)) J = 1 3790 IF (.NOT.(NAME(J) .NE. 0)) GOTO 3810 I = I + 1 FILNAM(I) = NAME(J) CIAS if (filnam(i) == LBRACE) filnam(i) = LBRACK CIAS if (filnam(i) == RBRACE) filnam(i) = RBRACK IF (.NOT.(FILNAM(I) .EQ. 123)) GOTO 3820 FILNAM(I) = 91 3820 CONTINUE IF (.NOT.(FILNAM(I) .EQ. 125)) GOTO 3840 FILNAM(I) = 93 3840 CONTINUE 3800 J = J + 1 GOTO 3790 3810 CONTINUE 3770 IF (.NOT.(T .EQ. 13 .OR. T .EQ. 59)) GOTO 3760 3780 CONTINUE FILNAM(I) = 0 IF (.NOT.(LEVEL .GE. 6)) GOTO 3860 CALL SYNERR('includes nested too deeply.') GOTO 3870 3860 CONTINUE INFILE(LEVEL + 1) = OPEN(FILNAM, 'R') LINECT(LEVEL + 1) = 1 IF (.NOT.(INFILE(LEVEL+1) .EQ. -1)) GOTO 3880 CALL PUTLIN(FILNAM, 3) CNOTIAS CALL SYNERR('can''t open include.') CIAS call synerr ('can''t open include') GOTO 3890 3880 CONTINUE LEVEL = LEVEL + 1 IF (.NOT.(FNAMP+I .LE. 6*34)) GOTO 3900 CALL SCOPY(FILNAM, 1, FNAMES, FNAMP) C push file name stack FNAMP = FNAMP + I 3900 CONTINUE 3890 CONTINUE 3870 CONTINUE 3700 GETTOK = DEFTOK(TOKEN, TOKSIZ, INFILE(LEVEL)) GOTO 3690 3710 CONTINUE IF (.NOT.(LEVEL .GT. 1)) GOTO 3920 C close include and pop file name stack CALL CLOSE(INFILE(LEVEL)) FNAMP = FNAMP - 1 3940 IF (.NOT.(FNAMP .GT. 1)) GOTO 3960 IF (.NOT.(FNAMES(FNAMP-1) .EQ. 0)) GOTO 3970 GOTO 3960 3970 CONTINUE 3950 FNAMP = FNAMP - 1 GOTO 3940 3960 CONTINUE 3920 CONTINUE 3670 LEVEL = LEVEL - 1 GOTO 3660 3680 CONTINUE C in case called more than once TOKEN(1) = - 10 TOKEN(2) = 0 GETTOK = - 10 RETURN END C ARCHIVE GTOK.RAT 76 25-JUN-80 23:06:21 C# gtok - get token for Ratfor BYTE FUNCTION GTOK(LEXSTR, TOKSIZ, FD) BYTE NGETCH, TYPE INTEGER FD, I, TOKSIZ BYTE C, LEXSTR(200) CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES 3990 IF (.NOT.(NGETCH(C, FD) .NE. -10)) GOTO 4000 IF (.NOT.(C .NE. 32 .AND. C .NE. 9)) GOTO 4010 GOTO 4000 4010 CONTINUE GOTO 3990 4000 CONTINUE CALL PUTBAK(C) I = 1 4030 IF (.NOT.(I .LE. TOKSIZ)) GOTO 4050 GTOK = TYPE(NGETCH(LEXSTR(I), FD)) IF (.NOT.(GTOK .NE. 1 .AND. GTOK .NE. 2)) GOTO 4060 GOTO 4050 4060 CONTINUE 4040 I = I + 1 GOTO 4030 4050 CONTINUE IF (.NOT.(I .GT. TOKSIZ)) GOTO 4080 CALL SYNERR('token too long.') I = I - 1 4080 CONTINUE IF (.NOT.(I .GT. 1)) GOTO 4100 C some alpha seen C went one too far CALL PUTBAK(LEXSTR(I)) I = I - 1 GTOK = - 100 GOTO 4110 4100 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 91)) GOTO 4120 C allow [ for { LEXSTR(1) = 123 GTOK = 123 GOTO 4130 4120 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 93)) GOTO 4140 C allow ] for } LEXSTR(1) = 125 GTOK = 125 GOTO 4150 4140 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 36)) GOTO 4160 C allow $( and $) for { and } IF (.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40)) GOTO 4180 LEXSTR(1) = 123 GTOK = 123 GOTO 4190 4180 CONTINUE IF (.NOT.(LEXSTR(2) .EQ. 41)) GOTO 4200 LEXSTR(1) = 125 GTOK = 125 GOTO 4210 4200 CONTINUE CALL PUTBAK(LEXSTR(2)) 4210 CONTINUE 4190 CONTINUE GOTO 4170 4160 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 39 .OR. LEXSTR(1) .EQ. 34)) GOTO *4220 I = 2 4240 IF (.NOT.(NGETCH(LEXSTR(I),FD) .NE. LEXSTR(1))) GOTO 426 *0 IF (.NOT.(LEXSTR(I) .EQ. 13)) GOTO 4270 4290 IF (.NOT.(I .GT. 1)) GOTO 4310 Cwpw Cwpw CALL PUTBAK(LEXSTR(I)) 4300 I = I - 1 GOTO 4290 4310 CONTINUE GOTO 4260 4270 CONTINUE IF (.NOT.(I .GE. TOKSIZ-1)) GOTO 4320 CALL SYNERR('missing quote.') LEXSTR(I) = LEXSTR(1) CALL PUTBAK(13) GOTO 4260 4320 CONTINUE 4280 CONTINUE 4250 I = I + 1 GOTO 4240 4260 CONTINUE GOTO 4230 4220 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 35)) GOTO 4340 C output comments CALL PUTCH(67, 2) 4360 IF (.NOT.(NGETCH(LEXSTR(1), FD) .NE. 13)) GOTO 4370 CALL PUTCH(LEXSTR(1), 2) GOTO 4360 4370 CONTINUE CALL PUTCH(13, 2) GTOK = 13 GOTO 4350 4340 CONTINUE IF (.NOT.(LEXSTR(1) .EQ. 62 .OR. LEXSTR(1) .EQ. 60 .OR *. LEXSTR(1) .EQ. 126 .OR. LEXSTR(1) .EQ. 33 .OR. LEXSTR(1) .EQ. 94 * .OR. LEXSTR(1) .EQ. 92 .OR. LEXSTR(1) .EQ. 61 .OR. LEXSTR(1) .EQ. * 38 .OR. LEXSTR(1) .EQ. 124)) GOTO 4380 CALL RELATE(LEXSTR, I, FD) 4380 CONTINUE 4350 CONTINUE 4230 CONTINUE 4170 CONTINUE 4150 CONTINUE 4130 CONTINUE 4110 CONTINUE LEXSTR(I + 1) = 0 IF (.NOT.(LEXSTR(1) .EQ. 13)) GOTO 4400 LINECT(LEVEL) = LINECT(LEVEL) + 1 4400 CONTINUE RETURN END C ARCHIVE IFCODE.RAT 13 11-APR-80 02:36:51 C# ifcode - generate initial code for if SUBROUTINE IFCODE(LAB) INTEGER LABGEN INTEGER LAB C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER XFER = 0 LAB = LABGEN(2) CALL IFGO(LAB) CALL INDEN(2) RETURN END C ARCHIVE IFGO.RAT 24 25-MAR-80 01:23:02 C# ifgo - generate 'if (.not.(...)) goto lab' SUBROUTINE IFGO(LAB) INTEGER LAB C string ifnot 'if (.not.' BYTE IFNOT(10) DATA IFNOT(1)/73/ DATA IFNOT(2)/70/ DATA IFNOT(3)/32/ DATA IFNOT(4)/40/ DATA IFNOT(5)/46/ DATA IFNOT(6)/78/ DATA IFNOT(7)/79/ DATA IFNOT(8)/84/ DATA IFNOT(9)/46/ DATA IFNOT(10)/0/ C get to column 7 CALL OUTTAB C ' if(.not. ' CALL OUTSTR(IFNOT) C collect and output condition CALL BALPAR C ' ) ' CALL OUTCH(41) CALL OUTCH(32) C ' goto lab ' CALL OUTGO(LAB) RETURN END C ARCHIVE INITKW.RAT 22 25-MAR-80 01:23:02 C# initkw - initialize table and install keywords 'define' and 'DEFINE' SUBROUTINE INITKW INTEGER I C-------------------------------------------------------------------- C# preprocessor common block to hold definitions C put on a file named 'clook' C Used by ratfor preprocessor, macro, and form tools COMMON/CLOOK/AVAIL, TABPTR(127), TABLE(6500) Cfirst location in table; init = 1 INTEGER AVAIL Cname poiners; init = 0 INTEGER TABPTR Cactual text of names and definitions INTEGER TABLE C string defnam 'define' and 'DEFINE' BYTE DEFNAM(14), DEFTYP(2) DATA DEFNAM(1)/100/, DEFNAM(2)/101/, DEFNAM(3)/102/ DATA DEFNAM(4)/105/, DEFNAM(5)/110/, DEFNAM(6)/101/ DATA DEFNAM(7)/0/ DATA DEFNAM(8)/68/, DEFNAM(9)/69/, DEFNAM(10)/70/ DATA DEFNAM(11)/73/, DEFNAM(12)/78/, DEFNAM(13)/69/ DATA DEFNAM(14)/0/ DATA DEFTYP(1), DEFTYP(2)/ - 4, 0/ AVAIL = 1 I = 1 4420 IF (.NOT.(I .LE. 127)) GOTO 4440 TABPTR(I) = 0 4430 I = I + 1 GOTO 4420 4440 CONTINUE CALL INSTAL(DEFNAM, DEFTYP) CALL INSTAL(DEFNAM(8), DEFTYP) RETURN END C ARCHIVE INITRT.RAT 112 25-JUN-80 23:06:24 C#initrt - initialize variables for ratfor compiler /*/sor/rat4r/initrt SUBROUTINE INITRT C initialize global variables C these may be put in a block data program C if available on your system C common blocks C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C---------------------------------------------------------------------- C# preprocessor common block to hold input characters C Put on a file called 'cdefio' C Used by ratfor preprocessor, macro, form, and shell tools COMMON/CDEFIO/BP, BUF(300) C next available character; init = 0 INTEGER BP C pushed-back characters BYTE BUF C-------------------------------------------------------------------------- C# preprocessor common block to hold info about 'for' statements C put on a file named 'cfor' C Used only by ratfor preprocessor COMMON/CFOR/FORDEP, FORSTK(200) C current depth of for statements INTEGER FORDEP C stack of reinit strings BYTE FORSTK C-------------------------------------------------------------------- C# preprocessor common block to hold definitions C put on a file named 'clook' C Used by ratfor preprocessor, macro, and form tools COMMON/CLOOK/AVAIL, TABPTR(127), TABLE(6500) Cfirst location in table; init = 1 INTEGER AVAIL Cname poiners; init = 0 INTEGER TABPTR Cactual text of names and definitions INTEGER TABLE C-------------------------------------------------------------------- C# preprocessor common block to hold ratfor keywords C put on a file named 'ckeywd' C Used only by ratfor preprocessor COMMON/CKEYWD/VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, * VUNTIL, VLITRL, VRET, VWRITE, VREAD, VENCOD, VDECOD, VFORMA, SDO, * SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SREPT, SUNTIL, SLITRL, S *RET, SWRITE, SREAD, SENCOD, SDECOD, SFORMA INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2) INTEGER VFOR(2), VREPT(2), VUNTIL(2), VLITRL(2), VRET(2) INTEGER VWRITE(2), VREAD(2), VENCOD(2), VDECOD(2), VFORMA(2) BYTE SDO(4), SIF(4), SELSE(6), SWHILE(6), SBREAK(6), SNEXT(6) BYTE SFOR(4), SREPT(8), SUNTIL(6), SLITRL(2), SRET(8) BYTE SWRITE(6), SREAD(5), SENCOD(7), SDECOD(7), SFORMA(7) C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C-------------------------------------------------------------------------- C# preprocessor common block to hold current function name C put on a file named 'cfname' C Used only by ratfor preprocessor COMMON/CFNAME/FCNAME(20) Ctext of current function name BYTE FCNAME C------------------------------------------------------------------ C# preprocessor common block to hold flags C put on a file named 'cflags' C Used only by ratfor preprocessor COMMON/CFLAGS/INFORM C when .true., < and > aren't LOGICAL INFORM C converted to .lt. and .gt. C------------------------------------------------------------------ C keywords: DATA SDO(1), SDO(2), SDO(3)/68, 79, 0/ DATA VDO(1), VDO(2)/ - 7, 0/ DATA SIF(1), SIF(2), SIF(3)/73, 70, 0/ DATA VIF(1), VIF(2)/ - 12, 0/ DATA SELSE(1), SELSE(2), SELSE(3), SELSE(4), SELSE(5)/69, 76, 83, *69, 0/ DATA VELSE(1), VELSE(2)/ - 11, 0/ DATA SWHILE(1), SWHILE(2), SWHILE(3), SWHILE(4), SWHILE(5), SWHILE *(6)/87, 72, 73, 76, 69, 0/ DATA VWHILE(1), VWHILE(2)/ - 15, 0/ DATA SBREAK(1), SBREAK(2), SBREAK(3), SBREAK(4), SBREAK(5), SBREAK *(6)/66, 82, 69, 65, 75, 0/ DATA VBREAK(1), VBREAK(2)/ - 8, 0/ DATA SNEXT(1), SNEXT(2), SNEXT(3), SNEXT(4), SNEXT(5)/78, 69, 88, *84, 0/ DATA VNEXT(1), VNEXT(2)/ - 13, 0/ DATA SFOR(1), SFOR(2), SFOR(3), SFOR(4)/70, 79, 82, 0/ DATA VFOR(1), VFOR(2)/ - 16, 0/ DATA SREPT(1), SREPT(2), SREPT(3), SREPT(4), SREPT(5), SREPT(6), S *REPT(7)/82, 69, 80, 69, 65, 84, 0/ DATA VREPT(1), VREPT(2)/ - 17, 0/ DATA SLITRL(1), SLITRL(2)/37, 0/ DATA VLITRL(1), VLITRL(2)/ - 19, 0/ DATA SUNTIL(1), SUNTIL(2), SUNTIL(3), SUNTIL(4), SUNTIL(5), SUNTIL *(6)/85, 78, 84, 73, 76, 0/ DATA VUNTIL(1), VUNTIL(2)/ - 18, 0/ DATA SRET(1), SRET(2), SRET(3), SRET(4), SRET(5), SRET(6), SRET(7) */82, 69, 84, 85, 82, 78, 0/ DATA VRET(1), VRET(2)/ - 20, 0/ DATA SWRITE/87, 82, 73, 84, 69, 0/ DATA VWRITE/ - 21, 0/ DATA SREAD/82, 69, 65, 68, 0/ DATA VREAD/ - 22, 0/ DATA SENCOD/69, 78, 67, 79, 68, 69, 0/ DATA VENCOD/ - 23, 0/ DATA SDECOD/68, 69, 67, 79, 68, 69, 0/ DATA VDECOD/ - 24, 0/ DATA SFORMA/70, 79, 82, 77, 65, 84, 0/ DATA VFORMA/ - 25, 0/ C output character pointer C(note--this is also initialized in 'parse') DATA OUTP/0/ C indent level DATA INDENT/0/ C file conrol C (note--also initialized in 'parse') DATA LEVEL/1/ DATA LINECT(1)/1/ DATA INFILE(1)/5/ DATA FNAMP/2/ DATA FNAMES(1)/0/ C pushback buffer pointer C (note--also initialized in 'parse') DATA BP/0/ C depth of for stack C (note--also initialized in 'parse') DATA FORDEP/0/ C pointers for table lookup code DATA AVAIL/1/ DATA TABPTR/127*0/ C current function name for return DATA FCNAME(1)/0/ C flag controlling conversion of > and < to .gt. and .lt. DATA INFORM/.FALSE./ Cinstall keywords in table CALL INITKW RETURN END C ARCHIVE INSTAL.RAT 27 25-MAR-80 01:23:03 C# instal - add name and definition to table SUBROUTINE INSTAL(NAME, DEFN) BYTE DEFN(200), NAME(200) INTEGER C INTEGER LENGTH INTEGER DLEN, NLEN C-------------------------------------------------------------------- C# preprocessor common block to hold definitions C put on a file named 'clook' C Used by ratfor preprocessor, macro, and form tools COMMON/CLOOK/AVAIL, TABPTR(127), TABLE(6500) Cfirst location in table; init = 1 INTEGER AVAIL Cname poiners; init = 0 INTEGER TABPTR Cactual text of names and definitions INTEGER TABLE NLEN = LENGTH(NAME) + 1 DLEN = LENGTH(DEFN) + 1 IF (.NOT.(AVAIL+NLEN+DLEN .GT. 6500)) GOTO 4450 CALL PUTLIN(NAME, 3) CALL REMARK(': too many definitions.') RETURN 4450 CONTINUE C = NAME(1) TABLE(AVAIL) = TABPTR(C) TABPTR(C) = AVAIL C***NOTE*** Some systems allow byte-addressable character strings C which differ in format from integered strings. Thus C special 'scopy' routines are needed to deal with them. CALL SCOPYI(NAME, 1, TABLE, AVAIL + 1) CALL SCOPYI(DEFN, 1, TABLE, AVAIL + NLEN + 1) AVAIL = AVAIL + NLEN + DLEN + 1 RETURN END C ARCHIVE LABELC.RAT 18 10-APR-80 10:05:44 C# labelc - output statement number SUBROUTINE LABELC(LEXSTR) BYTE LEXSTR(1) INTEGER LENGTH, I C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C can't suppress goto's now XFER = 0 C if (length(lexstr) == 5) # warn about 23xxx labels C if (lexstr(1) == DIG2 & lexstr(2) == DIG3) I = LENGTH(LEXSTR) IF (.NOT.(LEXSTR(I) .EQ. 48)) GOTO 4470 IF (.NOT.(I .GT. 4 .OR. (LEXSTR(1) .NE. 49 .AND. I .EQ. 4))) GOT *O 4490 CALL SYNERR('warning: possible label conflict.') 4490 CONTINUE 4470 CONTINUE CALL OUTSTR(LEXSTR) CALL OUTTAB RETURN END C ARCHIVE LITRAL.RAT 27 25-MAR-80 01:23:04 C# litral - process literal ratfor lines SUBROUTINE LITRAL INTEGER GETLIN C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C Finish off any left-over characters IF (.NOT.(OUTP .GT. 0)) GOTO 4510 CALL OUTDON 4510 CONTINUE C throw away end of current line CALL GETLIN(OUTBUF, INFILE(LEVEL)) Cloop through input until matching toggle found 4530 IF (.NOT.(GETLIN(OUTBUF, INFILE(LEVEL)) .NE. -10)) GOTO 4540 I = 1 4550 IF (.NOT.(OUTBUF(I) .EQ. 32)) GOTO 4570 4560 I = I + 1 GOTO 4550 4570 CONTINUE IF (.NOT.(OUTBUF(I) .EQ. 37)) GOTO 4580 GOTO 4540 4580 CONTINUE CALL PUTLIN(OUTBUF, 2) LINECT(LEVEL) = LINECT(LEVEL) + 1 GOTO 4530 4540 CONTINUE OUTP = 0 RETURN END C ARCHIVE LABGEN.RAT 9 10-APR-80 10:05:45 C# labgen - generate n consecutive labels, return first one INTEGER FUNCTION LABGEN(N) INTEGER LABEL, N DATA LABEL/2000/ LABGEN = LABEL LABEL = LABEL + N*10 RETURN END C ARCHIVE LEX.RAT 51 25-JUN-80 23:06:28 C# lex - return lexical type of token INTEGER FUNCTION LEX(LEXSTR) BYTE GETTOK BYTE LEXSTR(200) INTEGER ALLDIG, EQUAL C-------------------------------------------------------------------- C# preprocessor common block to hold ratfor keywords C put on a file named 'ckeywd' C Used only by ratfor preprocessor COMMON/CKEYWD/VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, * VUNTIL, VLITRL, VRET, VWRITE, VREAD, VENCOD, VDECOD, VFORMA, SDO, * SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SREPT, SUNTIL, SLITRL, S *RET, SWRITE, SREAD, SENCOD, SDECOD, SFORMA INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2) INTEGER VFOR(2), VREPT(2), VUNTIL(2), VLITRL(2), VRET(2) INTEGER VWRITE(2), VREAD(2), VENCOD(2), VDECOD(2), VFORMA(2) BYTE SDO(4), SIF(4), SELSE(6), SWHILE(6), SBREAK(6), SNEXT(6) BYTE SFOR(4), SREPT(8), SUNTIL(6), SLITRL(2), SRET(8) BYTE SWRITE(6), SREAD(5), SENCOD(7), SDECOD(7), SFORMA(7) 4600 IF (.NOT.(GETTOK(LEXSTR, 200) .EQ. 13)) GOTO 4610 GOTO 4600 4610 CONTINUE LEX = LEXSTR(1) IF (.NOT.(LEX .EQ. -10 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LEX * .EQ. 125)) GOTO 4620 RETURN 4620 CONTINUE IF (.NOT.(ALLDIG(LEXSTR) .EQ. 1)) GOTO 4640 LEX = - 9 GOTO 4650 4640 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1)) GOTO 4660 LEX = VIF(1) GOTO 4670 4660 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1)) GOTO 4680 LEX = VELSE(1) GOTO 4690 4680 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1)) GOTO 4700 LEX = VWHILE(1) GOTO 4710 4700 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1)) GOTO 4720 LEX = VDO(1) GOTO 4730 4720 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1)) GOTO 4740 LEX = VBREAK(1) GOTO 4750 4740 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1)) GOTO 4760 LEX = VNEXT(1) GOTO 4770 4760 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1)) GOTO 4780 LEX = VFOR(1) GOTO 4790 4780 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1)) GOTO 4800 LEX = VREPT(1) GOTO 4810 4800 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1)) GOTO 48 *20 LEX = VUNTIL(1) GOTO 4830 4820 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SRET) .EQ. 1)) GOTO 48 *40 LEX = VRET(1) GOTO 4850 4840 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SLITRL) .EQ. 1)) GOT *O 4860 LEX = VLITRL(1) GOTO 4870 4860 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SWRITE) .EQ. 1)) G *OTO 4880 LEX = VWRITE(1) GOTO 4890 4880 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SREAD) .EQ. 1)) *GOTO 4900 LEX = VREAD(1) GOTO 4910 4900 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SENCOD) .EQ. 1 *)) GOTO 4920 LEX = VENCOD(1) GOTO 4930 4920 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SDECOD) .EQ. * 1)) GOTO 4940 LEX = VDECOD(1) GOTO 4950 4940 CONTINUE IF (.NOT.(EQUAL(LEXSTR, SFORMA) .E *Q. 1)) GOTO 4960 LEX = VFORMA(1) GOTO 4970 4960 CONTINUE LEX = - 14 4970 CONTINUE 4950 CONTINUE 4930 CONTINUE 4910 CONTINUE 4890 CONTINUE 4870 CONTINUE 4850 CONTINUE 4830 CONTINUE 4810 CONTINUE 4790 CONTINUE 4770 CONTINUE 4750 CONTINUE 4730 CONTINUE 4710 CONTINUE 4690 CONTINUE 4670 CONTINUE 4650 CONTINUE RETURN END C ARCHIVE LOOKUP.RAT 25 25-MAR-80 01:23:05 C# lookup - locate name, extract definition from table INTEGER FUNCTION LOOKUP(NAME, DEFN) BYTE DEFN(200), NAME(200) INTEGER I, J, K, C C-------------------------------------------------------------------- C# preprocessor common block to hold definitions C put on a file named 'clook' C Used by ratfor preprocessor, macro, and form tools COMMON/CLOOK/AVAIL, TABPTR(127), TABLE(6500) Cfirst location in table; init = 1 INTEGER AVAIL Cname poiners; init = 0 INTEGER TABPTR Cactual text of names and definitions INTEGER TABLE C = NAME(1) I = TABPTR(C) 4980 IF (.NOT.(I .GT. 0)) GOTO 5000 J = I + 1 K = 1 5010 IF (.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 0)) GOTO 5030 J = J + 1 5020 K = K + 1 GOTO 5010 5030 CONTINUE IF (.NOT.(NAME(K) .EQ. TABLE(J))) GOTO 5040 C got one C***NOTE*** Some systems allow byte-addressable character C strings, which differ from integer strings. Thus C special 'scopy' routines are needed to deal with C them. CALL ICOPYS(TABLE, J + 1, DEFN, 1) LOOKUP = 1 RETURN 5040 CONTINUE 4990 I = TABLE(I) GOTO 4980 5000 CONTINUE LOOKUP = 0 RETURN END C ARCHIVE NGETCH.RAT 28 23-JUN-80 00:24:50 C# ngetch - get a (possibly pushed back) character BYTE FUNCTION NGETCH(C, FD) BYTE GETCH BYTE C, C2 INTEGER FD C---------------------------------------------------------------------- C# preprocessor common block to hold input characters C Put on a file called 'cdefio' C Used by ratfor preprocessor, macro, form, and shell tools COMMON/CDEFIO/BP, BUF(300) C next available character; init = 0 INTEGER BP C pushed-back characters BYTE BUF 10 IF (.NOT.(BP .GT. 0)) GOTO 5060 C = BUF(BP) BP = BP - 1 GOTO 5070 5060 CONTINUE C = GETCH(C, FD) 5070 CONTINUE IF (.NOT.(C .EQ. 95)) GOTO 5080 IF (.NOT.(BP .GT. 0)) GOTO 5100 C2 = BUF(BP) BP = BP - 1 GOTO 5110 5100 CONTINUE C2 = GETCH(C2, FD) 5110 CONTINUE IF (.NOT.(C2 .EQ. 13)) GOTO 5120 GOTO 10 5120 CONTINUE CALL PUTBAK(C2) 5080 CONTINUE NGETCH = C RETURN END C ARCHIVE OTHERC.RAT 13 25-MAR-80 01:23:05 C# otherc - output ordinary Fortran statement SUBROUTINE OTHERC(LEXSTR) BYTE LEXSTR(1) C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER XFER = 0 CALL OUTTAB CALL OUTSTR(LEXSTR) CALL EATUP CALL OUTDON RETURN END C ARCHIVE OUTCH.RAT 18 25-MAR-80 01:23:06 C# outch - put one character into output buffer SUBROUTINE OUTCH(C) BYTE C INTEGER I C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ IF (.NOT.(OUTP .GE. 72)) GOTO 5140 C continuation card CALL OUTDON I = 1 5160 IF (.NOT.(I .LT. 6)) GOTO 5180 OUTBUF(I) = 32 5170 I = I + 1 GOTO 5160 5180 CONTINUE OUTBUF(6) = 42 OUTP = 6 5140 CONTINUE OUTP = OUTP + 1 OUTBUF(OUTP) = C RETURN END C ARCHIVE OUTCON.RAT 28 25-MAR-80 01:23:06 C# outcon - output 'n continue' SUBROUTINE OUTCON(N) INTEGER N C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ C string contin 'continue' BYTE CONTIN(9) DATA CONTIN(1)/67/ DATA CONTIN(2)/79/ DATA CONTIN(3)/78/ DATA CONTIN(4)/84/ DATA CONTIN(5)/73/ DATA CONTIN(6)/78/ DATA CONTIN(7)/85/ DATA CONTIN(8)/69/ DATA CONTIN(9)/0/ XFER = 0 IF (.NOT.(N .LE. 0 .AND. OUTP .EQ. 0)) GOTO 5190 C don't need unlabeled continues RETURN 5190 CONTINUE IF (.NOT.(N .GT. 0)) GOTO 5210 CALL OUTNUM(N) 5210 CONTINUE CALL OUTTAB CALL OUTSTR(CONTIN) CALL OUTDON RETURN END C ARCHIVE OUTDON.RAT 11 25-MAR-80 01:23:06 C# outdon - finish off an output line SUBROUTINE OUTDON C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ OUTBUF(OUTP + 1) = 13 OUTBUF(OUTP + 2) = 0 CALL PUTLIN(OUTBUF, 2) OUTP = 0 RETURN END C ARCHIVE OUTGO.RAT 22 25-MAR-80 01:23:06 C# outgo - output 'goto n' SUBROUTINE OUTGO(N) INTEGER N C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C string goto 'goto' BYTE GOTO(6) DATA GOTO(1)/71/ DATA GOTO(2)/79/ DATA GOTO(3)/84/ DATA GOTO(4)/79/ DATA GOTO(5)/32/ DATA GOTO(6)/0/ IF (.NOT.(XFER .EQ. 1)) GOTO 5230 RETURN 5230 CONTINUE CALL OUTTAB CALL OUTSTR(GOTO) CALL OUTNUM(N) CALL OUTDON RETURN END C ARCHIVE OUTNUM.RAT 30 25-MAR-80 01:23:07 C# outnum - output positive decimal number SUBROUTINE OUTNUM(N) BYTE CHARS(10) INTEGER D, I, M C string digits '0123456789' BYTE DIGITS(11) DATA DIGITS(1)/48/ DATA DIGITS(2)/49/ DATA DIGITS(3)/50/ DATA DIGITS(4)/51/ DATA DIGITS(5)/52/ DATA DIGITS(6)/53/ DATA DIGITS(7)/54/ DATA DIGITS(8)/55/ DATA DIGITS(9)/56/ DATA DIGITS(10)/57/ DATA DIGITS(11)/0/ M = N I = 0 5250 CONTINUE I = I + 1 D = MOD(M, 10) CHARS(I) = DIGITS(D + 1) M = M/10 5260 IF (.NOT.(M .EQ. 0 .OR. I .GE. 10)) GOTO 5250 5270 CONTINUE 5280 IF (.NOT.(I .GT. 0)) GOTO 5300 CALL OUTCH(CHARS(I)) 5290 I = I - 1 GOTO 5280 5300 CONTINUE RETURN END C ARCHIVE OUTSTR.RAT 34 25-JUN-80 23:06:32 C# outstr - output string SUBROUTINE OUTSTR(STR) C***NOTE*** - strings on BKY were converted to nL... format, a C hollerith string terminated with a zero byte. C***NOTE*** - modified to put out quoted literals BYTE C, STR(1) INTEGER I, J I = 1 5310 IF (.NOT.(STR(I) .NE. 0)) GOTO 5330 C = STR(I) IF (.NOT.((C .NE. 39 .AND. C .NE. 34) .OR. STR(I+1) .EQ. 0)) GOT *O 5340 CALL OUTCH(C) GOTO 5350 5340 CONTINUE CALL OUTCH(39) I = I + 1 5360 IF (.NOT.(STR(I) .NE. C)) GOTO 5380 IF (.NOT.(STR(I) .EQ. 39)) GOTO 5390 C "'" -> '''' CALL OUTCH(39) 5390 CONTINUE CALL OUTCH(STR(I)) 5370 I = I + 1 GOTO 5360 5380 CONTINUE CALL OUTCH(39) C i = i + 1 C for (j = i; str(j) ~= c; j = j + 1) # find end C ; C call outnum(j-i) C call outch (BIGH) #NOTBKY C #BKY call outch (BIGL) C for ( ; i < j; i = i + 1) C call outch(str(i)) 5350 CONTINUE 5320 I = I + 1 GOTO 5310 5330 CONTINUE RETURN END C ARCHIVE OUTTAB.RAT 11 11-APR-80 02:38:45 C# outtab - get past column 6 SUBROUTINE OUTTAB INTEGER I, MOD C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ I = MOD(INDENT, 44) + 6 5410 IF (.NOT.(OUTP .LT. I)) GOTO 5420 CALL OUTCH(32) GOTO 5410 5420 CONTINUE RETURN END C ARCHIVE PARSE.RAT 93 25-JUN-80 23:06:34 C# parse - parse Ratfor source program SUBROUTINE PARSE BYTE LEXSTR(200) INTEGER LEX INTEGER LAB, LABVAL(100), LEXTYP(100), SP, TOKEN C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C---------------------------------------------------------------------- C# preprocessor common block to hold input characters C Put on a file called 'cdefio' C Used by ratfor preprocessor, macro, form, and shell tools COMMON/CDEFIO/BP, BUF(300) C next available character; init = 0 INTEGER BP C pushed-back characters BYTE BUF C-------------------------------------------------------------------------- C# preprocessor common block to hold info about 'for' statements C put on a file named 'cfor' C Used only by ratfor preprocessor COMMON/CFOR/FORDEP, FORSTK(200) C current depth of for statements INTEGER FORDEP C stack of reinit strings BYTE FORSTK C-------------------------------------------------------------------------- C# preprocessor common block to hold current function name C put on a file named 'cfname' C Used only by ratfor preprocessor COMMON/CFNAME/FCNAME(20) Ctext of current function name BYTE FCNAME C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C-------------------------------------------------------------------- C# preprocessor common block to hold ratfor keywords C put on a file named 'ckeywd' C Used only by ratfor preprocessor COMMON/CKEYWD/VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, * VUNTIL, VLITRL, VRET, VWRITE, VREAD, VENCOD, VDECOD, VFORMA, SDO, * SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SREPT, SUNTIL, SLITRL, S *RET, SWRITE, SREAD, SENCOD, SDECOD, SFORMA INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2) INTEGER VFOR(2), VREPT(2), VUNTIL(2), VLITRL(2), VRET(2) INTEGER VWRITE(2), VREAD(2), VENCOD(2), VDECOD(2), VFORMA(2) BYTE SDO(4), SIF(4), SELSE(6), SWHILE(6), SBREAK(6), SNEXT(6) BYTE SFOR(4), SREPT(8), SUNTIL(6), SLITRL(2), SRET(8) BYTE SWRITE(6), SREAD(5), SENCOD(7), SDECOD(7), SFORMA(7) C------------------------------------------------------------------ C# preprocessor common block to hold flags C put on a file named 'cflags' C Used only by ratfor preprocessor COMMON/CFLAGS/INFORM C when .true., < and > aren't LOGICAL INFORM C converted to .lt. and .gt. C------------------------------------------------------------------ Cinitialize variables for current input file OUTP = 0 INDENT = 0 LEVEL = 1 LINECT(1) = 1 FNAMP = 2 FNAMES(1) = 0 BP = 0 FORDEP = 0 FCNAME(1) = 0 SP = 1 LEXTYP(1) = - 10 TOKEN = LEX(LEXSTR) 5430 IF (.NOT.(TOKEN .NE. -10)) GOTO 5450 IF (.NOT.(TOKEN .EQ. -12)) GOTO 5460 CALL IFCODE(LAB) GOTO 5470 5460 CONTINUE IF (.NOT.(TOKEN .EQ. -7)) GOTO 5480 CALL DOCODE(LAB) GOTO 5490 5480 CONTINUE IF (.NOT.(TOKEN .EQ. -15)) GOTO 5500 CALL WHILEC(LAB) GOTO 5510 5500 CONTINUE IF (.NOT.(TOKEN .EQ. -16)) GOTO 5520 CALL FORCOD(LAB) GOTO 5530 5520 CONTINUE IF (.NOT.(TOKEN .EQ. -17)) GOTO 5540 CALL REPCOD(LAB) GOTO 5550 5540 CONTINUE IF (.NOT.(TOKEN .EQ. -9)) GOTO 5560 CALL LABELC(LEXSTR) GOTO 5570 5560 CONTINUE IF (.NOT.(TOKEN .EQ. -11)) GOTO 5580 IF (.NOT.(LEXTYP(SP) .EQ. -12)) GOTO 5600 CALL ELSE IF(LABVAL(SP)) GOTO 5610 5600 CONTINUE CALL SYNERR('illegal else.') 5610 CONTINUE GOTO 5590 5580 CONTINUE IF (.NOT.(TOKEN .EQ. -19)) GOTO 5620 CALL LITRAL 5620 CONTINUE 5590 CONTINUE 5570 CONTINUE 5550 CONTINUE 5530 CONTINUE 5510 CONTINUE 5490 CONTINUE 5470 CONTINUE IF (.NOT.(TOKEN .EQ. -12 .OR. TOKEN .EQ. -11 .OR. TOKEN .EQ. -15 * .OR. TOKEN .EQ. -16 .OR. TOKEN .EQ. -17 .OR. TOKEN .EQ. -7 .OR. T *OKEN .EQ. -9 .OR. TOKEN .EQ. 123)) GOTO 5640 C beginning of statement SP = SP + 1 IF (.NOT.(SP .GT. 100)) GOTO 5660 CALL ERROR('stack overflow in parser.') 5660 CONTINUE C stack type and value LEXTYP(SP) = TOKEN LABVAL(SP) = LAB GOTO 5650 5640 CONTINUE C end of statement - prepare to unstack IF (.NOT.(TOKEN .EQ. 125)) GOTO 5680 IF (.NOT.(LEXTYP(SP) .EQ. 123)) GOTO 5700 SP = SP - 1 GOTO 5710 5700 CONTINUE CALL SYNERR('illegal right brace.') 5710 CONTINUE GOTO 5690 5680 CONTINUE IF (.NOT.(TOKEN .EQ. -14)) GOTO 5720 CALL OTHERC(LEXSTR) GOTO 5730 5720 CONTINUE IF (.NOT.(TOKEN .EQ. -21)) GOTO 5740 CALL FORMAT(SWRITE) GOTO 5750 5740 CONTINUE IF (.NOT.(TOKEN .EQ. -22)) GOTO 5760 CALL FORMAT(SREAD) GOTO 5770 5760 CONTINUE IF (.NOT.(TOKEN .EQ. -23)) GOTO 5780 CALL FORMAT(SENCOD) GOTO 5790 5780 CONTINUE IF (.NOT.(TOKEN .EQ. -24)) GOTO 5800 CALL FORMAT(SDECOD) GOTO 5810 5800 CONTINUE IF (.NOT.(TOKEN .EQ. -25)) GOTO 5820 INFORM = .TRUE. CALL OTHERC(LEXSTR) INFORM = .FALSE. GOTO 5830 5820 CONTINUE IF (.NOT.(TOKEN .EQ. -8 .OR. TOKEN .EQ. -13)) GO *TO 5840 CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN) GOTO 5850 5840 CONTINUE IF (.NOT.(TOKEN .EQ. -20)) GOTO 5860 CALL RETCOD 5860 CONTINUE 5850 CONTINUE 5830 CONTINUE 5810 CONTINUE 5790 CONTINUE 5770 CONTINUE 5750 CONTINUE 5730 CONTINUE 5690 CONTINUE C peek at next token TOKEN = LEX(LEXSTR) CALL PBSTR(LEXSTR) CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN) 5650 CONTINUE 5440 TOKEN = LEX(LEXSTR) GOTO 5430 5450 CONTINUE IF (.NOT.(SP .NE. 1)) GOTO 5880 CALL SYNERR('unexpected EOF.') 5880 CONTINUE RETURN END C ARCHIVE PBSTR.RAT 10 25-MAR-80 01:23:08 C# pbstr - push string back onto input SUBROUTINE PBSTR(IN) BYTE IN(1) INTEGER LENGTH INTEGER I I = LENGTH(IN) 5900 IF (.NOT.(I .GT. 0)) GOTO 5920 CALL PUTBAK(IN(I)) 5910 I = I - 1 GOTO 5900 5920 CONTINUE RETURN END C ARCHIVE PUTBAK.RAT 12 25-MAR-80 01:23:08 C# putbak - push character back onto input SUBROUTINE PUTBAK(C) BYTE C C---------------------------------------------------------------------- C# preprocessor common block to hold input characters C Put on a file called 'cdefio' C Used by ratfor preprocessor, macro, form, and shell tools COMMON/CDEFIO/BP, BUF(300) C next available character; init = 0 INTEGER BP C pushed-back characters BYTE BUF BP = BP + 1 IF (.NOT.(BP .GT. 300)) GOTO 5930 CALL ERROR('too many characters pushed back.') 5930 CONTINUE BUF(BP) = C RETURN END C ARCHIVE RELATE.RAT 78 25-JUN-80 23:06:37 C# relate - convert relational shorthands into long form SUBROUTINE RELATE(TOKEN, LAST, FD) BYTE NGETCH BYTE TOKEN(1) INTEGER LENGTH INTEGER FD, LAST C------------------------------------------------------------------ C# preprocessor common block to hold flags C put on a file named 'cflags' C Used only by ratfor preprocessor COMMON/CFLAGS/INFORM C when .true., < and > aren't LOGICAL INFORM C converted to .lt. and .gt. 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. ' BYTE DOTGE(7), DOTGT(7), DOTLT(7), DOTLE(7) BYTE DOTNE(7), DOTNOT(6), DOTEQ(7), DOTAND(8), DOTOR(7) DATA DOTGE/32, 46, 71, 69, 46, 32, 0/ DATA DOTGT/32, 46, 71, 84, 46, 32, 0/ DATA DOTLE/32, 46, 76, 69, 46, 32, 0/ DATA DOTLT/32, 46, 76, 84, 46, 32, 0/ DATA DOTNE/32, 46, 78, 69, 46, 32, 0/ DATA DOTEQ/32, 46, 69, 81, 46, 32, 0/ DATA DOTOR/32, 46, 79, 82, 46, 32, 0/ DATA DOTAND/32, 46, 65, 78, 68, 46, 32, 0/ DATA DOTNOT/46, 78, 79, 84, 46, 0/ IF (.NOT.(NGETCH(TOKEN(2), FD) .NE. 61)) GOTO 5950 CALL PUTBAK(TOKEN(2)) 5950 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 62)) GOTO 5970 IF (.NOT.(TOKEN(2) .EQ. 61)) GOTO 5990 CALL SCOPY(DOTGE, 1, TOKEN, 1) GOTO 6000 5990 CONTINUE IF (.NOT.(INFORM)) GOTO 6010 TOKEN(2) = 0 GOTO 6020 6010 CONTINUE CALL SCOPY(DOTGT, 1, TOKEN, 1) 6020 CONTINUE 6000 CONTINUE GOTO 5980 5970 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 60)) GOTO 6030 IF (.NOT.(TOKEN(2) .EQ. 61)) GOTO 6050 CALL SCOPY(DOTLE, 1, TOKEN, 1) GOTO 6060 6050 CONTINUE IF (.NOT.(INFORM)) GOTO 6070 TOKEN(2) = 0 GOTO 6080 6070 CONTINUE CALL SCOPY(DOTLT, 1, TOKEN, 1) 6080 CONTINUE 6060 CONTINUE GOTO 6040 6030 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 126 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1 *) .EQ. 94)) GOTO 6090 IF (.NOT.(TOKEN(2) .EQ. 61)) GOTO 6110 CALL SCOPY(DOTNE, 1, TOKEN, 1) GOTO 6120 6110 CONTINUE CALL SCOPY(DOTNOT, 1, TOKEN, 1) 6120 CONTINUE GOTO 6100 6090 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 61)) GOTO 6130 IF (.NOT.(TOKEN(2) .EQ. 61)) GOTO 6150 CALL SCOPY(DOTEQ, 1, TOKEN, 1) GOTO 6160 6150 CONTINUE TOKEN(2) = 0 6160 CONTINUE GOTO 6140 6130 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 38)) GOTO 6170 CALL SCOPY(DOTAND, 1, TOKEN, 1) GOTO 6180 6170 CONTINUE IF (.NOT.(TOKEN(1) .EQ. 124 .OR. TOKEN(1) .EQ. 92)) GOTO * 6190 CALL SCOPY(DOTOR, 1, TOKEN, 1) GOTO 6200 6190 CONTINUE C can't happen TOKEN(2) = 0 6200 CONTINUE 6180 CONTINUE 6140 CONTINUE 6100 CONTINUE 6040 CONTINUE 5980 CONTINUE LAST = LENGTH(TOKEN) RETURN END C ARCHIVE REPCOD.RAT 12 11-APR-80 02:38:49 C# repcod - generate code for beginning of repeat SUBROUTINE REPCOD(LAB) INTEGER LABGEN INTEGER LAB C in case there was a label CALL OUTCON(0) LAB = LABGEN(3) CALL OUTCON(LAB) CALL INDEN(2) C label to go on next's LAB = LAB + 10 RETURN END C ARCHIVE RETCOD.RAT 36 10-APR-80 11:11:08 C# retcod - generate code for return SUBROUTINE RETCOD BYTE TOKEN(200), GETTOK, T C-------------------------------------------------------------------------- C# preprocessor common block to hold current function name C put on a file named 'cfname' C Used only by ratfor preprocessor COMMON/CFNAME/FCNAME(20) Ctext of current function name BYTE FCNAME C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER C string retrn 'return' C string eqstr ' = ' BYTE RETRN(7) BYTE EQSTR(4) DATA RETRN(1)/82/ DATA RETRN(2)/69/ DATA RETRN(3)/84/ DATA RETRN(4)/85/ DATA RETRN(5)/82/ DATA RETRN(6)/78/ DATA RETRN(7)/0/ DATA EQSTR/32, 61, 32, 0/ T = GETTOK(TOKEN, 200) IF (.NOT.(T .NE. 13 .AND. T .NE. 59 .AND. T .NE. 125)) GOTO 6210 CALL PBSTR(TOKEN) CALL OUTTAB CALL OUTSTR(FCNAME) CALL OUTSTR(EQSTR) CALL EATUP CALL OUTDON GOTO 6220 6210 CONTINUE IF (.NOT.(T .EQ. 125)) GOTO 6230 CALL PBSTR(TOKEN) 6230 CONTINUE 6220 CONTINUE CALL OUTTAB CALL OUTSTR(RETRN) CALL OUTDON XFER = 1 RETURN END C ARCHIVE SYNERR.RAT 9 12-JUN-80 12:01:30 C synerr - report rat4 syntax error SUBROUTINE SYNERR(MSG) BYTE MSG(1) CALL XITSTA(3) CALL SYN2(MSG, 3) CALL SYN2(MSG, 2) RETURN END C ARCHIVE UNSTAK.RAT 30 11-APR-80 02:47:48 C# unstak - unstack at end of statement SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN) INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN 6250 IF (.NOT.(SP .GT. 1)) GOTO 6270 IF (.NOT.(LEXTYP(SP) .EQ. 123)) GOTO 6280 GOTO 6270 6280 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -12 .AND. TOKEN .EQ. -11)) GOTO 6300 GOTO 6270 6300 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -12)) GOTO 6320 CALL OUTDEN(2) CALL OUTCON(LABVAL(SP)) GOTO 6330 6320 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -11)) GOTO 6340 IF (.NOT.(SP .GT. 2)) GOTO 6360 SP = SP - 1 6360 CONTINUE CALL OUTDEN(2) CALL OUTCON(LABVAL(SP) + 10) GOTO 6350 6340 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -7)) GOTO 6380 CALL DOSTAT(LABVAL(SP)) GOTO 6390 6380 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -15)) GOTO 6400 CALL WHILES(LABVAL(SP)) GOTO 6410 6400 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -16)) GOTO 6420 CALL FORS(LABVAL(SP)) GOTO 6430 6420 CONTINUE IF (.NOT.(LEXTYP(SP) .EQ. -17)) GOTO 6440 CALL UNTILS(LABVAL(SP), TOKEN) 6440 CONTINUE 6430 CONTINUE 6410 CONTINUE 6390 CONTINUE 6350 CONTINUE 6330 CONTINUE 6260 SP = SP - 1 GOTO 6250 6270 CONTINUE RETURN END C ARCHIVE UNTILS.RAT 20 11-APR-80 02:38:51 C# untils - generate code for until or end of repeat SUBROUTINE UNTILS(LAB, TOKEN) BYTE PTOKEN(200) INTEGER LEX INTEGER JUNK, LAB, TOKEN C-------------------------------------------------------------------- C# preprocessor common block to hold 'goto' flags C put on a file named 'cgoto' C Used only by ratfor preprocessor COMMON/CGOTO/XFER CYES if just made transfer; else NO INTEGER XFER XFER = 0 CALL OUTNUM(LAB) IF (.NOT.(TOKEN .EQ. -18)) GOTO 6460 JUNK = LEX(PTOKEN) CALL IFGO(LAB - 10) GOTO 6470 6460 CONTINUE CALL OUTGO(LAB - 10) 6470 CONTINUE CALL OUTDEN(2) CALL OUTCON(LAB + 10) RETURN END C ARCHIVE WHILEC.RAT 12 11-APR-80 02:38:51 C# whilec - generate code for beginning of while SUBROUTINE WHILEC(LAB) INTEGER LABGEN INTEGER LAB C unlabeled continue, in case there was a label CALL OUTCON(0) LAB = LABGEN(2) CALL OUTNUM(LAB) CALL IFGO(LAB + 10) CALL INDEN(2) RETURN END C ARCHIVE WHILES.RAT 9 11-APR-80 02:38:57 C# whiles - generate code for end of while SUBROUTINE WHILES(LAB) INTEGER LAB CALL OUTGO(LAB) CALL OUTDEN(2) CALL OUTCON(LAB + 10) RETURN END C ARCHIVE ICOPYS.RAT 14 25-MAR-80 01:23:11 C# icopys - copy integer string to character string SUBROUTINE ICOPYS(FROM, I, TO, J) BYTE TO(1) INTEGER FROM(1), I, J, K1, K2 K2 = J K1 = I 6480 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 6500 TO(K2) = FROM(K1) K2 = K2 + 1 6490 K1 = K1 + 1 GOTO 6480 6500 CONTINUE TO(K2) = 0 RETURN END C ARCHIVE SCOPYI.RAT 14 25-MAR-80 01:23:11 C# scopyi - copy character string to integer string SUBROUTINE SCOPYI(FROM, I, TO, J) BYTE FROM(1) INTEGER TO(1), I, J, K1, K2 K2 = J K1 = I 6510 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 6530 TO(K2) = FROM(K1) K2 = K2 + 1 6520 K1 = K1 + 1 GOTO 6510 6530 CONTINUE TO(K2) = 0 RETURN END C ARCHIVE INDEN.RAT 7 11-APR-80 11:42:04 C# inden - indent the tab position SUBROUTINE INDEN(IND) INTEGER IND C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ INDENT = INDENT + IND RETURN END C ARCHIVE OUTDEN.RAT 7 11-APR-80 11:42:05 C# outden - outdent the tab position SUBROUTINE OUTDEN(OUT) INTEGER OUT C------------------------------------------------------------------ C# preprocessor common block to hold output characters C put on a file named 'coutln' C Used only by ratfor preprocessor COMMON/COUTLN/OUTP, INDENT, OUTBUF(134) C last position filled in outbuf; init = 0 INTEGER OUTP C current indent level (tab position) INTEGER INDENT C output lines collected here BYTE OUTBUF C------------------------------------------------------------------ INDENT = INDENT - OUT RETURN END C ARCHIVE SYN2.RAT 53 12-JUN-80 12:01:36 C# syn2 - report Ratfor syntax error SUBROUTINE SYN2(MSG, F) BYTE LC(10), MSG(1) INTEGER ITOC INTEGER I, JUNK, F CNOTE: On the IAS and VMS implementations, where characters are stored C as logical*1 (bytes), DEC requires that common block dimensions C be an even number. These dimensions have been adjusted C accordingly. C------------------------------------------------------------------ C# preprocessor common block to hold info about lines and included files C put on a file named 'cline' C Used only by ratfor preprocessor COMMON/CLINE/LEVEL, LINECT(6), INFILE(6), FNAMP, FNAMES(6*34) C level of file inclusion; init = 1 INTEGER LEVEL C line count on input file(level); init = 1 INTEGER LINECT C file number(level); init infile(1) = STDIN INTEGER INFILE C next free slot in fnames; init = 2 INTEGER FNAMP C stack of include names; init fnames(1) = EOS BYTE FNAMES C string serror '? error at line ' BYTE SERROR(17) C string in ' in ' BYTE IN(5) DATA SERROR(1)/63/ DATA SERROR(2)/32/ DATA SERROR(3)/101/ DATA SERROR(4)/114/ DATA SERROR(5)/114/ DATA SERROR(6)/111/ DATA SERROR(7)/114/ DATA SERROR(8)/32/ DATA SERROR(9)/97/ DATA SERROR(10)/116/ DATA SERROR(11)/32/ DATA SERROR(12)/108/ DATA SERROR(13)/105/ DATA SERROR(14)/110/ DATA SERROR(15)/101/ DATA SERROR(16)/32/ DATA SERROR(17)/0/ DATA IN(1)/32/ DATA IN(2)/105/ DATA IN(3)/110/ DATA IN(4)/32/ DATA IN(5)/0/ CALL PUTLIN(SERROR, F) IF (.NOT.(LEVEL .GE. 1)) GOTO 6540 I = LEVEL GOTO 6550 6540 CONTINUE C for EOF errors I = 1 6550 CONTINUE JUNK = ITOC(LINECT(I), LC, 10) CALL PUTLIN(LC, F) I = FNAMP - 1 6560 IF (.NOT.(I .GT. 1)) GOTO 6580 IF (.NOT.(FNAMES(I-1) .EQ. 0)) GOTO 6590 C print file name CALL PUTLIN(IN, F) CALL PUTLIN(FNAMES(I), F) GOTO 6580 6590 CONTINUE 6570 I = I - 1 GOTO 6560 6580 CONTINUE CALL PUTCH(58, F) CALL PUTCH(32, F) CALL PUTLIN(MSG, F) CALL PUTCH(13, F) RETURN END C ARCHIVE FORMAT.RAT 86 25-JUN-80 23:57:35 C format - output format statement for write, read, encode, and decode SUBROUTINE FORMAT(TOKEN) BYTE TOKEN(1), T, TOK(200), FORST(200) BYTE GETTOK BYTE FORM(7) INTEGER J, LENGTH, LABGEN, LAB C------------------------------------------------------------------ C# preprocessor common block to hold flags C put on a file named 'cflags' C Used only by ratfor preprocessor COMMON/CFLAGS/INFORM C when .true., < and > aren't LOGICAL INFORM C converted to .lt. and .gt. C------------------------------------------------------------------ DATA FORM/70, 79, 82, 77, 65, 84, 0/ CALL OUTTAB CALL OUTSTR(TOKEN) T = GETTOK(TOK, 200) IF (.NOT.(T .NE. 40)) GOTO 6610 CALL PBSTR(TOK) CALL EATUP CALL OUTDON RETURN 6610 CONTINUE CALL OUTSTR(TOK) CALL SKPOUT(T) IF (.NOT.(T .EQ. -10)) GOTO 6630 RETURN 6630 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 6650 CALL EATUP CALL OUTDON RETURN 6650 CONTINUE T = GETTOK(TOK, 200) IF (.NOT.(T .NE. 40)) GOTO 6670 CALL PBSTR(TOK) 6690 CONTINUE CALL SKPOUT(T) IF (.NOT.(T .EQ. -10)) GOTO 6720 RETURN 6720 CONTINUE 6700 IF (.NOT.(T .EQ. 41)) GOTO 6690 6710 CONTINUE CALL EATUP CALL OUTDON GOTO 6680 6670 CONTINUE LAB = LABGEN(1) CALL OUTNUM(LAB) J = 1 FORST(1) = 0 NLPAR = 0 Cdon't convert < and > to .lt. and .gt. INFORM = .TRUE. 6740 CONTINUE T = GETTOK(TOK, 200) IF (.NOT.(T .EQ. -10)) GOTO 6770 CALL PBSTR(TOK) CALL SYNERR('unexpected EOF.') INFORM = .FALSE. RETURN 6770 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 6790 NLPAR = NLPAR + 1 GOTO 6800 6790 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 6810 NLPAR = NLPAR - 1 6810 CONTINUE 6800 CONTINUE IF (.NOT.(NLPAR .GE. 0 .AND. T .NE. 13)) GOTO 6830 IF (.NOT.(J+LENGTH(TOK) .GE. 200)) GOTO 6850 CALL SYNERR('format too long.') GOTO 6760 6850 CONTINUE CALL SCOPY(TOK, 1, FORST, J) J = J + LENGTH(TOK) 6830 CONTINUE 6750 IF (.NOT.(NLPAR .LT. 0)) GOTO 6740 6760 CONTINUE INFORM = .FALSE. 6870 CONTINUE CALL SKPOUT(T) IF (.NOT.(T .EQ. -10)) GOTO 6900 RETURN 6900 CONTINUE 6880 IF (.NOT.(T .EQ. 41)) GOTO 6870 6890 CONTINUE CALL EATUP CALL OUTDON CALL INDEN(2) CALL OUTNUM(LAB) CALL OUTTAB CALL OUTSTR(FORM) CALL OUTCH(40) CALL OUTSTR(FORST) CALL OUTCH(41) CALL OUTDON CALL OUTDEN(2) 6680 CONTINUE RETURN END C ARCHIVE SKPOUT.RAT 26 25-JUN-80 23:57:37 SUBROUTINE SKPOUT(T) BYTE T, TOK(200) INTEGER NLPAR, GETTOK NLPAR = 0 6920 CONTINUE T = GETTOK(TOK, 200) IF (.NOT.(T .EQ. -10)) GOTO 6950 CALL PBSTR(TOK) CALL SYNERR('unexpected EOF.') RETURN 6950 CONTINUE IF (.NOT.(T .EQ. 40)) GOTO 6970 NLPAR = NLPAR + 1 GOTO 6980 6970 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 6990 NLPAR = NLPAR - 1 6990 CONTINUE 6980 CONTINUE IF (.NOT.(T .NE. 13)) GOTO 7010 CALL OUTSTR(TOK) IF (.NOT.(T .EQ. 44)) GOTO 7030 CALL OUTCH(32) 7030 CONTINUE 7010 CONTINUE 6930 IF (.NOT.(NLPAR .LT. 0 .OR. (T .EQ. 44 .AND. NLPAR .EQ. 0))) GOT *O 6920 6940 CONTINUE IF (.NOT.(T .EQ. 41)) GOTO 7050 CALL OUTCH(32) 7050 CONTINUE RETURN END