Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/comman.mac
There are 8 other files named comman.mac in the archive. Click here to see a list.
TITLE FTNCMD %5A(621) COMMAND SCANNER INTERFACE FOR FORTRAN COMPILER
SUBTTL DONALD LEWINE/DAL/FI/HPW/DBT/NEA/MD/JNT/DCE/SJW/JNG 30-SEP-77
;COPYRIGHT (C) 1972,1977 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
TWOSEG
SUBTTL REVISION HISTORY
;124 ----- ADDED MAIN ENTRY SYMBOL MRP0 FOR SINGLE SEGMENT COMPILER
; /HPW
;125 ----- ADDED BUGOUT COMPLIER DIAGNOSTIC SWITCH /DBT
;126 ----- FIXED ERROR TRAP TO CLEAR FIRST PART DONE
;127 ----- CHANGED SIZE OF POOL
;130 ----- MOVE APR TRAP INITIALIZATION TO BE RESET AFTER
; EACH PROGRAM
;131 ----- CHANGED BIT POSITION OF EOCS BIT IN FLAG REGISTER
;132 ----- PUT BOUNDS SWITCH BACK IN
;133 ----- CHANGE NXTFIL TO A SUBROUTINE WHICH WILL OPEN THE INPUT
; FILE AS WELL AS BUILD THE OPEN BLOCK. PHAZ1 CAN THEN CALL PHAZCO
; AND THEN NXTFIL SO THAT THE "+" COMPIL CONSTRUCTION
; WILL WORK
;134 ----- FIX ABSENT SPEC (PRESENT SWITCH)
; BEING TREATED AS PRESENT SPEC. E.G. /SWT,X=X
; TREATED AS *.*/SWT,X=X
;135 ----- CATCH THE OCCURRENCE OF "=" COMMAND LINE
; IE. NO INPUT FILES AT ALL
;
;136 ----- CALCULATE THE MAXIMUM CORE REQUIRED FOR THE LIST
; OF INPUT FILES AND STORE IN BGSTBF. PHAZ1 WILL RESERVE
; THIS AMMOUNT OF CORE WHEN THE FIRST FILE IS OPENED
;
;137 ----- PUT ERROR MESSAGES IN NEW FORMAT
;138 ----- PUT IN FTTENX SUPPORT
;********** BEGIN VERSION 4A
;230 DRIVER(14) ----- ALLOCATE VARIABLE DIMENSIONS PASSED
; ACT1(99) ----- AS ARGUMENTS.
;231 ERROUT(32) ----- CHANGE WARNING 77 (DO INDEX)
;232 ACT1(100) ----- FIX PROCESSING OF RECORD NUMBER IN BLDUNIT
;233 PEEPOP(71) ----- FIX PEEPOP OF JUMP INSTRUCTION
;234 PNROPT(144) 14167 FIX PROPAGATION OF LIBRARY FUNCTION
; CALLS WITH CONSTANT ARGUMENT.
;235 STA3(56) ----- NAMELIST PROBLEMS
; ASHELP(3) 1-ITEMS NOT ALLOWED IN COMMON
; ACT1(101) 2-SOMETIMES NOT ALLOCATED
; 3-NOT CREFED PROPERLY
;236 OUTMOD(63) 14654 EQUIVALENCE PROBLEM
;237 REGAL2(127) ----- REGISTER ALLOCATION FAILS
;240 PH3G(229) 14569 REGISTER ALLOCATION PROBLEM
;241 OUTMOD(64) ----- FIX HISEG BLOCK FOR BIG LOW SEG
;242 CODETA(1) 15010 ALLOW CONTINUE AS OBJECT OF
; SKSTMN(92) A LOGICAL IF STATEMENT.
;243 GCMNSB(67) 14916 FIX OPTIMIZER (INT COMP ERROR)
;244 GCMNSB(68) 14940 FIX OPTIMIZER (FINDTHESPOT TO MOVE
; COMMON EXPRESSIONS).
;245 PEEPOP(72) 15039 CORRECT MOVEMENT OF JRST ADDRESS TO INCLUDE
; THE INDEX AND INDIRECT BITS.
;246 PH3G(230) 15209 FORCE PRELOADS ON BRANCHES IN LOOPS
;247 LISTOU(54) 15349 CHANGE FORMAT LABEL REFERENCES TO P (FROM F)
;250 REGAL2(128) 15356 DON'T ALLOCATE REG WHEN ALCRETREGFLG ON
;251 PEEPOP(73) 15652 DON'T OPT OUT LABELED INDIRECT JRST
;252 DEFPT(116) 14967 CHECK NODES FOR FUNNY OPRCLS IN SELECTIT
;253 PEEPOP(74) 15425 DON'T OPT OUT MOVE FOLLOWING PUSHJ OR DIVIDE
; OF AC-1
;254 STREGA(202) 15425 FORGET WHAT WAS IN 0 WHEN BOOLEAN FUNCTIONS ALLOCATE
; THE RETURN VALUE TO 0
;255 STA3(57) 15432 CHECK THE DO LOOP TERMINATION LABEL FOR
; BEING ON THE DO STATEMENT ITSELF.
;256 CGDO(134) 15493 DON'T COUNT ENTRY LABELS FOR STATEMENT FUNCTIONS
;257 PEEPOP(75) 15511 ELIMINATE REDUNDANT ADDI SUBI PAIRS
;260 SKSTMN(93) ----- ADD DOT FOR MATERILIZING INDEX AROUND FUNCTION CALLS
;261 STREGA(203) 15772 WHEN COMPILING WITH /DEBUG:LABELS, DO NOT
; PEEPOP(76) OPTIMIZE REGISTER USAGE BETWEEN
; TABLES(154) STATEMENTS
;262 COMMAN 15710 CORRECT LOOPS ON ENTER FAILURES
;263 PHA2(108) 15865 FIX STACK VALUE SAVED
;264 OPGNTA(119) 15974 FIX COMPLEX DIVIDE TO MEMORY ON KI
;265 ACT1(102) 15946 ADD WARNING FOR MULTIPLY INITIALIZED
; ERROUT(33) VARIABLES IN DATA STATEMENTS
; ASHELP(4)
;266 PH3G(231) 15952 FIX AN OPTIMIZER MOVEMENT BUG
;267 REGAL2(129) ----- FIX SIDE EFFECT OF 250 IN RELATIONALS
;270 STREGA(204) 16013 CLEAR REGSTATE FOR VARIABLES IN INPUT NAMELIST
;271 COMMAN ----- CHANGE COMMAN TO SEARCH C AND SCNMAC
;272 ACT1(103) ----- CHANGE 265 TO NOT CHECK ARRAYS
;273 DATAST(43) 16361 HANDLE NEGATIVE DIMENSIONS RIGHT IN DATA STATEMENTS
;274 REGAL2(130) 16050 ALLOCATE SAVES FOR 0-1 IN FUNCTION CALLS
; AFTER ALLOCATING UNDER CALL
;275 CNSTCM(65) ----- CHECK FOR UNDERFLOW RIGHT
;276 TSTR(45) ----- REDUCE NEGATIVE MULTIPLICATIONS CORRECTLY
;277 PH3G(232) 16112 FIX FLIPCODES TO CALL LEAFLOOKER WITH THE
; REGS WE REALLY WANT SUBSTITUTED
;300 STREGA(205) ----- FIX 270
;301 CMPLEX(127) 16154 REMEMBER THAT FUNCTION CALLS CLOBBER 0 AND 1
; STREGA(206) SO DON'T USE PROLOG VALUES IN THEM
;302 REGAL2(131) 16181 CATCH ALL CASES OF NOT REMEMBERING REG CONTENTS FOR
; BOOLEAN EXPRESSIONS WHICH MAY NOT BE COMPLETELY EXECUTED
;303 DRIVER(15) 16369 CATCH ALL CASES OF DIMENSIONED VARIABLES
; OCCURRING WITHOUT INDICES
;304 REGAL2(132) 16441 CLOBBER BOTH REGISTER STATES ON A DOUBLE
; TO SINGLE TYPE CONVERSION
;305 PEEPOP(77) 16518 FIX PEEPOP TO CHECK FOR INDEXING WHEN ELIMINATING
; REDUNDANT MOVE FROM MOVEM-XXXX-MOVE
;306 CGSTMN(124) 16156 FIX CALL/OPEN TO DO FORMAL ARRAYS INDIRECTLY
;307 DRIVER(15) 16611 CHANGE ORDER OF CLEANUP TO FIX PYROTECHNICS
;310 STREGA(207) 16602 CHANGE ORDER OF OPEN/CLOSE REGISTER ALLOCATION
;311 STREGA(208) 16665 ALLOCATE IOLIST REGS ONLY FOR NON-DATA ITEMS
;312 GNRCFN(31) 16668 CHECK MIN AND MAX FUNCTIONS FOR LESS THAN 2 ARGUMENTS
;313 STA1(62) 16666 HANDLE DIALOG W/O = RIGHT
;314 DATAST(44) QAR FIX DATA STATEMENT DO LOOPS OF - NUMBERS
;315 DEFPT(117) 16667 FIX ARRAYREFS WITH CONST SS DEFINITION POINT
;316 PH3G(233) QAR FIX 277 RIGHT
;317 LISTOU(55) QAR FIX 247 RIGHT
;
; BEGIN VERSION 4B, 26-AUG-75
;
;320 STA2(41) 16787 CATCH COMMON /X/A(5)B(5) AS ERROR
;321 TSTR(46) 17005 SCAN FOR INDUCTION VARIABLE IN OPEN/CLOSE WHEN /OPT
;322 IOPT(48) 16688 CHECK FOR DISJOINT IOLISTS BEFORE COLLAPSING
;323 CGDO(135) 16729 CHANGE NAME OF TEMPS USED TO SAVE REGS
; DOALC(106) IN FUNCTION PRO/EPI-LOGUE FROM .XXXNN
; TO .A00NN TO AVOID CONFLICT.
;324 STA3(58) 16750 CLEAN UP SYMBOL TABLE ENTRIES AFTER
; BAD STATEMENT FUNCTION.
;325 ACT0(52) 17044 CHECK FOR OVERFLOW OF STK CAUSED BY LONG
; ARGUMENT LISTS, AND REMEDY SITUATION.
;326 REGAL2(133) 17086 FIX REGISTER TARGETING FOR ASSIGNMENT STATEMENTS
; WITH AND/OR NODES AND FUNCTION CALLS.
;327 GRAPH(117) 16688 PREVENT OPTIMIZER FROM DYING ON
; PROGRAMS WITH POTENTIALLY INFINITE LOOPS
;330 GRAPH(118) 17150 ENSURE THAT THE OPTIMIZER DOES NOT
; CONSIDER ENTRY STATEMENTS TO BE INACCESSIBLE
;331 P2S2(51) 17091 FIX PROPAGATION OF NEGATION FOR SPECIAL
; OPERATOR: RAISE TO AN ODD CONSTANT INTEGER
; POWER CANNOT ABSORB A NEGATE FROM BELOW.
;332 DOALC(107) 17045 FIX ASSIGN STATEMENTS WITHIN DO LOOPS
; LEAFLOOKER(234)
;333 GRAPH(119) 17045 FIX UP CODE GENERATED FOR ASSIGNED GO TO
; STATEMENTS WITHIN DO LOOPS.
;334 F72BNF.SYN 17420 CORRECT FORMAT OF DO STATEMENT (ADD LINEND)
;335 INOUT(36) 17377 FIX FATLERR SO THAT IT DOES NOT DESTROY
; THE CONTENT OF NAME FOR LEXICA.
;336 STA0(46) 17259 CHECK FOR I/O LIST WITH NAMELIST
; ERROUT(34) DIRECTED I/O
;337 OUTMOD(65) 17305 ROUND UP IMMEDIATE REAL CONSTANTS
; CGEXPR(71) BEFORE LISTING THEM
;340 GCMNSB(69) 16989 DO NOT ALLOW CALL TO MATCHER TO
; CHANGE VALUE OF PHI - OPTIMIZER BUG
;341 REGAL2(134) 17770 FIX REGISTER ALLOCATION FOR EXPONENTIATION
; INSIDE FUNCTION
;342 LISTNG(10) 17876 MAKE LONG UNCLASSIFIABLE STATEMENTS WORK
; LEXICA(14) PROPERLY - SEVERAL MINOR PATCHES
;343 DRIVER(17) 17636 FIX END OF STATEMENT PROCESSING
; SO THAT THE LINE NUMBER IS CORRECT.
;344 CMPLEX(128) 17768 FIX PROPAGATION OF FNCALL FLAG
; TO A NEG/NOT NODE.
;345 P2S2(52) 17554 FIX COMMON SUBS INVOLVING EXPONENTIATION
; TO EVEN POWERS SOMETHING WITH A NEG FLAG
;346 TSTR(47) 17928 PASS OUT RETURN INFORMATION TO OUTER DO LOOPS
;347 PH3G(235) 17545 IN GLOBAL REGISTER ALLOCATION, PREVENT
; BAD PRELOADS CAUSED BY LOGICAL IF'S.
;350 PH3G(236) 17545 COMMON SUBS MUST ALSO CAUSE PRELOADS
; OF REGISTERS ON OCCASION - FIX THIS.
;351 LISTNG(11) FIX EDIT 342 PROPERLY
;352 PH3G(237) 18007 FIX EDIT 266 FOR CASE WITH ONE MATERIALIZATION
;353 PH3G(238) 18004 FIX TWO CALLS GENERATING BAD CODE
;354 TSTR(48) 18015 BAD CODE INVOLVING REDUCTION IN STRENGTH
;355 SRCA(49) 18132 CORE MANAGEMENT INSUFFICIENT FOR LARGE
; DATA STATEMENT
;356 LISTOU(56) 18105 MAKE MAIN. GLOBAL SYMBOL FOR MAIN PROGS.
;357 COMMAN 18191 FIX OPEN ERROR REPORTING
;360 CGDO(136) 18243 FIX RETURN STMNT AT END OF DO LOOP
;361 GRAPH(120) 18451 FIX GO TO END OF DO LOOP
;362 LEXSUP(8) 18245 FIX UP ARGUMENT BLOCK TYPES FOR
; GLOBAL(75) LOGICAL AND OCTAL AND DOUBLE OCTAL CONSTANTS
;363 STREGA(209) 18269 CHECK A1NOTFLG BEFORE REMEMBERING REG CONTENTS
;364 OUTMOD(66) 18251 CORRECT EQUIVALENCE PROCESSING
;365 LEXICA(15) 18857 TAKE CARE OF FORM FEEDS BETWEEN ROUTINES
;366 LEXSUP(9) 18210 SAVLINE CANNOT CLOBBER NAME
; LEXICA(16) X=.123EQ.A AND X=1.1HABC ARE ILLEGAL
;367 CGSTMN(125) 18239 WRITE(U) GENERATES WRONG CODE
;370 GCMNSB(70) 17938 REMOVE [244] REAL FIX IS IN REDUCE (TSTR)
; TSTR(49) FIX CODE MOTION FOR .R VARIABLES
;371 COMSUB(255) 18471 FIX CSE FOR STRAIGHT CASE IN MATCHER
;372 GRAPH(121) 18314 FIX ASSIGN GO TO INSIDE LOOPS
;373 REGAL2(135) 18242 CORRECT REGISTER ALLOCATION FOR LARGE
; ASSIGNMENT STATEMENTS
;374 GRAPH(122) ----- FIX MIS-SPELLED MACRO NAME
;375 PNROPT(145) 18450 USE .O INSTEAD OF .R FOR DP TEMPORARY
;376 CGWRIT(126) 18398 FIX WRITE STMNT WITH DEBUG SET
;377 REGAL2(136) 18476 FIX REG ALLOCATION FOR COS(X)*A(I)
;400 PH3G(239) 18704 FIX LOGICAL IF BEFORE NESTED LOOPS
;401 GCMNSB(71) 17813 FIX A(I)=B(I)+B(I)+1.0
;
; BEGIN VERSION 5, 7-MAY-76
;
; ACT1 (104) ARRXPN (52) CANNON (25) COMSUB (256V)
; GCMNSB (72) OPTMAC PH3G (240V) PHA2 (109)
; PNROPT (146) TSTR (50) VER5 (1)
;
;402 STA2(42) 18917 RESTORE FLGREG PROPERLY AFTER INCLUDE
;403 STREGA(210) 18961 BAD REG ALLOCATION FOR I=I/J
;404 GOPTIM(53) 18869 MAKE ASSOCIATE VARIABLE LIST CORRECTLY,
; PH3G(240) AND DON'T LET THEM LIVE IN REGISTERS
;405 COMSUB(256) 18967 FIX A(P(I)) IN IOLIST
;406 IOPT(49) 18978 FIX CHAR(K(I,J)) IN IOLIST
;407 VERSION 5, 25-JUN-76
; GRAPH (123) STA1 (63) ADD ERR= ON OPEN/CLOSE
;410 GLOBAL(76) QA568 MAKE DTABPTR GLOBAL FOR BLDDIM
; ACT1(105)
;411 CMPLEX(129) 19537 DON'T SWAP ARGS FOR MAX OR MIN IF
; FIRST ARG IS NEGATIVE
;412 CMPLEX(130) VER5 NODE WITH ARG1 = DOUBLE ARRAY REF FOR
; KA10 MUST HAVE COMPLEXITY AT LEAST 3
; REGAL2(137) VER5 USE SUBSCRIPT REG FOR DOUBLE ARRAY REF
; VALUE EXCEPT ON KA10
;413 CNSTCM(66) ----- DON'T USE FADL IN INTDP IF NOT ON KA10
;414 ACT1(106) QA625 FIX .I OFFSET SHARING SO ONLY SHARES
; DIM2 .I IF DIM1 SAME
;415 ACT1(107) 18964 DON'T DESTROY SYMBOL TABLE ENTRY FOR
; FORMAL FUNCTION WHEN ENTRY STATMNT
; SEEN WITH THE FUNCTION AS A PARAM.
;416 GCMNSB(73) QA650 FIX MOVCNST SO HASH ENTRY IGNORED ON
; NEXT PASS IF .R+X CAN'T BE MOVED AS .O
;417 STA3(58) QA637 FIX BAD STATEMENT FUNCTION FROM
; CLOBBERING THINGS ON CLEANUP IN 324
;420 STA3(59) QA637 AFTER BAD ST FN, CLEAN UP THE NAME
; SO THAT IT DOES NOT CAUSE TROUBLE LATER
;421 PNROPT(147) QA651 DON'T PROPAGATE .O IF CAME FROM .R
;422 LISTNG(12) 18493 IMBEDDED NULLS CAUSE LOW LEVEL LOOPING
;423 ACT1(108) QA709 FIX PATCH 414: DIMNUM IS 1-RELATIVE
;424 STA1(64) QA690 ERROR IF DIRECTORY= NOT LITERAL OR ARRAY
; NAME IN OPENCLOSE
;425 PHA2(110) QA714 CALL ZTREE TO CLEAR DEFPTS IF
; OPTIMIZATIONS DISCONTINUED IN OPTERR
;426 CMPLEX(131) 18816 SET FNCALLSFLG FOR IMPLICIT FN CALLS,
; DOALC(108) SO 0,1, AND 16 ARE KNOWN TO BE CLOBBERED
;427 COMSUB(257) 18871 FIX COMSUBS IN IOLISTS
;430 P2S2(53) 18876 MAKE ARITH IF NODES ABSORB NEGS RIGHT.
;431 PH3G(241) 19121 MATERIALIZE VARIBLES THAT HAVE BEEN
; ALLOCATED TO REGISTERS DURING A
; DOUBLY-NESTED DO LOOP CORRECTLY.
;432 REGAL2(138) 19037 FIX CONVERSION OF LOGICAL ARRAY REF
;433 DOXPN(81) 19130 MAKE DO I=10,1 EXECUTE ONCE
;434 P2S1(60) 19211 CHECK FUNCTION CALL CONTAINING DO INDEX
; AS A PARAMETER AFTER CONSTANT FOLDING.
;435 IOPT(50) 18964 FIX IO LISTS WITH VARIABLE INCREMENT
;436 OUTMOD(67) 19427 CATCH EQUIVALENCE VIOLATION WHEN
; BUILDING EQUIVALENCE CLASSES.
;437 GCMNSB(74) QA771 DON'T LET DOTOHASGN MOVE .O=EXPR IF
; .O CAME FROM .R
; VER5(2) MARK SUBSUMING .O IF SUBSUMEE .O CAME
; FROM .R IN DOTOFIX
;440 GCMNSB(75) QA771 DON'T NEXTUP .O IF CAME FROM .R IN
; MOVCNST
;441 REGAL2(139) 19231 FIX REGISTER ALLOCATION FOR A D.P.
; ARRAYREF AS A FN CALL PARAMTER.
;442 COMSUB(258) 19233 MAKE THE DELETION OF HASH ELEMENT
; WORK IF ELEMENT IS FIRST IN ITS LIST
;443 GRAPH(124) QA656 WARNING + OPT STOPPED IF DISCOVER
; ILLEGAL DO NESTING IN LNKEXTND
; ERROVD ADD WARNING MESSAGE E140
; ERROUT(37)
;444 PH3G(242) 19484 FIX TO 246 - DON'T FORCE PRELOAD OF
; COMPILER VARIABLES IF GOTO ENCOUNTERED.
;445 P2S1(61) 19632 USE FEWER LOCALS ON STACK DURING
; RECURSIVE CALLS TO P2SKARITH
;446 STREGA(211) 20652 BAD CODE FOR I=I*3 AND I=I**7 (QAR753)
;447 UTIL(85) 19547 NEGATIVES PROPAGATED TOO MUCH IN FORTG
;450 COMSUB(259) QA784 DON'T NEXTUP ARRAYREF IF INSIDE IOLIST
;451 ERROUT(35) 19610 CORRECT SPELLING IN ERROR MESSAGE
;452 COMMAN(452) 19610 NUL: CAUSES PROBLEMS AS OUTPUT DEV
;453 DEFPT(118) 19695 DON'T MAKE DO BE DEFPT OF ALL VARS
; MODIFIED INSIDE THE LOOP.
;454 PH3G(243) 19699 DON'T PLACE PRELOADS 1 STATEMENT TOO
; LATE WHEN PLACING AFTER A DO LOOP.
;455 GCMNSB(76) QA784 CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO
; IF INSIDE LOGICAL IF
;456 GCMNSB(77) QA784 FIX FINDTHESPOT SO CALLER TELLS IT WHERE
; TO STOP
; ADD NEW ROUTINE FINDPA FOR GLOBMOV AND
; DOTOHASGN
; CALL FINDTHESPOT WITH 2ND PARAM IN
; GLOBMOV AND DOTOHASGN
; COMSUB(260) GIVE GLOBMOV ENTIRE HASH ENTRY IN CMNMAK
; FOR FINDPA
; MOVA(26) CALL FINDTHESPOT WITH 2ND PARAM = TOP IN
; HAULASS
; TSTR(51) CALL FINDTHESPOT WITH 2ND PARAM = TOP IN
; REDUCE
;457 REGAL2(140) 19805 TRY HARDER NOT TO REQUEST A REG IN
; REGAL2 UNLESS WE REALLY NEED IT - MIGHT
; RUN OUT EARLY.
;460 ACT1(109) 19477 CHANGE DIMENSION PROCESSING TO BE
; ERROUT(36) MORE THOROUGH AND LESS APT TO EXIT EARLY
;461 LISTOU(57) 19477 DETECT WHEN PROGRAM IS TOO LARGE
; ERROVG(1) ADD E142
; ERROUT(38)
;462 DRIVER(18) 19960 FIX MRP1 TO LEAVE SREG<LEFT> WITH THE
; SAME VALUE IT FOUND IN IT
;463 UTIL(86) 19989 FIX IMPLIED DO'S WHOS INITIAL VALUE OR
; STEP SIZE COME FROM AN OUTER AOBJN DO.
;464 LISTOU(58) QA754 ADD LINE-NUMBER/OCTAL-LOCATION MAP IF
; PHA3(50) 780 MACRO LISTING NOT REQUESTED
; GLOBAL(77) ADD 3 GLOBALS FOR LINE-HANDLING
;465 PNROPT(148) 20657 CLEAR INDVAR BEFORE CALLING REDUCE FOR
; STATEMENTS BEFORE THE DO LOOP; WE MIGHT
; FIND SOME REDUCTIONS OTHERWISE (!!!).
;466 PNROPT(149) VER5 DELETE CODE TO ZERO DEFPTS BETWEEN
; LENTRY & TOP (REMOVE 465 AND MORE)
;467 IOFLG(9) VER5 TAKE OUT FORSWI.REQ
; INOUT(37) REQUIRE FTTENX.REQ
; LISTNG(13)
; STA2(43)
; MAIN(29) REQUIRE FT1SEG.REQ
;470 OUTMOD(68) 20744 MAKE SURE THE HIGH SEG STARTS AT LEAST
; A PAGE ABOVE THE END OF THE LOW SEG.
;471 STREGA(212) 20309 LHS A LOGICAL EQUIVALENCED VAR MAY
; GENERATE BAD CODE
;472 OUTMOD(69) 20494 INCORRECT EQUIVALENCE PROCESSING
; WHEN LAST ELEMENT OF GROUP IN COMMON
;473 OUTMOD(70) 20478 SCALARS AND ARRAYS LISTING TOO WIDE
;474 OUTMOD(71) 20479 OUTPUT CRLF AFTER LAST COMMON BLOCK NAME
;475 IOPT(51) 20813 DON'T COLLAPSE ELISTS THAT WE SHOULDN'T
;476 IOFLG(10) QA754 MAKE MAPFLG FROM STATFLG IN FLGREG
; COMMAN(476) 780 MAKE /MAP A SWITCH TO SCAN
; LISTOU(59) MAKE LINE NUMBER/OCTAL LOCATION MAP
; PHA3(51) OPTIONAL UNDER /MAP SWITCH
;477 LEXSUP(10) QA831 MAKE MESSAGE NAMLEX'S MORE READABLE
;500 TSTR(52) 20818 DON'T SEE IF A NODE IS AN I/O STATEMENT
; UNLESS IT'S A STATEMENT.
;501 TSTR(53) 21113 DON'T REDUCE .O'S IN OUTER DO LOOPS.
;502 PH3G(244) 20463 SORT SAVED VS NON-SAVED REGS CORRECTLY
; IN FLIPCODES; FAKE ITMCT ALSO
; COMMAN(502) VER5 REMOVE XLIST'S FOR FTTENEX
;503 STREGA(213) 19976 FOR A(I) = FUNC. CALL, DON'T LEAVE I
; IN REG 1 WHEN CALCULATING LH FIRST.
;504 REGAL2(141) QA815 FIX EDIT 412 TO NOT ALLOW FETCHES OF
; COMPLEX NUMBERS INTO AN AC WHICH IS
; ALSO THE INDEX REG. NEGATED FETCHES
; USE TWO INSTRUCTIONS (EVEN ON KI'S),
; AND NEGFLG'S CAN SNEAK IN MUCH LATER.
;505 VER5(3) QA815 IN DOTORFIX DON'T MOVE .R INIT IF IT'S
; ALREADY IN THE CORRECT PLACE
;506 LISTNG(14) 10056 LINESEQUENCED FILES KILL LOW LEVEL BUFFERING
;507 GCMNSB(100) ----- FIX EDIT 440 TO ALLOW NEXTUP OF .O WHICH
; CAME FROM .R IN MOVCNST IF MOM IS
; ARITHMETIC
;510 CMPLEX(132) ----- DON'T TEST ALCRETREGFLG IN DATAOPR NODES
;511 ERROUT(39) ----- FIX E37,E79,E100 TO AGREE WITH ERROVD
; FIX AND MOVE E140 FROM [443]
; FIX SPELLING IN E74
; ERROVD(2) FIX E140
;512 COMMAN(512) ----- MAKE /MAP FROM [476] CALLED /LNMAP SINCE
; /MAP/LMAP ARE LOAD COMPIL SWITCHES
;513 GCMNSB(101) QA771 IN MOVCNST WHEN .O IS CREATED, PASS UP
; ORFIXFLG FROM ANY .O BEING SUBSUMED
; CHANGE [507] TO FREE VARAIBLE T IN MOVCNST
;514 GCMNSB(102) QA806 IN MOVCNST IF NARY INSURE .R IS 1ST ARG
; SINCE [V5] CODE ASSUMES .R + X
;515 VER5(4) QA815 REMOVE "TEMP [EXPRUSE] _ 1" IN DOTORFIX
;
; BEGIN VERSION 5A, 7-NOV-76
;
;516 COMMAN(516) 21215 FIND FILES WITH BLANK EXTENSIONS IN SFDS
;517 COMMAN(517) 21238 MAKE SFD'S IN COMMAND STRINGS WORK.
;520 COMSUB(261) 21271 PROHIBIT NEGATIONS IN RELATIONAL COMSUBS
;521 STA1(65) QA900 FIX PARAMS TO FATLEX IN OPENCLOSE
;522 STREGA(214) 20819 CHECK NEGFLGS FOR ARRAYREFS IN IOLISTS
;523 COMMAN(523) QA1038 FIX DEFAULT FLAG SETTINGS FOR SCAN:
; SWITCHES COUNT FROM LEFT NOT RIGHT
;524 COMSUB(262) QA876 PUT BACK ARRAY REF IN STPRECLUDE SO HASH
; ENTRY TAKEN OUT OF TREE
; CALL STPRECLUDE BEFORE CMNMAK SO CAN
; HASH SKEWED TREE WITH NEG FLAGS
; UNCHANGED
;525 VER5(5) QA949 DO CORRECT TYPECNV IN DOTOFIX ONLY IF
; NECESSARY
;526 GCMNSB(103) QA1035 IN CHKDOM IF FNARY AND NO MATCH ON
; "FUNC(ARRAYREF), PUT BACK ARRAYREF
; SO HASH TBL ENTRY NOT IN TREE
;527 STREGA(215) 20317 BAD CODE FOR ASSOCIATE VARS IN COMMON
;530 P2S2(54) 21606 BAD CODE FOR DOUBLE PRECISION SPECOPS
; WHICH GENERATED FSC INSTRUCTIONS
;531 STA1(66) 20323 GIVE WARNING WHEN SUBROUTINE PARAMETER
; ERROUT(40) IS USED AS ASSOCIATE VARIABLE
;532 STREGA(216) 20323 FIX CODE GENERATION FOR AN ARRAY ELEMENT
; CGSTMN(127) USED AS AN ASSOCIATE VARIABLE
;533 STA2(44) 21796 INCLUDE STMNT DESTROYS LOCS 4400-4402
;534 STA3(60) 21817 INTERNAL COMPILER ERRORS IN FORTB CAUSED
; BY BADLY STRUCTURED STATEMENT FUNCTIONS
;535 GRAPH(125) 21809 INACCESSIBLE CODE WITH ZERO LINE NUMBER
;536 LEFTFM(23) ADD RCHAR TO ERR NAME PLIT
;537 LISTNG(15) 21811 BAD PRINTING OF ERROR CONTINUATION LINE
;540 STA2(45) 22191 BAD COMMON STMNT GIVES ICE
;541 LISTNG(16) ----- -20 ONLY: CLEAR LASTCHARACTER IN READTXT
; AFTER ^Z SEEN SO MORE TTY: INPUT MAY
; BE DONE
;542 EXPRES(32) 22147 MAKE A NOT IMPLY TYPE LOGICAL ALWAYS.
;543 SRCA(50) ----- FIX BINARY SEARCH FOR LIBRARY NAME
;544 FIRST(127) 10290 FIND STMNT NODE TOO SMALL - EXPAND IT
;545 REGAL2(142) 22096 FUNCTION VALUES MUST GO INTO REALLY FREE REGS
;546 STREGA(217) 22030 FIX PROBLEMS WITH OPERATIONS WHICH CLOBBER
; FOLLOWING REGISTER (IDIV)
;547 LEXICA(17) 21280 (QAR863) FIX INITIAL TAB IN COLUMN 6 TO
; GO TO COL 7 ON AN INITIAL LINE OR COL
; 6 IF A CONTINUATION LINE
;550 REGAL2(143) 21824 FIX REG ALLOCATION FOR BIG EXPRESSION
;551 TABLES(155) 21826 FIX TYPE CONVERSION DURING CODE GENERATION
;552 REGAL2(144) 21826 GENERATE BETTER CODE FOR TYPE CONVERSION
; OF ARRAY REFERENCE
;553 P2S2(55) 21826 TYPE CONVERSION MAY BE NECESSARY IF LOGICAL
; OPERATION ABOVE IT IS LIQUIDATED
;554 REGAL2(145) 22324 AND NODE WITH THE NEGATION OF A FUNCTION
; CGEXPR(72) CALL BELOW IT GIVES BAD CODE
;555 LISTOU(60) 22281 FIX LINE NUMBER/OCTAL MAP WITH ENTRY POINTS
;556 LISTNG(17) ----- PUT /L IN HEADING OF PAGE IF OCTAL MAP REQUESTED
;557 COMMAN(557) ----- CATCH WILD PPN OR SFD AS ERROR
;560 COMMAN(560) ----- -20 ONLY: HANDLE PPNS IN THE COMMAND LINE CORRECTLY
;561 LISTNG(18) 10429 ALLOW CONTINUATION LINES AFTER PAGE
; LEXICA(18) MARKS AND FORM FEEDS
;562 PNROPT(150) 22540 IOLISTS IN OPTIMIZATIONS MAY KILL REG 0
;563 GNRCFN(32) 22541 SPURIOUS ERRORS IF FIRST ARG TO LIB FN
; IS OF UNACCEPTIBLE TYPE
;564 CGSTMN(130) 22693 MAKE CGREAD == CGWRIT: GENERATE FIN CALL
; ON UNFORMATTED WRITE WITH NO IOLIST
;565 GRAPH(126) 21810 EXTENDED RANGE DO LOOPS GIVES BAD GRAPH
;566 COMSUB(263) 22701 BAD COMSUBS WITH MANY NOT FLAGS
; AND SHAPE SKEW
;567 ACT1(110) 22284 EXTERNAL STMNT NOT REMEMBERED AT ENTRY POINTS
;570 STA3(61) 22703 BAD STMNT FN GIVES ICE (FN(2,3))
;571 FIRST(130) 22378 ADD IDUSECNT DEFINITION
; TABLES(156) ADD ARALINK DEFINITION
; ACT1(111) FIX V5 OPT THAT SHARES 2ND OFFSET OF FORMAL
; ARRAY IF 1ST DIMS = SO ALL WILL WORK IF
; ARRAY SUBSEQUENTLY TYPED DIFFERENT #
; WORDS THAN WHEN SHARING 1ST DONE
; DRIVER(19) DEFINE & CALL CLERIDUSECNT AT END OF MRP1
;572 ACT1(112) 21825 CHECK IMPLIED DO INDEX FOR ALREADY ACTIVE
; (FROM ENCLOSING IMPLIED OR REAL DO)
;573 DBUGIT ----- NEW REQUIRE FILE TO HOLD DBUGIT FLAG
; IOFLG(11) REMOVE "BIND DBUGIT="
; DRIVER(20) REQUIRE DBUGIT.REQ
; INOUT(40)
; LEXICA(19)
; LEXSUP(11)
;574 SRCA(51) ----- REWRITE BINARY SEARCH IN SRCHLIB TO WORK
; AFTER EDIT 543
;575 DEFPT(119) 22820 REWRITE ZAPLEVEL TO PREVENT STACK OVERFLOW
; FOR VERY LARGE BRANCHING PROGRAM.
;576 GRAPH(127) 22796 FIX LINE NUMBER GIVEN FOR INFINITE LOOP
;577 TSTR(54) 22352 DO LOOP WITH A CALL STATEMENT INSIDE MUST
; MATERIALIZE LOOP VARIABLE IF IT IS IN COMMON
;600 REGAL2(146) 22990 MORE EFFICIENT STACK USAGE IN FORTE
;601 ACT1(113) Q20-26 FIX EDIT 572 TO CHECK IMPLIED DO INDEX
; IN DATA STATEMENTS FOR ALREADY ACTIVE
; FROM ENCLOSING IMPLIED DO
;602 COMSUB(264) 22700 OPTIMIZED IOLISTS WITH SKEWED EXPRESSIONS
; MAY GENERATE ELISTS INCORRECTLY
;603 ACT0(53) 23442 ADD * AS INITIAL CHAR FOR LABEL CONSTANT
;604 OUTMOD(72) 23425 FIX LISTING OF COMMON BLOCK SO THAT WE
; DO NOT GET AN EXTRA CARRIAGE RETURN
;605 TSTR(55) 23478 BAD CODE WITH /OPT FOR ASGMNT STMNT WITH
; LHS LIKE A(I/2) OR A(I**5)
;606 CNSTCM(67) 22795 SOME OVERFLOWS DURING CONSTANT FOLDING
; NOT DETECTED AND POOR CODE GIVEN.
;607 GLOBAL(100) 22685 MAKE NEW GLOBAL NEDZER TO INDICATE IF
; ZERO-ARG-BLOCK NEEDED
; CGDO(137) SET NEDZER IN CGSBPRGM TO "0-A-B NEEDED"
; CGSTMN(131) SET NEDZER IN CGEND, CGSTOP & CGPAUS TO
; "0-A-B NEEDED"
; PHA3(52) GENERATE 0-A-B ONLY IF NEEDED
;610 P2S2(56) 23333 BAD CODE FOR COMSUB WITH NEG FLAG
; REPLACES EDIT 345.
;611 OPGNTA(120) 23662 IMMEDIATE SIZE COMPLEX CONSTANTS CAUSE
; TROUBLE FOR CODE GENERATION.
;612 IOPT(52) 23263 INITIALIZE ARRCOUNT IN IOCLEAR (THIS
; COMPLETES EDIT 406).
;613 CGDO(140) QA2114 IGNORE INDIRECT BIT IN FORMAL FUNCTION
; TARGET IN ENTRY PROLOGUE
;614 LISTOU(61) 23760 OUTPUT ONLY NON-BLANK LINES ON /LNMAP
;615 PH3G(245) 23116 BE CAREFUL WITH LABELS WHEN PRELOADING
;616 STREGA(218) 22345 I/O LIST UNDER REGISTER SCARCITY GIVES ICE
;617 UTIL(87) QA2121 ONLY TRY TO SUBSTITUTE THE SUBSCRIPT OF
; AN ARRAYREF IF IT ISN'T A CONSTANT
;620 COMSUB(265) 23720 D.P. ARRAY REF IN IO LIST CAUSES PROBLEMS
; DURING OPTIMIZATION (IOLSCLS NODE PTRS)
;621 LISTNG(19) QAR2120 ACCOUNT FOR PAGE MARKS AT END OF FILE.
;END REVISION HISTORY
PAGE
SUBTTL VERSION NUMBER
LASTED==0 ;LAST EDITOR
MAJVER==5 ;MAJOR VERSION NUMBER
MINVER==1 ;MINOR VERSION NUMBER
EDNUM==621 ;EDIT NUMBER
JOBVER=137
LOC JOBVER
EXP <LASTED>B2+<MAJVER>B11+<MINVER>B17+<EDNUM>
ENTRY NXTFIL
SEARCH FTTENX ;ASSEMBLY TIME SWITCHES
;**[560] INSERT AFTER "SEARCH FTTENX" SJW 6-APR-77
IFN FTTENX,< SEARCH MONSYM > ;[560]
IF2,<
IFE FTTENX, <PRINTX ASSEMBLING FORTRAN-10 COMMAN>
IFN FTTENX, <PRINTX ASSEMBLING FORTRAN-20 COMMAN>
> ;[560]
;**;[271],COMMAN,JNT,02-MAY-75
;**;[271],VERSION NUMBERS+2
SEARCH C,SCNMAC ;[271]
PAGE
SUBTTL SYMBOLIC DEFINITIONS
RELOC 400000
;AC'S USED COMMAND SCANNER
F=0 ;FLAGS
T1=1 ;TEMP
T2=2 ; ..
T3=3 ; ..
T4=4 ; ..
P1=5 ;PRESERVED AC
P2=6 ; ..
N=7 ;NUMBER AC
C=10 ;CHARACTER AC
IFN FTTENX,< VREG=15 ;BLIS10 VALUE RETURN REG>
FREG=16 ;STACK FRAME POINTER
P=17 ;PUSH DOWN POINTER
;I/O CHANNELS
BIN==1 ;REL FILE OUTPUT
LST==2 ;LISTING FILE OUTPUT
SRC==3 ;SOURCE FILE INPUT
IFN FTTENX,< ICL==4 ;INCLUDE FILE INPUT>
;OFFSETS INTO CHNLTBL
TBLMAX==^D10
IFN FTTENX,< JFN==0>
HDR==3
PNT==4
CNT==5
;FLAG BITS IN F (SEE IOFLG.BLI BEFORE CHANGING THESE BITS)
SW.OPT==1B35 ;GLOBAL OPTIMIZE
SW.NET==1B34 ;NO ERRORS ON TTY
SW.MAC==1B33 ;MACRO CODE
SW.IDS==1B32 ;INCLUDE DEBUG STATEMENTS
SW.EXP==1B31 ;EXPAND
SW.DEB==1B30 ;DEBUG
SW.CRF==1B29 ;CREF
LSTFLG==1B25 ;LISTING FILE BEING MADE
SW.KAX==1B24 ;KA-10 FLAG
RELFLG==1B22 ;REL FILE BEING MADE
SW.PHO==1B10 ;PEEP HOLE OPTIMIZE
COMKA==1B12 ;COMPILING ON A KA-10
SW.OCS==1B13 ;ONLY CHECK SYNTAX
EOCS==1B28 ;END OF COMMAND STRING
;**[476] COMMAN @394 SJW 14-OCT-76 (REPLACE SW.TIM)
SW.MAP==1B16 ;[476] LINE NUMBER/OCTAL LOCATION MAP
SW.BOU==1B5 ;ARRAY BOUNDS CHECKING SWITCH
TTYDEV==1B1 ;LISTING ON TTY:
SW.NOW==1B2 ;DON'T PRINT WARNING MESSAGES
EXTERN FLAGS2 ;SECONDARY FLAG REGISTER
TTYINP==1B0 ;INPUT DEVICE IS A TTY
IFN FTTENX,<
; GTJFN BITS
OLDFIL==100000 ;OLD FILE ONLY
OUTPUT==400000 ;FOR OUTPUT
XWILD==000100 ;ACCEPT WILD FIELDS
SHORT==000001 ;SHORT FORM
; OPENF
INBYT==440000 ;NON-TTY INPUT BYTE SIZE
BINBYT==440000 ;BINARY BYTE SIZE
LSTBYT==070000 ;LISTING BYTE SIZE
TTYBYT==070000 ;TTY INPUT BYTE SIZE
READ==200000 ;READABLE
WRITEE==100000 ;WRITEABLE
TTCODE==600012 ;TTY: DEVICE CODE
DSKCOD==600000 ;DSK: DEVICE CODE
; DEFAULT GTJFN TABLE FOR LISTING
LSTTAB: XWD OUTPUT,0 ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEVICE
0 ;DIRECTORY
0 ;FILENAME
XWD -1,[ASCIZ /LST/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT GTJFN TABLE FOR BINARY OUTPUT FILE
BINTAB: XWD OUTPUT,0 ;FLAGS,DEFAULT VERSION
XWD 377777,377777 ;NO JFN'S
0 ;DEVICE
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /REL/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT TABLE FOR SOURCE INPUT
SRCTAB: XWD OLDFIL!XWILD,0 ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEV
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /FOR/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT TABLE FOR INCLUDE INPUT
ICLTAB: XWD OLDFIL,0 ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEV
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /FOR/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
JSYS==104000000000
OPDEF DVCHR [JSYS 117]
OPDEF GNJFN [JSYS 17]
OPDEF GTJFN [JSYS 20]
OPDEF OPENF [JSYS 21]
OPDEF PSOUT [JSYS 76]
OPDEF CLOSF [JSYS 22]
OPDEF ERSTR [JSYS 11]
OPDEF GTINF [JSYS 13]
> ;END TOPS-20 ONLY
;DEFAULTS
DM ADV,1,0,1
DM BAK,1,0,1
DM BOU,1,0,1
DM BUG,377777,0,1
DM CRF,1,0,1
DM DEB,1,0,1
DM EXP,1,0,1
DM INC,1,0,1
DM MAC,1,0,1
DM NOE,1,0,1
DM WEO,1,0,1
DM ZER,1,0,1
DM OPT,1,0,1
DM OCS,1,0,1
DM NOW,1,0,1
DM MAP,1,0,1 ;[476] REPLACE DM TIM
ND PDLLEN,^D500 + ^D600 ;LENGTH OF PDL
;NOTE THE ADDITION OF 600 OF SPACE TO PDLLEN!!!
;SEEDECLARATION POOLSIZ IN FIRST.BLI
;THIS SPACE WILLACTUALLY BE OCCUPIED BY
;THE GLOBAL VECTORS STK AND POOL SO THAT
;MORE SPACE FOR THE STACK CAN BE MADE AVAILABLE
; TO HIGHLY RECURSIVE OPERATIONS
;THAT MAY OCCUR IN THE COMPILER
;DEFAULT FLAG SETTINGS
;**[476] COMMAN @437 SJW 14-OCT-76 ADD DEFAULT SETTING OF /MAP = OFF
;**[523] COMMAN @556 SJW 17-DEC-76 FIX DEFAULT SETTINGS: SWITCHES
;[523] COUNT FROM LEFT NOT RIGHT
INDADF: EXP <<AD.MAP>_<43-^L<SW.MAP>>> !
<<AD.CRF>_<43-^L<SW.CRF>>> !
<<AD.DEB>_<43-^L<SW.DEB>>> !
<<AD.EXP>_<43-^L<SW.EXP>>> !
<<AD.INC>_<43-^L<SW.IDS>>> !
<<AD.MAC>_<43-^L<SW.MAC>>> !
<<AD.NOE>_<43-^L<SW.NET>>>
EXTERNAL DEBGSW
DEFINE SWTCHS,<
SP ADVANCE,FAREA+F.ADV,.SWDEC##,ADV
SP BACKSPACE,FAREA+F.BACK,.SWDEC##,BAK
;SP BOUNDS,<POINTR(SAVEF,SW.BOU)>,.SWDEC##,BOU
SP BUGOUT,<POINT 18,BUGINT,35>,.SWOCT##,BUG
SP CROSSREF,<POINTR(SAVEF,SW.CRF)>,.SWDEC##,CRF
SL DEBUG,DEBGSD,BUGK,-1,FS.OBV
SP EXPAND,<POINTR(SAVEF,SW.EXP)>,.SWDEC##,EXP
SS KA10,<POINTR(SAVEF,SW.KAX)>,1
SS KI10,<POINTR(SAVEF,SW.KAX)>,0
SP INCLUDE,<POINTR(SAVEF,SW.IDS)>,.SWDEC##,INC
SP *MACROCODE,<POINTR(SAVEF,SW.MAC)>,.SWDEC##,MAC
SP *LNMAP,<POINTR(SAVEF,SW.MAP)>,.SWDEC##,MAP ;[512][476] REPLACE TIME
SP NOERRORS,<POINTR(SAVEF,SW.NET)>,.SWDEC##,NOE
SP NOWARNING,<POINTR(SAVEF,SW.NOW)>,.SWDEC##,NOW
SP *OPTIMIZE,<POINTR(SAVEF,SW.OPT)>,.SWDEC##,OPT
SP *SYNTAX,<POINTR(SAVEF,SW.OCS)>,.SWDEC##,OCS
SP TAPEND,FAREA+F.WEOF,.SWDEC##,WEO
SP ZERO,FAREA+F.DTZR,.SWDEC##,ZER
>
KEYS BUGK,<DIMENSIONS,LABELS,INDEX,TRACE,BOUNDS>
XALL
DOSCAN(FORT)
SALL
IFE FTTENX,<
PAGE
SUBTTL TOPS-10 COMPILER INITIALIZATION
MRP0:: ;SINGLE SEGMENT ENTRY POINT
FORTRA: TDZA T1,T1 ;FLAG AS NORMAL ENTRY
MOVEI T1,1 ;FLAG AS CCL ENTRY
MOVEM T1,CCLSW## ;SAVE CCL SWITCH
SKIPE T1,GETSBL## ;HAVE WE BEEN HER BEFORE?
JRST FORTR1 ;YES MUST BE DOING ^C START
MOVEM 11,GETSBL## ;STORE DEVICE NAME FROM RUN
MOVEM 7,GETSBL+4 ;STORE FILE NAME FROM RUN COMMAND
FORTR1:
MOVE T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
SETZM FIRZER ; ..
BLT T2,LASZER ; ..
JUMPPT (T1,CP166,KA10) ;FIGURE OUT TYPE OF CPU
TDZA T1,T1 ;KI-10 CLEAR FLAG
KA10: MOVX T1,SW.KAX!COMKA ;KA-10 SET FLAG
IORM T1,SAVEF ;STORE SWITCH IN MEMORY
RESET ;RESET ACTIVE I/O
MOVE T1,.JBFF## ;START OF CORE
CORE T1, ;REMOVE CRUFT FROM PREVIOUS JOBS
JFCL ;DO NOT CARE IF IT FAILS
;
MOVE P,[IOWD PDLLEN,STACK##] ;PUSH DOWN LIST
HRRZI FREG,(P) ;LIFE IS BLISS
MOVE T1,[2,,[EXP 0
XWD CCLSW##,'FOR']]
PUSHJ P,.ISCAN## ;FIRE UP SCAN
COMND:
;[130] INITIALIZE APR TRAP
;
; SET UP TRAP FOR
;
; AP.POV PUSHDOWN OVERFLOW
; AP.ABK ADDRESS BREAK (FUTURE)
; AP.ILM MEMORY PROTECTION VIOLATION
; AP.NXM NON-EXISTENT MEMORY
;
MOVEI T1,APRTRP ;[130] LOCATE TRAP ROUTINE
MOVEM T1,.JBAPR## ;[130] TELL THE MONITOR WHERE TRAP OCCURS
MOVEI T1,AP.POV!AP.ABK!AP.ILM!AP.NXM ;[130] SET CONDITIONS
APRENB T1, ;[130] ENABLE TRAPS
;
;SCAN NEXT LINE
MOVE T1,[10,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1
XWD CLRALL,CLRFIL
XWD ALLIN,ALLOUT
XWD MEMSTK,APPSTK
XWD CLRSTK,1B18
XWD 0,.POPJ1##]]
PUSHJ P,.TSCAN## ;SCAN 1 COMMAND LINE
MOVE T1,[4,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1]]
PUSHJ P,.OSCAN## ;SCAN THE OPTIONS FILE
PUSHJ P,ABSDEF ;FILL IN ABSENT DEFAULTS
SKIPN T1,FINPTR ;CHECK FOR NO INPUT FILES
JRST FORTR1 ;NO INPUT FILES
PUSHJ P,GETSIZ ;CALCULATE MAXIMUM BUFFER CORE REQUIREMENTS
PUSHJ P,NXTFIL ;GET THE NEXT FILE
JRST FORTR1 ;NO INPUT FILES GIVEN
MOVE T1,LBLOCK+.RBALC;GET THE NUMBER OF BLOCKS ALLOCATED
MOVEM T1,LBLOCK+.RBEST; AND ESTIMATE THAT AS THE SIZE OF
SETZM LBLOCK+.RBALC ; EACH OUTPUT FILE.
SKIPN T2,RELSPC+F.DEV ;IS THERE A REL DEVICE
JRST NOREL ;NONE TRY LISTING
MOVE T2,RELSPC+F.MOD ;CHECK FOR NUL DEVICE AND NAME
TXNN T2,FX.NDV ;NO SKIP MEANS DEVICE THERE
JRST ISREL
SKIPN RELSPC+F.NAME ;NO SKIP MEANS DEVICE THERE
JRST NOREL ;NO NAME SPECIFIED
ISREL:
MOVE T2,RELSPC+F.DEV ;SET UP OPEN BLK
TXO F,RELFLG ;LIGHT THE REL FILE BIT FOR OUTMOD
MOVEI P1,RELSPC ;POINTER TO FILESPEC
PUSHJ P,MTMODE ;SET UP MODE FOR MAG TAPE
ADDX T1,.IOBIN ;BINARY MODE
MOVSI T3,BINHDR ;HEADER POINTER
OPEN BIN,T1 ;OPEN THE DEVICE
JRST OPNERR ;CAN NOT DO IT!!!
PUSHJ P,SETENT ;SET UP FOR ENTER
JRST ERRST ;FILE NAME ERROR
MOVEI T1,BIN
DEVCHR T1,
TXNN T1,DV.DTA ;IS DEVICE A DECTAPE
JRST REL1 ;NO
ENTER BIN,LBLOCK+2
JRST UUOERR
JRST REL2
REL1:
ENTER BIN,LBLOCK ;ENTER IN UFD
JRST UUOERR
REL2:
OUTBUF BIN,0 ;SET UP O/P BUFFER
NOREL:
SKIPN T2,LSTSPC+F.DEV ;IS THERE A LISTING DEVICE
JRST NOLST ;NONE TODAY
MOVE T2,LSTSPC+F.MOD ;SAME AS FOR .REL FILE
TXNN T2,FX.NDV
JRST ISLST
SKIPN LSTSPC+F.NAME
JRST NOLST ;NO LISTING IF ZERO
ISLST:
MOVE T2,LSTSPC+F.DEV ;SET UP OPEN BLK
; MOVE T3,LSTSPC+F.MOD
; JRST NOLST
TXO F,LSTFLG ;FLAG THAT A LISTING IS NEEDED
MOVEI P1,LSTSPC ;LISTING SPEC POINTER
MOVE T3,LSTSPC+F.MOD ;GET MODIFIERS
TXNE F,SW.CRF ;CREF ?
TXNN T3,FX.NUL ;NUL EXTENSION?
JRST NOCREF ;NOT CREF OR EXTENSION ALREADY SPECIFIED
; MOVE T3,LSTSPC+F.EXT
; JUMPL T3,NOCREF ;SKIP IF EXPLICIT EXTENSION
MOVEI T3,'CRF'
HRLM T3,F.EXT(P1) ;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
PUSHJ P,MTMODE ;SET T1 FOR MAG TAPE MODE
ADDX T1,.IOASC ;ASCII MODE
MOVSI T3,LSTHDR ;POINTER TO BUFFER HEADER
OPEN LST,T1 ;OPEN THE DEVICE
JRST OPNERR ;CAN NOT OPEN DEVICE
PUSHJ P,SETENT ;SET UP FOR ENTER
JRST ERRST ;FILE NAME ERROR
MOVEI T1,LST ;SKIP RETURN OK
DEVCHR T1,
TXNE T1,DV.TTA
TXO F,TTYDEV ;SET BIT ON IF LST DEVICE IS TTY
TXNN T1,DV.DTA ;IS DEVICE A DECTAPE
JRST LST1 ;NO
ENTER LST,LBLOCK+2
JRST UUOERR
JRST LST2
LST1:
ENTER LST,LBLOCK ;ENTER THE FILE
JRST UUOERR
LST2:
MOVE T1,F.NAME(P1) ;GET LISTING FILENAME
MOVEM T1,CHNLTB##+20 ;STORE FOR USE IN PHASE1
OUTBUF LST,0 ;SET UP O/P LST BUFFER
NOLST: MOVEI T1,[ASCIZ /%FTNNOF No output files given
/]
TXNN F,RELFLG!LSTFLG!SW.OCS ;ANY OUTPUT REQUESTED?
PUSHJ P,.TSTRG## ;NO--GIVE THE WARNING
LOOP:
SKIPN T1,CCLSW
JRST BYNAM
MOVEI T1,[ASCIZ /FORTRAN: /]
PUSHJ P,.TSTRG##
SKIPE T1,CHNLTB##+32 ;GET FILE NAME IF ANY
PUSHJ P,.TSIXN## ;TYPE AS SIXBIT
PUSHJ P,.TCRLF## ;GIVE AN EOL
BYNAM:
MOVE T1,DEBGSD ;MOVE LOCAL TO GLOBAL - MACRO BUG
MOVEM T1,DEBGSW##
MOVE T1,BUGINT
MOVEM T1,BUGOUT## ;INTERMEDIATE OUTPUT REQUEST SWITCHWES
SETZM SEGINCORE## ;ARGUMENT TO PHASE CONTROL
PUSHJ P,PHAZCONTROL## ;GET THE NEXT PHASE
LOOPDN:
CLOSE LST,
CLOSE SRC,
CLOSE BIN,
MOVE T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
SETZM FIRZER ; ..
BLT T2,LASZER ; ..
JUMPPT (T1,CP166,KA102) ;FIGURE OUT TYPE OF CPU
TDZA T1,T1 ;KI-10 CLEAR FLAG
KA102: MOVX T1,SW.KAX!COMKA ;KA-10 SET FLAG
IORM T1,SAVEF ;STORE SWITCH IN MEMORY
RESET ;RESET ACTIVE I/O
MOVE T1,.JBFF## ;START OF CORE
CORE T1, ;REMOVE CRUFT FROM PREVIOUS JOBS
JFCL ;DO NOT CARE IF IT FAILS
JRST COMND ;INITIALIZE AND LOOK FOR NEXT COMMAND
PAGE
SUBTTL SUBROUTINES CALLED FROM .TSCAN
;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL: SKIPA T2,[LSTCLR] ;THE WHOLE THING
;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL: MOVEI T2,FAREA+F.LEN ;JUST CLEAR F AREA
MOVE T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
SETZM FIRZER ; ..
BLT T1,(T2) ; TO THE END
POPJ P, ; ..
;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT: AOS T3,OUTCNT ;T3 = COUNT OF OUPUT FILES
MOVE T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
MOVEI T2,F.SLEN ;T2 = LENGTH OF SPEC
CAIG T3,2 ;TOO MANY SPECS?
POPJ P, ;NO--ALL DONE
M.FAIL <FTNTOF More than 2 output files are not allowed>
;SUBROUTINE TO ALLOCATE AN INPUT AREA
ALLIN: SKIPE T1,LINPTR ;ANY LAST INPUT SPEC?
JRST ALLIN1 ;YES--MAKE ANOTHER
MOVE T1,.JBFF## ;FIRST INPUT SPEC GOES HERE
MOVEM T1,FINPTR ;SAVE FOR LATER
SUBI T1,F.LEN ;FIX UP SO FIRST SPEC IS CORRECT
MOVEM T1,LINPTR ;SAVE AWAY
ALLIN1: MOVEI T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
CAMGE T2,.JBREL## ;WILL IT FIT?
JRST ALLIN2 ;YES--CONTINUE
CORE T2, ;NO--EXPAND CORE
JRST E.NCF ;NO CORE--YOU LOOSE
ALLIN2: MOVEI T1,F.LEN ;LENGTH OF SPEC
ADDM T1,.JBFF## ;UPDATE JOBFF
ADDB T1,LINPTR ;UPDATE T1 AND POINTER
MOVEI T2,F.SLEN ;AMOUNT SCAN KNOWS ABOUT
POPJ P, ;RETURN
;SUBROUTINE TO CLEAR STICKEY DEFAULTS
CLRSTK: SETZM PAREA ;ALL THE STICKEY DEFAULTS
MOVE T1,[PAREA,,PAREA+1] ; ..
BLT T1,PAREA+F.LEN-1; ARE IN THE PAREA
POPJ P,
XALL
DEFINE MEM(A),<
IRP A,<
SKIPE T1,FAREA+F.'A ;IS A SPECIFIED?
MOVEM T1,PAREA+F.'A ;YES--REMEMBER A
>>
;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS
MEMSTK: MEM (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
DEFINE APPLY(A),<
IRP A,<
MOVE T1,PAREA+F.'A ;PICK UP STICKEY DEFAULT FOR A
SKIPN FAREA+F.'A ;IS A LOCAL OVER RIDE PRESENT
MOVEM T1,FAREA+F.'A ;NO--APPLY THE DEFAULT
>>
;SUBROUTINE TO APPLY STICKEY DEFAULTS
APPSTK: APPLY (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
SALL
PAGE
SUBTTL SUBROUTINES FOR COMMAND SCANNING
;SUBROUTINE TO APPLY ABSENT DEFAULTS
ABSDEF: SETCM F,SAVEFM ;T1 GETS A 1 BIT FOR EVERY BIT IN F
; WHICH WAS NOT EXPLICITLY SPECIFIED
; BY THE USER.
AND F,INDADF ;AND WITH THE DEFAULTS.
IORB F,SAVEF ;OR IN THE SELECTED BITS.
MOVEI T1,RELSPC ;POINT AT REL FILE
HRLOI T2,'REL' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;FILL IN DEFAULT
MOVEI T1,LSTSPC ;POINT TO LISTING FILE SPEC
HRLOI T2,'LST' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;FILL IN DEFAULT
MOVE T1,FINPTR ;POINT TO FIRST INPUT SPEC
ABSDF1: HRLOI T2,'FOR' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;GO DEFAULT IT
CAMN T1,LINPTR ;LAST INPUT POINTER
POPJ P, ;YES--ALL SET UP
ADDI T1,F.LEN ;POINT TO NEXT SPEC
JRST ABSDF1 ;LOOP FOR NEXT SPEC
;SUBROUTINE TO FILL IN A DEFAULT EXTENSION
;CALL WITH:
; T1 = FILE SPEC POINTER (PRESERVED)
; T2 = EXTENSION
; PUSHJ P,DEFEXT
; RETURN HERE
DEFEXT: HLRZ T3,F.EXT(T1) ;GET EXTENSION
JUMPN T3,.POPJ## ;ALL DONE IF IT WAS GIVEN
HRRE T3,F.EXT(T1) ;EXPLICITLY NULL
AOJE T3,.POPJ## ;JUMP IF YES
MOVEM T2,F.EXT(T1) ;NO--SET UP DEFAULT
POPJ P, ; RETURN
PAGE
SUBTTL LOOKUP/ENTER SUBROUTINES
;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
; PUSHJ P,NXTFIL
; NOTHING FOUND
; SPEC POINTER IN P1
NXTFIL: MOVE T1,[4,,[XWD FINPTR,LINPTR
XWD OBLOCK,LBLOCK
XWD F.LEN,.RBALC
EXP 1B0+<SRC>B17+LKTEMP]]
PUSHJ P,.LKWLD## ;SCAN THE DISK OR TAPE
POPJ P, ;NON-SKIP WHEN DONE
MOVE P1,LKTEMP ;POINTER TO CURRENT SPEC
CAMN P1,LINPTR ;SAME AS LAST SPEC
SKIPE .WLDFL## ; AND NO WILD CARDS?
TXZA F,EOCS ;NO--MAY BE MORE
TXO F,EOCS ;YES--THIS IS THE LAST SPEC.
PUSHJ P,OPENIN ;OPEN THE INPUT FILE
MOVE T1,F.NAME(P1) ;GET SRC FILENAME
MOVEM T1,CHNLTBL##+32 ;PUT IN TABLE TO BE LOOKED
; AT BY LISTING HEADER
MOVE T1,F.EXT(P1) ;EXTENSION
MOVEM T1,CHNLTBL+33 ;EXTENSION FIELD FOR SRC
;ROUTINE IN CLASS
JRST .POPJ1## ;SKIP RETURN
;SUBROUTINE TO OPEN THE INPUT FILE
;CALL WITH:
; P1 = FILE SPEC POINTER
; PUSHJ P,OPENIN
; RETURN HERE
OPENIN: HRRZI T1,SRCHDR ;BUFFER HEADER
MOVEM T1,OBLOCK+2 ;STORE IN OPEN BLOCK
OPEN SRC,OBLOCK ;OPEN THE DEVICE
JRST OPNER1 ;OPEN ERROR
MOVEI T1,SRC
DEVCHR T1,
MOVE T2,FLAGS2## ;SECONDARY FLAG REGISTER
TXNE T1,DV.TTY ;IS DEVICE A TTY
TXOA T2,TTYINP ;YES
TXZ T2,TTYINP ;NO
MOVEM T2,FLAGS2## ;SAVE IT
;**;[516] Insert @ OPENIN+11L JNG 9-Nov-76
PUSH P,LBLOCK+.RBPPN ;[516] SAVE .RBPPN OVER LOOKUP
TXNN T1,DV.DTA ;IS DEVICE DECTAPE
JRST OPEN1 ;NO
LOOKUP SRC,LBLOCK+2 ;DO DIFFERENT LOOKUP
JRST OPNER2
JRST OPEN2
OPEN1:
LOOKUP SRC,LBLOCK ;LOOKUP THE FILE
JRST OPNER2 ;NO CAN DO
OPEN2:
;**;[516] Insert @ OPEN2 JNG 9-Nov-76
POP P,LBLOCK+.RBPPN ;[516] RESTORE .RBPPN TO WHAT USER SAID
MOVE T2,OBLOCK ;T2 GETS THE DEVICE NAME
PJRST MTAOP ;POSITION MAG TAPE
OPNER1:
PUSHJ P,E.DFO##
ERRST: ;ERROR ENTRY
SKIPE T1,CCLSW
JRST COMND
JRST FORTR1 ;LOOP BACK
OPNER2:
;**;[516] Insert @ OPNER2 JNG 9-Nov-76
POP P,LBLOCK+.RBPPN ;[516] RESTORE .RBPPN FROM LOOKUP ERROR
HRRZ T1,LBLOCK+.RBEXT
JUMPN T1,OPNE2A ;EXPLICIT EXTENSION FILE LOOKUP ERROR
MOVX T1,FX.NUL ;NULL EXT MASK
TDNN T1,F.MOD(P1) ;WAS NULL EXTENSION INPUT?
JRST OPNE2A ;NO
ANDCAM T1,F.MOD(P1) ;YES,TURN OFF THAT BIT TO AVOID ALOOP
HRRZS LBLOCK+.RBEXT ;ZERO THE EXTENSION FIELD IN LOOKUP BLOCK
JRST OPENIN ;TRY AGAIN WITH NULL EXTENSION
OPNE2A:
PUSHJ P,E.DFL## ;TRY AGAIN AFTER ERROR MESSAGE
SKIPE T1,CCLSW
JRST COMND
JRST FORTR1 ;LOOP BACK
; SUBROUTINE TO CALCULATE THE MAX CORE REQUIREMENTS FOR THE LIST
; OF INPUT FILES. CHECK THE
; LIST OF FILES AND SAVE THE REQUIREMENTS OF THE LARGEST.
; CALL WITH:
; PUSHJ GETSIZ
; RETURN HERE
GETSIZ:MOVE T1,FINPTR ;FIRST FILE AREA
SETZM BGSTBF## ;CLEAR LARGEST SAVE LOCATION
GETSI2: ;SET UP ARG BLOCK
MOVEI T2,0 ;STATUS
MOVE T3,F.DEV(T1) ;DEVICE NAME
MOVEI T4,T2 ;ARG BLOCK ADDRESS
DEVSIZ T4, ;GET DEFAULT NUMBER AND SIZE OF BUFFERS
MOVE T4,[2,404] ;ASSUME OLD MONITOR - 2 DSK BUFFERS
JUMPLE T4,GETSI1 ;IGNORE ANY ERRORS
;SOMEONE ELSE WILL CATCH THEM
HLRZ T3,T4 ;MOVE NUMBER OF BUFFERS
HRRZ T4,T4 ;ZERO T4<LEFT>
IMUL T4,T3 ;TOTAL SIZE
CAMLE T4,BGSTBF## ;IS THIS LARGEST SO FAR?
MOVEM T4,BGSTBF## ;YES - SAVE IT
GETSI1:
CAMN T1,LINPTR ;ARE WE DONE?
POPJ P, ;YES
ADDI T1,F.LEN ;NO - DO NEXT ONE
JRST GETSI2
;SUBROUTINE TO SET UP FOR AN ENTER
;CALL WITH:
; P1 = FILE SPEC POINTER
; PUSHJ P,SETENT
; RETURN HERE
SETENT: PUSHJ P,MTAOP ;POSITION THE TAPE
SETZM LBLOCK+.RBPPN
SETZM LBLOCK+.RBSIZ
SETZM LBLOCK+.RBVER
SETZM LBLOCK+.RBSPL
SETZM LBLOCK+.RBALC
MOVE T1,F.NAME(P1) ;PICK UP FILE NAME
MOVE T2,F.NAMM(P1) ;PICK UP FILE NAME MASK
AOJN T2,E.WILD ;CAN NOT BE WILD
MOVEM T1,LBLOCK+.RBNAM;STORE THE FILE NAME
HRRE T2,F.EXT(P1) ;GET THE EXTION MASK
AOJN T2,E.WILD ;MUST BE ALL SPECIFIED
HLLZ T2,F.EXT(P1) ;PICK UP THE EXTENSION
MOVEM T2,LBLOCK+.RBEXT;STORE FOR THE ENTER
LDB T1,[<POINTR(F.MOD(P1),FX.PRO)>] ;GET THE PROTECTION
ROT T1,-^D9 ;PUT IN THE LEFT 9 BITS
MOVEM T1,LBLOCK+.RBPRV;STORE FOR THE ENTER
MOVX T1,FX.DIR ;DIRECTORY SPECIFIED?
TDNN T1,.FXMOD(P1) ; ??
JRST .POPJ1## ;NO--ALL DONE
;**[557] @SETENT+19.5L SJW 6-APR-77
MOVE T2,F.DIRM(P1) ;[557] IS PPN WILD?
AOJN T2,E.WILD ;[557] YES == ERROR
MOVE T1,F.DIR(P1) ;PICK UP PPN
MOVEM T1,LBLOCK+.RBPPN;STORE FOR THE MOMENT
SKIPN F.DIR+2(P1) ;NEED ANY SFD'S TODAY
JRST .POPJ1## ;NO--ALL DONE
MOVEI T2,PATH ;YES--POINT ENTER TO PATH
MOVEM T2,LBLOCK+.RBPPN; ..
ADDI T2,2 ;SKIP PAST SWITCHES
MOVEM T1,(T2) ;STORE PPN
MOVEI T1,F.DIR+2(P1) ;POINT TO SFD LIST
;**[557] @SETEN1 SJW 6-APR-77
SETEN1: MOVE T3,1(T1) ;[557] IS SFD WILD?
AOJN T3,E.WILD ;[557] YES == ERROR
MOVE T3,(T1) ;PICK UP SFD
MOVEM T3,1(T2) ;STORE IN PATH
ADDI T1,2 ;SKIP TO NEXT SFD
;**;[517] Change @ SETEN1+3L JNG 11-Nov-76
SKIPE (T1) ;[517] IS IT THERE??
AOJA T2,SETEN1 ;YES--LOOP OVER IT
SETZM 2(T2) ;NO--END THE LIST
JRST .POPJ1##
;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH TAPE POSITIONED
MTAOP: POPJ P, ;NULL FOR NOW
;SUBROUTINE TO SET UP T1 AS A MODE WORD FOR MAG TAPES
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH T1 SET UP
MTMODE: SETZM T1 ;START WITH A CLEAN SLATE
POPJ P, ;RETURN
PAGE
SUBTTL ERROR CONDITIONS
CP166: OUTSTR [ASCIZ /?FTNPD6 FORTRAN will not run on a PDP-6
/]
CLRBFI
EXIT
E.NCF: MOVEI N,1(T2)
M.FAID <FTNNCF Not enough core for file specs. Total K needed=>
UUOERR: HRRZ T2,LBLOCK+.RBEXT
HRRZ N,P1
;**;[262],UUOERR+2L,JNT,23-MAR-75
SETZM LKTEMP ;[262] CLEAR .LKWLD STATE
CAIN T2,2
JRST EER02
CAIN T2,6
JRST EER06
CAIN T2,14
JRST EER14
M.FAIF <FTNETF ENTER failure>
EER02: M.FAIF <FTNPRF PROTECTION FAILURE>
EER06: M.FAIF <FTNRDE RIB or directory error>
EER14: M.FAIF <FTNQEF Quota exceeded or disk full>
;**[357], COMMAN @827, DCE, 19-MAR-76
;**[357], FIX ERROR REPORTING FOR OPEN FAILURES
OPNERR: MOVEM T2,.WILDZ## ;[357]COPY DEVICE NAME TO FSTR IN WILD
JRST OPNER1 ;GIVE ERROR MESSAGE
E.WILD: MOVE N,P1
MOVE T1,F.DEV(P1) ;GET DEVICE NAME
DEVTYP T1, ;GET THE DEVICE TYPE
HALT . ;CAN ONLY FAIL IF THERE IS A BUG IN FORTRAN
; SINCE FOROTS NEEDS THIS CALLI IT MUST EXIST
;**;[452], COMMAN @E.WILD+4L, DCE, 17-SEP-76
;**;[452], ALLOW NUL: AS ACCEPTIBLE SPECIFICATION!
TXNN T1,TY.INT ;[452] IF INTERACTIVE, ALWAYS OK
TXNN T1,TY.MAN ;LOOKUP/ENTER MANDATORY?
JRST .POPJ1## ;NO--IGNORE BAD FILE NAME
SETOM T2 ;YES--GIVE ERROR MESSAGE
;**;[262],E.WILD+8L,JNT,23-MAR-75
SETZM LKTEMP ;[262] CLEAR .LKWLD STATE
M.FAIF <FTNNWD Incorrect use of * or ? in>
; FOR ERROR MESSAGES.
XLIST
LIT:: LIT
LIST
PAGE
SUBTTL RESIDENT CODE
RELOC 0 ;IMPURE CODE
; CORE UUO FAILURE ROUTINE IS LOW SEGMENT RESIDENT
CORERR:: ;HERE WHEN CORE UUO FAILS
MOVEM T1,APRSV1 ;STORE T1
MOVEM T2,APRSV2 ;STORE T2
SOS T1,0(P) ;WHERE WERE WE CALLED FROM
HRRZM T1,.JBTPC## ;STORE ADDRESS
MOVEI T2,CORTXT ;LOCATE MESSAGE
JRST APRTR4 ;FINISH MESSAGE
CORTXT: ASCIZ \?FTNUCE USER CORE EXCEEDED\
; APR TRAP ROUTINE IS LOW-SEGMENT RESIDENT
; TEXT FOR APR TRAP ROUTINE
APRNXM: ASCIZ \ILLEGAL MEMORY REFERENCE\
APRPOV: ASCIZ \STACK EXHAUSTED\
APRILM: ASCIZ \MEMORY PROTECTION VIOLATION\
APRABK: ASCIZ \ADDRESS BREAK\
APRTX0: ASCIZ \
?INTERNAL COMPILER ERROR
?\
APRTX1: ASCIZ \ AT LOCATION \
APRTX2: ASCIZ \ IN PHASE \
APRTX3: ASCIZ \
?WHILE PROCESSING STATEMENT \
APRPN1: POINT 3,.JBTPC##,17 ;USEFUL BYTE POINTER
APRPN2: POINT 6,400005 ;USEFUL BYTE POINTER
APRIOR: ASCII \00000\ ;MAKE A NUMBER
;**;[126],HPW,APRTRP,3/5/74
APRTRP: JRSTF @.+1 ;[126] CLEAR FIRST PART DONE
0,,.+1 ;[126] CLEAR APR FLAGS
TTCALL 3,APRTX0 ;PREFACE MESSAGE
MOVEM T1,APRSV1 ;SAVE A REGISTER
MOVEM T2,APRSV2 ;SAVE A REGISTER
MOVEI T2,APRNXM ;ASSUME ILL MEM REF
MOVE T1,.JBCNI## ;TEST ERROR
TRNE T1,AP.POV ;PDL OVERFLOW?
MOVEI T2,APRPOV ;LOCATE MESSAGE
TRNE T1,AP.ABK ;ADDRESS BREAK
MOVEI T2,APRABK ;LOCATE MESSAGE
TRNE T1,AP.ILM ;MEMORY PROTECTION
MOVEI T2,APRILM ;LOCATE MESSAGE
APRTR4: TTCALL 3,0(T2) ;TYPE MESSAGE
TTCALL 3,APRTX1 ;CONTINUE
MOVE T2,APRPN1 ;LOAD POINTER
APRTR1: ILDB T1,T2 ;TYPE ADDRESS
MOVEI T1,"0"(T1) ;TYPE ADDRESS
TTCALL 1,T1 ;TYPE DIGIT
TLNE T2,770000 ;TYPE 6 DIGITS
JRST APRTR1 ;TYPE 6 DIGITS
SKIPN .JBHRL## ;HIGH SEGMENT?
JRST APRTR2 ;NO
TTCALL 3,APRTX2 ;CONTINUE
MOVE T2,APRPN2 ;TYPE SEGMENT NAME
APRTR3: ILDB T1,T2 ;LOAD BYTE
MOVEI T1," "(T1) ;TO ASCII
TTCALL 1,T1 ;TYPE BYTE
TLNE T2,770000 ;TYPE 6 CHARACTER
JRST APRTR3 ;TYPE 6 CHARACTER
APRTR2: TTCALL 3,APRTX3 ;CONTINUE
MOVE T1,ISN## ;GET STATEMENT #
MOVEM T3,APRSV3 ;SAVE A REGISTER
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,^D29 ;BUILD NUMBER
LSHC T1,^D29 ;BUILD NUMBER
IOR T1,APRIOR ;CONVERT TO ASCII
MOVSI T2,(BYTE (7)15,12) ;FINISH MESSAGE
TTCALL 3,T1 ;FINISH MESSAGE
MOVE T1,APRSV1 ;RESTORE AC
MOVE T2,APRSV2 ;RESTORE AC
MOVE T3,APRSV3 ;RESTORE AC
EXIT 1, ;DONE
APRSV1: BLOCK 1
APRSV2: BLOCK 1
APRSV3: BLOCK 1
;FILE SPEC AREA DEFINITIONS
;CCLSW: BLOCK 1 ;0 IF NORMAL START, 1IF CCL START
FIRZER:! ;FIRST LOCATION TO ZERO
FAREA: PHASE 0
F.DEV:! BLOCK 1 ;DEVICE NAME
F.NAME:!BLOCK 1 ;FILE NAME
F.NAMM:!BLOCK 1 ;FILE NAME MASK
F.EXT:! BLOCK 1 ;EXTENSION
F.MOD:! BLOCK 1 ;MOD WORD
F.MODM:!BLOCK 1 ;MOD MASKS
F.DIR:! BLOCK 1 ;PPN
F.DIRM:!BLOCK 1 ;DIRECTORY MASK
BLOCK 12 ;SPACE FOR SFD BIWORDS
;**;[517] Change @ F.SLEN JNG 11-Nov-76
F.SLEN==.-F.DEV ;[517] SIZE OF THE BLOCK SCAN KNOWS ABOUT
F.ADV:! BLOCK 1 ;NUMBER OF FILES TO ADVANCE TAPE
F.BACK:!BLOCK 1 ;NUMBER OF FILES TO BACKSPACE TAPE
F.WEOF:!BLOCK 1 ;WRITE AN END OF FILE
F.REW:! BLOCK 1 ;REWIND THE TAPE
F.DTZR:!BLOCK 1 ;ZERO THE DTA DIRECTORY
DEPHASE
F.LEN=.-FAREA ;SIZE OF THE FAREA
;AREA TO REMEMBER STICKEY SWITCHES
PAREA: BLOCK F.LEN ;STICKEY SPEC BLOCK
;OTHER FILE SPECIFICATION STORAGE
RELSPC: BLOCK F.LEN ;AREA FOR REL FILE SPEC
LSTSPC: BLOCK F.LEN ;AREA FOR LIST FILE SPEC
FINPTR: BLOCK 1 ;POINTRER TO FIRST INPUT SPEC
LINPTR: BLOCK 1 ;POINTER TO LAST INPUT SPEC
OUTCNT: BLOCK 1 ;NUMBER OF OUTPUT FILE SPECS
LSTCLR==.-1 ;LAST WORD TO ZERO ON A *
;RANDOM LOCATIONS
SAVEF: BLOCK 1 ;HOLDS F WHILE IN SCAN SO .SWDPB DOES NOT
; HARM T1.
SAVEFM: BLOCK 1 ;MASKS FOR STORED FLAGS
DEBGSD: BLOCK 1 ;LOCAL HOLDER OF DEBUG SWITCHES
BUGINT: BLOCK 1 ;HOLDS INTERNAL OUTPUT SWITCHES
;LOCATIONS IN GLOBAL USED BY INOUT BUT SET UP HERE
DEFINE BUFHDR(A,B),<
IRP A,<
IRP B,<
A'B=CHNLTBL##+<<A-1>*TBLMAX>+B
>>>
BUFHDR (<BIN,LST,SRC>,<HDR,PNT,CNT>)
;UUO BLOCKS
LBLOCK: BLOCK .RBALC+1 ;FOR LOOKUPS
OBLOCK: BLOCK 3 ;FOR OPENS
LKTEMP: BLOCK 1 ;FOR WILD
PATH: BLOCK 1 ;FOR PATH. UUO
LASZER==.-1
PAGE
> ;END TOPS-10 COMMAND PROCESSOR
IFN FTTENX,< ;TOPS-20 COMMAND PROCESSOR
PAGE
SUBTTL TOPS-20 COMPILER INITIALIZATION
MRP0:: ;SINGLE SEGMENT ENTRY POINT
FORTRA: TDZA T1,T1 ;FLAG AS NORMAL ENTRY
MOVEI T1,1 ;FLAG AS CCL ENTRY
MOVEM T1,CCLSW## ;SAVE CCL SWITCH
FORTR1:
MOVE T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
SETZM FIRZER ; ..
BLT T2,LASZER ; ..
JUMPPT (T1,CP166,KA10) ;FIGURE OUT TYPE OF CPU
TDZA T1,T1 ;KI-10 CLEAR FLAG
KA10: MOVX T1,SW.KAX!COMKA ;KA-10 SET FLAG
IORM T1,SAVEF ;STORE SWITCH IN MEMORY
RESET ;RESET ACTIVE I/O
MOVE T1,.JBFF## ;START OF CORE
CORE T1, ;REMOVE CRUFT FROM PREVIOUS JOBS
JFCL ;DO NOT CARE IF IT FAILS
;
MOVE P,[IOWD PDLLEN,STACK##] ;PUSH DOWN LIST
HRRZI FREG,(P) ;LIFE IS BLISS
MOVE T1,[2,,[EXP 0
XWD CCLSW##,'FOR']]
PUSHJ P,.ISCAN## ;FIRE UP SCAN
COMND:
;[130] INITIALIZE APR TRAP
;
; SET UP TRAP FOR
;
; AP.POV PUSHDOWN OVERFLOW
; AP.ABK ADDRESS BREAK (FUTURE)
; AP.ILM MEMORY PROTECTION VIOLATION
; AP.NXM NON-EXISTENT MEMORY
;
MOVEI T1,APRTRP ;[130] LOCATE TRAP ROUTINE
MOVEM T1,.JBAPR## ;[130] TELL THE MONITOR WHERE TRAP OCCURS
MOVEI T1,AP.POV!AP.ABK!AP.ILM!AP.NXM ;[130] SET CONDITIONS
APRENB T1, ;[130] ENABLE TRAPS
;
;SCAN NEXT LINE
MOVE T1,[10,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1
XWD CLRALL,CLRFIL
XWD ALLIN,ALLOUT
XWD MEMSTK,APPSTK
XWD CLRSTK,1B18
XWD 0,.POPJ1##]]
PUSHJ P,.TSCAN## ;SCAN 1 COMMAND LINE
MOVE T1,[4,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1]]
PUSHJ P,.OSCAN## ;SCAN THE OPTIONS FILE
PUSHJ P,ABSDEF ;FILL IN ABSENT DEFAULTS
SKIPN T1,FINPTR ;CHECK FOR NO INPUT FILES
JRST FORTR1 ;NO INPUT FILES
SUBI T1,F.LEN ;INITIALIZE CURRENT INPUT POINTER
MOVEM T1,CINPTR ;SAVE
PUSHJ P,NEWJFN ;GET THE NEXT FILE
JRST FORTR1 ;NO INPUT FILES GIVEN
SKIPN T2,RELSPC+F.DEV ;IS THERE A REL DEVICE
JRST NOREL ;NONE TRY LISTING
MOVE T2,RELSPC+F.MOD ;CHECK FOR NUL DEVICE AND NAME
TXNN T2,FX.NDV ;NO SKIP MEANS DEVICE THERE
JRST ISREL
SKIPN RELSPC+F.NAME ;NO SKIP MEANS DEVICE THERE
JRST NOREL ;NO NAME SPECIFIED
ISREL:
TXO F,RELFLG ;LIGHT THE REL FILE BIT FOR OUTMOD
MOVEI P1,RELSPC ;POINTER TO FILESPEC
PUSHJ P,MTMODE ;SET UP MODE FOR MAG TAPE
PUSHJ P,XFILCV ;CONVERT REL SPEC BACK TO ASCII
MOVE T2,[POINT 7,FILSPC] ;POINTER TO NEW SPEC
HRRZI T1,BINTAB ;LONG GTJFN FOR OUTPUT
GTJFN
JRST FILERR ;PROBLEMS
MOVEM T1,BINJFN ;OK - SAVE JFN
HRRZ T1,T1 ;ZERO LEFT
MOVE T2,[XWD BINBYT,WRITEE] ;OPEN FOR WRITE
OPENF
JRST FILERR ;PROBLEMS
NOREL:
SKIPN T2,LSTSPC+F.DEV ;IS THERE A LISTING DEVICE
JRST NOLST ;NONE TODAY
MOVE T2,LSTSPC+F.MOD ;SAME AS FOR .REL FILE
TXNN T2,FX.NDV
JRST ISLST
SKIPN LSTSPC+F.NAME
JRST NOLST ;NO LISTING IF ZERO
ISLST:
TXO F,LSTFLG ;FLAG THAT A LISTING IS NEEDED
MOVEI P1,LSTSPC ;LISTING SPEC POINTER
MOVE T3,LSTSPC+F.MOD ;GET MODIFIERS
TXNE F,SW.CRF ;CREF ?
TXNN T3,FX.NUL ;NUL EXTENSION?
JRST NOCREF ;NOT CREF OR EXTENSION ALREADY SPECIFIED
MOVEI T3,'CRF'
HRLM T3,F.EXT(P1) ;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
PUSHJ P,MTMODE ;SET T1 FOR MAG TAPE MODE
PUSHJ P,XFILCV ;CONVERT LST SPEC BACK TO ASCII
MOVE T2,[POINT 7,FILSPC] ;POINTER TO NEW SPEC
HRRZI T1,LSTTAB ;LONG GTJFN FOR OUTPUT
GTJFN
JRST FILERR ;PROBLEMS
MOVEM T1,LSTJFN ;OK - SAVE JFN
HRRZ T1,T1 ;ZERO LEFT
MOVE T2,[XWD LSTBYT,WRITEE] ;OPEN FOR WRITE
OPENF
JRST FILERR ;PROBLEMS
;CONTROLLING TERMINAL?
HRRZ T1,LSTJFN ;GET JFN
DVCHR ;CHARACTERISTICS
HLRZ T1,T1 ;GET DEVICE TYPE
CAIE T1,TTCODE ;IS IT A TERMINAL
JRST NOTTY ;NO
HRRZ T3,T3 ;SAVE TERMINAL NUMBER
PUSH P,T3
GTINF ;CONTROLING INFORMATION
POP P,T3 ;GET TERMINAL NUMBER BACK
CAMN T4,T3 ;COMPARE TO CONROLLING TERMINAL NUMBER
TXO F,TTYDEV ;NOTE LST = CONTROLLING TTY:
NOTTY:
MOVE T1,F.NAME(P1) ;GET LISTING FILENAME
MOVEM T1,CHNLTB##+20 ;STORE FOR USE IN PHASE1
NOLST: MOVEI T1,[ASCIZ /%FTNNOF No output files given
/]
TXNN F,RELFLG!LSTFLG!SW.OCS ;ANY OUTPUT REQUESTED?
PUSHJ P,.TSTRG## ;NO--GIVE THE WARNING
LOOP:
SKIPN T1,CCLSW
JRST BYNAM
MOVEI T1,[ASCIZ /FORTRAN: /]
PUSHJ P,.TSTRG##
SKIPE T1,CHNLTB##+32 ;GET FILE NAME IF ANY
PUSHJ P,.TSIXN## ;TYPE AS SIXBIT
PUSHJ P,.TCRLF## ;GIVE AN EOL
BYNAM:
MOVE T1,DEBGSD ;MOVE LOCAL TO GLOBAL - MACRO BUG
MOVEM T1,DEBGSW##
MOVE T1,BUGINT
MOVEM T1,BUGOUT## ;INTERMEDIATE OUTPUT REQUEST SWITCHWES
SETZM SEGINCORE## ;ARGUMENT TO PHASE CONTROL
PUSHJ P,PHAZCONTROL## ;GET THE NEXT PHASE
LOOPDN:
PUSHJ P,CLOSUP## ;CLOSE EVERYTHING
MOVE T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
SETZM FIRZER ; ..
BLT T2,LASZER ; ..
JUMPPT (T1,CP166,KA102) ;FIGURE OUT TYPE OF CPU
TDZA T1,T1 ;KI-10 CLEAR FLAG
KA102: MOVX T1,SW.KAX!COMKA ;KA-10 SET FLAG
IORM T1,SAVEF ;STORE SWITCH IN MEMORY
RESET ;RESET ACTIVE I/O
MOVE T1,.JBFF## ;START OF CORE
CORE T1, ;REMOVE CRUFT FROM PREVIOUS JOBS
JFCL ;DO NOT CARE IF IT FAILS
JRST COMND ;INITIALIZE AND LOOK FOR NEXT COMMAND
PAGE
SUBTTL SUBROUTINES CALLED FROM .TSCAN
;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL: SKIPA T2,[LSTCLR] ;THE WHOLE THING
;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL: MOVEI T2,FAREA+F.LEN ;JUST CLEAR F AREA
MOVE T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
SETZM FIRZER ; ..
BLT T1,(T2) ; TO THE END
POPJ P, ; ..
;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT: AOS T3,OUTCNT ;T3 = COUNT OF OUPUT FILES
MOVE T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
MOVEI T2,F.SLEN ;T2 = LENGTH OF SPEC
CAIG T3,2 ;TOO MANY SPECS?
POPJ P, ;NO--ALL DONE
M.FAIL <FTNTOF More than 2 output files are not allowed>
;SUBROUTINE TO ALLOCATE AN INPUT AREA
ALLIN: SKIPE T1,LINPTR ;ANY LAST INPUT SPEC?
JRST ALLIN1 ;YES--MAKE ANOTHER
MOVE T1,.JBFF## ;FIRST INPUT SPEC GOES HERE
MOVEM T1,FINPTR ;SAVE FOR LATER
SUBI T1,F.LEN ;FIX UP SO FIRST SPEC IS CORRECT
MOVEM T1,LINPTR ;SAVE AWAY
ALLIN1: MOVEI T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
CAMGE T2,.JBREL## ;WILL IT FIT?
JRST ALLIN2 ;YES--CONTINUE
CORE T2, ;NO--EXPAND CORE
JRST E.NCF ;NO CORE--YOU LOOSE
ALLIN2: MOVEI T1,F.LEN ;LENGTH OF SPEC
ADDM T1,.JBFF## ;UPDATE JOBFF
ADDB T1,LINPTR ;UPDATE T1 AND POINTER
MOVEI T2,F.SLEN ;AMOUNT SCAN KNOWS ABOUT
POPJ P, ;RETURN
;SUBROUTINE TO CLEAR STICKEY DEFAULTS
CLRSTK: SETZM PAREA ;ALL THE STICKEY DEFAULTS
MOVE T1,[PAREA,,PAREA+1] ; ..
BLT T1,PAREA+F.LEN-1; ARE IN THE PAREA
POPJ P,
XALL
DEFINE MEM(A),<
IRP A,<
SKIPE T1,FAREA+F.'A ;IS A SPECIFIED?
MOVEM T1,PAREA+F.'A ;YES--REMEMBER A
>>
;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS
MEMSTK: MEM (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
DEFINE APPLY(A),<
IRP A,<
MOVE T1,PAREA+F.'A ;PICK UP STICKEY DEFAULT FOR A
SKIPN FAREA+F.'A ;IS A LOCAL OVER RIDE PRESENT
MOVEM T1,FAREA+F.'A ;NO--APPLY THE DEFAULT
>>
;SUBROUTINE TO APPLY STICKEY DEFAULTS
APPSTK: APPLY (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
SALL
PAGE
SUBTTL SUBROUTINES FOR COMMAND SCANNING
;SUBROUTINE TO APPLY ABSENT DEFAULTS
ABSDEF: SETCM F,SAVEFM ;T1 GETS A 1 BIT FOR EVERY BIT IN F
; WHICH WAS NOT EXPLICITLY SPECIFIED
; BY THE USER.
AND F,INDADF ;AND WITH THE DEFAULTS.
IORB F,SAVEF ;OR IN THE SELECTED BITS.
POPJ P, ;--ALL SET UP
PAGE
SUBTTL LOOKUP/ENTER SUBROUTINES
;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
; PUSHJ P,NXTFIL
; NOTHING FOUND
; SPEC POINTER IN P1
NXTFIL:
MOVE T1,SRCJFN ;GET JFN
GNJFN ;SEE IF THERE IS ANOTHER FILE HERE
JRST NEWJFN ;NO MORE
JRST OPNSRC ;GOT ONE
;GET 1ST JFN FOR FILE
NEWJFN:
MOVE P1,CINPTR ;GET CURRENT SPEC POINTER
CAMN P1,LINPTR ;ARE WE DONE
POPJ P, ;YES - NONSKIP RETURN
ADDI P1,F.LEN ;UPDATE POINTER
MOVEM P1,CINPTR ;SAVE IT
PUSHJ P,XFILCV ;CONVERT SPEC BACK TO ASCII
HRRZI T1,SRCTAB ;SRC LONG JFN TABLE
MOVE T2,[POINT 7,FILSPC] ;NEW FILE SPEC
GTJFN
JRST SRCNUL ;TRY WITHOUT DEFAULT OF "FOR"
NOTFOR:
MOVEM T1,SRCJFN ;SAVE JFN
;WHAT SORT OF DEVICE DO WE HAVE
OPNSRC:
HRRZ T1,T1 ;ZERO LEFT
DVCHR
MOVE T3,FLAGS2## ;PREPARE TO SET TTY BIT
HLRZ T1,T1 ;GET DEVICE CODE
CAIN T1,TTCODE ;IS IT TTY?
JRST TTYSRC ;YES
;SRC NOT TTY:
TXZ T3,TTYINP ;NOTE NOT TTY:
MOVE T2,[XWD INBYT,READ] ;SET UP FOR OPEN
JRST GOTSRC
;TTY:
TTYSRC:
TXO T3,TTYINP ;NOTE TTY:
MOVE T2,[XWD TTYBYT,READ!WRITEE] ;SET UP FOR OPEN
;OPEN THE FILE
GOTSRC:
MOVEM T3,FLAGS2## ;SAVE THOSE FLAGS
HRRZ T1,SRCJFN ;GET JFN
OPENF
JRST FILERR ;PROBLEMS
MOVE T1,F.NAME(P1) ;SAVE FILE NAME FOR
MOVEM T1,CHNLTBL##+32 ; THE COMPILER
MOVE T1,F.EXT(P1) ; AND EXTENSION
MOVEM T1,CHNLTBL##+33
TXZ F,EOCS ;CLEAR END INPUT BIT
JRST .POPJ1## ;GOT FILE - SKIP RETURN
;TRY SRC WITHOUT "FOR"
SRCNUL:
HRLZI T1,SHORT!OLDFILE!XWILD ;FLAGS
MOVE T2,[POINT 7,FILSPC] ;ASCII FILE SPEC
GTJFN
JRST FILERR ;GIVE IT UP
JRST NOTFOR ;GOT IT WITH "NUL"
;SUBROUTINE TO CONVERT FILE SPEC BLOCK
;POINTED TO BY P1 INTO AN ASCII STRING
; AND PUT IT IN FILSPC
;CALL WITH
; P1 - SPEC POINTER
; PUSHJ XFILCV
; RETURN HERE
XFILCV:
;**[560] @XFILCV SJW 6-APR-77
MOVE T1,[ASCIZ /DSK:/] ;[560] DEFAULT DEVICE
MOVEM T1,FILSPC ;[560] FOR PPNST
MOVE T3,[POINT 7,FILSPC,27] ;[560] PTR TO AFTER DEFAULT DEV:
SKIPN T2,F.DEV(P1) ;G