0018PROGRAM RATFOR0028# ******************0028# * FILE=RATRT.RAT *0028# ******************0005#0080#====================== RT11-DEC VERSION OF RATFOR ========================0005#0073# THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR0005#0073# This is the "driver" module for RATFOR for RT-11 V3B or later. This0077# version of RATFOR was derived from RATFOR-11 Version 20 (PCN# 94) which0061# was implemented by David Sykes (see below) for RSX-11M.0005#^^^^^^^^^^^^^^^^^^^^^^^^^^0074# The RT-11 CSI provides virtually the same services as the "ICSI.RAT"0075# module used with the RSX version. The switches are only one character0068# long instead of two and negation of switches is not supported.0074# There is no print spooler. So the switches have changed from the RSX0014# version:0005#0071# /C - Compress FORTRAN output by dropping blanks0062# /D{:n} - Process debug lines to level "n".0064# If ":n" not given, n defaults to 1.^^^^^0074# /H - Display switch information at user's terminal0078# /L:FOR - Include generated FORTRAN code on RATFOR listing.0079# /L:DEF - Include symbolic constant table in RATFOR listing.0073# /L:LC - Output generated FORTRAN code in lower case.0080# /L:CND - Include code within unsatisfied IFDEF's in listing.0076# /R - Retain define table from previous command line.0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0073# The "/GO" switch of the RSX-11 version has been replaced by two new0060# switches (/F and /X) which take advantage of the RT-110041# DEC Command Language System (DCLS):0005#0077# /F - Pass RT-11 a "FORTRAN filename" command line, so0073# that the FORTRAN compiler will automatically0076# process RATFOR's generated code. The "filename"0076# is the same as the first filename in the RATFOR^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0042# command line.0076# /X - Pass RT-11 a "EXECUTE/FORTRAN filename" command0074# line. This causes a complete compile,link and0076# run sequence to follow RATFOR's completion. The0074# "filename" is derived as in the /F switch. In0053# RATDEF.RT, there is a DEFINE which defines0055# a filespec for the /LINKLIBRARY switch. It is0045# currently defined as SY:FOROTS.OBJ.0005#^^^^^^^^^^^^0073# In the interest of cleanliness, the old style "CALL ASSIGN" I/O has0074# been deleted. All file hookups use the "OPEN" statements. This means0075# that this version will run under FORTRAN-11/RT-11 Version 2 or later,0035# but not under old Version 1C.0005#0074# Wherever possible, the original RATRSX.RAT code has been left alone.0054# The new RT-11 code is not identified explicitly.0005#0040# RATFOR-11/RSX Version 20 courtesy:0005#0020# David P. Sykes0039# American Management Systems, Inc.^^^^^^^^^^^^^0023# 1515 Wilson Blvd.0026# Arlington Va. 222090020# (703) 841-60860005#0023# RT-11 Conversion:0005#0021# Robert B. Denny0032# Creative System Design Co.0039# 3452 E. Foothill Blvd. Suite 6010026# Pasadena, Ca. 911070020# (213) 355-68360005#0060# Experimental Version X20.0 13-Mar-80 Initial version0066# Experimental Version X20.1 18-Mar-80 Many fixes throughout0065# Experimental Version X20.2 21-Mar-80 I'm getting there...0072# Experimental Version X20.3 22-Mar-80 Fix handling, it runs.^^^^0073# Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 800038# DECUS. "V" revision when we0034# get field test results.0005#0005#0079#==========================================================================0005#0005#0020INCLUDE/NL DEFIN0057INCLUDE RATDEF.RAT #RT-11 VERSION RATFOR DEFINITIONS0005 0054# ******************************0054# * R A T F O R / R T - 1 1 *0054# ******************************0005#0019# MAIN PROGRAM:0005#0074# CONTAINS CODE TO HANDLE USER/OS INTERFACE, GETTING THE COMMAND LINE,0068# PARSING THE COMMAND LINE, ACTING ON "IMMEDIATE" SWITCHES, FILE0020# HANDLING, ETC.0005#0021# Robert B. Denny0032# Creative System Design Co.0039# 3452 E. Foothill Blvd. Suite 6010026# Pasadena, Ca. 911070020# (213) 355-68360005#0073# Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 800038# DECUS. "V" revision when we0034# get field test results.0005#0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0061 INTEGER DOIT #FLAGS WHETHER TO CLEAR THE DEFINE TABLE0053 INTEGER ERR #RETURNS ERRORS FROM STRLIB CALLS0063 INTEGER BADOPT #INDICATES IF BAD /L:XXX OPTION WAS GIVEN0058 CHARACTER PROMPT(6) #HOLDS PROMPT STRING FOR GETLIN0064 CHARACTER FTNFIL(16) #HOLDS F4 OUTFILE NAME FOR /F AND /X0005#0063INCLUDE CFILES.RT #REQUIRES 'NSWT' AND 'NLOP' BE 'DEFINE'D0005#0017INCLUDE CLIST0005#0017INCLUDE CUCLC0005#0044 STRING REF " RATFOR ERRORS FOUND"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0061 DATA DEFEXT / 3RRAT, 3RFOR, 3RLST, 0 / # DEFAULT EXT'S.0069 DATA LSTOPT / 3RCND, 3RDEF, 3RFOR, 2RLC / #LEGAL /L:xxx options0079 DATA PROMPT / "R", "A", "T", ">", " ", 128 / #PROMPT ... "RAT> " NO CR/LF0005#0032# SWITCH DATA INITIALIZATION0005#0055 DATA SWITCH(1,1) /"C"/ #COMPRESS FORTRAN OUTPUT0051 DATA SWITCH(1,2) /"D"/ #PROCESS DEBUG LINES0057 DATA SWITCH(1,3) /"F"/ #CHAIN TO FORTRAN COMPILER0038 DATA SWITCH(1,4) /"H"/ #HELP!!0048 DATA SWITCH(1,5) /"L"/ #LISTING CONTROLS^^^^^^^^^^^^0028 DATA SWITCH(1,6) /"L"/0028 DATA SWITCH(1,7) /"L"/0028 DATA SWITCH(1,8) /"L"/0051 DATA SWITCH(1,9) /"R"/ #RETAIN DEFINE TABLE0062 DATA SWITCH(1,10) /"X"/ #CHAIN TO 'EXEC/FORT' DCLS CMD0031 # FOR COMPILE-LINK-GO0005#0079#==========================================================================0005#0019# *** START ***0005#0044CALL PRINT(VNUMBER) #ANNOUNCE VERSION0005#0054# THIS PROGRAM RUNS UNTIL ^C OR FATAL ERROR, SO...0012 REPEAT0009 [0020 CLB(1) = EOS0018 CALL HEADR0005#^^^^0049# GET THE COMMAND LINE, DO IMMEDIATE SWITCHES0005#0046 BADOPT = NO #RESET BAD OPTION FLAG0045 DO I=1,39 #CLEAR OUT 'SPEC' ARRAY0021 SPEC(I) = 00044 CALL RCTRLO #RESET ^O SUPRESSION0023 CALL PRINT(' ')0058 CALL GTLIN(CLB,PROMPT) #PICK UP THE COMMAND LINE0069 I = ICSI(SPEC, DEFEXT, CLB, SWITCH, NSWT) #PARSE COMMAND LINE0054 GO TO (10,11,12,13), I+1 #HANDLE ERROR CASES0005#0050 10 IF (SWITCH(2,4) > 0) #IF /H TYPED...0011 [^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0041 CALL RATHLP #...CALL HELPER.0039 NEXT #...AND PROMPT AGAIN0011 ]0005#0063 IF (SPEC(1) == 0 & SPEC(6) == 0) #IF NULL EFFORT...0043 NEXT #...ACT LIKE WE'RE DONE!0005#0065#-------------------- DO NORMAL SWITCHES --------------------0005#0042# ** LIST OPTIONS DEFAULT TO 'NO' **0046 IFPNT = NO # NO UNSAT. CONDITIONALS0049 LC = NO # DO NOT CONVERT TO LOWER CASE0045 F4CODE = NO # NO GENERATED F4 CODE0052 DEFTAB = NO # NO SYMB. CONST. DEFINE TAB.^0005#0077# GET UP TO 4 /L:xxx SWITCHES. ABORT CLI INTERPRETATION IF ILLEGAL OPT.0005#0074 FOR ( I=5; SWITCH(2,I) > 0 & I <= 8 & BADOPT == NO ; INCREMENT(I))0011 [0048 IF (SWITCH(4,I) == LSTOPT(1)) # /L:CND0013 [0023 IFPNT = YES0016 NEXT0013 ]0048 IF (SWITCH(4,I) == LSTOPT(2)) # /L:DEF0013 [0024 DEFTAB = YES0016 NEXT0013 ]0048 IF (SWITCH(4,I) == LSTOPT(3)) # /L:FOR0013 [0024 F4CODE = YES0016 NEXT^^^^^^^^^^^^0013 ]0047 IF (SWITCH(4,I) == LSTOPT(4)) # /L:LC0013 [0020 LC = YES0016 NEXT0013 ]0041 ELSE ### BAD LIST OPTION ###0024 BADOPT = YES0045 ] #END OF /L:xxx 'FOR' STATEMENT#0005#0049 IF (BADOPT == YES) # IF BAD LIST OPTION0011 [0052 CALL PRINT('Bad /L:xxx option, try again')0014 NEXT0011 ]0005#0005#0034 IF (SWITCH(2,1) > 0) # /C0022 COMPRS = YES0012 ELSE0021 COMPRS = NO0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0051 IF (SWITCH(2,2) <= 0) # /D{:n} Default n=10043 DEBUG = 9999 # = NO DEBUG LINES0012 ELSE0053 IF (SWITCH(2,2) == 2) # NUMERIC ARG GIVEN?0048 DEBUG = SWITCH(4,2) # IF SO, USE IT0014 ELSE0045 DEBUG = 1 # ELSE DEFAULT D TO 10005#0034 IF (SWITCH(2,9) > 0) # /R0060 DOIT = NO # FOUND, SUPRESS CLEARING DEFINITIONS0012 ELSE0052 DOIT = YES # CLEAR DEFINITIONS OTHERWISE0005#0073# ** OTHER SWITCHES (/F, /X) CHECKED PRIOR TO TRYING NEXT CMD LINE **0005#0005#0072#---------------------OPEN FORTRAN OUTPUT FILE----------------------0005#0005#0025 IF (SPEC(1) != 0)0011 [0054 CALL FSCONV(1) #CONV. RAD50 SPEC TO ASCII.0077 CALL SCOPY(FSPEC, FTNFIL, 16, ERR) #COPY FOR LATER CHAIN VIA RT-110074 OPEN (UNIT=STDOUT, NAME=FSPEC, TYPE='NEW', INITIALSIZE=SPEC(5),0023 ERR=20)0057 OUTPUT = YES #OPENED OK, TURN ON OUTPUT FLAG.0011 ]0012 ELSE0073 IF (F4CODE == YES & SPEC(6) != 0) #IF /L:FOR AND LISTFILE GIVEN^^^^^^^^0013 [0073 OPEN (UNIT=STDOUT, NAME='RATSCR.DAT', TYPE='SCRATCH', ERR=21)0059 OUTPUT = YES #USE THIS TO LIST FORTRAN OUTPUT0013 ]0014 ELSE0059 OUTPUT = NO #NO OUTPUT FILE GIVEN, NO /L:FOR.0005#0005#0072#------------------------OPEN LISTING FILE--------------------------0005#0005#0025 IF (SPEC(6) != 0)0011 [0054 CALL FSCONV(6) #CONV. RAD50 SPEC TO ASCII.0075 OPEN (UNIT=LISTOUT, NAME=FSPEC, TYPE='NEW', INITIALSIZE=SPEC(10),^^^^^^^^^^^^^^^^^^^^^^^^0047 CARRIAGECONTROL='LIST', ERR=22)0055 LST(1) = YES #OPENED OK, TURN ON LIST FLAG.0011 ]0012 ELSE0046 LST(1) = NO #NO LISTING FILE GIVEN0005#0005#0072#--------------------PROCESS ALL INPUT FILES------------------------0005#0005#0057 CALL RATGO (DOIT) #OK, INITIALIZE THE PROCESSOR0073 FOR (J=16; SPEC(J) != 0 & J <= 36; J=J+4) #FOR EACH FILE GIVEN...0011 [0054 CALL FSCONV(J) #CONV. RAD50 SPEC TO ASCII.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0059 OPEN (UNIT=STDIN, NAME=FSPEC, TYPE='OLD', ERR=23)0041 CALL PARSE #OK, GO FOR IT!!!!0060 CLOSE( UNIT=STDIN ) #DONE WITH THIS INPUT FILE...0045 NEXT #TRY FOR ANOTHER INPUT FILE0005#0068 23 CALL PRINT('Open failure on input file') #OOPS, ERROR..0027 CALL PRINT(FSPEC)0048 BREAK #BAIL OUT OF INPUT FILE LOOP.0011 ]0005#0005#0072#----------------FINISH UP FOR THIS COMMAND LINE--------------------0005#0005#0026 IF (DEFTAB == YES)0021 CALL DEFLST^^^^^^^^^0026 IF (F4CODE == YES)0021 CALL DUMPIT0026 IF (LST(1) == YES)0034 CLOSE ( UNIT = LISTOUT )0005#0023 IF (ERRORS > 0)0011 [0047 CALL RCTRLO #FORCE THIS TO BE SEEN0069 CALL SITOC ( ERRORS, REF(1), 5 ) #INSERT ASCII ERROR COUNT0059 CALL PRINT ( REF ) #PRINT "xxx RATFOR ERRORS"0075 CLOSE ( UNIT=STDOUT, DISP='DELETE', ERR=30 ) #FORGET FORTRAN FILE0045 30 CONTINUE #SUPRESS ERRORS HERE0011 ]0043 ELSE #NO ERROR, CLEAN UP NICELY0011 [^^^^^^0060 CLOSE ( UNIT=STDOUT, ERR=31 ) #CLOSE FORTRAN FILE0044 31 CONTINUE #WITHOUT ERROR MSGS0011 ]0005#0005#0072#---------------CHAIN TO FORTRAN OR FORTRAN/LINK/GO-----------------0005#0005#0080 IF (SWITCH(2,3) != 0 & OUTPUT == YES) # /F SW. GIVEN & OUTFILE REQUESTED0011 [0087 CALL SCOPY('FORTRAN/NOSWAP ',SPEC,81,ERR) #USE "SPEC" ARRAY TO SET RT-11 CMD.0068 CALL SJOIN(SPEC,FTNFIL,SPEC,81,ERR) #ADD FORTRAN FILE NAME0027 CALL SETCMD(SPEC)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0041 CALL EXIT #AND EXIT TO RT-110011 ]0005#0081 IF (SWITCH(2,10) != 0 & OUTPUT == YES) # /X SW. GIVEN $ OUTFILE REQUESTED0011 [0081 CALL SCOPY('EXEC/FORT/NOSWAP/LINK:',SPEC,81,ERR) #START OF COMMAND LINE0078 CALL SJOIN(SPEC,LINKLIBRARY,81,ERR) #ADD USER'S DEFAULT LINKLIB.0056 CALL SJOIN(SPEC,' ',81,ERR) #SPACE0077 CALL SJOIN(SPEC,FTNFIL) #AND THE FORTRAN FILE NAME.0063 CALL SETCMD(SPEC) #GIVE COMMAND LINE TO RT-11^^^^^^^^0043 CALL EXIT #EXIT TO RT-110011 ]0005#0082#=======================REPEAT FOR NEW COMMAND LINE===========================0005#0012 NEXT0005#0082#=============================================================================0005#0037# ERRORS COME HERE BEFORE LOOPING0005#0071 11 CALL PRINT('Syntax error, try again.') #ILLEGAL COMMAND LINE0014 NEXT0073 12 CALL PRINT('Unknown device, try again.') #ILLEGAL DEVICE SPEC.0014 NEXT^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0078 13 CALL PRINT('Option error, try again.') #UNKNOWN OR TOO MANY OPTIONS0014 NEXT0060 20 CALL PRINT('Open failure on FORTRAN output file')0014 NEXT0063 21 CALL PRINT('Open failure on scratch file, unit DK:')0014 NEXT0051 22 CALL PRINT('Open failure on list file')0014 NEXT0009 ]0005#0009 END0005 0024SUBROUTINE FSCONV(I)0005#0077# FSCONV -- CONVERT RAD50 FILESPECS FROM ICSI TO ASCII STRING FOR FORTRAN0005#0011# CALL:0020# CALL FSCONV(I)0005#0013# INPUTS:^^^^^^^^^^^^^^^^0065# I = ELEMENT IN "SPECS" USED BY ICSI OF START OF RAD50 SPEC.0005#0014# OUTPUTS:0061# ASCII FILESPEC STRING IN COMMON CHARACTER ARRAY "FSPEC"0005#0014# COMMONS:0049# FILES -- HAS ARRAYS AND SWITCHES FOR FILES.0005#0023# SUBROUTINES USED:0020# R50ASC (SYSF4)0005#0021# Robert B. Denny0032# Creative System Design Co.0039# 3452 E. Foothill Blvd. Suite 6010026# Pasadena, Ca. 911070020# (213) 355-68360005#0073# Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 80^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0038# DECUS. "V" revision when we0034# get field test results.0065#------------------------------------------------------------0005#0005#0021INCLUDE CFILES.RT0005#0046 DO J=1,16 #BLANK OUT FILESPEC STRING0022 FSPEC(J) = " "0058 CALL R50ASC(3, SPEC(I), FSPEC(1)) #DEVICE --> ASCII0046 DO J = 4,2,-1 #BACK UP J OVER BLANKS0031 IF ( FSPEC(J-1) != " ")0015 BREAK0042 FSPEC(J) = ":" #FOLLOW WITH COLON0054 CALL R50ASC(6, SPEC(I+1), FSPEC(J+1)) #FILENAME^^^^^^^^^^^^^^^^^^^^^^^^^0045 K = J+7 #K --> LAST CHR IN FILENAME0052 DO J = K,4,-1 #BACK J UP TILL IT POINTS...0062 IF ( FSPEC(J-1) != " ") #...TO FIRST ' ' IN FILENAME0015 BREAK0031 FSPEC(J) = "." #PERIOD0055 CALL R50ASC(3, SPEC(I+3), FSPEC(J+1)) #EXTENSION0042 FSPEC(J+4) = 0 #STRING TERMINATOR0005#0012 RETURN0009 END0005 0023 SUBROUTINE DUMPIT0005#0063# DUMPIT - TO LIST GENERATED FORTRAN SOURCE CODE ON PRINTER0005#0005#0025 INTEGER FLINE, ERR0021 CHARACTER FF(2)0020 LOGICAL*1 LERR0005#^^^^^^^0018INCLUDE CPRTLN0005#0029 DATA FF /FORMFEED, EOS/0005#0019 REWIND STDOUT0050 CALL RATLST (FF, 0, 0) #FORCE ADVANCE PAGE0013 FLINE=00012 REPEAT0009 [0072 CALL GETSTR(STDOUT, PRTBUF, MAXCARD, LERR) #GET THE FORTRAN LINE0021 IF(LERR != 0)0011 [0024 IF(LERR == -1)0042 BREAK #IF EOF, WE'RE DONE.0014 ELSE0077 CALL ERROR("Error reading .FOR file for listing") #ELSE HARD ERR.0011 ]0012 ELSE0011 [0035 IF(PRTBUF(1) == FORMFEED)0019 FLINE=0^^^0081 IF(PRTBUF(1) == BIGC \ PRTBUF(6) == CONTINCHAR \ PRTBUF(1) == FORMFEED)0065 CALL RATLST(PRTBUF, 0, 0) #DON'T NUMBER COMM., CONT.0014 ELSE0013 [0028 INCREMENT(FLINE)0052 CALL RATLST(PRTBUF, 0, FLINE) #PRINT THE LINE.0077 IF((PRTBUF(7) == BIGI & PRTBUF(8) == BIGF & PRTBUF(9) == BLANK) \0076 (PRTBUF(7) == LETI & PRTBUF(8) == LETF & PRTBUF(9) == BLANK))0060 INCREMENT(FLINE) #ADJUST FORTRAN LINE NUMBER0013 ]0011 ]0009 ]0005#^^^^^^^^0012 RETURN0009 END0005 0036 INTEGER FUNCTION GETLIN (BUFR)0005#0069# GETLIN - TO READ IN ANOTHER LINE FROM THE INPUT FILE FOR NGETCH0062## IF LINE BEGINS WITH A '%' IN COL. 1, TRANSFER IT TO THE0068## OUTPUT FILE WITH NO PROCESSING AT ALL EXCEPT DELETE THE '%'.0070## ALSO, TRANSFER FULL LINE COMMENTS ('#' IN COL 1) TO OUTPUT FILE0072## ALSO, LIST EACH LINE AS IT IS READ.EXCEPT WITHIN UNDEFINED IFDEFS0040## IF THE /N:CND SWITCH IS PRESENT.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0069# INTERPRET DEBUG LINES ("?" IN COL 1) AS WELL. PROCESS THEM IF0075# THE LEVEL SPECIFIED IN THE SECOND COL IS >= SPECIFIED DEBUG LEVEL.0005#0026# ----REVISION #1----0072# FIX HANDLING OF FORMFEEDS. REMOVE FROM THE INPUT BUFFER AND FORCE0027# NEW PAGE IN LISTING.0018# R. B. DENNY0016# 22-MAR-800035# MAKES RATFOR/RT VERSION 20.30026# -------------------0005#0026 INTEGER I, ERR, SLEN0029 CHARACTER BUFR(MAXLINE)0020 LOGICAL*1 LERR0005#0017INCLUDE CLINE0005#0018INCLUDE CPRTLN0005#^^^^^^^^^^^^^0017INCLUDE CLIST0005#0017INCLUDE CUCLC0005#0047 STRING DLEVL "123456789 " #DEBUG LEVELS0005#0016 GETLIN=YES0012 REPEAT0009 [0059 CALL PRTLIN #PRINT LAST LINE BEFORE READING NEXT0078 CALL GETSTR(INFILE(LEVEL), BUFR, MAXCARD, LERR) #READ NEXT INPUT LINE0022 IF (LERR != 0)0011 [0025 IF (LERR == -1)0024 RETURN (EOF)0014 ELSE0052 CALL ERROR ("Error reading input file.")0011 ]0025 ELSE #READ OK0011 [^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0056 CALL STRIM (BUFR) #TRIM ANY TRAILING BLANKS0005#0052## SPECIAL HANDLING OF RATFOR PROCESSOR FEATURES0005#0054 I = INDEX (BUFR, FORMFEED) ##----REV #1----0052 IF (I > 0) ##IF THERE'S A IN THERE0014 [0045 PLINE = 9999 ##FORCE NEW PAGE0053 J = SLEN(BUFR) ##FIND THE LINE LENGTH0056 IF (J == 1) ##IF THAT'S ALL ON THIS LINE0031 [ ##THEN...0057 READY = NO ##...SUPRESS PRINTING IT...^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0053 NEXT ##...AND GO GET THE NEXT LINE0017 ]0055 IF (I == J) ##IF IS AT END OF LINE0051 BUFR(I) = EOS ##JUST WIPE IT OUT.0050 ELSE ##OTHERWISE, REMOVE THE 0017 [0055 DO K=I,J-1 ##BY SHIFTING LINE LEFT 10037 BUFR(K) = BUFR(K+1)0059 BUFR(J) = EOS ##AND RE-TERMINATING STRING0017 ]0035 ] ##--------------0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0078 CALL SCOPY (BUFR, PRTBUF, MAXCARD ,ERR) #SAVE THIS LINE FOR LATER...0038 READY = YES #...PRINTING.0005#0031 IF (BUFR(1) == QMARK)0079 IF (INDEX(DLEVL, BUFR(2)) >= DEBUG) #CHECK DEBUG LEVEL OF THIS LINE0015 [0056 BUFR(1) = BLANK #PROCESS THIS DEBUG LINE0060 BUFR(2) = BLANK #BLANKING OUT THE "?N" FIRST0015 ]0016 ELSE0044 NEXT #SKIP THIS DEBUG LINE0005#0052 IF (BUFR(1) != PERCENT & BUFR(1) != SHARP)^^^^^^^^^^^^^^^^^^0045 BREAK #** NORMAL GOOD LINE **0005#0026 IF (INIF == YES)0053 NEXT #SKIP COMM'S & % LINES IN IFDEFS0014 ELSE0035 IF (BUFR(1) == PERCENT)0015 [0068 CALL PUTLIN (BUFR(2), STDOUT, NO) #OUTPUT % LINE AS IS0054 INCREMENT (FTNLN) #BUMP FORTRAN LINE #0015 ]0016 ELSE0063 IF (COMPRS == NO) #IF NOT IN "COMPRESS" MODE...0017 [0061 BUFR(1) = BIGC #...PASS COMMENTS TO FORTRAN^^^^^^^^^^^^^^^^^^^^^^^^^0046 CALL PUTLIN (BUFR, STDOUT, NO)0017 ]0011 ]0041 ] #REPEAT, GET ANOTHER LINE.0005#0012 RETURN0009 END0005 0038 SUBROUTINE GETNAM (BUFR, LSTIT)0005#0053# GETNAM - GET THE FILE NAME OF AN INCLUDED FILE.0083# INCLUDE/NL FILE AND INCLUDE FILE/NL BOTH OK, BUT 2ND WON'T BE LISTED RIGHT.0005#0037# LEFT ALONE FROM THE RSX VERSION0005#0005#0031 INTEGER LSTIT, LEN, SKIP0044 CHARACTER NGETCH, CHAR, BUFR(MAXNAME)0005#0012 LEN=00014 SKIP=NO0016 LSTIT=YES0005#^^^^^^^^0049#SINCE THE STRING MAY CONTAIN SEVERAL TOKENS 0063# AND EVEN SEMICOLONS, FORCE READ THE REST OF THIS LINE AND0039# TAKE IT TO BE THE FILE NAME SPEC.0005#0055 WHILE (NGETCH(CHAR) != NEWLINE & CHAR != SHARP &0066 LEN < MAXNAME) [0042 IF (SKIP == YES & CHAR == BLANK)0061 SKIP=NO #GOT PAST THE SWITCH,RETURN TO NORMAL0047 ELSE IF (CHAR == SLASH) [ #FOUND /NL?0058 SKIP=YES #YES, WE MUST SKIP THE SWITCH NAME^^^^^^^^^^^^^^^^^^^^^^^^^^^0049 LSTIT=NO #WE WON'T PRINT THIS FILE0014 ]0062 ELSE IF (CHAR != BLANK & CHAR != TAB & SKIP == NO) [0027 INCREMENT(LEN)0027 BUFR(LEN)=CHAR0014 ]0069 ] #GET THE REST OF THE LINE (EXCEPT COMMENTS) AS THE NAME0055 CALL PUTBAK(CHAR) #WE DON'T WANT THE TERMINATOR0005#0022 BUFR(LEN+1)=EOS0005#0013 RETURN0010 END0005 0023 SUBROUTINE HEADR0005#0064# HEADR - TO FILL IN DAY,DATE,TIME FOR RATLST'S PAGE HEADER.0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0040# REMOVED DAY OF WEEK CODE FOR RT-110005#0005#0018INCLUDE CDATIM0005#0027 DATA DATIM / 25*" "/0005#0027 CALL DATE (DATIM(6))0028 CALL TIME (DATIM(17))0042 DATIM(25)=EOS #MAKE IT A STRING0005#0013 RETURN0010 END0005 0022 SUBROUTINE OPENI0005#0049# OPENI - TO OPEN INCLUDED FILES FOR RATFOR.0005#0067# THE LUN FOR EACH INPUT FILE IS STORED IN INFILE(LEVEL),WHERE0058# LEVEL IS THE INCLUSION LEVEL (BASIC INPUT FILE=1).0068# CURRENTLY, THE LUN=THE INCLUSION LEVEL; INFILE(LEVEL)=LEVEL.^^^0072# IF THE INCLUDE FILE ISN'T FOUND AND THERE WAS NO DEVICE SPECIFIED0072# (I.E., "DK:" DEFAULT), ANOTHER ATTEMPT IS MADE WITH "SY:" AS THE0061# DEVICE. THIS ALLOWS COMMON INCLUDES TO BE KEPT ON SY:0005#0044 CHARACTER BUFR(MAXNAME), BUF2(MAXNAME)0021 INTEGER I, IERR0005#0017INCLUDE CLINE0005#0017INCLUDE CLIST0005#0043 STRING RAT ".RAT" #DEFAULT EXTENSION0005#0026 IF (LEVEL >= NFILES)0078 CALL ERROR ("INCLUDE's too deeply nested.") #RAN OUT OF RT-11 CHANNELS0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0067 CALL GETNAM (BUFR, LSTIT) #GET THE FILE NAME AND LIST STATUS0045 INCREMENT (LEVEL) #BUMP INCLUDE LEVEL0053 INFILE(LEVEL)=LEVEL #STORE LUN FOR THIS LEVEL0060 LST(LEVEL)=LSTIT #RECORD LISTING STATUS FOR NEW FILE0005#0068 IF (INDEX(BUFR, PERIOD) == 0) #ADD AN EXTENSION IF NONE THERE0046 CALL SJOIN(BUFR, RAT, MAXNAME-1, IERR)0005#0017 CALL ERRSNS0071 OPEN(UNIT=INFILE(LEVEL), NAME=BUFR, READONLY, TYPE='OLD', ERR=11)0025 RETURN #ALL OK0005#0026 11 CALL ERRSNS(IERR)^^^^^^^^^^^^^^^^^^^0078 IF (IERR == 28 & INDEX(BUFR,COLON) == 0) #IF NOT FOUND AND NO DEV: GIVEN0011 [0045 BUF2(1) = EOS #ADD "SY:" IN FRONT0040 CALL SINSRT(DEFAULTOPEN, BUF2)0050 CALL SJOIN (BUF2, BUFR, MAXNAME-1, IERR)0021 CALL ERRSNS0075 OPEN(UNIT=INFILE(LEVEL), NAME=BUF2, READONLY, TYPE='OLD', ERR=12)0037 RETURN #THAT ONE DID IT0011 ]0005#0057# IF WE GOT THIS FAR, ALL EFFORTS TO OPEN FILE FAILED0052 12 CALL ERROR ("Open failure on INCLUDE file")0012 RETURN0005#0009 END^^^^0005 0023 SUBROUTINE PRTLIN0005#0059# PRTLIN - PRINT A LINE OF SOURCE ON THE RATFOR LISTING0005#0077# IF LISTING (BOTH IN GENERAL AND AT THIS PARTICULAR TIME), FIGURE OUT IF0080# THIS LINE (WHICH IS THE ONE JUST PROCESSED, ONE BEHIND THE ONE JUST READ)0079# NEEDS RATFOR LINE NUMBER, FTN LINE NUMBER, BOTH, OR NEITHER. CALL RATLST0076# TO PRINT THE LINE WITH THE CORRECT NUMBER(S). ALSO CONVERT COMMENTS TO0084# LOWER CASE, IF NEEDED. ALSO KEEP FTN LINE NUMBERS STRAIGHT (NO SMALL PROBLEM).^^^^^^^^^^^^^^^^^^^0078# ARRANGE TO ALWAYS PRINT IFDEF,IFNOTDEF,ENDIF LINES WITH RATFOR NUMBERS,0053# TO LIST PROPERLY, THESE MUST BE IN UPPER CASE.0064# NOTE THAT DUMPIT AND DEFLST ALSO USE PRTBUF TO SAVE SPACE.0005#0005#0048 INTEGER EQLS, I, FUDGE, KLUGE, FORCIF, IT0005#0017INCLUDE CLINE0005#0018INCLUDE CPRTLN0005#0017INCLUDE CLIST0005#0017INCLUDE CUCLC0005#0046 STRING DLEVL "123456789 " #DEBUG LEVELS0039 STRING INCLU "INCLUDE" #KEYWORDS0029 STRING ENDIF "ENDIFDEF"0027 STRING IFDEFS "IFDEF"^^^^^^^^^^^^^^^^^^^^^^^^0029 STRING IFNOT "IFNOTDEF"0026 STRING DEFI "DEFINE"0025 STRING MACR "MACRO"0005#0069 IF (LST(1) == YES & READY == YES) #ARE WE EVEN DOING A LISTING?0009 [0074 FOR (IT=1; PRTBUF(IT) == BLANK \ PRTBUF(IT) == TAB; INCREMENT(IT))0045 ; #SKIP LEADING BLANKS AND TABS0079 IF ((EQLS(PRTBUF(IT),IFDEFS) == YES) \ (EQLS(PRTBUF(IT),IFNOT) == YES))0056 FORCIF=YES #WHAT'S FIRST THING ON THIS LINE?0057 ELSE #MUST FORCE LISTING OF 'IFDEF'&'IFNOTDEF'0019 FORCIF=NO0005#^^^^^^^^^^^^^^0077 IF (INIF == NO \ IFPNT == YES \ FORCIF == YES) #DO WE WANT TO PRINT?0011 [0024 IF (LC == YES)0013 [0067 I=INDEX (PRTBUF, SHARP) #IS THERE COMMENT ON THIS LINE?0022 IF (I > 0)0068 CALL FOLD (PRTBUF(I+1)) #CONVERT COMMENT TO LOWER CASE0013 ]0005#0037# DON'T NUMBER UNPROCESSED LINES0005#0067 IF ((PRTBUF(1) == SHARP) \ (INIF == YES & FORCIF == NO) \0077 (PRTBUF(1) == QMARK & INDEX(DLEVL,PRTBUF(2)) < DEBUG))^^^^^^^^^^^^^^^^^^^^^^^^^^0037 CALL RATLST(PRTBUF, 0, 0)0005#0074# RATFOR LINE NUMBER ONLY ON UNPROCESSED LINES AND PROCESSOR FEATURES0005#0014 ELSE0049 IF ((EQLS(PRTBUF(IT),ENDIF) == YES) \0048 (EQLS(PRTBUF(IT),MACR) == YES) \0049 (EQLS(PRTBUF(IT),DEFI) == YES) \0065 (EQLS(PRTBUF(IT),INCLU) == YES) \ FORCIF == YES)0015 [0057 IF ((LEVEL > 1) & (PRTBUF(IT+7) == SLASH) &0063 (EQLS(PRTBUF(IT),INCLU) == YES))0017 [^^^^^^^^^^^^^^0047 KLUGE=YES #INCLUDE/NL?, IF SO,0057 LST(LEVEL)=YES #FORCE RATLST TO PRINT IT0017 ]0018 ELSE0024 KLUGE=NO0062 CALL RATLST (PRTBUF, LINECT, 0) #RAT #, NO FTN #0032 INCREMENT (LINECT)0054 IF (KLUGE == YES) #WE FAKED RATLST, NOW0063 LST(LEVEL)=NO #RESET INCLUDED LEVEL TO NO LIST0015 ]0005#0062# RATFOR AND FORTRAN NUMBERS ON LINES THAT GENERATED CODE0005#0016 ELSE0015 [^^^^^^^^^^^^^^^^^^^^0071 IF (FORTYP == YES) #THIS LINE IS 'FOR' WITH INIT CLAUSE?0061 FUDGE=1 #YES, BACK OFF AN EXTRA LINE NUMBER0041 ELSE #(ALSO FOR 'UNTIL')0023 FUDGE=00055 CALL RATLST (PRTBUF, LINECT, FTNLN-FUDGE)0032 INCREMENT (LINECT)0037 #IF'S USE 2 FTN LINE NUMBERS0049 IF (IFTYP == YES) #NUMBER ON 'IF'S0067 INCREMENT (FTNLN) #FOR THE 'GOTO'. SO ADD IT HERE.0015 ]0005#0045 READY=NO #PRTBUF NO LONGER VALID0011 ]0016 IFTYP=NO0017 FORTYP=NO0009 ]0005#0012 RETURN0009 END0005 0042 SUBROUTINE PUTLIN (BUF, FIL, FMTCHR)0005#0058# PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE0005#0079# IF OUTPUT IS TO FORTRAN FILE (STDOUT), MAKE FINAL DECISION ABOUT OUTPUT.0084# IF OUTPUT IS TO ANOTHER FILE (EG LISTING), ASSUME CALLER HAS ALREADY DECIDED.0005#0005#0022 INTEGER ERR, FIL0036 CHARACTER BUF(MAXLINE), FMTCHR0017INCLUDE CLIST0005#0005#0058 IF ((OUTPUT == YES & FIL == STDOUT) \ FIL != STDOUT)0009 [^^^^0042 CALL PUTSTR(FIL, BUF, FMTCHR, ERR)0021 IF (ERR == 0)0037 RETURN #STRING OUTPUT OK0036 ELSE #ERROR DURING OUTPUT0050 CALL ERROR("Text output error - PUTLIN")0009 ]0005#0013 RETURN0010 END0005 0043 SUBROUTINE RATLST (BUFR, LINE, FLINE)0005#0065# RATLST - TO PRINT A LINE ON LISTING & DO PAGE HOUSEKEEPING.0005#0005#0041 INTEGER N, LINE, SITOC, JUNK, FLINE0044 CHARACTER BUFR(DUMMYSIZE), OUTBUF(133)0005#0021INCLUDE CFILES.RT0005#0017INCLUDE CLIST0005#0017INCLUDE CLINE0005#^0018INCLUDE CDATIM0005#0034 STRING STARSS "************"0005#0063# ERRORS (LINE=HUGE) WITHIN INCLUDED/NL FILES ARE LISTED, 0005#0078 FOR (N=1; N <= LEVEL; INCREMENT(N)) #TO LIST THIS LINE, ALL LEVELS UP TO0073 IF (LST(N) == NO & LINE <= 9999) #THE CURRENT ONE MUST BE LISTED.0063 RETURN #OTHERWISE, RETURN WITHOUT PRINTING ANYTHING0005#0079 IF (PLINE > PAGELENGTH \ BUFR(1) == FORMFEED) #ADVANCE PAGE AND DO HEADER0009 [0026 OUTBUF(1)=FORMFEED0021 OUTBUF(2)=EOS^^^^^^^^^^^^^^^^^^^^^^^^^^^^0058 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #ADVANCE PAGE0023 OUTBUF(1)=BLANK0044 CALL PUTLIN (OUTBUF, LISTOUT, BLANK)0057 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #BLANK LINES0044 CALL PUTLIN (OUTBUF, LISTOUT, BLANK)0024 INCREMENT (PAGE)0030 CALL SPAD (OUTBUF, 77)0040 CALL SINSRT (VNUMBER, OUTBUF(1))0038 CALL SINSRT(DATIM, OUTBUF(35))0040 CALL SINSRT ("PAGE", OUTBUF(71))0040 JUNK=SITOC (PAGE, OUTBUF(77), 4)0063 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #PRINT THE HEADING^^^^^^^^^^^0041 CALL PUTLIN (CLB, LISTOUT, BLANK)0023 OUTBUF(1)=BLANK0021 OUTBUF(2)=EOS0057 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #BLANK LINES0044 CALL PUTLIN (OUTBUF, LISTOUT, BLANK)0015 PLINE=60032 IF (BUFR(1) == FORMFEED)0029 RETURN #DONE IT0009 ]0019 OUTBUF(1)=EOS0048 CALL SPAD (OUTBUF,7) #PRINT FTN LINE #'S0020 IF (FLINE > 0)0009 [0024 OUTBUF(1)=LPAREN0058 N=SITOC (FLINE, OUTBUF(2), 4) #CONVERT FTN LINE #0050 OUTBUF(N+2)=RPAREN #KLOBBER SITOC'S EOS0009 ]^^^^0051 IF (LINE > 0) #DO SOURCE CODE LINE NUMBER0051 IF (LINE > 9999) #ERRORS HAVE LINE=HUGE,0057 CALL SCOPY(STARSS,OUTBUF,15,JUNK) #SO FLAG 'EM0012 ELSE0065 JUNK=SITOC (LINE, OUTBUF(7), 5) #CONVERT RATFOR LINE #0028 CALL SPAD (OUTBUF, 21)0042 FOR (N=1; N <= NFILES; INCREMENT(N))0025 IF (N <= LEVEL-1)0051 OUTBUF(11+N)=STAR #FLAG INCLUDED FILES0057 CALL SCOPY (BUFR, OUTBUF(14+NFILES), 132-14-NFILES)0059 CALL PUTLIN (OUTBUF, LISTOUT, BLANK) #PRINT THE LINE^^^^^^^^^^^^^^0023 INCREMENT (PLINE)0012 RETURN0009 END0005 0028 SUBROUTINE SYNERR(MSG)0005#0041# SYNERR - REPORT RATFOR SYNTAX ERROR0005#0005#0045 CHARACTER BUFOUT(MAXLINE), MSG(MAXLINE)0022 INTEGER I, LASTC0033 EQUIVALENCE (BUFOUT,HEADER)0018INCLUDE COUTLN0017INCLUDE CLIST0040 STRING HEADER "C***RATFOR ERROR: "0005#0014 LASTC=190078 FOR(I=1;MSG(I) != EOS & MSG(I) != PERIOD & LASTC < MAXCARD;INCREMENT(I))0009 [0030 BUFOUT(LASTC) = MSG(I)0025 INCREMENT (LASTC)0009 ]0023 BUFOUT(LASTC)=EOS^^^^^^^^^^^0040 INCREMENT (ERRORS) #COUNT ERRORS0005#0029# OUTPUT TO STANDARD FILE0005#0054 IF (OUTP > 0) #FINISH OFF PREVIOUS LINE FIRST0019 CALL OUTDON0038 CALL PUTLIN (BUFOUT, STDOUT, NO)0005#0045# OUTPUT TO TERMINAL AND (MAYBE) LISTFILE0005#0025 IF (LST(1) == YES) 0066 CALL RATLST (BUFOUT(2), HUGE, 0) #PRINT WITH '***', PCN 750034 CALL RCTRLO #MAKE SURE...0059 CALL PRINT(BUFOUT(2)) #...IT SHOWS ON USER TERMINAL0005#0012 RETURN0009 END^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^