C CFILE=RATRSX.RAT C=================== RSX11-DEC VERSION OF RATFOR ====================== C$ **** THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR C NOTE: FORTRAN IV V2.2 BUG CAUSES ODD ADDR TRAP (ERROR 3) ON ANY OPEN E C EXCEPT 'NO SUCH FILE' (E.G. 'INVALID DEVICE') IF OPENS ARE USED. C## VERSION 21 ISSUED, 1 APRIL 80. C PCN #103, 20 MAY 80, ALLOW FUNCTION NAMES TO BE SYMBOLIC CONSTANTS. C PCN #104, JUL 80, ALLOW SPAWN OF FTN WITHOUT USING FTNSWITCHES. C PCN #106, 28 SEP 80, SUPPRESS UNLABELED 'CONTINUE' FTN STATEMENTS. C PCN #107, 29 SEP 80, ALLOW MULTI-LEVEL BREAK AND NEXT STATEMENTS. C PCN #108, 1 OCT 80, USE EXPLICIT DEFAULT DEVICE OF SY:. TIDY UP FILES C PCN #109, 1 OCT 80, FIX TYPO IN TOKDEF CALL.CHANGE 'LAST' TO INTEGER. C IMPROVE ERROR MESSAGES GENERALLY. C## VERSION 22 ISSUED, 1 NOV 80 C PCN #112, 20 JUN 81, ADD TO END OF SPAWN CMD LINE TO GET > BACK. C PCN #113, 20 JUN 81, CHANGE REAL TO I*4 IN 'DAYS'. DELETE 'REALCODE'SY C PCN #114, 21 JUN 81, REPLACE STRGET WITH GETIN TO SPEED UP INPUT IN GE C PCN #115, 21 JUN 81, REPLACE STRGET WITH GETIN IN DUMPIT & DMPIDX C PCN #116, 21 JUN 81, DELETE CPRTLN FROM DEFLST AND USE LOCAL BUFFER IN C PCN #117, 21 JUN 81, FIX LISTING OF PROCESSOR KEYWORDS TO ALLOW LOWER C PCN #118, 22 JUN 81, FIX BUGS RE OPEN & CLOSE IFDEF/IFNOTDEFS C PCN #119, 11 JUL 81, DELETE ALL CALL ASSIGN FILE OPENS. ALLOW BIG BUFF C PCN #120, 12 JUL 81, ALLOW PERIODS(DECIMAL POINTS) TO BE PART OF TOKEN C PCN #121, 12 JUL 81, ALLOW (AND IGNORE) ' AND " IN INCLUDE FILE SPECS C PCN #122, 3 AUG 81, PRINT NAME OF INCLUDE FILE IF NOT FOUND IT IN OPE C PCN #123, 3 AUG 81, CHOP LONG COMMENT LINES AT COL 72 TO KEEP FTN HAP C VERSION 23 RELEASED 10 AUG 81 C CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT. C C FILE=RATDEF.RAT CDEFINE (DECWRITER,) #DEFINED FOR DECWRITER OUTPUT C C C#DEFINE (DECF4P,) #DEFINE TO DO F4P LINE NUMBERS RIGHT(AND SPAWNING) C#DEFINE (WAITFORFTN,) #DEFINE IF YOU WANT TO WAIT FOR SPAWNED COMPILER C#DEFINE (SPAWNIT,) #DEFINE IF RSX11M V3.2 FOR /GO SWITCH, ***PCN 71 ! C C C$ CLOSE - SUBROUTINE TO CLOSE A FILE, GIVEN THE LUN NUMBER C PCN 119 11 JUL 81, NEW SUBROUTINE C SUBROUTINE CLOSE ( LUN ) C INTEGER LUN C CLOSE ( UNIT = LUN ) C RETURN END C C$ DAYS - RETURN DAY OF WEEK AS 3 CHAR (REAL) AND INTEGER (1-7) C PCN 90, 11 FEB 80 C PCN #113, 20 JUN 81, CHANGE REAL TO I*4 . DELETE 'REALCODE'SYMBOL C INTEGER FUNCTION DAYS ( DAY ) C INTEGER N1, N2, N3, N4, JDA, JMO, JYR REAL DAYWK ( 7 ), DAY DATA DAYWK / 4HSUN , 4HMON , 4HTUE , 4HWED , 4HTHU , 4HFRI , $4HSAT / C C CALL IDATE ( JMO, JDA, JYR ) C JYR = 1900 + JYR IF (.NOT.( JMO .LE. 2 )) GOTO 20000 JYR = JYR - 1 JMO = JMO + 12 20000 CONTINUE N4 = JYR / 400 N3 = JYR / 100 N2 = 5 * JYR / 4 N1 = 13 * ( JMO + 1 ) / 5 N0 = N1 + N2 - N3 + N4 + JDA - 1 DAYS = N0 - ( 7 * ( N0 / 7 ) ) + 1 DAY = DAYWK ( DAYS ) C RETURN END C C$ DUMPIT - LIST GENERATED FORTRAN SOURCE CODE ON PRINTER C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING, USE FOR DUMPED CODE C PCN # 77, 5 JAN 80, USE PRTBUF TO GET AND PUT LINES, VICE INTERNAL BUF C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. C PCN #115, 21 JUN 81, DROP PRTBUF, GO TO INTERNAL BUFFER; USE GETIN VIC C SUBROUTINE DUMPIT C INTEGER LEN, FLINE, GETIN LOGICAL * 1 FF ( 2 ), BUFR ( 97 ) DATA FF / 12, 0 / C REWIND 7 CALL RATLST ( FF, 0, 0 ) FLINE = 0 CALL DOINDX ( 5, 36H***DUMP OF GENERATED FORTRAN CODE*** ) 20002 CONTINUE LEN = GETIN ( 7, BUFR, BUFR ) IF (.NOT.( LEN .EQ. - 3 )) GOTO 20005 GOTO 20004 20005 CONTINUE IF (.NOT.( LEN .EQ. - 1 )) GOTO 20007 CALL ERROR ( 41HDUMPIT I/O ERROR READING FTN OUTPUT FILE. ) GOTO 20008 20007 CONTINUE IF (.NOT.( BUFR ( 1 ) .EQ. 12 )) GOTO 20009 FLINE = 0 20009 CONTINUE IF (.NOT.( BUFR ( 1 ) .EQ. 67 .OR. BUFR ( 6 ) .EQ. 36 .OR. BUFR ( $1 ) .EQ. 12 )) GOTO 20011 CALL RATLST ( BUFR, 0, 0 ) GOTO 20012 20011 CONTINUE FLINE = FLINE + 1 CALL RATLST ( BUFR, 0, FLINE ) IF (.NOT.( ( BUFR ( 7 ) .EQ. 73 .AND. BUFR ( 8 ) .EQ. 70 .AND. $BUFR ( 9 ) .EQ. 32 ) .OR. ( BUFR ( 7 ) .EQ. 105 .AND. BUFR ( 8 ) $.EQ. 102 .AND. BUFR ( 9 ) .EQ. 32 ) )) GOTO 20013 FLINE = FLINE + 1 20013 CONTINUE 20012 CONTINUE 20008 CONTINUE 20006 CONTINUE C 20003 GOTO 20002 20004 CONTINUE RETURN END C C$ FILFIX - CALL ERRSET FROM OVERLAY TO TURN OFF FTN ERROR MESSAGES C PCN #85, 20 JAN 80 C SUBROUTINE FILFIX C CALL ERRSET ( 63, .TRUE., .FALSE.,, .FALSE. ) CALL ERRSET ( 43, .TRUE., .FALSE.,, .FALSE. ) CALL ERRSET ( 29, .TRUE., .FALSE.,, .FALSE. ) CALL ERRSET ( 39, .TRUE., .FALSE.,, .FALSE. ) CALL ERRSET ( 30, .TRUE., .FALSE.,, .FALSE. ) C RETURN END C C$ GETIN - FAST READ OF A STRING FROM A SPECIFIED LUN C# PCN 114, JUN 81, ADD GETIN. SPEED UP INPUT BY USING A8 INSTEAD OF A1 C# THIS ROUTINE REPLACES STRGET. IT IS 35% FASTER, SO IT CUTS TOTAL PROC C# TIME BY 15%. THE IDEA FOR THIS APPROACH CAME FROM TOM SCHULZ. C# THE CALLING PROGRAM MUST USE THE SAME ARRAY AS BOTH RSTR AND CSTR IN C# CALLING SEQUENCE, THIS IMPLICITLY EQUIVALENCES THE BYTE AND REAL*8 C# THIS IS ILLEGAL STANDARD FORTRAN BUT WORKS FINE WITH DEC'S FORTRANS C INTEGER FUNCTION GETIN ( LUN, RSTR, CSTR ) C LOGICAL * 1 CSTR ( 97 ) INTEGER LUN, NCHAR REAL * 8 RSTR ( 12 ) C READ ( LUN, 1, END = 100, ERR = 101 ) NCHAR, RSTR 1 FORMAT ( Q, 12 A8 ) 20015 IF (.NOT.( NCHAR .GT. 0 .AND. CSTR ( NCHAR ) .EQ. 32 )) GOTO $20016 NCHAR = NCHAR - 1 GOTO 20015 20016 CONTINUE CSTR ( NCHAR + 1 ) = 0 GETIN = ( NCHAR ) RETURN C 100 CSTR ( 1 ) = 0 GETIN = ( - 3 ) RETURN C 101 CSTR ( 1 ) = 0 GETIN = ( - 1 ) RETURN C END C C$ GETLIN - READ IN ANOTHER LINE FROM THE RATFOR INPUT FILE FOR NGETCH C PCN # 82, 8 FEB 80, DELETE UNNEEDED CALL TO 'ERRSNS' AND ERROR MSG. C PCN # 94, 17 FEB 80, CALLER NO LONGER NEEDS TO PASS INPUT FILE LUN. C PCN #114, 21 JUN 81, REPLACE STRGET WITH GETIN TO SPEED UP THE READS C PCN #123, 3 AUG 81, CHOP LONG COMMENT LINES AT COL 72 TO KEEP FTN HAP C# IF LINE BEGINS WITH A '%' IN COL. 1, TRANSFER IT TO THE C# OUTPUT FILE WITH NO PROCESSING AT ALL EXCEPT DELETE THE '%'. C# ALSO, TRANSFER FULL LINE COMMENTS ('#' IN COL 1) TO OUTPUT FILE C# ALSO, LIST EACH LINE AS IT IS READ.EXCEPT WITHIN UNDEFINED IFDEFS C IF THE /IF SWITCH IS PRESENT. C INTERPRET DEBUG LINES ("?" IN COL 1) AS WELL. PROCESS THEM IF C THE LEVEL SPECIFIED IN THE SECOND COL IS >= SPECIFIED DEBUG LEVEL. C INTEGER FUNCTION GETLIN ( BUFR ) C INTEGER GETIN INTEGER I, LEN, INDEX, SCOPY LOGICAL * 1 BUFR ( 97 ) LOGICAL * 1 INMAP C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 DLEVL (11) C DATA DLEVL/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H ,0/ GETLIN = 1 20017 CONTINUE CALL PRTLIN LEN = GETIN ( INFILE ( LEVEL ), BUFR, BUFR ) IF (.NOT.( LEN .EQ. - 3 )) GOTO 20020 GETLIN = ( - 3 ) RETURN 20020 CONTINUE IF (.NOT.( LEN .EQ. - 1 )) GOTO 20022 CALL ERROR ( 29HI/O ERROR READING INPUT FILE. ) C 20022 CONTINUE 20021 CONTINUE JUNK = SCOPY ( BUFR, PRTBUF, 96, JUNK ) READY = 1 C C#SPECIAL PROCESSING OF RATFOR PROCESSOR FEATURES IF (.NOT.( BUFR ( 1 ) .EQ. 63 )) GOTO 20024 IF (.NOT.( INDEX ( DLEVL, BUFR ( 2 ) ) .GE. DEBUG )) GOTO 20026 BUFR ( 1 ) = 32 BUFR ( 2 ) = 32 GOTO 20027 20026 CONTINUE GOTO 20018 C 20027 CONTINUE 20024 CONTINUE IF (.NOT.( LEN .EQ. 1 .AND. BUFR ( 1 ) .EQ. 12 )) GOTO 20028 GOTO 20018 20028 CONTINUE IF (.NOT.( BUFR ( 1 ) .NE. 37 .AND. BUFR ( 1 ) .NE. 35 )) GOTO $20030 GOTO 20019 C 20030 CONTINUE 20029 CONTINUE IF (.NOT.( INIF .EQ. 1 )) GOTO 20032 GOTO 20018 20032 CONTINUE IF (.NOT.( BUFR ( 1 ) .EQ. 37 )) GOTO 20034 CALL PUTLIN ( BUFR ( 2 ), 7, 0 ) FTNLN = FTNLN + 1 GOTO 20035 20034 CONTINUE IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20036 IF (.NOT.( LEN .GT. 72 )) GOTO 20038 BUFR ( 73 ) = 0 20038 CONTINUE BUFR ( 1 ) = 67 CALL PUTLIN ( BUFR, 7, 0 ) 20036 CONTINUE 20035 CONTINUE 20033 CONTINUE C 20018 GOTO 20017 20019 CONTINUE RETURN END C C$ GETNAM - GET THE FILE NAME OF AN INCLUDED FILE CPCN # 93, 17 FEB 80 C INCLUDE/NL FILE AND INCLUDE FILE/NL BOTH OK, BUT 2ND WON'T BE LISTED C PCN #121, 12 JUL 81, ALLOW (AND IGNORE) ' AND " IN INCLUDE FILE SPECS C SUBROUTINE GETNAM ( BUFR, LSTIT ) C INTEGER LSTIT, LEN, SKIP LOGICAL * 1 NGETCH, CHAR, BUFR ( 35 ) C LEN = 0 SKIP = 0 LSTIT = 1 C CSINCE THE STRING MAY CONTAIN SEVERAL TOKENS C AND EVEN SEMICOLONS, FORCE READ THE REST OF THIS LINE AND C TAKE IT TO BE THE FILE NAME SPEC. C 20040 IF (.NOT.( NGETCH ( CHAR ) .NE. 10 .AND. CHAR .NE. 35 .AND. LEN $.LT. 35 )) GOTO 20041 IF (.NOT.( SKIP .EQ. 1 .AND. CHAR .EQ. 32 )) GOTO 20042 SKIP = 0 GOTO 20043 20042 CONTINUE IF (.NOT.( CHAR .EQ. 47 )) GOTO 20044 SKIP = 1 LSTIT = 0 GOTO 20045 20044 CONTINUE IF (.NOT.( CHAR .NE. 32 .AND. CHAR .NE. 9 .AND. CHAR .NE. 34 $.AND. CHAR .NE. 39 .AND. SKIP .EQ. 0 )) GOTO 20046 LEN = LEN + 1 BUFR ( LEN ) = CHAR 20046 CONTINUE 20045 CONTINUE 20043 CONTINUE GOTO 20040 20041 CONTINUE CALL PUTBAK ( CHAR ) C BUFR ( LEN + 1 ) = 0 C RETURN END C C$ HEADR - FILL IN DAY,DATE,TIME FOR RATLST'S PAGE HEADER C PCN #90, 11 FEB 80 C PCN #113, 20 JUN 81, CHANGE REAL TO I*4 IN 'DAYS'. DELETE 'REALCODE'SY C SUBROUTINE HEADR C INTEGER JUNK, DAYS C C FILE = CDATIM.RAT FOR RATFOR COMMON / CDATIM / DATIM ( 25 ) LOGICAL * 1 DATIM C DATA DATIM / 25 * 1H / C JUNK = DAYS ( DATIM ( 1 ) ) CALL DATE ( DATIM ( 6 ) ) CALL TIME ( DATIM ( 17 ) ) DATIM ( 25 ) = 0 C RETURN END C C$ OPENI - OPEN INCLUDED FILES FOR RATFOR CSYKES,24APR77, ALLOW /NL TO SUPPRESS LISTING OF INCLUDED FILES CSYKES,19NOV76,27MAY77 C PCN #77, JAN 80, CHANGE FORMATED READ TO STRGET C PCN #82, FEB 80, USE 'OPEN', IF AVAILABLE. C PCN # 91, 13 FEB 80, ALLOW DEFAULT DEV/UIC SPECIFICATION. C PCN # 93, 17 FEB 80, SETUP START OF INCLUDES(FROM GETTOK). CREATE 'GET C PCN # 95, 11 MAR 80, CHANGE ELSE IF AFTER THE RETURN TO IF (FOR F4P) C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. C PCN #108, 1 OCT 80, EXPLICITLY USE "SY:" AS DEFAULT DEVICE. C PCN #122, 2 AUG 81, REPORT NAME OF A FILE WE CAN'T FIND; GENERAL CLE C THE LUN FOR EACH INPUT FILE IS STORED IN INFILE(LEVEL),WHERE C LEVEL IS THE INCLUSION LEVEL (BASIC INPUT FILE=1). C CURRENTLY, THE LUN=THE INCLUSION LEVEL; INFILE(LEVEL)=LEVEL. CNOTE: AN EXPLICIT VERSION NUMBER WORKS ONLY IF THERE IS ALSO AN C EXPLICIT EXTENSION SPECIFIED. C SUBROUTINE OPENI C LOGICAL * 1 BUFR ( 35 ), BUF2 ( 35 ) INTEGER I, INDEX, SJOIN, JUNK, OPNIN, IERR, SCOPY C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C IF (.NOT.( LEVEL .GE. 4 )) GOTO 20048 CALL ERROR ( 27HINCLUDES NESTED TOO DEEPLY. ) C 20048 CONTINUE CALL GETNAM ( BUFR, LSTIT ) LEVEL = LEVEL + 1 INFILE ( LEVEL ) = LEVEL LST ( LEVEL ) = LSTIT C IF (.NOT.( INDEX ( BUFR, 46 ) .EQ. 0 )) GOTO 20050 LEN = SJOIN ( BUFR, 4H.RAT, 35 - 1, JUNK ) C 20050 CONTINUE BUF2 ( 1 ) = 0 IF (.NOT.( INDEX ( BUFR, 58 ) .EQ. 0 )) GOTO 20052 JUNK = SCOPY ( 3HSY:, BUF2 ( 1 ), 35, JUNK ) 20052 CONTINUE JUNK = SJOIN ( BUF2, BUFR, 35, JUNK ) IF (.NOT.( OPNIN ( BUF2, INFILE ( LEVEL ), IERR ) .EQ. 1 )) GOTO $20054 CALL DOINDX ( 3, BUFR ) RETURN C IF "NO SUCH FILE" ERROR, & NO DEV:UIC GIVEN, ADD DEFAULT DEV:UIC & TRY 20054 CONTINUE IF (.NOT.( IERR .EQ. 29 .AND. INDEX ( BUFR, 58 ) .EQ. 0 .AND. $INDEX ( BUFR, 91 ) .EQ. 0 )) GOTO 20056 JUNK = SCOPY ( 11HDB1:[314,1], BUF2, 35, JUNK ) JUNK = SJOIN ( BUF2, BUFR, 35 - 1, JUNK ) IF (.NOT.( OPNIN ( BUF2, INFILE ( LEVEL ), IERR ) .EQ. 1 )) GOTO $20058 CALL DOINDX ( 3, BUF2 ) RETURN 20058 CONTINUE C C IF WE GOT THIS FAR, ALL EFFORTS TO OPEN FILE FAILED 20056 CONTINUE CALL SYNERR ( 36HOPEN FAILURE ON INCLUDE FILE NAMED:. ) CALL ERROR ( BUFR ) RETURN C END C C$ OPNIN - OPEN AN INCLUDE FILE AND FIELD ERRORS C PCN 91, 13 FEB 80, MAKE THIS OPEN MESS A SEPARATE ROUTINE. C PCN #119, 11 JUL 81, DELETE ALL CALL ASSIGN/FDBSET FILE OPENS. C INTEGER FUNCTION OPNIN ( BUFR, UNIT, IERR ) C INTEGER UNIT, IERR, I LOGICAL * 1 BUFR ( 35 ) C CALL ERRSNS C C TO IMPLEMENT BIG BUFFERING (5 BLOCK READ) OF INPUT FILE, C DEFINE "DISK_BLOCKSIZE" TO BE 2560. STANDARD IS 512. IF (.NOT.( UNIT .EQ. 1 )) GOTO 20060 OPEN ( UNIT = UNIT, NAME = BUFR, READONLY, SHARED, BLOCKSIZE = $512, TYPE = 'OLD', ERR = 11 ) GOTO 20061 20060 CONTINUE OPEN ( UNIT = UNIT, NAME = BUFR, READONLY, SHARED, TYPE = 'OLD', $ERR = 11 ) C 20061 CONTINUE 11 CALL ERRSNS ( IERR ) IF (.NOT.( IERR .EQ. 0 )) GOTO 20062 OPNIN = ( 1 ) RETURN 20062 CONTINUE OPNIN = ( - 1 ) RETURN C 20063 CONTINUE END C C$ OPNOUT - OPEN OUTPUT FILES FOR RATFOR C PCN 91, 14 FEB 80, GET THIS OPEN MESS OUT OF MAINLINE. C PCN 119, 11 JUL 81, DELETE OPENCLOSE AND CALL ASSIGN,FDBSET C INTEGER FUNCTION OPNOUT ( BUFR, UNIT ) C INTEGER UNIT, IERR LOGICAL * 1 BUFR ( 1 ) C CALL ERRSNS C C TO USE BIG BUFFERING, DEFINE DISK_BLOCKSIZE TO BE > THE STANDARD 512 C OPEN ( UNIT = UNIT, NAME = BUFR, TYPE = 'NEW', ERR = 11, $BLOCKSIZE = 512, CARRIAGECONTROL = 'LIST' ) C 11 CALL ERRSNS ( IERR ) IF (.NOT.( IERR .EQ. 0 )) GOTO 20064 OPNOUT = ( 1 ) RETURN 20064 CONTINUE OPNOUT = ( - 1 ) RETURN C 20065 CONTINUE END C C$ PRTLIN - PRINT A LINE OF RATFOR SOURCE ON THE LISTING C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. C PCN 100, 29 MAR 80, DON'T NUMBER NULL RATFOR SOURCE LINES C PCN #117, 21 JUN 81, FIX LISTING OF PROCESSOR KEYWORDS TO ALLOW LOWER C IF LISTING (BOTH IN GENERAL AND AT THIS PARTICULAR TIME), FIGURE OUT I C THIS LINE (WHICH IS THE ONE JUST PROCESSED, ONE BEHIND THE ONE JUST R C NEEDS RATFOR LINE NUMBER, FTN LINE NUMBER, BOTH, OR NEITHER. CALL RAT C TO PRINT THE LINE WITH THE CORRECT NUMBER(S). ALSO CONVERT COMMENTS TO C LOWER CASE, IF NEEDED. KEEP FTN LINE NUMBERS STRAIGHT (NO SMALL PROBLE C ARRANGE TO ALWAYS PRINT IFDEF,IFNOTDEF,ENDIF LINES WITH RATFOR NUMBER C SUBROUTINE PRTLIN C INTEGER INDEX, EQLS, I, FUDGE, KLUGE, FORCIF, IT LOGICAL * 1 TEMP ( 20 ) C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 DLEVL (11) LOGICAL * 1 INCLU (8) LOGICAL * 1 ENDIF (9) LOGICAL * 1 IFDEFS (6) LOGICAL * 1 IFNOT (9) LOGICAL * 1 DEFI (7) LOGICAL * 1 MACR (6) LOGICAL * 1 FLAGLN (4) C DATA DLEVL/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H ,0/ DATA INCLU/1HI,1HN,1HC,1HL,1HU,1HD,1HE,0/ DATA ENDIF/1HE,1HN,1HD,1HI,1HF,1HD,1HE,1HF,0/ DATA IFDEFS/1HI,1HF,1HD,1HE,1HF,0/ DATA IFNOT/1HI,1HF,1HN,1HO,1HT,1HD,1HE,1HF,0/ DATA DEFI/1HD,1HE,1HF,1HI,1HN,1HE,0/ DATA MACR/1HM,1HA,1HC,1HR,1HO,0/ DATA FLAGLN/1H#,1H$,1H ,0/ IF (.NOT.( LST ( 1 ) .EQ. 1 .AND. READY .EQ. 1 )) GOTO 20066 IF (.NOT.( EQLS ( PRTBUF ( 1 ), FLAGLN ) .EQ. 1 )) GOTO 20068 CALL DOINDX ( 2, PRTBUF ( 4 ) ) 20068 CONTINUE IT = 1 20070 IF (.NOT.( PRTBUF ( IT ) .EQ. 32 .OR. PRTBUF ( IT ) .EQ. 9)) GOTO $20072 20071 IT = IT + 1 GOTO 20070 20072 CONTINUE JUNK = SCOPY ( PRTBUF ( IT ), TEMP, 19, JUNK ) CALL UNFOLD ( TEMP ) IF (.NOT.( ( EQLS ( TEMP, IFDEFS ) .EQ. 1 ) .OR. ( EQLS ( TEMP, $IFNOT ) .EQ. 1 ) )) GOTO 20073 FORCIF = 1 GOTO 20074 20073 CONTINUE FORCIF = 0 C 20074 CONTINUE IF (.NOT.( INIF .EQ. 0 .OR. IFPNT .EQ. 1 .OR. FORCIF .EQ. 1 )) $GOTO 20075 IF (.NOT.( LC .EQ. 1 )) GOTO 20077 I = INDEX ( PRTBUF, 35 ) IF (.NOT.( I .GT. 0 )) GOTO 20079 CALL FOLD ( PRTBUF ( I + 1 ) ) 20079 CONTINUE C C DON'T NUMBER UNPROCESSED LINES, PCN #75, PCN #100 C 20077 CONTINUE IF (.NOT.( ( PRTBUF ( IT ) .EQ. 35 .OR. PRTBUF ( IT ) .EQ. 12 $.OR. PRTBUF ( IT ) .EQ. 10 .OR. PRTBUF ( IT ) .EQ. 0 ) .OR. ( $INIF .EQ. 1 .AND. FORCIF .EQ. 0 ) .OR. ( PRTBUF ( 1 ) .EQ. 63 $.AND. INDEX ( DLEVL, PRTBUF ( 2 ) ) .LT. DEBUG ) )) GOTO 20081 CALL RATLST ( PRTBUF, 0, 0 ) C C RATFOR LINE NUMBER ONLY ON UNPROCESSED LINES AND PROCESSOR FEATURES C GOTO 20082 20081 CONTINUE IF (.NOT.( ( EQLS ( TEMP, ENDIF ) .EQ. 1 ) .OR. ( EQLS ( TEMP, $MACR ) .EQ. 1 ) .OR. ( EQLS ( TEMP, DEFI ) .EQ. 1 ) .OR. ( EQLS $( TEMP, INCLU ) .EQ. 1 ) .OR. FORCIF .EQ. 1 )) GOTO 20083 IF (.NOT.( ( LEVEL .GT. 1 ) .AND. ( PRTBUF ( IT + 7 ) .EQ. 47 ) $.AND. ( EQLS ( TEMP, INCLU ) .EQ. 1 ) )) GOTO 20085 KLUGE = 1 LST ( LEVEL ) = 1 GOTO 20086 20085 CONTINUE KLUGE = 0 20086 CONTINUE CALL RATLST ( PRTBUF, LINECT, 0 ) LINECT = LINECT + 1 IF (.NOT.( KLUGE .EQ. 1 )) GOTO 20087 LST ( LEVEL ) = 0 20087 CONTINUE C C RATFOR AND FORTRAN NUMBERS ON LINES THAT GENERATED CODE C GOTO 20084 20083 CONTINUE IF (.NOT.( FORTYP .EQ. 1 )) GOTO 20089 FUDGE = 1 GOTO 20090 20089 CONTINUE FUDGE = 0 20090 CONTINUE CALL RATLST ( PRTBUF, LINECT, FTNLN - FUDGE ) LINECT = LINECT + 1 IF (.NOT.( IFTYP .EQ. 1 )) GOTO 20091 FTNLN = FTNLN + 1 20091 CONTINUE C 20084 CONTINUE 20082 CONTINUE READY = 0 20075 CONTINUE IFTYP = 0 FORTYP = 0 C 20066 CONTINUE RETURN END C C$ PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE CSYKES,14OCT76,16DEC76,27MAY77 C PCN #77, 5 JAN 80, USE 'STRPUT' INSTEAD OF FORMATS. USE FMTCHR FROM CA C IF OUTPUT IS TO FORTRAN FILE (STDOUT), MAKE FINAL DECISION ABOUT OUTP C IF OUTPUT IS TO ANOTHER FILE (EG LISTING), ASSUME CALLER HAS ALREADY C PCN #83, 16 JAN 80, DELETE CALL TO 'ERROR' IF STRPUT GETS ERROR. C SUBROUTINE PUTLIN ( BUF, FIL, FMTCHR ) C INTEGER I, J, FIL, STRPUT LOGICAL * 1 BUF ( 97 ), FMTCHR LOGICAL * 1 OUTMAP C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C IF (.NOT.( ( OUTPUT .EQ. 1 .AND. FIL .EQ. 7 ) .OR. FIL .NE. 7 )) $GOTO 20093 JUNK = STRPUT ( FIL, BUF, FMTCHR ) RETURN C 20093 CONTINUE RETURN END C C$ RATFOR - PREPROCESSOR MAINLINE AND OPERATOR/OS INTERFACE C PCN # 77, 8 JAN 80, CHANGE 'PROMPT' TO STRING. C PCN # 82, 8 FEB 80, USE OPEN INSTEAD OF ASSIGN/FDBSET, IF AVAILABLE C PCN # 90, 11 FEB 80, CALL HEADR TO SET UP DATE/TIME FOR 'RATLST'. C PCN #91, 13 FEB 80, USE OPNIN FOR INPUT FILE OPENS & OPNOUT FOR OUTPUT C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. C PCN # 97, 22 MAR 80, DEFINE DEFAULTS FOR SWITCHES, PROCESS IN RATGO C PCN # 108, 1 OCT 80, USE EXPLICIT DEFAULT OF SY:. TIDY UP FILES. C PCN #118, 22 JUN 81, FIX BUGS RE OPEN & CLOSE IFDEF/IFNOTDEFS C PCN #119, 11 JUL 81, DELETE 'OPENCLOSE' AND USE OF CALL ASSIGN,FDBSET C INTEGER SWITCH ( 4, 12 ), ICSI, DOIT, I, J, STATUS, SLEN, JUNK, $FLAG INTEGER STRPUT, SITOC, OPNIN, OPNOUT, SWTFO, SWTSC, SWTSP, SWTGO LOGICAL * 1 NAMES ( 35, 9 ) REAL DEFALT ( 4 ) C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C LOGICAL * 1 REF (24) LOGICAL * 1 PROMPT (5) DATA REF/1H ,1H ,1H ,1H ,1HR,1HA,1HT,1HF,1HO,1HR,1H ,1HE,1HR,1HR, $1HO,1HR,1HS,1H ,1HF,1HO,1HU,1HN,1HD,0/ DATA PROMPT/1HR,1HA,1HT,1H>,0/ DATA DEFALT / 4HFTN , 4HLST , 4HOBJ , 4HRAT / DATA IFIRST / 1 / C DATA SWITCH ( 1, 1 ) / 2HRE / DATA SWITCH ( 1, 2 ) / 2HCO / DATA SWITCH ( 1, 3 ) / 2HFO / DATA SWITCH ( 1, 4 ) / 2HSC / DATA SWITCH ( 1, 5 ) / 2HLC / DATA SWITCH ( 1, 6 ) / 2HHE / DATA SWITCH ( 1, 7 ) / 2HDE / DATA SWITCH ( 1, 8 ) / 2HVE / DATA SWITCH ( 1, 9 ) / 2HIF / DATA SWITCH ( 1, 10 ) / 2HSP / DATA SWITCH ( 1, 11 ) / 2HGO / DATA SWITCH ( 1, 12 ) / 2HIN / C C CALL FILFIX USER = 5 INDLUN = 8 C 20095 CONTINUE C C----------------------------------- GET CMD LINE, DO SWITCHES --------- C CLB ( 1 ) = 0 CALL HEADR STATUS = ICSI ( NAMES, DEFALT, SWITCH, 12, PROMPT ) IF (.NOT.( STATUS .EQ. - 3 )) GOTO 20098 CALL EXIT GOTO 20099 20098 CONTINUE IF (.NOT.( STATUS .EQ. 1 )) GOTO 20100 IF (.NOT.( SWITCH ( 2, 6 ) .GT. 0 )) GOTO 20102 CALL RATHLP GOTO 20103 20102 CONTINUE IF (.NOT.( SWITCH ( 2, 8 ) .GT. 0 )) GOTO 20104 JUNK = STRPUT ( 5, 21HRATFOR RSX/V 23-O-123, 32 ) GOTO 20105 20104 CONTINUE CALL RATGO ( SWITCH, SWTFO, SWTSC, SWTSP, SWTGO ) C C------------------------------SET UP FTN OUTPUT FILE------------------- C IF (.NOT.( SLEN ( NAMES ( 1, 1 ) ) .GT. 0 )) GOTO 20106 OUTPUT = 1 IF (.NOT.( OPNOUT ( NAMES ( 1, 1 ), 7 ) .EQ. - 1 )) GOTO 20108 CALL ICSIE ( 31HOpen Failure on FTN Output File ) GOTO 20096 20108 CONTINUE CNEXT ELSE IF CLAUSE USES TEMP OUTPUT FILE SO LISTING CAN INCLUDE FORTRA C CODE (/FO) WITHOUT KEEPING A REGULAR OUTPUT FILE. C GOTO 20107 20106 CONTINUE IF (.NOT.( SWTFO .EQ. 1 .AND. SLEN ( NAMES ( 1, 2 ) ) .GT. 0 )) $GOTO 20110 OPEN ( UNIT = 7, NAME = 'SY:FOO.TMP', TYPE = 'SCRATCH' ) OUTPUT = 1 GOTO 20111 20110 CONTINUE OUTPUT = 0 C C------------------------------------SET UP LISTING FILE---------------- C 20111 CONTINUE 20107 CONTINUE IF (.NOT.( SLEN ( NAMES ( 1, 2 ) ) .GT. 0 )) GOTO 20112 LST ( 1 ) = 1 IF (.NOT.( OPNOUT ( NAMES ( 1, 2 ), 6 ) .EQ. - 1 )) GOTO 20114 CALL ICSIE ( 25HOpen Failure on List File ) GOTO 20096 20114 CONTINUE CALL QIO ( 768, 6 ) 20115 CONTINUE GOTO 20113 20112 CONTINUE LST ( 1 ) = 0 INDXIT = 0 C 20113 CONTINUE IF (.NOT.( LST ( 1 ) .EQ. 0 .AND. OUTPUT .EQ. 0 )) GOTO 20116 GOTO 20096 20116 CONTINUE IF (.NOT.( INDXIT .EQ. 1 )) GOTO 20118 OPEN ( UNIT = 9, NAME = 'SY:RATINDX.TMP', TYPE = 'SCRATCH' ) C C------------------------------ PROCESS ALL INPUT FILES ---------------- C 20118 CONTINUE FLAG = 1 J = 4 20120 IF (.NOT.( J .LE. 9 .AND. SLEN ( NAMES ( 1, J ) ) .GT. 0)) GOTO $20122 IF (.NOT.( OPNIN ( NAMES ( 1, J ), 1, JUNK ) .EQ. - 1 )) GOTO $20123 CALL ICSIE ( 26HOpen Failure on Input File ) FLAG = - 1 GOTO 20122 20123 CONTINUE CALL DOINDX ( 1, NAMES ( 1, J ) ) CALL PARSE CALL CLOSE ( 1 ) 20124 CONTINUE C C------------------------------------- CLEAN UP, END OF CMD LINE ------- C 20121 J = J + 1 GOTO 20120 20122 CONTINUE IF (.NOT.( FLAG .EQ. 1 )) GOTO 20125 IF (.NOT.( SWTSC .EQ. 1 .AND. LST ( 1 ) .EQ. 1 )) GOTO 20127 CALL DEFLST 20127 CONTINUE IF (.NOT.( SWTFO .EQ. 1 .AND. OUTPUT .EQ. 1 .AND. LST ( 1 ) .EQ. $1 )) GOTO 20129 CALL DUMPIT 20129 CONTINUE IF (.NOT.( INDXIT .EQ. 1 )) GOTO 20131 CALL DMPIDX 20131 CONTINUE 20125 CONTINUE IF (.NOT.( OUTPUT .EQ. 1 )) GOTO 20133 CALL CLOSE ( 7 ) 20133 CONTINUE IF (.NOT.( INDXIT .EQ. 1 )) GOTO 20135 CALL CLOSE ( 9 ) C CIF LISTOUT=LP:, LISTING IS ALWAYS SPOOLED BY D. AND M PLUS. CIF LISTOUT=DISK, /SP WILL CAUSE IT TO BE PRINTED UNDER EITHER D OR M. 20135 CONTINUE IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 20137 IF (.NOT.( SWTSP .EQ. 1 )) GOTO 20139 CLOSE ( UNIT = 6, DISPOSE = 'PRINT' ) GOTO 20140 20139 CONTINUE CALL CLOSE ( 6 ) 20140 CONTINUE C 20137 CONTINUE IF (.NOT.( ERRORS .GT. 0 )) GOTO 20141 I = SITOC ( ERRORS, REF ( 1 ), 3 ) REF ( I + 1 ) = 32 CALL ICSIE ( REF ) C 20141 CONTINUE 20105 CONTINUE 20103 CONTINUE 20100 CONTINUE 20099 CONTINUE C 20096 GOTO 20095 20097 CONTINUE END C C$ RATGO - RATFOR INITIALIZATION ROUTINE C SYKES 26 SEP 76 C PCN # 97, 22 MAR 80, DEFINE DEFAULTS FOR SWITCHES, PROCESS IN RATGO C SUBROUTINE RATGO ( SWITCH, SWTFO, SWTSC, SWTSP, SWTGO ) C INTEGER SWITCH ( 4, 12 ), JUNK, I, LABGEN, SWTFO, SWTSC, SWTSP, $SWTGO C C FILE = CDEFIO.RAT FOR RATFOR.RAT COMMON / CDEFIO / BP, BUF ( 160 ) INTEGER BP LOGICAL * 1 BUF C C FILE = CFOR.RAT FOR RATFOR.RAT COMMON / CFOR / FORDEP, FORSTK ( 150 ), FORLEN INTEGER FORDEP LOGICAL * 1 FORSTK INTEGER FORLEN C C FILE=CFUNC.RAT FOR RATFOR COMMON / CFUNC / INFUNC, FNAM ( 80 ) INTEGER INFUNC LOGICAL * 1 FNAM C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C FILE = CLOOK.RAT FOR RATFOR.RAT COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 250 ), TABLE ( 3000 $) INTEGER LASTP INTEGER TWOS INTEGER LASTT INTEGER NAMPTR LOGICAL * 1 TABLE C C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE= CSTR.RAT FOR RATFOR COMMON / CSTR / LASTS, LASTR, STRPTR ( 35 ), TABLES ( 400 ) INTEGER LASTS INTEGER LASTR INTEGER STRPTR LOGICAL * 1 TABLES C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C COMPRS = 0 IF (.NOT.( SWITCH ( 2, 2 ) .LT. 0 )) GOTO 20143 COMPRS = 0 GOTO 20144 20143 CONTINUE IF (.NOT.( SWITCH ( 2, 2 ) .GT. 0 )) GOTO 20145 COMPRS = 1 20145 CONTINUE 20144 CONTINUE LC = 0 IF (.NOT.( SWITCH ( 2, 5 ) .LT. 0 )) GOTO 20147 LC = 0 GOTO 20148 20147 CONTINUE IF (.NOT.( SWITCH ( 2, 5 ) .GT. 0 )) GOTO 20149 LC = 1 20149 CONTINUE 20148 CONTINUE IFPNT = 1 IF (.NOT.( SWITCH ( 2, 9 ) .LT. 0 )) GOTO 20151 IFPNT = 0 GOTO 20152 20151 CONTINUE IF (.NOT.( SWITCH ( 2, 9 ) .GT. 0 )) GOTO 20153 IFPNT = 1 20153 CONTINUE 20152 CONTINUE INDXIT = 1 IF (.NOT.( SWITCH ( 2, 12 ) .LT. 0 )) GOTO 20155 INDXIT = 0 GOTO 20156 20155 CONTINUE IF (.NOT.( SWITCH ( 2, 12 ) .GT. 0 )) GOTO 20157 INDXIT = 1 20157 CONTINUE 20156 CONTINUE SWTFO = 0 IF (.NOT.( SWITCH ( 2, 3 ) .LT. 0 )) GOTO 20159 SWTFO = 0 GOTO 20160 20159 CONTINUE IF (.NOT.( SWITCH ( 2, 3 ) .GT. 0 )) GOTO 20161 SWTFO = 1 20161 CONTINUE 20160 CONTINUE SWTSC = 1 IF (.NOT.( SWITCH ( 2, 4 ) .LT. 0 )) GOTO 20163 SWTSC = 0 GOTO 20164 20163 CONTINUE IF (.NOT.( SWITCH ( 2, 4 ) .GT. 0 )) GOTO 20165 SWTSC = 1 20165 CONTINUE 20164 CONTINUE SWTSP = 0 IF (.NOT.( SWITCH ( 2, 10 ) .LT. 0 )) GOTO 20167 SWTSP = 0 GOTO 20168 20167 CONTINUE IF (.NOT.( SWITCH ( 2, 10 ) .GT. 0 )) GOTO 20169 SWTSP = 1 20169 CONTINUE 20168 CONTINUE SWTGO = 0 IF (.NOT.( SWITCH ( 2, 11 ) .LT. 0 )) GOTO 20171 SWTGO = 0 GOTO 20172 20171 CONTINUE IF (.NOT.( SWITCH ( 2, 11 ) .GT. 0 )) GOTO 20173 SWTGO = 1 20173 CONTINUE 20172 CONTINUE IF (.NOT.( SWITCH ( 2, 7 ) .LE. 0 )) GOTO 20175 DEBUG = 9999 GOTO 20176 20175 CONTINUE IF (.NOT.( SWITCH ( 2, 7 ) .EQ. 2 )) GOTO 20177 DEBUG = SWITCH ( 4, 7 ) GOTO 20178 20177 CONTINUE DEBUG = 1 C C##COUTLN 20178 CONTINUE 20176 CONTINUE OUTP = 0 C C## CLINE LEVEL = 1 LINECT = 1 INFILE ( 1 ) = 1 FTNLN = 0 C C## CDEFIO BP = 0 C C## CFOR FORDEP = 0 FORLEN = 1 C C## CFUNC INFUNC = 0 C C## CLOOK IF (.NOT.( SWITCH ( 2, 1 ) .LE. 0 )) GOTO 20179 LASTP = 0 LASTT = 0 TWOS = 1 C C## CLIST 20179 CONTINUE PAGE = 0 PLINE = 9999 ERRORS = 0 INIF = 0 C C## CPRTLN READY = 0 C C## CSTR LASTS = 0 LASTR = 0 C I = LABGEN ( 0 ) JUNK = LABGEN ( 20000 - I ) C RETURN END C C$ RATHLP - PRINT HELP ON THE TERMINAL FOR THE USER C ***PCN#19, 21, 22, 10 DEC 77 C ***PCN # 34, 16 JAN 78 C ***PCN # 35, 22 JAN 78 C ***PCN # 71, DEC 79, ADD /GO C PCN # 77, 5 JAN 80, FIX DISPLAY OF /SP SWITCH C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING. C SUBROUTINE RATHLP C WRITE ( 5, 1 ) 1 FORMAT ( / 1H , 21HRATFOR RSX/V 23-O-123 /, 12H SWITCHS: /, $60H /DE:N-PROCESS DEBUG LINES WITH LEVEL >= N ('?N' IN COL 1&2) / $, 55H /CO - SUPPRESS BLANKS BETWEEN TOKENS IN FORTRAN OUTPUT /, $31H /FO - LIST OUTPUT FORTRAN CODE /, $27H /HE - GET THIS HELP (ONLY) ) C C WRITE ( 5, 4 ) 4 FORMAT ( 42H /IF - LIST CODE IN UNDEFINED CONDITIONALS /, $36H /IN - LIST RATFOR SOURCE CODE INDEX /, $39H /LC - GENERATE LOWER CASE FORTRAN CODE /, $56H /RE - RETAIN THE DEFINITIONS FROM PREVIOUS COMMAND LINE /, $46H /SC - LIST SYMBOLIC CONSTANT DEFINITION TABLE ) C WRITE ( 5, 6 ) 6 FORMAT ( 36H /SP - SPOOL LISTING FILE TO PRINTER ) C WRITE ( 5, 2 ) 2 FORMAT ( $55H /VE - PRINT RATFOR'S VERSION NUMBER ON TERMINAL (ONLY) /, $53H COMMAND LINE: (SINGLE LEVEL INDIRECT FILES ALLOWED) /, $47H [OUTPUT][,LIST][,OBJ]=IN1[,IN2...,IN6][/SW...] /, $52H IF NO OUTPUT FILES ARE SPECIFIED, DEFAULT FILES ARE /, $60H ARE CREATED WITH SAME DEV, UIC, & NAME AS FIRST INPUT FILE. ) C WRITE ( 5, 3 ) 3 FORMAT ( 26H DEFAULT FILE EXTENSIONS: /, $36H OUTPUT =FTN LIST =LST OBJECT =OBJ /, $24H INPUT =RAT COMMAND=CMD ) C RETURN END C C$ RATLST - PRINT A LINE ON LISTING & DO PAGE HOUSEKEEPING CSYKES 28MAY77 C PCN # 69, 10 OCT 79, MAKE STRPUT TYPE INTEGER C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING C PCN #77, JAN 80, CHANGE STRPUT CALLS TO PUTLIN CALLS TO MAP CHAR. SETS C PCN #90, 11 FEB 80, GET DATE/TIME FROM 'CDATIM'. C SUBROUTINE RATLST ( BUFR, LINE, FLINE ) C INTEGER N, LINE, SCOPY, SITOC, JUNK, FLINE LOGICAL * 1 BUFR ( 1 ), OUTBUF ( 133 ) C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN C C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C C FILE = CDATIM.RAT FOR RATFOR COMMON / CDATIM / DATIM ( 25 ) LOGICAL * 1 DATIM C LOGICAL * 1 STARSS (13) C C ERRORS (LINE=HUGE) WITHIN INCLUDED/NL FILES ARE LISTED, DATA STARSS/1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,0/ N = 1 20181 IF (.NOT.( N .LE. LEVEL)) GOTO 20183 IF (.NOT.( LST ( N ) .EQ. 0 .AND. LINE .LE. 9999 )) GOTO 20184 RETURN C 20184 CONTINUE 20182 N = N + 1 GOTO 20181 20183 CONTINUE IF (.NOT.( PLINE .GT. 57 .OR. BUFR ( 1 ) .EQ. 12 )) GOTO 20186 OUTBUF ( 1 ) = 12 OUTBUF ( 2 ) = 0 CALL PUTLIN ( OUTBUF, 6, 0 ) OUTBUF ( 1 ) = 32 CALL PUTLIN ( OUTBUF, 6, 0 ) CALL PUTLIN ( OUTBUF, 6, 0 ) PAGE = PAGE + 1 CALL SPAD ( OUTBUF, 77 ) CALL SINSRT ( 21HRATFOR RSX/V 23-O-123, OUTBUF ( 1 ) ) CALL SINSRT ( DATIM, OUTBUF ( 35 ) ) CALL SINSRT ( 4HPAGE, OUTBUF ( 71 ) ) JUNK = SITOC ( PAGE, OUTBUF ( 77 ), 4 ) CALL PUTLIN ( OUTBUF, 6, 32 ) CALL PUTLIN ( CLB, 6, 32 ) OUTBUF ( 1 ) = 32 OUTBUF ( 2 ) = 0 CALL PUTLIN ( OUTBUF, 6, 0 ) CALL PUTLIN ( OUTBUF, 6, 0 ) PLINE = 5 IF (.NOT.( BUFR ( 1 ) .EQ. 12 )) GOTO 20188 RETURN 20188 CONTINUE 20186 CONTINUE OUTBUF ( 1 ) = 0 CALL SPAD ( OUTBUF, 7 ) IF (.NOT.( FLINE .GT. 0 )) GOTO 20190 OUTBUF ( 1 ) = 40 N = SITOC ( FLINE, OUTBUF ( 2 ), 4 ) OUTBUF ( N + 2 ) = 41 20190 CONTINUE IF (.NOT.( LINE .GT. 0 )) GOTO 20192 IF (.NOT.( LINE .GT. 9999 )) GOTO 20194 JUNK = SCOPY ( STARSS, OUTBUF ( 1 ), 15, JUNK ) GOTO 20195 20194 CONTINUE JUNK = SITOC ( LINE, OUTBUF ( 7 ), 5 ) 20195 CONTINUE 20192 CONTINUE CALL SPAD ( OUTBUF, 21 ) N = 1 20196 IF (.NOT.( N .LE. 4)) GOTO 20198 IF (.NOT.( N .LE. LEVEL - 1 )) GOTO 20199 OUTBUF ( 11 + N ) = 42 20199 CONTINUE 20197 N = N + 1 GOTO 20196 20198 CONTINUE JUNK = SCOPY ( BUFR, OUTBUF ( 14 + 4 ), 132 - 14 - 4, JUNK ) CALL PUTLIN ( OUTBUF, 6, 32 ) PLINE = PLINE + 1 RETURN END C C C$ SYNERR - REPORT RATFOR SYNTAX ERRORS CSYKES 28SEP76,20MAY77 C PCN # 57, 31 AUG 79, ALWAYS PRINT ERRORS ON TERMINAL C SUBROUTINE SYNERR ( MSG ) C LOGICAL * 1 BUFOUT ( 97 ), MSG ( 97 ) INTEGER I, LASTC EQUIVALENCE ( BUFOUT, HEADER ) C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 97 ) INTEGER OUTP LOGICAL * 1 OUTBUF C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG, INDXIT INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG INTEGER INDXIT LOGICAL * 1 HEADER (19) C DATA HEADER/1HC,1H*,1H*,1H*,1HR,1HA,1HT,1HF,1HO,1HR,1H ,1HE,1HR, $1HR,1HO,1HR,1H:,1H ,0/ LASTC = 19 I = 1 20201 IF (.NOT.( MSG ( I ) .NE. 0 .AND. MSG ( I ) .NE. 46 .AND. LASTC $.LT. 96)) GOTO 20203 BUFOUT ( LASTC ) = MSG ( I ) LASTC = LASTC + 1 20202 I = I + 1 GOTO 20201 20203 CONTINUE BUFOUT ( LASTC ) = 0 ERRORS = ERRORS + 1 C OUTPUT TO STANDARD FILE IF (.NOT.( OUTP .GT. 0 )) GOTO 20204 CALL OUTDON 20204 CONTINUE CALL PUTLIN ( BUFOUT, 7, 0 ) C C OUTPUT TO LISTING FILE, AND-OR TO TERMINAL IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 20206 CALL RATLST ( BUFOUT ( 2 ), 32767, 0 ) C ELSE #PCN # 57 20206 CONTINUE CALL ICSIE ( BUFOUT ( 2 ) ) C RETURN END