PROGRAM RATFOR C ****************** C * FILE=RATRT.RAT * C ****************** C C====================== RT11-DEC VERSION OF RATFOR ======================== C C THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR C C This is the "driver" module for RATFOR for RT-11 V3B or later. This C version of RATFOR was derived from RATFOR-11 Version 20 (PCN# 94) which C was implemented by David Sykes (see below) for RSX-11M. C C The RT-11 CSI provides virtually the same services as the "ICSI.RAT" C module used with the RSX version. The switches are only one character C long instead of two and negation of switches is not supported. C There is no print spooler. So the switches have changed from the RSX C version: C C /C - Compress FORTRAN output by dropping blanks C /D{:n} - Process debug lines to level "n". C If ":n" not given, n defaults to 1. C /H - Display switch information at user's terminal C /L:FOR - Include generated FORTRAN code on RATFOR listing. C /L:DEF - Include symbolic constant table in RATFOR listing. C /L:LC - Output generated FORTRAN code in lower case. C /L:CND - Include code within unsatisfied IFDEF's in listing. C /R - Retain define table from previous command line. C C The "/GO" switch of the RSX-11 version has been replaced by two new C switches (/F and /X) which take advantage of the RT-11 C DEC Command Language System (DCLS): C C /F - Pass RT-11 a "FORTRAN filename" command line, so C that the FORTRAN compiler will automatically C process RATFOR's generated code. The "filename" C is the same as the first filename in the RATFOR C command line. C /X - Pass RT-11 a "EXECUTE/FORTRAN filename" command C line. This causes a complete compile,link and C run sequence to follow RATFOR's completion. The C "filename" is derived as in the /F switch. In C RATDEF.RT, there is a DEFINE which defines C a filespec for the /LINKLIBRARY switch. It is C currently defined as SY:FOROTS.OBJ. C C In the interest of cleanliness, the old style "CALL ASSIGN" I/O has C been deleted. All file hookups use the "OPEN" statements. This means C that this version will run under FORTRAN-11/RT-11 Version 2 or later, C but not under old Version 1C. C C Wherever possible, the original RATRSX.RAT code has been left alone. C The new RT-11 code is not identified explicitly. C C RATFOR-11/RSX Version 20 courtesy: C C David P. Sykes C American Management Systems, Inc. C 1515 Wilson Blvd. C Arlington Va. 22209 C (703) 841-6086 C C RT-11 Conversion: C C Robert B. Denny C Creative System Design Co. C 3452 E. Foothill Blvd. Suite 601 C Pasadena, Ca. 91107 C (213) 355-6836 C C Experimental Version X20.0 13-Mar-80 Initial version C Experimental Version X20.1 18-Mar-80 Many fixes throughout C Experimental Version X20.2 21-Mar-80 I'm getting there... C Experimental Version X20.3 22-Mar-80 Fix handling, it runs. C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 80 C DECUS. "V" revision when we C get field test results. C C C========================================================================== C C CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT. C C ****************** C FILE=RATDEF.RT C ****************** C C==============DEFINITIONS FOR RT-11 RATFOR PREPROCESSOR=============== C CLINK LIBRARY FOR COMPILE/LINK/GO OPTION C C=========================================================================== C ****************************** C * R A T F O R / R T - 1 1 * C ****************************** C C MAIN PROGRAM: C C CONTAINS CODE TO HANDLE USER/OS INTERFACE, GETTING THE COMMAND LINE, C PARSING THE COMMAND LINE, ACTING ON "IMMEDIATE" SWITCHES, FILE C HANDLING, ETC. C C Robert B. Denny C Creative System Design Co. C 3452 E. Foothill Blvd. Suite 601 C Pasadena, Ca. 91107 C (213) 355-6836 C C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 80 C DECUS. "V" revision when we C get field test results. C C INTEGER DOIT INTEGER ERR INTEGER BADOPT LOGICAL * 1 PROMPT ( 6 ) LOGICAL * 1 FTNFIL ( 16 ) C C FILE = CFILES.RT FOR RT-11 RATFOR COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, $FSPEC, CLB INTEGER SPEC ( 39 ) INTEGER SWITCH ( 4, 10 ) INTEGER DEFEXT ( 4 ) INTEGER LSTOPT ( 4 ) INTEGER F4CODE INTEGER DEFTAB LOGICAL * 1 FSPEC ( 16 ) LOGICAL * 1 CLB ( 84 ) C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG C C FILE= CUCLC.RAT FOR RATFOR COMMON / CUCLC / LC, COMPRS INTEGER LC INTEGER COMPRS C LOGICAL * 1 REF (26) DATA REF/1H ,1H ,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 DEFEXT / 3RRAT, 3RFOR, 3RLST, 0 / DATA LSTOPT / 3RCND, 3RDEF, 3RFOR, 2RLC / DATA PROMPT / 1HR, 1HA, 1HT, 1H>, 1H , 128 / C C SWITCH DATA INITIALIZATION C DATA SWITCH ( 1, 1 ) / 1HC / DATA SWITCH ( 1, 2 ) / 1HD / DATA SWITCH ( 1, 3 ) / 1HF / DATA SWITCH ( 1, 4 ) / 1HH / DATA SWITCH ( 1, 5 ) / 1HL / DATA SWITCH ( 1, 6 ) / 1HL / DATA SWITCH ( 1, 7 ) / 1HL / DATA SWITCH ( 1, 8 ) / 1HL / DATA SWITCH ( 1, 9 ) / 1HR / DATA SWITCH ( 1, 10 ) / 1HX / C C========================================================================== C C *** START *** C CALL PRINT ( 19HRATFOR/RT-11 Y20.4 ) C C THIS PROGRAM RUNS UNTIL ^C OR FATAL ERROR, SO... 20000 CONTINUE CLB ( 1 ) = 0 CALL HEADR C C GET THE COMMAND LINE, DO IMMEDIATE SWITCHES C BADOPT = 0 DO 20003 I = 1, 39 SPEC ( I ) = 0 20003 CONTINUE 20004 CONTINUE CALL RCTRLO CALL PRINT ( ' ' ) CALL GTLIN ( CLB, PROMPT ) I = ICSI ( SPEC, DEFEXT, CLB, SWITCH, 10 ) GO TO ( 10, 11, 12, 13 ), I + 1 C 10 IF (.NOT.( SWITCH ( 2, 4 ) .GT. 0 )) GOTO 20005 CALL RATHLP GOTO 20001 C 20005 CONTINUE IF (.NOT.( SPEC ( 1 ) .EQ. 0 .AND. SPEC ( 6 ) .EQ. 0 )) GOTO $20007 GOTO 20001 C C-------------------- DO NORMAL SWITCHES -------------------- C C ** LIST OPTIONS DEFAULT TO 'NO' ** 20007 CONTINUE IFPNT = 0 LC = 0 F4CODE = 0 DEFTAB = 0 C C GET UP TO 4 /L:xxx SWITCHES. ABORT CLI INTERPRETATION IF ILLEGAL OPT. C CONTINUE I = 5 20009 IF (.NOT.( SWITCH ( 2, I ) .GT. 0 .AND. I .LE. 8 .AND. BADOPT $.EQ. 0)) GOTO 20011 IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 1 ) )) GOTO 20012 IFPNT = 1 GOTO 20010 20012 CONTINUE IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 2 ) )) GOTO 20014 DEFTAB = 1 GOTO 20010 20014 CONTINUE IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 3 ) )) GOTO 20016 F4CODE = 1 GOTO 20010 20016 CONTINUE IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 4 ) )) GOTO 20018 LC = 1 GOTO 20010 20018 CONTINUE BADOPT = 1 20019 CONTINUE C 20010 I = I + 1 GOTO 20009 20011 CONTINUE IF (.NOT.( BADOPT .EQ. 1 )) GOTO 20020 CALL PRINT ( 'Bad /L:xxx option, try again' ) GOTO 20001 C C 20020 CONTINUE IF (.NOT.( SWITCH ( 2, 1 ) .GT. 0 )) GOTO 20022 COMPRS = 1 GOTO 20023 20022 CONTINUE COMPRS = 0 C 20023 CONTINUE IF (.NOT.( SWITCH ( 2, 2 ) .LE. 0 )) GOTO 20024 DEBUG = 9999 GOTO 20025 20024 CONTINUE IF (.NOT.( SWITCH ( 2, 2 ) .EQ. 2 )) GOTO 20026 DEBUG = SWITCH ( 4, 2 ) GOTO 20027 20026 CONTINUE DEBUG = 1 C 20027 CONTINUE 20025 CONTINUE IF (.NOT.( SWITCH ( 2, 9 ) .GT. 0 )) GOTO 20028 DOIT = 0 GOTO 20029 20028 CONTINUE DOIT = 1 C C ** OTHER SWITCHES (/F, /X) CHECKED PRIOR TO TRYING NEXT CMD LINE ** C C C---------------------OPEN FORTRAN OUTPUT FILE---------------------- C C 20029 CONTINUE IF (.NOT.( SPEC ( 1 ) .NE. 0 )) GOTO 20030 CALL FSCONV ( 1 ) CALL SCOPY ( FSPEC, FTNFIL, 16, ERR ) OPEN ( UNIT = 8, NAME = FSPEC, TYPE = 'NEW', INITIALSIZE = SPEC ( $ 5 ), ERR = 20 ) OUTPUT = 1 GOTO 20031 20030 CONTINUE IF (.NOT.( F4CODE .EQ. 1 .AND. SPEC ( 6 ) .NE. 0 )) GOTO 20032 OPEN ( UNIT = 8, NAME = 'RATSCR.DAT', TYPE = 'SCRATCH', ERR = 21 $) OUTPUT = 1 GOTO 20033 20032 CONTINUE OUTPUT = 0 C C C------------------------OPEN LISTING FILE-------------------------- C C 20033 CONTINUE 20031 CONTINUE IF (.NOT.( SPEC ( 6 ) .NE. 0 )) GOTO 20034 CALL FSCONV ( 6 ) OPEN ( UNIT = 6, NAME = FSPEC, TYPE = 'NEW', INITIALSIZE = SPEC ( $ 10 ), CARRIAGECONTROL = 'LIST', ERR = 22 ) LST ( 1 ) = 1 GOTO 20035 20034 CONTINUE LST ( 1 ) = 0 C C C--------------------PROCESS ALL INPUT FILES------------------------ C C 20035 CONTINUE CALL RATGO ( DOIT ) CONTINUE J = 16 20036 IF (.NOT.( SPEC ( J ) .NE. 0 .AND. J .LE. 36)) GOTO 20038 CALL FSCONV ( J ) OPEN ( UNIT = 1, NAME = FSPEC, TYPE = 'OLD', ERR = 23 ) CALL PARSE CLOSE ( UNIT = 1 ) GOTO 20037 C 23 CALL PRINT ( 'Open failure on input file' ) CALL PRINT ( FSPEC ) GOTO 20038 C C C----------------FINISH UP FOR THIS COMMAND LINE-------------------- C C 20037 J = J + 4 GOTO 20036 20038 CONTINUE IF (.NOT.( DEFTAB .EQ. 1 )) GOTO 20039 CALL DEFLST 20039 CONTINUE IF (.NOT.( F4CODE .EQ. 1 )) GOTO 20041 CALL DUMPIT 20041 CONTINUE IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 20043 CLOSE ( UNIT = 6 ) C 20043 CONTINUE IF (.NOT.( ERRORS .GT. 0 )) GOTO 20045 CALL RCTRLO CALL SITOC ( ERRORS, REF ( 1 ), 5 ) CALL PRINT ( REF ) CLOSE ( UNIT = 8, DISP = 'DELETE', ERR = 30 ) 30 CONTINUE GOTO 20046 20045 CONTINUE CLOSE ( UNIT = 8, ERR = 31 ) 31 CONTINUE C C C---------------CHAIN TO FORTRAN OR FORTRAN/LINK/GO----------------- C C 20046 CONTINUE IF (.NOT.( SWITCH ( 2, 3 ) .NE. 0 .AND. OUTPUT .EQ. 1 )) GOTO $20047 CALL SCOPY ( 'FORTRAN/NOSWAP ', SPEC, 81, ERR ) CALL SJOIN ( SPEC, FTNFIL, SPEC, 81, ERR ) CALL SETCMD ( SPEC ) CALL EXIT C 20047 CONTINUE IF (.NOT.( SWITCH ( 2, 10 ) .NE. 0 .AND. OUTPUT .EQ. 1 )) GOTO $20049 CALL SCOPY ( 'EXEC/FORT/NOSWAP/LINK:', SPEC, 81, ERR ) CALL SJOIN ( SPEC, 13HSY:FORLIB.OBJ, 81, ERR ) CALL SJOIN ( SPEC, ' ', 81, ERR ) CALL SJOIN ( SPEC, FTNFIL ) CALL SETCMD ( SPEC ) CALL EXIT C C=======================REPEAT FOR NEW COMMAND LINE=========================== C 20049 CONTINUE GOTO 20001 C C============================================================================= C C ERRORS COME HERE BEFORE LOOPING C 11 CALL PRINT ( 'Syntax error, try again.' ) GOTO 20001 12 CALL PRINT ( 'Unknown device, try again.' ) GOTO 20001 13 CALL PRINT ( 'Option error, try again.' ) GOTO 20001 20 CALL PRINT ( 'Open failure on FORTRAN output file' ) GOTO 20001 21 CALL PRINT ( 'Open failure on scratch file, unit DK:' ) GOTO 20001 22 CALL PRINT ( 'Open failure on list file' ) GOTO 20001 C 20001 GOTO 20000 20002 CONTINUE END SUBROUTINE FSCONV ( I ) C C FSCONV -- CONVERT RAD50 FILESPECS FROM ICSI TO ASCII STRING FOR FORTRAN C C CALL: C CALL FSCONV(I) C C INPUTS: C I = ELEMENT IN "SPECS" USED BY ICSI OF START OF RAD50 SPEC. C C OUTPUTS: C ASCII FILESPEC STRING IN COMMON CHARACTER ARRAY "FSPEC" C C COMMONS: C FILES -- HAS ARRAYS AND SWITCHES FOR FILES. C C SUBROUTINES USED: C R50ASC (SYSF4) C C Robert B. Denny C Creative System Design Co. C 3452 E. Foothill Blvd. Suite 601 C Pasadena, Ca. 91107 C (213) 355-6836 C C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 80 C DECUS. "V" revision when we C get field test results. C------------------------------------------------------------ C C C FILE = CFILES.RT FOR RT-11 RATFOR COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, $FSPEC, CLB INTEGER SPEC ( 39 ) INTEGER SWITCH ( 4, 10 ) INTEGER DEFEXT ( 4 ) INTEGER LSTOPT ( 4 ) INTEGER F4CODE INTEGER DEFTAB LOGICAL * 1 FSPEC ( 16 ) LOGICAL * 1 CLB ( 84 ) C DO 20051 J = 1, 16 FSPEC ( J ) = 1H 20051 CONTINUE 20052 CONTINUE CALL R50ASC ( 3, SPEC ( I ), FSPEC ( 1 ) ) DO 20053 J = 4, 2, - 1 IF (.NOT.( FSPEC ( J - 1 ) .NE. 1H )) GOTO 20055 GOTO 20054 20055 CONTINUE 20053 CONTINUE 20054 CONTINUE FSPEC ( J ) = 1H: CALL R50ASC ( 6, SPEC ( I + 1 ), FSPEC ( J + 1 ) ) K = J + 7 DO 20057 J = K, 4, - 1 IF (.NOT.( FSPEC ( J - 1 ) .NE. 1H )) GOTO 20059 GOTO 20058 20059 CONTINUE 20057 CONTINUE 20058 CONTINUE FSPEC ( J ) = 1H. CALL R50ASC ( 3, SPEC ( I + 3 ), FSPEC ( J + 1 ) ) FSPEC ( J + 4 ) = 0 C RETURN END SUBROUTINE DUMPIT C C DUMPIT - TO LIST GENERATED FORTRAN SOURCE CODE ON PRINTER C C INTEGER FLINE, ERR LOGICAL * 1 FF ( 2 ) LOGICAL * 1 LERR C C FILE=CPRTLN.RAT FOR RATFOR COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C DATA FF / 12, 0 / C REWIND 8 CALL RATLST ( FF, 0, 0 ) FLINE = 0 20061 CONTINUE CALL GETSTR ( 8, PRTBUF, 90, LERR ) IF (.NOT.( LERR .NE. 0 )) GOTO 20064 IF (.NOT.( LERR .EQ. - 1 )) GOTO 20066 GOTO 20063 20066 CONTINUE CALL ERROR ( 35HError reading .FOR file for listing ) 20067 CONTINUE GOTO 20065 20064 CONTINUE IF (.NOT.( PRTBUF ( 1 ) .EQ. 12 )) GOTO 20068 FLINE = 0 20068 CONTINUE IF (.NOT.( PRTBUF ( 1 ) .EQ. 67 .OR. PRTBUF ( 6 ) .EQ. 36 .OR. $PRTBUF ( 1 ) .EQ. 12 )) GOTO 20070 CALL RATLST ( PRTBUF, 0, 0 ) GOTO 20071 20070 CONTINUE FLINE = FLINE + 1 CALL RATLST ( PRTBUF, 0, FLINE ) IF (.NOT.( ( PRTBUF ( 7 ) .EQ. 73 .AND. PRTBUF ( 8 ) .EQ. 70 $.AND. PRTBUF ( 9 ) .EQ. 32 ) .OR. ( PRTBUF ( 7 ) .EQ. 105 .AND. $PRTBUF ( 8 ) .EQ. 102 .AND. PRTBUF ( 9 ) .EQ. 32 ) )) GOTO 20072 FLINE = FLINE + 1 20072 CONTINUE 20071 CONTINUE 20065 CONTINUE C 20062 GOTO 20061 20063 CONTINUE RETURN END INTEGER FUNCTION GETLIN ( BUFR ) C C GETLIN - TO READ IN ANOTHER LINE FROM THE INPUT FILE FOR NGETCH 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 /N:CND 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 C ----REVISION #1---- C FIX HANDLING OF FORMFEEDS. REMOVE FROM THE INPUT BUFFER AND FORCE C NEW PAGE IN LISTING. C R. B. DENNY C 22-MAR-80 C MAKES RATFOR/RT VERSION 20.3 C ------------------- C INTEGER I, ERR, SLEN LOGICAL * 1 BUFR ( 91 ) LOGICAL * 1 LERR C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 3 ), 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 ( 91 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG 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 20074 CONTINUE CALL PRTLIN CALL GETSTR ( INFILE ( LEVEL ), BUFR, 90, LERR ) IF (.NOT.( LERR .NE. 0 )) GOTO 20077 IF (.NOT.( LERR .EQ. - 1 )) GOTO 20079 GETLIN = ( - 3 ) RETURN 20079 CONTINUE CALL ERROR ( 25HError reading input file. ) 20080 CONTINUE GOTO 20078 20077 CONTINUE CALL STRIM ( BUFR ) C C# SPECIAL HANDLING OF RATFOR PROCESSOR FEATURES C I = INDEX ( BUFR, 12 ) IF (.NOT.( I .GT. 0 )) GOTO 20081 PLINE = 9999 J = SLEN ( BUFR ) IF (.NOT.( J .EQ. 1 )) GOTO 20083 READY = 0 GOTO 20075 20083 CONTINUE IF (.NOT.( I .EQ. J )) GOTO 20085 BUFR ( I ) = 0 GOTO 20086 20085 CONTINUE DO 20087 K = I, J - 1 BUFR ( K ) = BUFR ( K + 1 ) 20087 CONTINUE 20088 CONTINUE BUFR ( J ) = 0 20086 CONTINUE C 20081 CONTINUE CALL SCOPY ( BUFR, PRTBUF, 90, ERR ) READY = 1 C IF (.NOT.( BUFR ( 1 ) .EQ. 63 )) GOTO 20089 IF (.NOT.( INDEX ( DLEVL, BUFR ( 2 ) ) .GE. DEBUG )) GOTO 20091 BUFR ( 1 ) = 32 BUFR ( 2 ) = 32 GOTO 20092 20091 CONTINUE GOTO 20075 C 20092 CONTINUE 20089 CONTINUE IF (.NOT.( BUFR ( 1 ) .NE. 37 .AND. BUFR ( 1 ) .NE. 35 )) GOTO $20093 GOTO 20076 C 20093 CONTINUE IF (.NOT.( INIF .EQ. 1 )) GOTO 20095 GOTO 20075 20095 CONTINUE IF (.NOT.( BUFR ( 1 ) .EQ. 37 )) GOTO 20097 CALL PUTLIN ( BUFR ( 2 ), 8, 0 ) FTNLN = FTNLN + 1 GOTO 20098 20097 CONTINUE IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20099 BUFR ( 1 ) = 67 CALL PUTLIN ( BUFR, 8, 0 ) 20099 CONTINUE 20098 CONTINUE 20096 CONTINUE 20078 CONTINUE C 20075 GOTO 20074 20076 CONTINUE RETURN END SUBROUTINE GETNAM ( BUFR, LSTIT ) C C GETNAM - GET THE FILE NAME OF AN INCLUDED FILE. C INCLUDE/NL FILE AND INCLUDE FILE/NL BOTH OK, BUT 2ND WON'T BE LISTED RIGHT. C C LEFT ALONE FROM THE RSX VERSION C C INTEGER LSTIT, LEN, SKIP LOGICAL * 1 NGETCH, CHAR, BUFR ( 16 ) 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 20101 IF (.NOT.( NGETCH ( CHAR ) .NE. 10 .AND. CHAR .NE. 35 .AND. LEN $.LT. 16 )) GOTO 20102 IF (.NOT.( SKIP .EQ. 1 .AND. CHAR .EQ. 32 )) GOTO 20103 SKIP = 0 GOTO 20104 20103 CONTINUE IF (.NOT.( CHAR .EQ. 47 )) GOTO 20105 SKIP = 1 LSTIT = 0 GOTO 20106 20105 CONTINUE IF (.NOT.( CHAR .NE. 32 .AND. CHAR .NE. 9 .AND. SKIP .EQ. 0 )) $GOTO 20107 LEN = LEN + 1 BUFR ( LEN ) = CHAR 20107 CONTINUE 20106 CONTINUE 20104 CONTINUE GOTO 20101 20102 CONTINUE CALL PUTBAK ( CHAR ) C BUFR ( LEN + 1 ) = 0 C RETURN END SUBROUTINE HEADR C C HEADR - TO FILL IN DAY,DATE,TIME FOR RATLST'S PAGE HEADER. C C REMOVED DAY OF WEEK CODE FOR RT-11 C C C FILE = CDATIM.RAT FOR RATFOR COMMON / CDATIM / DATIM ( 25 ) LOGICAL * 1 DATIM C DATA DATIM / 25 * 1H / C CALL DATE ( DATIM ( 6 ) ) CALL TIME ( DATIM ( 17 ) ) DATIM ( 25 ) = 0 C RETURN END SUBROUTINE OPENI C C OPENI - TO OPEN INCLUDED FILES FOR RATFOR. C 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. C IF THE INCLUDE FILE ISN'T FOUND AND THERE WAS NO DEVICE SPECIFIED C (I.E., "DK:" DEFAULT), ANOTHER ATTEMPT IS MADE WITH "SY:" AS THE C DEVICE. THIS ALLOWS COMMON INCLUDES TO BE KEPT ON SY: C LOGICAL * 1 BUFR ( 16 ), BUF2 ( 16 ) INTEGER I, IERR C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 3 ), 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 ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG C LOGICAL * 1 RAT (5) C DATA RAT/1H.,1HR,1HA,1HT,0/ IF (.NOT.( LEVEL .GE. 3 )) GOTO 20109 CALL ERROR ( 28HINCLUDE's too deeply nested. ) C 20109 CONTINUE CALL GETNAM ( BUFR, LSTIT ) LEVEL = LEVEL + 1 INFILE ( LEVEL ) = LEVEL LST ( LEVEL ) = LSTIT C IF (.NOT.( INDEX ( BUFR, 46 ) .EQ. 0 )) GOTO 20111 CALL SJOIN ( BUFR, RAT, 16 - 1, IERR ) C 20111 CONTINUE CALL ERRSNS OPEN ( UNIT = INFILE ( LEVEL ), NAME = BUFR, READONLY, TYPE = $'OLD', ERR = 11 ) RETURN C 11 CALL ERRSNS ( IERR ) IF (.NOT.( IERR .EQ. 28 .AND. INDEX ( BUFR, 58 ) .EQ. 0 )) GOTO $20113 BUF2 ( 1 ) = 0 CALL SINSRT ( 3HSY:, BUF2 ) CALL SJOIN ( BUF2, BUFR, 16 - 1, IERR ) CALL ERRSNS OPEN ( UNIT = INFILE ( LEVEL ), NAME = BUF2, READONLY, TYPE = $'OLD', ERR = 12 ) RETURN C C IF WE GOT THIS FAR, ALL EFFORTS TO OPEN FILE FAILED 20113 CONTINUE 12 CALL ERROR ( 28HOpen failure on INCLUDE file ) RETURN C END SUBROUTINE PRTLIN C C PRTLIN - PRINT A LINE OF SOURCE ON THE RATFOR LISTING C C IF LISTING (BOTH IN GENERAL AND AT THIS PARTICULAR TIME), FIGURE OUT IF C THIS LINE (WHICH IS THE ONE JUST PROCESSED, ONE BEHIND THE ONE JUST READ) C NEEDS RATFOR LINE NUMBER, FTN LINE NUMBER, BOTH, OR NEITHER. CALL RATLST C TO PRINT THE LINE WITH THE CORRECT NUMBER(S). ALSO CONVERT COMMENTS TO C LOWER CASE, IF NEEDED. ALSO KEEP FTN LINE NUMBERS STRAIGHT (NO SMALL PROBLEM). C ARRANGE TO ALWAYS PRINT IFDEF,IFNOTDEF,ENDIF LINES WITH RATFOR NUMBERS, C TO LIST PROPERLY, THESE MUST BE IN UPPER CASE. C NOTE THAT DUMPIT AND DEFLST ALSO USE PRTBUF TO SAVE SPACE. C C INTEGER EQLS, I, FUDGE, KLUGE, FORCIF, IT C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 3 ), 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 ( 91 ) INTEGER FORTYP INTEGER IFTYP INTEGER READY LOGICAL * 1 PRTBUF C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG 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) 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/ IF (.NOT.( LST ( 1 ) .EQ. 1 .AND. READY .EQ. 1 )) GOTO 20115 CONTINUE IT = 1 20117 IF (.NOT.( PRTBUF ( IT ) .EQ. 32 .OR. PRTBUF ( IT ) .EQ. 9)) GOTO $ 20119 20118 IT = IT + 1 GOTO 20117 20119 CONTINUE IF (.NOT.( ( EQLS ( PRTBUF ( IT ), IFDEFS ) .EQ. 1 ) .OR. ( EQLS $( PRTBUF ( IT ), IFNOT ) .EQ. 1 ) )) GOTO 20120 FORCIF = 1 GOTO 20121 20120 CONTINUE FORCIF = 0 C 20121 CONTINUE IF (.NOT.( INIF .EQ. 0 .OR. IFPNT .EQ. 1 .OR. FORCIF .EQ. 1 )) $GOTO 20122 IF (.NOT.( LC .EQ. 1 )) GOTO 20124 I = INDEX ( PRTBUF, 35 ) IF (.NOT.( I .GT. 0 )) GOTO 20126 CALL FOLD ( PRTBUF ( I + 1 ) ) 20126 CONTINUE C C DON'T NUMBER UNPROCESSED LINES C 20124 CONTINUE IF (.NOT.( ( PRTBUF ( 1 ) .EQ. 35 ) .OR. ( INIF .EQ. 1 .AND. $FORCIF .EQ. 0 ) .OR. ( PRTBUF ( 1 ) .EQ. 63 .AND. INDEX ( DLEVL, $ PRTBUF ( 2 ) ) .LT. DEBUG ) )) GOTO 20128 CALL RATLST ( PRTBUF, 0, 0 ) C C RATFOR LINE NUMBER ONLY ON UNPROCESSED LINES AND PROCESSOR FEATURES C GOTO 20129 20128 CONTINUE IF (.NOT.( ( EQLS ( PRTBUF ( IT ), ENDIF ) .EQ. 1 ) .OR. ( EQLS $( PRTBUF ( IT ), MACR ) .EQ. 1 ) .OR. ( EQLS ( PRTBUF ( IT ), $DEFI ) .EQ. 1 ) .OR. ( EQLS ( PRTBUF ( IT ), INCLU ) .EQ. 1 ) $.OR. FORCIF .EQ. 1 )) GOTO 20130 IF (.NOT.( ( LEVEL .GT. 1 ) .AND. ( PRTBUF ( IT + 7 ) .EQ. 47 ) $.AND. ( EQLS ( PRTBUF ( IT ), INCLU ) .EQ. 1 ) )) GOTO 20132 KLUGE = 1 LST ( LEVEL ) = 1 GOTO 20133 20132 CONTINUE KLUGE = 0 20133 CONTINUE CALL RATLST ( PRTBUF, LINECT, 0 ) LINECT = LINECT + 1 IF (.NOT.( KLUGE .EQ. 1 )) GOTO 20134 LST ( LEVEL ) = 0 20134 CONTINUE C C RATFOR AND FORTRAN NUMBERS ON LINES THAT GENERATED CODE C GOTO 20131 20130 CONTINUE IF (.NOT.( FORTYP .EQ. 1 )) GOTO 20136 FUDGE = 1 GOTO 20137 20136 CONTINUE FUDGE = 0 20137 CONTINUE CALL RATLST ( PRTBUF, LINECT, FTNLN - FUDGE ) LINECT = LINECT + 1 IF (.NOT.( IFTYP .EQ. 1 )) GOTO 20138 FTNLN = FTNLN + 1 20138 CONTINUE C 20131 CONTINUE 20129 CONTINUE READY = 0 20122 CONTINUE IFTYP = 0 FORTYP = 0 C 20115 CONTINUE RETURN END SUBROUTINE PUTLIN ( BUF, FIL, FMTCHR ) C C PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE C C IF OUTPUT IS TO FORTRAN FILE (STDOUT), MAKE FINAL DECISION ABOUT OUTPUT. C IF OUTPUT IS TO ANOTHER FILE (EG LISTING), ASSUME CALLER HAS ALREADY DECIDED. C C INTEGER ERR, FIL LOGICAL * 1 BUF ( 91 ), FMTCHR C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG C C IF (.NOT.( ( OUTPUT .EQ. 1 .AND. FIL .EQ. 8 ) .OR. FIL .NE. 8 )) $GOTO 20140 CALL PUTSTR ( FIL, BUF, FMTCHR, ERR ) IF (.NOT.( ERR .EQ. 0 )) GOTO 20142 RETURN 20142 CONTINUE CALL ERROR ( 26HText output error - PUTLIN ) 20143 CONTINUE C 20140 CONTINUE RETURN END SUBROUTINE RATLST ( BUFR, LINE, FLINE ) C C RATLST - TO PRINT A LINE ON LISTING & DO PAGE HOUSEKEEPING. C C INTEGER N, LINE, SITOC, JUNK, FLINE LOGICAL * 1 BUFR ( 1 ), OUTBUF ( 133 ) C C FILE = CFILES.RT FOR RT-11 RATFOR COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, $FSPEC, CLB INTEGER SPEC ( 39 ) INTEGER SWITCH ( 4, 10 ) INTEGER DEFEXT ( 4 ) INTEGER LSTOPT ( 4 ) INTEGER F4CODE INTEGER DEFTAB LOGICAL * 1 FSPEC ( 16 ) LOGICAL * 1 CLB ( 84 ) C C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG C C FILE = CLINE.RAT FOR RATFOR.RAT C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN INTEGER LEVEL INTEGER INFILE INTEGER LINECT INTEGER INIF INTEGER FTNLN 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, C DATA STARSS/1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,0/ N = 1 20144 IF (.NOT.( N .LE. LEVEL)) GOTO 20146 IF (.NOT.( LST ( N ) .EQ. 0 .AND. LINE .LE. 9999 )) GOTO 20147 RETURN C 20147 CONTINUE 20145 N = N + 1 GOTO 20144 20146 CONTINUE IF (.NOT.( PLINE .GT. 57 .OR. BUFR ( 1 ) .EQ. 12 )) GOTO 20149 OUTBUF ( 1 ) = 12 OUTBUF ( 2 ) = 0 CALL PUTLIN ( OUTBUF, 6, 32 ) OUTBUF ( 1 ) = 32 CALL PUTLIN ( OUTBUF, 6, 32 ) CALL PUTLIN ( OUTBUF, 6, 32 ) CALL PUTLIN ( OUTBUF, 6, 32 ) PAGE = PAGE + 1 CALL SPAD ( OUTBUF, 77 ) CALL SINSRT ( 19HRATFOR/RT-11 Y20.4, 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, 32 ) CALL PUTLIN ( OUTBUF, 6, 32 ) PLINE = 6 IF (.NOT.( BUFR ( 1 ) .EQ. 12 )) GOTO 20151 RETURN 20151 CONTINUE 20149 CONTINUE OUTBUF ( 1 ) = 0 CALL SPAD ( OUTBUF, 7 ) IF (.NOT.( FLINE .GT. 0 )) GOTO 20153 OUTBUF ( 1 ) = 40 N = SITOC ( FLINE, OUTBUF ( 2 ), 4 ) OUTBUF ( N + 2 ) = 41 20153 CONTINUE IF (.NOT.( LINE .GT. 0 )) GOTO 20155 IF (.NOT.( LINE .GT. 9999 )) GOTO 20157 CALL SCOPY ( STARSS, OUTBUF, 15, JUNK ) GOTO 20158 20157 CONTINUE JUNK = SITOC ( LINE, OUTBUF ( 7 ), 5 ) 20158 CONTINUE 20155 CONTINUE CALL SPAD ( OUTBUF, 21 ) N = 1 20159 IF (.NOT.( N .LE. 3)) GOTO 20161 IF (.NOT.( N .LE. LEVEL - 1 )) GOTO 20162 OUTBUF ( 11 + N ) = 42 20162 CONTINUE 20160 N = N + 1 GOTO 20159 20161 CONTINUE CALL SCOPY ( BUFR, OUTBUF ( 14 + 3 ), 132 - 14 - 3 ) CALL PUTLIN ( OUTBUF, 6, 32 ) PLINE = PLINE + 1 RETURN END SUBROUTINE SYNERR ( MSG ) C C SYNERR - REPORT RATFOR SYNTAX ERROR C C LOGICAL * 1 BUFOUT ( 91 ), MSG ( 91 ) INTEGER I, LASTC EQUIVALENCE ( BUFOUT, HEADER ) C FILE= COUTLN.RAT FOR RATFOR.RAT COMMON / COUTLN / OUTP, OUTBUF ( 91 ) INTEGER OUTP LOGICAL * 1 OUTBUF C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, $DEBUG INTEGER LST INTEGER PLINE INTEGER PAGE INTEGER ERRORS INTEGER OUTPUT INTEGER IFPNT INTEGER DEBUG LOGICAL * 1 HEADER (19) C DATA HEADER/1HC,1H*,1H*,1H*,1HR,1HA,1HT,1HF,1HO,1HR,1H ,1HE,1HR,1 $HR,1HO,1HR,1H:,1H ,0/ LASTC = 19 I = 1 20164 IF (.NOT.( MSG ( I ) .NE. 0 .AND. MSG ( I ) .NE. 46 .AND. LASTC $.LT. 90)) GOTO 20166 BUFOUT ( LASTC ) = MSG ( I ) LASTC = LASTC + 1 20165 I = I + 1 GOTO 20164 20166 CONTINUE BUFOUT ( LASTC ) = 0 ERRORS = ERRORS + 1 C C OUTPUT TO STANDARD FILE C IF (.NOT.( OUTP .GT. 0 )) GOTO 20167 CALL OUTDON 20167 CONTINUE CALL PUTLIN ( BUFOUT, 8, 0 ) C C OUTPUT TO TERMINAL AND (MAYBE) LISTFILE C IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 20169 CALL RATLST ( BUFOUT ( 2 ), 32767, 0 ) 20169 CONTINUE CALL RCTRLO CALL PRINT ( BUFOUT ( 2 ) ) C RETURN END