#FILE=RATRSX.RAT #=================== RSX11-DEC VERSION OF RATFOR ======================== # THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR # VERSION 13-14, PCN#10, 21OCT77, ELIMINATE GOTO S YOU CAN'T GET TO # VERSION 14-15, 15 NOV 77, PCN #16, FIX PCN #10 # PCN # 17, CHANGE SYMBOL DECFOR TO DECF4P # PCN # 18, ADD /SP SPOOL SWITCH FOR RSX11M # VERSION 15-16, 10 DEC 77, PCN # 19, REMOVE /GO SWITCH # PCN # 21, ADD /COMPRESS SWITCH # PCN # 22, ADD LEVELS OF DEBUG TO /DE SWITCH # PCN # 23, CORRECT SENSE OF SWITCH TESTS SO /-XX WORKS RIGHT # PCN # 34, SET .FOR EXTENSION FOR FOR # PCN # 35, 22 JAN 78, REMOVE PCN #34 # PCN # 40, 18 NOV 78, FIX ,LP:=FOO/FO BUG # VERSION 16-17, 1 APR 79, CONVERT FOR RSX11/M # PCN # 46, REPLACE 'COMPAR' WITH 'SCOMPR' # PCN # 47, ELIMINATE RATLIB # PCN # 57, 31 AUG 79, ALWAYS PRINT ERRORS ON TI # PCN # 58, 31 AUG 79, ATTACH 'LISTOUT' TO MAKE CTRL/O USEFUL # PCN # 59, 31 AUG 79, IF /LC, CONVERT COMMENTS TO LOWER CASE. # PCN # 66, 6 OCT 79, FIX DEFLST # PCN # 67, 6 OCT 79, CORRECT MATH ERROR IN LOOKFR IF LASTP=0 # PCN # 68, 10 OCT, 79, ADDDEF, FIX BUG IF LASTP=1, OF READING NAMPTR(0) # PCN # 69, 10 OCT, 79, RATLST, MAKE STRPUT TYPE INTEGER # PCN # 71, 1 NOV 79, ADD /GO SWITCH TO START FORTRAN # ##DEFINE (DECF4P,) #DEFINE TO NUMBER FTN OUTPUT LIKE F4P DEFINE(VNUMBER,"RATFOR RSX/V 18") #VERSION NUMBER ###DEFINE (OPENCLOSE,) #DEFINE TO ALLOW SPOOL OUTPUT TO PRINTER ###DEFINE (SPAWNIT,) #DEFINE IF RSX11M V3.2 FOR /GO SWITCH, ***PCN 71 !!! # INCLUDE/NL DEFIN INCLUDE RATDEF # BLOCK DATA - INITIALIZE GLOBAL VARIABLES # BLOCK DATA # INCLUDE CKEYWD IFNOTDEF (ASCII) INCLUDE CCHAR ENDIFDEF # KEYWORDS: DATA SDO(1), SDO(2), SDO(3) /BIGD, BIGO, EOS/ DATA SEND(1), SEND(2), SEND(3),SEND(4)/BIGE, BIGN, BIGD, EOS/ DATA SIF(1), SIF(2), SIF(3) /BIGI, BIGF, EOS/ DATA SELSE(1), SELSE(2), SELSE(3), SELSE(4), SELSE(5) /BIGE, BIGL, BIGS, BIGE, EOS/ DATA SWHILE(1), SWHILE(2), SWHILE(3), SWHILE(4), SWHILE(5), SWHILE(6) /BIGW, BIGH, BIGI, BIGL, BIGE, EOS/ DATA SBREAK(1), SBREAK(2), SBREAK(3), SBREAK(4), SBREAK(5), SBREAK(6) /BIGB, BIGR, BIGE, BIGA, BIGK, EOS/ DATA SNEXT(1), SNEXT(2), SNEXT(3), SNEXT(4), SNEXT(5) /BIGN, BIGE, BIGX, BIGT, EOS/ DATA SFOR(1), SFOR(2), SFOR(3), SFOR(4) /BIGF, BIGO, BIGR, EOS/ DATA SREPT(1), SREPT(2), SREPT(3), SREPT(4), SREPT(5), SREPT(6), SREPT(7) /BIGR, BIGE, BIGP, BIGE, BIGA, BIGT, EOS/ DATA SUNTIL(1), SUNTIL(2), SUNTIL(3), SUNTIL(4), SUNTIL(5), SUNTIL(6) /BIGU, BIGN, BIGT, BIGI, BIGL, EOS/ DATA SSTOP(1), SSTOP(2), SSTOP(3), SSTOP(4), SSTOP(5) / BIGS, BIGT, BIGO, BIGP, EOS/ DATA SRETRN(1), SRETRN(2), SRETRN(3), SRETRN(4), SRETRN(5), SRETRN(6), SRETRN(7) / BIGR, BIGE, BIGT, BIGU, BIGR, BIGN, EOS / # IFNOTDEF (ASCII) # CHARACTER SET DEFINITIONS:(USED BY INMAP/OUTMAP) DATA EXTBLK /" "/, INTBLK /BLANK/ DATA EXTDIG(1) /"0"/, INTDIG(1) /DIG0/ DATA EXTDIG(2) /"1"/, INTDIG(2) /DIG1/ DATA EXTDIG(3) /"2"/, INTDIG(3) /DIG2/ DATA EXTDIG(4) /"3"/, INTDIG(4) /DIG3/ DATA EXTDIG(5) /"4"/, INTDIG(5) /DIG4/ DATA EXTDIG(6) /"5"/, INTDIG(6) /DIG5/ DATA EXTDIG(7) /"6"/, INTDIG(7) /DIG6/ DATA EXTDIG(8) /"7"/, INTDIG(8) /DIG7/ DATA EXTDIG(9) /"8"/, INTDIG(9) /DIG8/ DATA EXTDIG(10)/"9"/, INTDIG(10)/DIG9/ # LOWER CASE OF LETTERS DATA EXTLET(1) /"a"/, INTLET(1) /LETA/ DATA EXTLET(2) /"b"/, INTLET(2) /LETB/ DATA EXTLET(3) /"c"/, INTLET(3) /LETC/ DATA EXTLET(4) /"d"/, INTLET(4) /LETD/ DATA EXTLET(5) /"e"/, INTLET(5) /LETE/ DATA EXTLET(6) /"f"/, INTLET(6) /LETF/ DATA EXTLET(7) /"g"/, INTLET(7) /LETG/ DATA EXTLET(8) /"h"/, INTLET(8) /LETH/ DATA EXTLET(9) /"i"/, INTLET(9) /LETI/ DATA EXTLET(10) /"j"/, INTLET(10) /LETJ/ DATA EXTLET(11) /"k"/, INTLET(11) /LETK/ DATA EXTLET(12) /"l"/, INTLET(12) /LETL/ DATA EXTLET(13) /"m"/, INTLET(13) /LETM/ DATA EXTLET(14) /"n"/, INTLET(14) /LETN/ DATA EXTLET(15) /"o"/, INTLET(15) /LETO/ DATA EXTLET(16) /"p"/, INTLET(16) /LETP/ DATA EXTLET(17) /"q"/, INTLET(17) /LETQ/ DATA EXTLET(18) /"r"/, INTLET(18) /LETR/ DATA EXTLET(19) /"s"/, INTLET(19) /LETS/ DATA EXTLET(20) /"t"/, INTLET(20) /LETT/ DATA EXTLET(21) /"u"/, INTLET(21) /LETU/ DATA EXTLET(22) /"v"/, INTLET(22) /LETV/ DATA EXTLET(23) /"w"/, INTLET(23) /LETW/ DATA EXTLET(24) /"x"/, INTLET(24) /LETX/ DATA EXTLET(25) /"y"/, INTLET(25) /LETY/ DATA EXTLET(26) /"z"/, INTLET(26) /LETZ/ # UPPER CASE OF LETTERS DATA EXTBIG(1) /"A"/, INTBIG(1) /BIGA/ DATA EXTBIG(2) /"B"/, INTBIG(2) /BIGB/ DATA EXTBIG(3) /"C"/, INTBIG(3) /BIGC/ DATA EXTBIG(4) /"D"/, INTBIG(4) /BIGD/ DATA EXTBIG(5) /"E"/, INTBIG(5) /BIGE/ DATA EXTBIG(6) /"F"/, INTBIG(6) /BIGF/ DATA EXTBIG(7) /"G"/, INTBIG(7) /BIGG/ DATA EXTBIG(8) /"H"/, INTBIG(8) /BIGH/ DATA EXTBIG(9) /"I"/, INTBIG(9) /BIGI/ DATA EXTBIG(10) /"J"/, INTBIG(10) /BIGJ/ DATA EXTBIG(11) /"K"/, INTBIG(11) /BIGK/ DATA EXTBIG(12) /"L"/, INTBIG(12) /BIGL/ DATA EXTBIG(13) /"M"/, INTBIG(13) /BIGM/ DATA EXTBIG(14) /"N"/, INTBIG(14) /BIGN/ DATA EXTBIG(15) /"O"/, INTBIG(15) /BIGO/ DATA EXTBIG(16) /"P"/, INTBIG(16) /BIGP/ DATA EXTBIG(17) /"Q"/, INTBIG(17) /BIGQ/ DATA EXTBIG(18) /"R"/, INTBIG(18) /BIGR/ DATA EXTBIG(19) /"S"/, INTBIG(19) /BIGS/ DATA EXTBIG(20) /"T"/, INTBIG(20) /BIGT/ DATA EXTBIG(21) /"U"/, INTBIG(21) /BIGU/ DATA EXTBIG(22) /"V"/, INTBIG(22) /BIGV/ DATA EXTBIG(23) /"W"/, INTBIG(23) /BIGW/ DATA EXTBIG(24) /"X"/, INTBIG(24) /BIGX/ DATA EXTBIG(25) /"Y"/, INTBIG(25) /BIGY/ DATA EXTBIG(26) /"Z"/, INTBIG(26) /BIGZ/ # SPECIAL CHARACTERS. SOME OF THESE MAY # CHANGE FOR YOUR MACHINE DATA EXTCHR(1) /"!"/, INTCHR( 1) /NOT/ # USE EXCLAM FOR NOT-SIGN DATA EXTCHR(2) /"'"/, INTCHR(2) /DQUOTE/ DATA EXTCHR(3) /"#"/, INTCHR(3) /SHARP/ DATA EXTCHR(4) /"$"/, INTCHR(4) /DOLLAR/ DATA EXTCHR(5) /"%"/, INTCHR(5) /PERCENT/ DATA EXTCHR(6) /"&"/, INTCHR(6) /AMPER/ DATA EXTCHR(7) /"'"/, INTCHR(7) /SQUOTE/ DATA EXTCHR(8) /"("/, INTCHR(8) /LPAREN/ DATA EXTCHR(9) /")"/, INTCHR(9) /RPAREN/ DATA EXTCHR(10) /"*"/, INTCHR(10) /STAR/ DATA EXTCHR(11) /"+"/, INTCHR(11) /PLUS/ DATA EXTCHR(12) /","/, INTCHR(12) /COMMA/ DATA EXTCHR(13) /"-"/, INTCHR(13) /MINUS/ DATA EXTCHR(14) /"."/, INTCHR(14) /PERIOD/ DATA EXTCHR(15) /"/"/, INTCHR(15) /SLASH/ DATA EXTCHR(16) /":"/, INTCHR(16) /COLON/ DATA EXTCHR(17) /";"/, INTCHR(17) /SEMICOL/ DATA EXTCHR(18) /"<"/, INTCHR(18) /LESS/ DATA EXTCHR(19) /"="/, INTCHR(19) /EQUALS/ DATA EXTCHR(20) /">"/, INTCHR(20) /GREATER/ DATA EXTCHR(21) /"?"/, INTCHR(21) /QMARK/ DATA EXTCHR(22) /"@"/, INTCHR(22) /ATSIGN/ DATA EXTCHR(23) /"["/, INTCHR(23) /LBRACK/ DATA EXTCHR(24) /"\"/, INTCHR(24) /BACKSLASH/ DATA EXTCHR(25) /"]"/, INTCHR(25) /RBRACK/ DATA EXTCHR(26) /"_"/, INTCHR(26) /UNDERLINE/ DATA EXTCHR(27) /123/, INTCHR(27) /LBRACE/ #BRACE/BRACKET DATA EXTCHR(28) /124/, INTCHR(28) /BAR/ #VERTICAL BAR DATA EXTCHR(29) /125/, INTCHR(29) /RBRACE/ #BRACE/BRACKET DATA EXTCHR(30) /""/, INTCHR(30) /BACKSPACE/ DATA EXTCHR(31) /" "/, INTCHR(31) /TAB/ DATA EXTCHR(32) /"!"/, INTCHR(32) / NOT/ # USE CARET FOR NOT-SIGN DATA EXTCHR(33) /"~"/, INTCHR(33) /NOT/ # USE TILDE FOR NOT-SIGN # NCHARS IS LAST SUBSCRIPT IN THIS ARRAY ENDIFDEF END # # DUMPIT - TO LIST GENERATED FORTRAN SOURCE CODE ON PRINTER #SYKES,28SEP76,27MAY77 # SUBROUTINE DUMPIT # INTEGER LEN, LINE, STRGET CHARACTER BUFR(MAXLINE), FF(2) DATA FF /FORMFEED, EOS/ # REWIND STDOUT CALL RATLST (FF, 0) #FORCE ADVANCE PAGE LINE=0 REPEAT [ LEN=STRGET(STDOUT, BUFR, MAXCARD) #GET THE FORTRAN LINE IF (LEN == EOF) BREAK ELSE IF (LEN == BAD) CALL ERROR ("ERROR READING OUTPUT FILE.") #TERMINATE ELSE [ IF (BUFR(1) == FORMFEED) LINE=0 IF (BUFR(1) == BIGC \ BUFR(6) == CONTINCHAR \ BUFR(1) == FORMFEED) CALL RATLST (BUFR, 0) #DON'T NUMBER COMMENTS OR CONTINUATIONS ELSE [ INCREMENT(LINE) CALL RATLST (BUFR, LINE) #PRINT THE LINE IFNOTDEF(DECF4P) IF ((BUFR(7) == BIGI & BUFR(8) == BIGF & BUFR(9) == BLANK) \ (BUFR(7) == LETI & BUFR(8) == LETF & BUFR(9) == BLANK)) INCREMENT(LINE) ENDIFDEF ] ] ] # RETURN END # # ERROR - PRINT FATAL ERROR MESSAGE, THEN DIE #SYKES 28 SEP 76 # SUBROUTINE ERROR(BUF) # CHARACTER BUF(DUMMYSIZE) # CALL SYNERR(BUF) CALL SYNERR ("**ABORT**.") CALL EXIT #TERMINATE HERE END # # GETLIN - TO READ IN ANOTHER LINE FROM THE INPUT FILE FOR NGETCH # PCN # 22, 10 DEC 77, ADD DEBUG LEVELS # PCN # 59, 31 AUG 79, IF /LC, CONVERT COMMENTS TO LOWER CASE. ## SYKES, DEC 76,27MAY77 ## IF LINE BEGINS WITH A '%' IN COL. 1, TRANSFER IT TO THE ## OUTPUT FILE WITH NO PROCESSING AT ALL EXCEPT DELETE THE '%'. ## ALSO, TRANSFER FULL LINE COMMENTS ('#' IN COL 1) TO OUTPUT FILE ## ALSO, LIST EACH LINE AS IT IS READ.EXCEPT WITHIN UNDEFINED IFDEFS # IF THE /IF SWITCH IS PRESENT. # INTERPRET DEBUG LINES ("?" IN COL 1) AS WELL. PROCESS THEM IF # THE LEVEL SPECIFIED IN THE SECOND COL IS >= SPECIFIED DEBUG LEVEL. # CHARFUNC FUNCTION GETLIN FUNCSIZE (BUFR, F) # INTEGER I, F, STRGET, STRIM, LEN, INDEX CHARACTER BUFR(MAXLINE) IFNOTDEF (ASCII) CHARACTER INMAP ENDIFDEF INCLUDE CLINE INCLUDE CLIST INCLUDE CUCLC STRING DLEVL "123456789 " #DEBUG LEVELS # CALL ERRSNS #CLEAR FILE ERRORS!!!! GETLIN=YES REPEAT [ LEN=STRGET (F, BUFR, MAXCARD) #GET THE LINE IF (LEN == EOF) [ GETLIN=EOF BREAK ] ELSE IF (LEN == BAD) [ CALL ERRSNS(I) #RSX!!! IF (I == 39) CALL ERROR ("ERROR READING INPUT FILE.") ELSE CALL ERROR ("OPEN FAILURE ON INPUT FILE.") ] # ELSE IFNOTDEF (ASCII) FOR (I = 1; I <= LEN; INCREMENT(I)) #SYKES 5 OCT 76 ASSUME ASCII BUFR(I) = INMAP(BUFR(I)) #OTHERWISE, THIS IS WHERE WE MAP ENDIFDEF LEN=STRIM(BUFR) #REMOVE ANY TRAILING BLANKS # ##PRINT THE NEW LINE # IF (INIF == NO \ IFPNT == YES) [ I=INDEX (BUFR, SHARP) #PCN#59, IS THERE COMMENT ON THIS LINE IF (I > 0 & LC == YES) #YES, SO CALL FOLD (BUFR(I+1)) #CONVERT COMMENT TO LOWER CASE IF ((BUFR(1) == SHARP) \ (INIF == YES) \ (BUFR(1) == QMARK & INDEX(DLEVL,BUFR(2)) < DEBUG)) CALL RATLST(BUFR, 0) #DON'T NUMBER UNPROCESSED LINES ELSE [ CALL RATLST (BUFR, LINECT) #ONLY IF INTERNAL & EXTERNAL CHAR. SETS ARE ASCII INCREMENT (LINECT) ] ] # ##SPECIAL PROCESSING OF RATFOR PROCESSOR FEATURES # IF (BUFR(1) == QMARK) IF (INDEX(DLEVL,BUFR(2)) >= DEBUG) [ #CONVERT DEBUG LEVEL AND COMPARE BUFR(1)=BLANK #PROCESS DEBUG LINES NORMALLY BUFR(2)=BLANK #CLEAR THE ?N BEFORE PROCESSING ] ELSE NEXT #ELSE SKIP DEBUG LINES # IF (LEN == 1 & BUFR(1) == FORMFEED) #SKIP FORMFEED ONLY LINES NEXT ELSE IF (BUFR(1) != PERCENT & BUFR(1) != SHARP) BREAK #RETURN WITH A GOOD LINE # IF (INIF == YES) NEXT #DO NOTHING WITH COMMENTS AND % LINES WITHIN IFDEF'S ELSE IF (BUFR(1) == PERCENT) #OUTPUT % LINES AS IS CALL PUTLIN (BUFR(2), STDOUT) ELSE IF (COMPRS == NO) [ #EXCEPT IN COMPRESS MODE, PASS BUFR(1) = BIGC #FULL LINE COMMENTS CALL PUTLIN (BUFR, STDOUT) ] ] # RETURN END # # OPENI - TO OPEN INCLUDED FILES FOR RATFOR #SYKES,24APR77, ALLOW /NL TO SUPPRESS LISTING OF INCLUDED FILES #SYKES,19NOV76,27MAY77 # THE LUN FOR EACH INPUT FILE IS STORED IN INFILE(LEVEL),WHERE # LEVEL IS THE INCLUSION LEVEL (BASIC INPUT FILE=1). # CURRENTLY, THE LUN=THE INCLUSION LEVEL; INFILE(LEVEL)=LEVEL. #NOTE: AN EXPLICIT VERSION NUMBER WORKS ONLY IF THERE IS ALSO AN # EXPLICIT EXTENSION SPECIFIED. # INTEGER FUNCTION OPENI # CHARACTER BUFR(MAXNAME) CHARACTER NGETCH, CHAR INTEGER LEN, I, INDEX, SJOIN, JUNK, SKIP, STRGET INCLUDE CLINE INCLUDE CLIST STRING RAT ".RAT" #DEFAULT EXTENSION # OPENI=LEVEL+1 #LOGICAL UNIT NUMBER LST(LEVEL+1)=YES #DEFAULT IS TO LIST INCLUDED FILES LEN=0 SKIP=NO # #SINCE THE STRING MAY CONTAIN SEVERAL TOKENS # AND EVEN SEMICOLONS, FORCE READ THE REST OF THIS LINE AND # TAKE IT TO BE THE FILE NAME SPEC. # WHILE (NGETCH(CHAR, INFILE(LEVEL)) != NEWLINE & CHAR != SHARP & LEN < MAXNAME) [ IF (SKIP == YES & CHAR == BLANK) SKIP=NO #GOT PAST THE SWITCH,RETURN TO NORMAL ELSE IF (CHAR == SLASH) [ #FOUND /NL? SKIP=YES #YES, WE MUST SKIP THE SWITCH NAME LST(LEVEL+1)=NO #WE WON'T PRINT THIS FILE ] ELSE IF (CHAR != BLANK & CHAR != TAB & SKIP == NO) [ INCREMENT(LEN) BUFR(LEN)=CHAR ] ] #GET THE REST OF THE LINE (EXCEPT COMMENTS) AS THE NAME CALL PUTBAK(CHAR) #WE DON'T WANT THE TERMINATOR # BUFR(LEN+1)=EOS # IF (INDEX(BUFR, PERIOD) == 0) #ADD AN EXTENSION IF NONE THERE LEN=SJOIN (BUFR, RAT, MAXNAME-1, JUNK) # CALL ERRSNS #!!! CALL ASSIGN (OPENI, BUFR, LEN) #RSX!!! CALL FDBSET (OPENI, "READONLY", "SHARE") #!!! CALL ERRSNS (I) #!!! IF (I == 43) [ CALL SYNERR ("BAD FILENAME SPEC.") OPENI=BAD ] ELSE [ #DUMMY READ TO SEE IF IT'S THERE READ (OPENI, 1, ERR=2, END=2) 1 FORMAT (A1) REWIND OPENI #ONLY IF INPUT IS FROM DISK FILE ] RETURN # 2 OPENI=BAD RETURN END # # PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE #SYKES,14OCT76,16DEC76,27MAY77 # SUBROUTINE PUTLIN (B,F) # INTEGER I, J, F CHARACTER B(MAXLINE) IFNOTDEF (ASCII) CHARACTER OUTMAP ENDIFDEF INCLUDE CLIST # # # ONLY IF WE ARE OUTPUTTING FORTRAN CODE: IF (OUTPUT == YES) [ FOR(I=1;I <= MAXCARD & B(I) != NEWLINE & B(I) != EOS;INCREMENT(I)) IFNOTDEF (ASCII) B(I)=OUTMAP(B(I)) #MAP TO EXTERNAL CHAR. SET HERE, IF NEEDED ENDIFDEF ; B(I)=EOS #MAKE SURE IT'S A STRING DECREMENT (I) IF (I <= 0) WRITE (F, 1, ERR=14, END=14) #BLANK LINE ELSE WRITE (F, 1, ERR=14, END=14) (B(J),J=1,I) 1 FORMAT (MAXCARD A1) ] RETURN # 14 CALL ERROR ("ERROR WRITING OUTPUT FILE.") #TERMINATE END # # RATFOR - PREPROCESSOR MAINLINE AND OPERATOR/OS INTERFACE #SYKES 22 NOV 76 # PCN # 17, 15 NOV 77, CHANGE DECFOR TO DECF4P, ADD RUN ...FOR # PCN # 18, 15 NOV 77, ADD /SP SWITCH # PCN# 19, 21, 22, 23, 10 DEC 77, AFFECT SWITCHES # PCN # 34, ADD .FOR DEFAULT EXTENSION # PCN # 35, 22 JAN 78, REMOVE .FOR DEFAULT EXTENSION # PCN #40, 18 JAN 78, FIX ,LP:=FOO/FO BUG # PCN # 58, 31 AUG 79, ATTACH 'LISTOUT' TO MAKE CTRL/O USEFUL # PCN # 71, 1 DEC 79, ADD /GO, IF SPAWN DIRECTIVE IS AVAILABLE # INTEGER SWITCH(4,11), ICSI, DOIT, I, J, STATUS, SLEN, JUNK INTEGER STRPUT, SITOC CHARACTER NAMES(35,9) REAL DEFALT(4), PROMPT INCLUDE CLIST INCLUDE CICSI INCLUDE CUCLC # STRING REF " RATFOR ERRORS FOUND" DATA DEFALT /"FTN ", "LST ", "OBJ ", "RAT "/ #DEFAULT EXTENSIONS, PCN#71 DATA PROMPT /"RAT>"/ #PROMPT AT USERS TERMINAL DATA IFIRST/ YES / #FOR ICSI # DATA SWITCH(1,1) /"RE"/ #RETAIN DEFINE TABLE FROM LAST COMMAND LINE DATA SWITCH(1,2) /"CO"/ #COMPRESS FORTRAN OUTPUT BY DROPPING BLANKS DATA SWITCH(1,3) /"FO"/ #LIST THE FORTRAN SOURCE GENERATED DATA SWITCH(1,4) /"SC"/ #LIST THE SYMBOLIC CONSTANT DEFINE TABLE DATA SWITCH(1,5) /"LC"/ #OUTPUT GENERATED FORTRAN CODE IN LOWER CASE DATA SWITCH(1,6) /"HE"/ #GIVE THE OPERATOR SOME SWITCH HELP DATA SWITCH(1,7) /"DE"/ #INCLUDE DEBUG LINES ("?" IN COL. 1) DATA SWITCH(1,8) /"VE"/ #PRINT RATFOR"S VERSION NUMBER ON TERMINAL DATA SWITCH(1,9) /"IF"/ #DON"T PRINT CODE WITHIN UNDEFINED IFDEF S DATA SWITCH(1,10)/"SP"/ #SPOOL LISTING FILE DATA SWITCH(1,11)/"GO"/ #SPAWN FORTRAN?***PCN 71 # CALL ERRSET (63,.TRUE.,.FALSE.,,.FALSE.) #TURN OFF CONVERSION ERRORS CALL ERRSET (43,.TRUE.,.FALSE.,,.FALSE.) #TURN OFF BAD FILE NAME ERRORS LOGGING CALL ERRSET (29,.TRUE.,.FALSE.,,.FALSE.) #TURN OFF NO SUCH FILE ERRORS CALL ERRSET (39,.TRUE.,.FALSE.,,.FALSE.) #TURN OFF READ ERRORS CALL ERRSET (30,.TRUE.,.FALSE.,,.FALSE.) #TURN OFF OPEN FAILURE ERRORS # # USER=USERIN INDLUN=INDIRLUN #FOR ICSI REPEAT [ CLB(1)=EOS STATUS=ICSI(NAMES,DEFALT,SWITCH,11,PROMPT) IF (STATUS == EOF) CALL EXIT #DONE! ELSE IF (STATUS == YES) [ #DO A GOOD LINE IF (SWITCH(2,6) > 0) #***PCN # 23 CALL RATHLP #GIVE USER SOME HELP ELSE IF (SWITCH(2,8) > 0) #***PCN#23 JUNK=STRPUT (USEROUT, VNUMBER) ELSE [ #ELSE DO THE COMMAND IF (SWITCH(2,2) <= 0) #PROCESS COMPRESS SWITCH COMPRS=NO ELSE #***PCN # 21 COMPRS=YES IF (SWITCH(2,5) <= 0) #PCN # 23 LC=NO ELSE LC=YES IF (SWITCH(2,1) <= 0) #CLEAR DEFINE TABLE? ***PCN#23 DOIT = YES ELSE DOIT = NO IF (SWITCH(2,9) <= 0) #PRINT UNDEFINED IFDEFS? ***PCN # 23 IFPNT=YES ELSE IFPNT=NO IF (SWITCH(2,7) <= 0) #PROCESS DEBUG LINES? ***PCN#23 DEBUG=9999 #=NO DEBUG ELSE IF (SWITCH(2,7) == 2) #SWITCH SPECIFIED DEBUG LEVEL ***PCN#22 DEBUG=SWITCH(4,7) #SO DEBUG LINES ?N >= /DE:N ELSE DEBUG=1 #/DE == /DE:1 # CALL ERRSNS IF (SLEN(NAMES(1,1)) > 0) [ OUTPUT = YES CALL ASSIGN(STDOUT,NAMES(1,1),0) #FORTRAN OUTPUT FILE CALL FDBSET (STDOUT, "NEW",,2) #RSX!!! CALL ERRSNS (I) #CHECK FOR VALID FILE NAME STRINGS IF (I != 0) [ CALL ICSIE ("BAD OUTPUT FILE SPEC!") NEXT ] ELSE IF (STRPUT(STDOUT, " ") != YES) [ CALL ICSIE ("OPEN FAIL FOR OUTPUT FILE") NEXT ] ELSE REWIND STDOUT ] IFDEF (OPENCLOSE) #A NEXT ELSE IF CLAUSE USES TEMP OUTPUT FILE SO LISTING CAN INCLUDE FORTRAN # CODE (/FO) WITHOUT KEEPING A REGULAR OUTPUT FILE. FOR OLDER DEC 'FOR' FORTRAN # (NO 'OPEN' STATEMENT), DELETE THIS FEATURE. # DELETION ALSO SAVES 433 WORDS OF CORE IN A NON-F4PRES ENVIORNMENT. ELSE IF (SWITCH(2,3) != 0 & SLEN(NAMES(1,2)) > 0) [ I=STDOUT #PCN # 40 % OPEN(UNIT=I,NAME='FOO.TMP',TYPE='SCRATCH') OUTPUT=YES ] ENDIFDEF ELSE OUTPUT = NO # IF (SLEN(NAMES(1,2)) > 0) [ LST(1) = YES CALL ASSIGN (LISTOUT,NAMES(1,2),0) #LISTING FILE CALL FDBSET (LISTOUT, "NEW",, 2) #RSX!!! CALL ERRSNS (I) #CHECK FOR VALID FILE NAME STRINGS IF (I != 0) [ CALL ICSIE ("BAD LIST FILE SPEC!") NEXT ] ELSE IF (STRPUT(LISTOUT, " ") != YES) [ CALL ICSIE ("OPEN FAIL FOR LIST FILE") NEXT ] ELSE [ REWIND LISTOUT CALL QIO (768, LISTOUT) #PCN#58,ATTACH LIST DEV(768="1400) !!! ] ] ELSE LST(1) = NO IF (LST(1) == NO & OUTPUT == NO) #CHECK FOR NULL EFFORT NEXT # CALL RATGO (DOIT) #INITIALIZE FOR (J=4; J <= 9 & SLEN(NAMES(1,J)) > 0; INCREMENT(J)) [ CALL ERRSNS CALL ASSIGN (STDIN,NAMES(1,J),0) #BASIC INPUT FILE CALL FDBSET (STDIN, "READONLY", "SHARE") #RSX!!! CALL ERRSNS (I) #CHECK FOR FILENAME SPEC ERRORS IF (I != 0) [ CALL ICSIE ("BAD INPUT FILE SPEC!") BREAK ] CALL PARSE #DO ALL THE WORK HERE CALL CLOSE (STDIN) ] # IF (SWITCH(2,4) > 0 & LST(1) == YES) #***PCN#23 CALL DEFLST #LIST CURRENT DEFINE TABLE IF (SWITCH(2,3) > 0 & OUTPUT == YES & LST(1) == YES) #***PCN#23 CALL DUMPIT #LIST THE FORTRAN CODE IF (OUTPUT == YES) CALL CLOSE (STDOUT) # IF (LST(1) == YES) IFDEF (OPENCLOSE) #IF LISTOUT=LP:, LISTING IS ALWAYS SPOOLED BY D, ALWAYS PRINTED BY M; #IF LISTOUT=DISK, /SP WILL CAUSE IT TO BE PRINTED UNDER EITHER D OR M. # DROP THIS UNDER OLDER DEC FORTRAN IV WITH NO 'CLOSE' STATEMENT. IF (SWITCH(2,10) > 0) [ #***PCN#18 I=LISTOUT % CLOSE (UNIT=I, DISPOSE='PRINT') ] ELSE ENDIFDEF CALL CLOSE (LISTOUT) IF (ERRORS > 0) [ I=SITOC (ERRORS, REF(1), 3) REF(I+1)=BLANK #KILL THE EOS CALL ICSIE (REF) ] IFDEF (SPAWNIT) #***PCN 71, ADD /GO ELSE IF (SWITCH(2,11) > 0) CALL SPAWNF (NAMES) ENDIFDEF ] ] ] #GET ANOTHER COMMAND LINE # END # # RATHLP - TO PRINT HELP ON THE TERMINAL FOR THE USER # ***PCN#19, 21, 22, 10 DEC 77 # ***PCN # 34, 16 JAN 78 # ***PCN # 35, 22 JAN 78 # ***PCN # 71, DEC 79, ADD /GO # SUBROUTINE RATHLP # WRITE (USEROUT,1) 1 FORMAT (/" ",VNUMBER//, " SWITCHS: (ALL DEFAULTS ARE NO)" /, " /DE:N-PROCESS DEBUG LINES WITH LEVEL >= N ('?N' IN COL 1&2)"/, " /CO - SUPPRESS BLANKS BETWEEN TOKENS IN FORTRAN OUTPUT"/, " /FO - LIST OUTPUT FORTRAN CODE"/, " /HE - GET THIS HELP (ONLY)") IFDEF (SPAWNIT) WRITE (USEROUT,5) 5 FORMAT (" /GO - SPAWN FORTRAN TO COMPILE THIS FILE") ENDIFDEF WRITE (USEROUT,4) 4 FORMAT (" /IF - SUPRESS LISTING UNDEFINED CONDITIONALS"/, " /LC - GENERATE LOWER CASE FORTRAN CODE"/, " /RE - RETAIN THE DEFINITIONS FROM PREVIOUS COMMAND LINE"/, " /SC - LIST SYMBOLIC CONSTANT DEFINITION TABLE"/, " /SP - SPOOL LISTING FILE TO PRINTER"/, " /VE - PRINT RATFOR'S VERSION NUMBER ON TERMINAL (ONLY)"/) # WRITE (USEROUT,2) 2 FORMAT (" COMMAND LINE: (SINGLE LEVEL INDIRECT FILES ALLOWED)"/, " [OUTPUT][,LIST][,OBJ]=IN1[,IN2...,IN6][/SW...]"/, " IF NO OUTPUT FILES ARE SPECIFIED, DEFAULT FILES ARE"/, " ARE CREATED WITH SAME DEV, UIC, & NAME AS FIRST INPUT FILE."/) # WRITE (USEROUT,3) 3 FORMAT (" DEFAULT FILE EXTENSIONS:"/, " OUTPUT =FTN LIST =LST OBJECT =OBJ"/, #***PCN 71 " INPUT =RAT COMMAND=CMD"/) # RETURN END # # RATLST - TO LIST RATFOR SOURCE CODE ON PRINTER #SYKES 28MAY77 # PCN # 69, 10 OCT 79, MAKE STRPUT TYPE INTEGER # SUBROUTINE RATLST (BUFR, LINE) # INTEGER N, LINE, SCOPY, SITOC, JUNK, STRPUT #***PCN # 69 CHARACTER BUFR(DUMMYSIZE), OUTBUF(133) INCLUDE CLIST INCLUDE CLINE INCLUDE CICSI STRING STARSS "******" # # ERRORS WITHIN INCLUDED/NL FILES ARE LISTED, # EXCEPT FROM SYNERR (LINE=HUGE). FOR (N=1; N <= LEVEL; INCREMENT(N)) #TO LIST THIS LINE, ALL LEVELS UP TO IF (LST(N) == NO & LINE <= 9999) #THE CURRENT ONE MUST BE LISTED. RETURN #OTHERWISE, RETURN WITHOUT PRINTING ANYTHING # IF (PLINE > PAGELENGTH \ BUFR(1) == FORMFEED) [ #ADVANCE PAGE AND DO HEADER OUTBUF(1)=FORMFEED OUTBUF(2)=EOS JUNK=STRPUT (LISTOUT, OUTBUF) #ADVANCE PAGE OUTBUF(1)=BLANK JUNK=STRPUT (LISTOUT, OUTBUF) JUNK=STRPUT (LISTOUT, OUTBUF) #BLANK LINES JUNK=STRPUT (LISTOUT, OUTBUF) JUNK=STRPUT (LISTOUT, OUTBUF) INCREMENT (PAGE) CALL SPAD (OUTBUF, 75) CALL SINSRT (VNUMBER, OUTBUF(1)) CALL DATE (OUTBUF(35)) #RSX!!! CALL TIME (OUTBUF(47)) CALL SINSRT ("PAGE", OUTBUF(69)) JUNK=SITOC (PAGE, OUTBUF(75), 5) JUNK=STRPUT (LISTOUT, OUTBUF) #PRINT THE HEADING JUNK=STRPUT (LISTOUT, CLB) #PRINT THE COMMAND LINE OUTBUF(1)=BLANK OUTBUF(2)=EOS JUNK=STRPUT (LISTOUT, OUTBUF) #BLANK LINES JUNK=STRPUT (LISTOUT, OUTBUF) PLINE=6 IF (BUFR(1) == FORMFEED) RETURN #DONE IT ] OUTBUF(1)=EOS IF (LINE > 0) #DO SOURCE CODE LINE NUMBER IF (LINE > 9999) #ERRORS HAVE LINE=HUGE, JUNK=SCOPY(STARSS, OUTBUF(1), 15, JUNK) #SO FLAG THEM ELSE JUNK=SITOC (LINE, OUTBUF(1), 5) CALL SPAD (OUTBUF, 15) FOR (N=1; N <= NFILES; INCREMENT(N)) IF (N <= LEVEL-1) OUTBUF(5+N)=STAR #FLAG INCLUDED FILES JUNK=SCOPY (BUFR, OUTBUF(8+NFILES), 132-8-NFILES, JUNK) JUNK=STRPUT (LISTOUT, OUTBUF) #PRINT THE LINE INCREMENT (PLINE) # RETURN END # IFDEF (SPAWNIT) # SPAWNF - SUBROUTINE TO CALL FORTRAN TO MAKE OBJECT MODULE DIRECTLY # NOV 79, SYKES, FOR RSX11M V3.2 ONLY # TO MAKE RATFOR WAIT FOR THE COMPILER, ADD AN EVENT FLAG TO THE # SPAWN CALL. # SUBROUTINE SPAWNF (NAMES) # CHARACTER NAMES(35,9) #USER-SPECIFIED FILE NAMES FROM ICSI CHARACTER CMDLIN(61) #COMMAND LINE BUFFER FOR COMPILER INTEGER SCOPY, INDEX, SJOIN, SLEN INTEGER LEN, IDS, JUNK REAL TSKNAM IFDEF (DECF4P) STRING FORSWT "/CO:10" #SWITCHES FOR COMPILER STRING TSKN "F4P " % DATA TSKNAM /6R...F4P/ ENDIFDEF IFNOTDEF (DECF4P) STRING TSKN "FOR " STRING FORSWT "/-LO" #SWITCHES FOR THE COMPILER % DATA TSKNAM /6R...FOR/ ENDIFDEF # JUNK=SCOPY (TSKN, CMDLIN(1), 60, JUNK) #COMPILER TASK NAME IF (SLEN (NAMES(1,3)) > 0) #DID HE SPECIFY .OBJ FILE NAME? JUNK=SCOPY (NAMES(1,3), CMDLIN(5), 60, JUNK) #MOVE NAME IN AFTER TASK NAME ELSE [ LEN=INDEX (NAMES(1,1), ".") #FIND . IN OUTPUT FILE SPEC JUNK=SCOPY (NAMES(1,1), CMDLIN(5), LEN-1, JUNK) #USE 1ST FILE SPEC INSTEAD ] JUNK=SJOIN (CMDLIN, "=", 60, JUNK) #ADD = JUNK=SJOIN (CMDLIN, NAMES(1,1), 60, JUNK) #ADD INPUT FILESPEC LEN= SJOIN (CMDLIN, FORSWT, 60, JUNK) #ADD ANY SWITCHES ?9 CALL ICSIE (CMDLIN) # CALL SPAWN (TSKNAM, , , , , , , CMDLIN, LEN, , , IDS) # IF (IDS != 1) CALL ICSIE (" SPAWN DIRECTIVE FAILURE, FORTRAN NOT RUN") # RETURN END ENDIFDEF # # SYNERR - REPORT RATFOR SYNTAX ERROR #SYKES 28SEP76,20MAY77 # PCN # 57, 31 AUG 79, ALWAYS PRINT ERRORS ON TERMINAL # SUBROUTINE SYNERR(MSG) # CHARACTER BUFOUT(MAXLINE), MSG(MAXLINE) INTEGER I, LASTC, STRPUT EQUIVALENCE (BUFOUT,HEADER) INCLUDE COUTLN INCLUDE CLIST STRING HEADER "C***RATFOR ERROR: " # LASTC=19 FOR(I=1;MSG(I) != EOS & MSG(I) != PERIOD & LASTC < MAXCARD;INCREMENT(I)) [ BUFOUT(LASTC) = MSG(I) INCREMENT (LASTC) ] BUFOUT(LASTC)=EOS INCREMENT (ERRORS) #COUNT ERRORS # OUTPUT TO STANDARD FILE IF (OUTP > 0) #FINISH OFF PREVIOUS LINE FIRST CALL OUTDON CALL PUTLIN (BUFOUT, STDOUT) # # OUTPUT TO LISTING FILE, OR TO TERMINAL, IF NOT LISTING IF (LST(1) == YES) CALL RATLST (BUFOUT(2), HUGE) #PRINT WITH '***' # ELSE #PCN # 57 CALL ICSIE (BUFOUT(2)) # RETURN END