#FILE=RATRSX.RAT #=================== RSX11-DEC VERSION OF RATFOR ======================== #$ **** THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR # 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 ### VERSION 18 ISSUED, NOV 79. # PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT., ADD # PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING # PCN #76, DEC 79, FIX BUG IN DUMPIN/OUTIF. NOT NUMBERING IF'S RIGHT # PCN #77, JAN 79, GENERAL CLEANUP. CHANGE CALL SEQUENCE OF 'STRPUT', 'ICSI'. ### VERSION 19 ISSUED, JAN 80. # PCN 83, 16 JAN 80, DELETE CALL TO 'ERROR' IN PUTLIN. # PCN 85, 20 JAN 80, CREATE OVERLAYED VERSION, MOVE ERRSET TO OVERLAY # PCN 82, 8 FEB 80, USE OPEN STATEMENT VICE ASSIGN,FDBSET IF 'OPENCLOSE'. # NOTE: FORTRAN IV V2.2 BUG CAUSES ODD ADDR TRAP (ERROR 3) ON ANY OPEN ERROR # EXCEPT 'NO SUCH FILE' (E.G. 'INVALID DEVICE') IF OPENS ARE USED. # PCN 87, 10 FEB 80, ALLOW << AND >> FOR < AND >. PASS '...' STRINGS UNCHNAGED. # PCN 90, 11 FEB 80, ADD DAY OF WEEK TO HEADING IF REAL CODE IS ALLOWED. # PCN 91, 13 FEB 80, PROVIDE DEFAULT DEV/UIC FOR INCLUDE FILES. # PCN 93, 16 FEB 80, DROP CKEYWD, FOR STRINGS IN 'LEX', MOVE FROM GETTOK. # PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER. ### VERSION 20 ISSUED, 1 MARCH 80. # PCN #95, 11 MAR 80, PREVENT WARNING MSG FROM F4P IN INDEX AND OPENI. # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # PCN # 97, 22 MAR 80, DEFINE DEFAULTS FOR SWITCHES, PROCESS IN RATGO # PCN 98, 27 MAR 80, REORGANIZE SCAN WITH MOST COMMON KEYWORDS FIRST. # PCN 100, 29 MAR 80, DON'T NUMBER NULL RATFOR SOURCE LINES. #PCN 101, 29 MAR 80, OPTIONAL WAIT FOR SPAWNED COMPILER, CLEAN UP SPAWN # PCN 102, 29 MAR 80, ALLOW UNDERLINE EMBEDDED IN TOKENS ### VERSION 21 ISSUED, 1 APRIL 80. # INCLUDE/NL DEFIN INCLUDE RATDEF # ##DEFINE (DECF4P,) #DEFINE TO DO F4P LINE NUMBERS RIGHT(AND SPAWNING) DEFINE (DEFAULTOPEN="SY:[1,1]") #DEFAULT FOR INCLUDE FILES. MUST BE STRING IN " DEFINE (FTNSWITCHES="/-LO/-SN") #SWITCHES FOR SPAWNED COMPILER. MUST BE STRING ##DEFINE (OPENCLOSE,) #DEFINE TO ALLOW SPOOL OUTPUT TO PRINTER ##DEFINE (REALCODE,) #DEFINE IF FLOATING PT. MATH IS OK.(FOR 'DAYS') ##DEFINE (WAITFORFTN,) #DEFINE IF YOU WANT TO WAIT FOR SPAWNED COMPILER ##DEFINE (SPAWNIT,) #DEFINE IF RSX11M V3.2 FOR /GO SWITCH, ***PCN 71 !!! DEFINE(VNUMBER,"RATFOR RSX/V 21-O-102") #VERSION NUMBER # IFNOTDEF (ASCII) #$ BLOCK DATA - INITIALIZE GLOBAL VARIABLES # PCN 93, 16 FEB 80, DELETE CKEYWD, USE STRINGS IN 'LEX' INSTEAD. # BLOCK DATA # INCLUDE CCHAR # # 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) /34/, 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) /39/, 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) /"{"/, INTCHR(27) /LBRACE/ DATA EXTCHR(28) /"|"/, INTCHR(28) /BAR/ DATA EXTCHR(29) /"}"/, INTCHR(29) /RBRACE/ DATA EXTCHR(30) /""/, INTCHR(30) /BACKSPACE/ DATA EXTCHR(31) /" "/, INTCHR(31) /TAB/ DATA EXTCHR(32) /"^"/, INTCHR(32) /CARET/ # PCN #73, DEC 79 DATA EXTCHR(33) /"~"/, INTCHR(33) /TILDE/ # PCN 73, DEC 79 # NCHARS IS LAST SUBSCRIPT IN THIS ARRAY END ENDIFDEF # IFDEF (REALCODE) #$ DAYS - RETURN DAY OF WEEK AS 3 CHAR (REAL) AND INTEGER (1-7) # PCN 90, 11 FEB 80 # INTEGER FUNCTION DAYS (DAY) # INTEGER N0,N1,N2,N3,N4,JDA,JMO,JYR REAL DAYWK(7), X0, DAY DATA DAYWK /"SUN ","MON ","TUE ","WED ","THU ","FRI ","SAT "/ # # CALL IDATE(JMO,JDA,JYR) #RSX!!! # N0=0.6+1.0/JMO JYR=1900+JYR-N0 JMO=JMO+12*N0 X0=JYR/100.0 N4=X0/4.0 N3=X0 N2=5.0*JYR/4.0 N1=13.0*(JMO+1.0)/5.0 N0=N1+N2-N3+N4+JDA-1 DAYS=N0-(7*(N0/7))+1 DAY=DAYWK(DAYS) # RETURN END ENDIFDEF # #$ DUMPIT - LIST GENERATED FORTRAN SOURCE CODE ON PRINTER # PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING, USE FOR DUMPED CODE # PCN # 77, 5 JAN 80, USE PRTBUF TO GET AND PUT LINES, VICE INTERNAL BUFFER # (ONLY TO SAVE SPACE!!) # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # SUBROUTINE DUMPIT # INTEGER LEN, FLINE, STRGET CHARACTER FF(2) # INCLUDE CPRTLN # DATA FF /FORMFEED, EOS/ # REWIND STDOUT CALL RATLST (FF, 0, 0) #FORCE ADVANCE PAGE, PCN #75 FLINE=0 CALL DOINDX (5, "***DUMP OF GENERATED FORTRAN CODE***") #***PCN #96 REPEAT [ LEN=STRGET(STDOUT, PRTBUF, MAXCARD) #GET THE FORTRAN LINE(AS A STRING) IF (LEN == EOF) BREAK ELSE IF (LEN == BAD) CALL ERROR ("DUMPIT ERROR READING FTN OUTPUT FILE.") #TERMINATE ELSE [ IF (PRTBUF(1) == FORMFEED) FLINE=0 IF (PRTBUF(1) == BIGC \ PRTBUF(6) == CONTINCHAR \ PRTBUF(1) == FORMFEED) CALL RATLST (PRTBUF, 0, 0) #DON'T NUMBER COMMENTS OR CONTINUATIONS ELSE [ INCREMENT(FLINE) CALL RATLST (PRTBUF, 0, FLINE) #PRINT THE LINE IFNOTDEF(DECF4P) #JUGGLE LINE NUMBERING FOR FORTRAN IV IF ((PRTBUF(7) == BIGI & PRTBUF(8) == BIGF & PRTBUF(9) == BLANK) \ (PRTBUF(7) == LETI & PRTBUF(8) == LETF & PRTBUF(9) == BLANK)) INCREMENT(FLINE) ENDIFDEF ] ] ] # RETURN END # #$ FILFIX - CALL ERRSET FROM OVERLAY TO TURN OFF FTN ERROR MESSAGES # PCN #85, 20 JAN 80 # SUBROUTINE FILFIX # 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 # RETURN END # #$ GETLIN - READ IN ANOTHER LINE FROM THE RATFOR INPUT FILE FOR NGETCH # PCN # 22, 10 DEC 77, ADD DEBUG LEVELS # PCN # 75, DEC 79, ADD FTN LINE NUMBERS TO LISTING # PCN # 82, 8 FEB 80, DELETE UNNEEDED CALL TO 'ERRSNS' AND ERROR MSG. # PCN # 94, 17 FEB 80, CALLER NO LONGER NEEDS TO PASS INPUT FILE LUN. ## 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. # INTEGER FUNCTION GETLIN (BUFR) #PCN #77, MAKE INTEGER,PCN#94 # INTEGER I, STRGET, STRIM, LEN, INDEX, SCOPY CHARACTER BUFR(MAXLINE) CHARACTER INMAP #USED ONLY IF 'ASCII' NOT DEFINED # INCLUDE CLINE # INCLUDE CPRTLN # INCLUDE CLIST # INCLUDE CUCLC # STRING DLEVL "123456789 " #DEBUG LEVELS # GETLIN=YES REPEAT [ CALL PRTLIN #PRINT LAST LINE BEFORE READING NEXT ONE LEN=STRGET (INFILE(LEVEL), BUFR, MAXCARD) #****GET THE LINE(AS A STRING) IF (LEN == EOF) RETURN (EOF) ELSE IF (LEN == BAD) #***PCN#82 CALL ERROR ("ERROR READING INPUT FILE.") #TERMINATE 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 # JUNK=SCOPY (BUFR, PRTBUF, MAXCARD, JUNK) #SAVE THIS LINE FOR LATER READY=YES #PRINTING, PCN#75 # ##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 #***NORMAL RETURN WITH 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, NO) INCREMENT (FTNLN) #PCN #75 ] ELSE IF (COMPRS == NO) [ #EXCEPT IN COMPRESS MODE, PASS BUFR(1) = BIGC #FULL LINE COMMENTS CALL PUTLIN (BUFR, STDOUT, NO) ] ] #REPEAT, GET ANOTHER LINE # RETURN END # #$ GETNAM - GET THE FILE NAME OF AN INCLUDED FILE #PCN # 93, 17 FEB 80 # INCLUDE/NL FILE AND INCLUDE FILE/NL BOTH OK, BUT 2ND WON'T BE LISTED RIGHT. # SUBROUTINE GETNAM (BUFR, LSTIT) # INTEGER LSTIT, LEN, SKIP CHARACTER NGETCH, CHAR, BUFR(MAXNAME) # LEN=0 SKIP=NO LSTIT=YES # #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) != 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 LSTIT=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 # RETURN END # #$ HEADR - FILL IN DAY,DATE,TIME FOR RATLST'S PAGE HEADER # PCN #90, 11 FEB 80 # SUBROUTINE HEADR # INTEGER JUNK, DAYS # INCLUDE CDATIM # DATA DATIM / 25*" "/ # IFDEF (REALCODE) JUNK=DAYS (DATIM(1)) #IF REAL MATH IS ALLOWED, GET DAY OF WEEK ENDIFDEF CALL DATE (DATIM(6)) #RSX!!! CALL TIME (DATIM(17)) #RSX!!! DATIM(25)=EOS #MAKE A STRING # RETURN END # #$ OPENI - OPEN INCLUDED FILES FOR RATFOR #SYKES,24APR77, ALLOW /NL TO SUPPRESS LISTING OF INCLUDED FILES #SYKES,19NOV76,27MAY77 # PCN #77, JAN 80, CHANGE FORMATED READ TO STRGET # PCN #82, FEB 80, USE 'OPEN', IF AVAILABLE. # PCN # 91, 13 FEB 80, ALLOW DEFAULT DEV/UIC SPECIFICATION. # PCN # 93, 17 FEB 80, SETUP START OF INCLUDES(FROM GETTOK). CREATE 'GETNAM'. # PCN # 95, 11 MAR 80, CHANGE ELSE IF AFTER THE RETURN TO IF (FOR F4P) # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # 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. # SUBROUTINE OPENI # CHARACTER BUFR(MAXNAME), BUF2(MAXNAME) INTEGER I, INDEX, SJOIN, JUNK, OPNIN, IERR # INCLUDE CLINE # INCLUDE CLIST # STRING RAT ".RAT" #DEFAULT EXTENSION # IF (LEVEL >= NFILES) #PCN #93 CALL ERROR ("INCLUDES NESTED TOO DEEPLY.") #TERMINATE HERE # CALL GETNAM (BUFR, LSTIT) #PCN #93, GET THE FILE NAME AND LIST SSTATUS INCREMENT (LEVEL) #BUMP INCLUDE LEVEL INFILE(LEVEL)=LEVEL #STORE LUN FOR THIS LEVEL LST(LEVEL)=LSTIT #RECORD LISTING STATUS FOR NEW FILE # IF (INDEX(BUFR, PERIOD) == 0) #ADD AN EXTENSION IF NONE THERE LEN=SJOIN (BUFR, RAT, MAXNAME-1, JUNK) # IF (OPNIN(BUFR, INFILE(LEVEL), IERR) == YES) [ #PCN #91, DO THE OPEN CALL DOINDX (3, BUFR) #PCN #96, WRITE INDEX LINE RETURN #ALL OK ] IFDEF (DEFAULTOPEN) # IF "NO SUCH FILE" ERROR, & NO DEV:UIC GIVEN, ADD DEFAULT DEV:UIC & TRY AGAIN. IF (IERR == 29 & INDEX(BUFR,COLON) == 0 #PCN #95 & INDEX(BUFR,LBRACK) == 0) [ BUF2(1)=EOS CALL SINSRT (DEFAULTOPEN, BUF2) #COPY "DEV:[UIC]" JUNK=SJOIN (BUF2, BUFR, MAXNAME-1, JUNK) #APPEND "NAME.EXT" IF (OPNIN(BUF2, INFILE(LEVEL), IERR) == YES) [ #TRY AGAIN CALL DOINDX (3, BUF2) #PCN #96, WRITE INDEX LINE RETURN #THAT ONE DID IT ] ] ENDIFDEF # # IF WE GOT THIS FAR, ALL EFFORTS TO OPEN FILE FAILED CALL ERROR ("OPEN FAILURE ON INCLUDE FILE.") #PCN #82 TERMINATE RETURN # END # #$ OPNIN - OPEN AN INCLUDE FILE AND FIELD ERRORS # PCN 91, 13 FEB 80, MAKE THIS OPEN MESS A SEPARATE ROUTINE. # INTEGER FUNCTION OPNIN (BUFR, UNIT, IERR) # INTEGER UNIT, IERR, STRGET, I CHARACTER BUFR(MAXNAME) # CALL ERRSNS #!!! IFDEF (OPENCLOSE) #PCN #82 OPEN (UNIT=UNIT, NAME=BUFR, READONLY, SHARED, TYPE='OLD', ERR=11) 11 CALL ERRSNS (IERR) #!!! IF (IERR == 0) # 0 MEANS NO ERRORS RETURN (YES) ELSE RETURN (BAD) ENDIFDEF # IFNOTDEF (OPENCLOSE) #PCN #82 CALL ASSIGN (UNIT, BUFR, 0) #RSX!!! CALL FDBSET (UNIT, "READONLY", "SHARE") #!!! CALL ERRSNS (IERR) IF (IERR == 0) [ I=STRGET (UNIT, JUNK, 0) #PCN #77 IF (I == BAD) [ CALL ERRSNS (IERR) #FIND OUT WHAT ERROR RETURN (BAD) #RETURN ERROR CODE ] ELSE [ REWIND UNIT #ONLY IF INPUT IS FROM DISK FILE RETURN (YES) ] ] ELSE RETURN (BAD) ENDIFDEF # RETURN END # #$ OPNOUT - OPEN OUTPUT FILES FOR RATFOR # PCN 91, 14 FEB 80, GET THIS OPEN MESS OUT OF MAINLINE. # INTEGER FUNCTION OPNOUT (BUFR, UNIT) # INTEGER UNIT, IERR, STRPUT CHARACTER BUFR(DUMMYSIZE) # CALL ERRSNS #RSX!!! OPNOUT=YES #ASSUME SUCCESS IFNOTDEF (OPENCLOSE) CALL ASSIGN(UNIT,BUFR,0) CALL FDBSET (UNIT, "NEW",,2) #RSX!!! CALL ERRSNS (IERR) #CHECK FOR VALID FILE NAME STRINGS IF (IERR!= 0 \ STRPUT(UNIT," ",BLANK) != YES) #TEST. IS IT OK? OPNOUT=BAD ELSE REWIND UNIT ENDIFDEF IFDEF (OPENCLOSE) #PCN #82 OPEN (UNIT=UNIT, NAME=BUFR, TYPE='NEW', ERR=11, CARRIAGECONTROL='LIST') 11 CALL ERRSNS (IERR) #IS THE FILE FOR REAL? IF (IERR != 0) #PCN #82 OPNOUT=BAD ENDIFDEF # RETURN END # #$ PRTLIN - PRINT A LINE OF RATFOR SOURCE ON THE LISTING # PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # PCN 100, 29 MAR 80, DON'T NUMBER NULL RATFOR SOURCE LINES # IF LISTING (BOTH IN GENERAL AND AT THIS PARTICULAR TIME), FIGURE OUT IF # THIS LINE (WHICH IS THE ONE JUST PROCESSED, ONE BEHIND THE ONE JUST READ) # NEEDS RATFOR LINE NUMBER, FTN LINE NUMBER, BOTH, OR NEITHER. CALL RATLST # TO PRINT THE LINE WITH THE CORRECT NUMBER(S). ALSO CONVERT COMMENTS TO # LOWER CASE, IF NEEDED. ALSO KEEP FTN LINE NUMBERS STRAIGHT (NO SMALL PROBLEM). # ARRANGE TO ALWAYS PRINT IFDEF,IFNOTDEF,ENDIF LINES WITH RATFOR NUMBERS, # TO LIST PROPERLY, THESE MUST BE IN UPPER CASE. # NOTE THAT DUMPIT AND DEFLST ALSO USE PRTBUF TO SAVE SPACE. # SUBROUTINE PRTLIN # INTEGER INDEX, EQLS, I, FUDGE, KLUGE, FORCIF, IT # INCLUDE CLINE # INCLUDE CPRTLN # INCLUDE CLIST # INCLUDE CUCLC # STRING DLEVL "123456789 " #DEBUG LEVELS STRING INCLU "INCLUDE" STRING ENDIF "ENDIFDEF" STRING IFDEFS "IFDEF" STRING IFNOT "IFNOTDEF" STRING DEFI "DEFINE" STRING MACR "MACRO" STRING FLAGLN "#$ " #DEFINE FLAG FOR LINE TO BE INDEXED # IF (LST(1) == YES & READY == YES) [ #ARE WE EVEN DOING A LISTING? IF (EQLS(PRTBUF(1),FLAGLN) == YES) #PCN #96, INDEX THIS LINE? CALL DOINDX (2, PRTBUF(4)) #YES, MINUS THE #$B FOR (IT=1; PRTBUF(IT) == BLANK \ PRTBUF(IT) == TAB; INCREMENT(IT)) ; #SKIP LEADING BLANKS AND TABS IF ((EQLS(PRTBUF(IT),IFDEFS) == YES) \ (EQLS(PRTBUF(IT),IFNOT) == YES)) FORCIF=YES #WHAT'S FIRST THING ON THIS LINE? ELSE #MUST FORCE LISTING OF 'IFDEF'&'IFNOTDEF' FORCIF=NO # IF (INIF == NO \ IFPNT == YES \ FORCIF == YES) [ #DO WE WANT TO PRINT? IF (LC == YES) [ I=INDEX (PRTBUF, SHARP) #PCN#59, IS THERE COMMENT ON THIS LINE IF (I > 0) CALL FOLD (PRTBUF(I+1)) #CONVERT COMMENT TO LOWER CASE ] # # DON'T NUMBER UNPROCESSED LINES, PCN #75, PCN #100 # IF ((PRTBUF(IT) == SHARP \ PRTBUF(IT) == FORMFEED \ PRTBUF(IT) == NEWLINE \ PRTBUF(IT) == EOS) \ #PCN 100 (INIF == YES & FORCIF == NO) \ (PRTBUF(1) == QMARK & INDEX(DLEVL,PRTBUF(2)) < DEBUG)) CALL RATLST(PRTBUF, 0, 0) # # RATFOR LINE NUMBER ONLY ON UNPROCESSED LINES AND PROCESSOR FEATURES # ELSE IF ((EQLS(PRTBUF(IT),ENDIF) == YES) \ (EQLS(PRTBUF(IT),MACR) == YES) \ (EQLS(PRTBUF(IT),DEFI) == YES) \ (EQLS(PRTBUF(IT),INCLU) == YES) \ FORCIF == YES) [ IF ((LEVEL > 1) & (PRTBUF(IT+7) == SLASH) & (EQLS(PRTBUF(IT),INCLU) == YES)) [ KLUGE=YES #INCLUDE/NL?, IF SO, LST(LEVEL)=YES #FORCE RATLST TO PRINT IT ] ELSE KLUGE=NO CALL RATLST (PRTBUF, LINECT, 0) #RAT #, NO FTN # INCREMENT (LINECT) IF (KLUGE == YES) #WE FAKED RATLST, NOW LST(LEVEL)=NO #RESET INCLUDED LEVEL TO NO LIST ] # # RATFOR AND FORTRAN NUMBERS ON LINES THAT GENERATED CODE # ELSE [ IF (FORTYP == YES) #THIS LINE IS 'FOR' WITH INIT CLAUSE? FUDGE=1 #YES, BACK OFF AN EXTRA LINE NUMBER ELSE #(ALSO FOR 'UNTIL') FUDGE=0 CALL RATLST (PRTBUF, LINECT, FTNLN-FUDGE) INCREMENT (LINECT) IFNOTDEF (DECF4P) #DEC FORTRAN IV NEEDS EXTRA FTN LINE IF (IFTYP == YES) #NUMBER ON 'IF'S INCREMENT (FTNLN) #FOR THE 'GOTO'. SO ADD IT HERE. ENDIFDEF ] # READY=NO #PRTBUF NO LONGER VALID ] IFTYP=NO FORTYP=NO ] # RETURN END # #$ PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE #SYKES,14OCT76,16DEC76,27MAY77 # PCN #77, 5 JAN 80, USE 'STRPUT' INSTEAD OF FORMATS. USE FMTCHR FROM CALLER # IF OUTPUT IS TO FORTRAN FILE (STDOUT), MAKE FINAL DECISION ABOUT OUTPUT. # IF OUTPUT IS TO ANOTHER FILE (EG LISTING), ASSUME CALLER HAS ALREADY DECIDED. # PCN #83, 16 JAN 80, DELETE CALL TO 'ERROR' IF STRPUT GETS ERROR. # SUBROUTINE PUTLIN (BUF, FIL, FMTCHR) #PCN 77, 5 JAN 80 # INTEGER I, J, FIL, STRPUT CHARACTER BUF(MAXLINE), FMTCHR CHARACTER OUTMAP #USED ONLY IF NOT ASCII INCLUDE CLIST # # IF ((OUTPUT == YES & FIL == STDOUT) \ FIL != STDOUT) [ IFNOTDEF (ASCII) FOR(I=1;I <= MAXCARD & BUF(I) != NEWLINE & BUF(I) != EOS;INCREMENT(I)) BUF(I)=OUTMAP(BUF(I)) #MAP TO EXTERNAL CHAR. SET HERE, IF NEEDED BUF(I)=EOS #MAKE SURE IT'S A STRING ENDIFDEF JUNK=STRPUT (FIL, BUF, FMTCHR) #OUTPUT THE LINE RETURN ] # RETURN END # #$ RATFOR - PREPROCESSOR MAINLINE AND OPERATOR/OS INTERFACE # PCN # 77, 8 JAN 80, CHANGE 'PROMPT' TO STRING. # PCN # 82, 8 FEB 80, USE OPEN INSTEAD OF ASSIGN/FDBSET, IF AVAILABLE # PCN # 90, 11 FEB 80, CALL HEADR TO SET UP DATE/TIME FOR 'RATLST'. # PCN #91, 13 FEB 80, USE OPNIN FOR INPUT FILE OPENS & OPNOUT FOR OUTPUT. # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # PCN # 97, 22 MAR 80, DEFINE DEFAULTS FOR SWITCHES, PROCESS IN RATGO # INTEGER SWITCH(4,12), ICSI, DOIT, I, J, STATUS, SLEN, JUNK INTEGER STRPUT, SITOC, OPNIN, OPNOUT, SWTFO, SWTSC, SWTSP, SWTGO CHARACTER NAMES(35,9) REAL DEFALT(4) # INCLUDE CLIST # INCLUDE CICSI # STRING REF " RATFOR ERRORS FOUND" STRING PROMPT "RAT>" #PCN #77 DATA DEFALT /"FTN ", "LST ", "OBJ ", "RAT "/ #DEFAULT EXTENSIONS 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 DATA SWITCH(1,12)/"IN"/ #PRINT INDEX? ***PCN #96 # # CALL FILFIX #PCN #85, TURN OFF FILE ERROR REPORTING USER=USERIN INDLUN=INDIRLUN #FOR ICSI # REPEAT [ # #----------------------------------- GET CMD LINE, DO SWITCHES --------------- # CLB(1)=EOS CALL HEADR #PCN 90, GET DATE/TIME STATUS=ICSI(NAMES,DEFALT,SWITCH,12,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, BLANK) ELSE [ # ELSE DO THE COMMAND LINE CALL RATGO (SWITCH, SWTFO, SWTSC, SWTSP, SWTGO) # DO SWITCHES, PCN 97 # #------------------------------SET UP FTN OUTPUT FILE------------------------ # IF (SLEN(NAMES(1,1)) > 0) [ #REAL FTN OUTPUT FILE OUTPUT = YES IF ( OPNOUT (NAMES(1,1), STDOUT) == BAD ) [ #PCN #91 CALL ICSIE ("Open Failure on FTN Output File") NEXT ] ] IFDEF (OPENCLOSE) #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. ELSE IF (SWTFO == YES & SLEN(NAMES(1,2)) > 0) [ OPEN(UNIT=STDOUT,NAME='FOO.TMP',TYPE='SCRATCH') OUTPUT=YES ] ENDIFDEF ELSE OUTPUT = NO # #------------------------------------SET UP LISTING FILE--------------------- # IF (SLEN(NAMES(1,2)) > 0) [ LST(1) = YES IF ( OPNOUT (NAMES(1,2), LISTOUT) == BAD) [ #PCN #91 CALL ICSIE ("Open Failure on List File") NEXT ] ELSE CALL QIO (768, LISTOUT) #PCN#58,ATTACH LIST DEV(768="1400) !!! ] ELSE [ LST(1) = NO #NO LISTING INDXIT = NO #SO DON'T DO INDEX EITHER ] # IF (LST(1) == NO & OUTPUT == NO) #CHECK FOR NULL EFFORT NEXT IF (INDXIT == YES) #OPEN SCRATCH FILE TO SAVE INDEX DATA IN IFDEF (OPENCLOSE) #***PCN #96 OPEN (UNIT=LUNINDX, NAME='RATINDX.TMP',TYPE='SCRATCH') ENDIFDEF IFNOTDEF (OPENCLOSE) CALL ASSIGN (LUNINDX, "RATINDX.TMP", 0) #JUNK FILE WILL BE LEFT ENDIFDEF # #------------------------------ PROCESS ALL INPUT FILES ----------------------- # FOR (J=4; J <= 9 & SLEN(NAMES(1,J)) > 0; INCREMENT(J)) [ IF (OPNIN(NAMES(1,J),STDIN,JUNK) == BAD) [ #PCN #91 CALL ICSIE ("Open Failure on Input File") BREAK ] ELSE [ CALL DOINDX (1, NAMES(1,J)) #PCN #96 ADD FILE NAME TO INDEX CALL PARSE #**** DO ALL THE WORK HERE CALL CLOSE (STDIN) ] ] # #------------------------------------- CLEAN UP, END OF CMD LINE -------------- # IF (SWTSC == YES & LST(1) == YES) #PCN 97 CALL DEFLST #LIST CURRENT DEFINE TABLE IF (SWTFO == YES & OUTPUT == YES & LST(1) == YES) #PCN 97 CALL DUMPIT #LIST THE FORTRAN CODE IF (INDXIT == YES) [ #PCN #96 CALL DMPIDX #PRINT THE INDEX AT END OF LISTING CALL CLOSE (LUNINDX) ] IF (OUTPUT == YES) CALL CLOSE (STDOUT) # IF (LST(1) == YES) IFDEF (OPENCLOSE) #IF LISTOUT=LP:, LISTING IS ALWAYS SPOOLED BY D. AND M PLUS. #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 (SWTSP == YES) #PCN 97 CLOSE (UNIT=LISTOUT, 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 (SWTGO == YES) CALL SPAWNF (NAMES) ENDIFDEF ] ] ] #END REPEAT, THAT CMD LINE DONE, GET ANOTHER CMD LINE # END # #$ RATHLP - 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 # PCN # 77, 5 JAN 80, FIX DISPLAY OF /SP SWITCH # PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. # SUBROUTINE RATHLP # WRITE (USEROUT,1) 1 FORMAT (/" ",VNUMBER/, " SWITCHS: " /, " /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 - LIST CODE IN UNDEFINED CONDITIONALS"/, " /IN - LIST RATFOR SOURCE CODE INDEX"/, #PCN #96 " /LC - GENERATE LOWER CASE FORTRAN CODE"/, " /RE - RETAIN THE DEFINITIONS FROM PREVIOUS COMMAND LINE"/, " /SC - LIST SYMBOLIC CONSTANT DEFINITION TABLE") # IFDEF (OPENCLOSE) WRITE (USEROUT,6) 6 FORMAT (" /SP - SPOOL LISTING FILE TO PRINTER") ENDIFDEF # WRITE (USEROUT,2) 2 FORMAT (" /VE - PRINT RATFOR'S VERSION NUMBER ON TERMINAL (ONLY)"/, " 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 - PRINT A LINE ON LISTING & DO PAGE HOUSEKEEPING #SYKES 28MAY77 # PCN # 69, 10 OCT 79, MAKE STRPUT TYPE INTEGER # PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING # PCN #77, JAN 80, CHANGE STRPUT CALLS TO PUTLIN CALLS TO MAP CHAR. SETS. # PCN #90, 11 FEB 80, GET DATE/TIME FROM 'CDATIM'. # SUBROUTINE RATLST (BUFR, LINE, FLINE) #PCN #75, ADD FLINE # INTEGER N, LINE, SCOPY, SITOC, JUNK, FLINE CHARACTER BUFR(DUMMYSIZE), OUTBUF(133) # INCLUDE CLIST # INCLUDE CLINE # INCLUDE CICSI # INCLUDE CDATIM # STRING STARSS "************" # # ERRORS (LINE=HUGE) WITHIN INCLUDED/NL FILES ARE LISTED, 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 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #ADVANCE PAGE OUTBUF(1)=BLANK CALL PUTLIN (OUTBUF, LISTOUT, BLANK) CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #BLANK LINES CALL PUTLIN (OUTBUF, LISTOUT, BLANK) INCREMENT (PAGE) CALL SPAD (OUTBUF, 77) CALL SINSRT (VNUMBER, OUTBUF(1)) CALL SINSRT (DATIM, OUTBUF(35)) #***PCN #90 CALL SINSRT ("PAGE", OUTBUF(71)) JUNK=SITOC (PAGE, OUTBUF(77), 4) CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #PRINT THE HEADING CALL PUTLIN (CLB, LISTOUT, BLANK) OUTBUF(1)=BLANK OUTBUF(2)=EOS CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #BLANK LINES CALL PUTLIN (OUTBUF, LISTOUT, BLANK) PLINE=6 IF (BUFR(1) == FORMFEED) RETURN #DONE IT ] OUTBUF(1)=EOS CALL SPAD (OUTBUF,7) #PCN#75, PRINT FTN LINE #'S IF (FLINE > 0) [ OUTBUF(1)=LPAREN N=SITOC (FLINE, OUTBUF(2), 4) #CONVERT FTN LINE # OUTBUF(N+2)=RPAREN #KLOBBER SITOC'S 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(7), 5) #CONVERT RATFOR LINE # CALL SPAD (OUTBUF, 21) FOR (N=1; N <= NFILES; INCREMENT(N)) IF (N <= LEVEL-1) OUTBUF(11+N)=STAR #FLAG INCLUDED FILES JUNK=SCOPY (BUFR, OUTBUF(14+NFILES), 132-14-NFILES, JUNK) CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #PRINT THE LINE INCREMENT (PLINE) RETURN END # IFDEF (SPAWNIT) #$ SPAWNF - SUBROUTINE TO CALL FORTRAN TO MAKE OBJECT MODULE DIRECTLY # NOV 79, SYKES, FOR SYSTEMS WITH SPAWN DIRECTIVE ONLY. #PCN 101, 29 MAR 80, OPTIONAL WAIT FOR SPAWNED COMPILER.MAKE FTN SWITCHES DEFINEABLE # 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) % DATA TSKNAM /6R...F4P/ ENDIFDEF IFNOTDEF (DECF4P) % DATA TSKNAM /6R...FOR/ ENDIFDEF # CMDLIN(1)=BLANK #PCN #101 IF (SLEN (NAMES(1,3)) > 0) #DID HE SPECIFY .OBJ FILE NAME? JUNK=SCOPY (NAMES(1,3), CMDLIN(2), 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(2), 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 IFDEF(FTNSWITCHES) LEN= SJOIN (CMDLIN, FTNSWITCHES, 60, JUNK) #ADD ANY SWITCHES, PCN #101 ENDIFDEF ?9 CALL ICSIE (CMDLIN) # CALL SPAWN (TSKNAM, , , 1, , , , CMDLIN, LEN, , , IDS) # IFDEF (WAITFORFTN) IF (IDS == 1) CALL WAITFR (1) #WAIT FOR THE COMPILER TO FINISH, PCN #101 ELSE CALL ICSIE ("SPAWN Failure, FORTRAN not Run") ENDIFDEF IFNOTDEF (WAITFORFTN) IF (IDS != 1) CALL ICSIE ("SPAWN Failure, FORTRAN not Run") ENDIFDEF # RETURN END ENDIFDEF # #$ SYNERR - REPORT RATFOR SYNTAX ERRORS #SYKES 28SEP76,20MAY77 # PCN # 57, 31 AUG 79, ALWAYS PRINT ERRORS ON TERMINAL # SUBROUTINE SYNERR(MSG) # CHARACTER BUFOUT(MAXLINE), MSG(MAXLINE) INTEGER I, LASTC 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, NO) # # OUTPUT TO LISTING FILE, AND-OR TO TERMINAL IF (LST(1) == YES) CALL RATLST (BUFOUT(2), HUGE, 0) #PRINT WITH '***', PCN 75 # ELSE #PCN # 57 CALL ICSIE (BUFOUT(2)) # RETURN END