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 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 B2+B11+B17+ ENTRY NXTFIL SEARCH FTTENX ;ASSEMBLY TIME SWITCHES ;**[560] INSERT AFTER "SEARCH FTTENX" SJW 6-APR-77 IFN FTTENX,< SEARCH MONSYM > ;[560] IF2,< IFE FTTENX, IFN FTTENX, > ;[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 <_<43-^L>> !  <_<43-^L>> !  <_<43-^L>> !  <_<43-^L>> !  <_<43-^L>> !  <_<43-^L>> !  <_<43-^L>> EXTERNAL DEBGSW DEFINE SWTCHS,< SP ADVANCE,FAREA+F.ADV,.SWDEC##,ADV SP BACKSPACE,FAREA+F.BACK,.SWDEC##,BAK ;SP BOUNDS,,.SWDEC##,BOU SP BUGOUT,,.SWOCT##,BUG SP CROSSREF,,.SWDEC##,CRF SL DEBUG,DEBGSD,BUGK,-1,FS.OBV SP EXPAND,,.SWDEC##,EXP SS KA10,,1 SS KI10,,0 SP INCLUDE,,.SWDEC##,INC SP *MACROCODE,,.SWDEC##,MAC SP *LNMAP,,.SWDEC##,MAP ;[512][476] REPLACE TIME SP NOERRORS,,.SWDEC##,NOE SP NOWARNING,,.SWDEC##,NOW SP *OPTIMIZE,,.SWDEC##,OPT SP *SYNTAX,,.SWDEC##,OCS SP TAPEND,FAREA+F.WEOF,.SWDEC##,WEO SP ZERO,FAREA+F.DTZR,.SWDEC##,ZER > KEYS BUGK, 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 ;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,(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 () 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 () 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+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 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,[] ;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 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 EER02: M.FAIF EER06: M.FAIF EER14: M.FAIF ;**[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 ; 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##+<*TBLMAX>+B >>> BUFHDR (,) ;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 ;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,(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 () 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 () 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) ;GET DEVICE NAME JRST NODEV ;NONE THERE ;**[560] @XFILCV + 2.5L SJW 6-APR-77 SETZM T1,FILSPC ;[560] CLEAR DEFAULT DEVICE MOVE T3,[POINT 7,FILSPC] ;[560] INITIAL POINTER PUSHJ P,X6.7CV ;CONVERT MOVEI T1,":" ;PUT IN COLON IDPB T1,T3 NODEV: ;**[560] @NODEV SJW 6-APR-77 MOVX T2,FX.DIR ;[560] TDNN T2,.FXMOD(P1) ;[560] IS THERE A PPN? JRST NOPPN ;[560] NO MOVE T2,F.DIRM(P1) ;[560] IS PPN WILD? AOJN T2,E.WILD ;[560] YES == ERROR MOVE T1,[POINT 7,FILSPC] ;[560] PUT ANSWER HERE MOVE T2,F.DIR(P1) ;[560] GET PPN MOVE T4,T3 ;[560] SAVE PTR TO AFTER DEV: FOR DIRST MOVE T3,T1 ;[560] POINT TO DEV: PPNST ;[560] PPN TO DIRECTORY ERJMP CHK1B ;[560] DIDN'T WORK: CHECK FOR 1B PPNOK: ;[560] MOVE T3,T1 ;[560] T3 IS OUR FILE SPEC PTR NOPPN: ;[560] SKIPN T2,F.NAME(P1) ;FILE NAME JRST NONAM ;NOPE PUSHJ P,X6.7CV ;CONVERT IT NONAM: HLLZS F.EXT(P1) ;CLEAR RIGHT HALF SKIPE T2,F.EXT(P1) ;EXTENSION JRST DODOT ;YES MOVX T1,FX.NUL ;NULL EXT MASK TDNE T1,F.MOD(P1) ;EXPLICITLY NULL? JRST NULEXT ;NO DODOT: MOVEI T1,"." ;PUT DOT IN IDPB T1,T3 CAIE T2, ;DID WE HAVE A NAME PUSHJ P,X6.7CV ;YES CONVERT NULEXT: MOVEI T1,0 ;NULL TERMINATOR IDPB T1,T3 POPJ P, ;RETURN ;**[560] INSERT @NULEXT + 3.5L SJW 6-APR-77 ;[560] PPNST FAILED: IF IT FAILED BECAUSE THE JSYS WAS UNDEFINED, ;[560] THEN WE MUST BE RUNNING ON VERSION 1B MONITOR AND CAN USE ;[560] DIRST TO CONVERT THE PPN TO A DIRECTORY CHK1B: ;[560] HRRZI T1,400000 ;[560] GET PROCESS HANDLE GETER ;[560] WHY DID PPNST FAIL? HRRZ T2,T2 ;[560] REMOVE PROCESS HANDLE CAIE T2,ILINS2 ;[560] IS PPNST JSYS DEFINED? JRST FILERR ;[560] YES == VERSION 2 ERROR HLRZ T2,F.DIR(P1) ;[560] CHECK PROJECT # CAIE T2,4 ;[560] IS PROJ # = 4? JRST PPN4ER ;[560] NO == ERROR HRRZ T2,F.DIR(P1) ;[560] GET PROG # = DIRECTORY # MOVE T1,T4 ;[560] GET PTR TO AFTER DEV: SAVED ABOVE MOVEI T3,"<" ;[560] IDPB T3,T1 ;[560] PUT IN PUNCTUATION DIRST ;[560] PROG # TO DIRECTORY JRST FILERR ;[560] PPN ERROR MOVEI T3,">" ;[560] IDPB T3,T1 ;[560] PUT IN PUNCTUATION JRST PPNOK ;[560] ;ROUTINE TO CONVERT 6BIT TO 7BIT ;CALL WITH ; T3 = BYTE POINTER OF DESTINATION ; T2 = 6BIT NAME ; PUSHJ P,X6.7CV ; RETURN HERE X6.7CV: SETZM T1 ;CLEAR CHARACTER REG LSHC T1,6 ;GET CHAR CAIN T1, POPJ P, ;DONE ADDI T1," " ; TO 7BIT IDPB T1,T3 ;STORE IT JRST X6.7CV ;DO MORE ;ROUTINE TO PROCESS FILE ERRORS ; JRST FILERR FILERR: MOVE T1,[-1,,FLEHDR] ;MESSAGE HEADER PSOUT ;TYPE IT HRRZI T1,101 ;PRIMARY OUTPUT JFN HRLOI T2,400000 ;CURRENT FORK,CURRENT ERROR SETZM T3 ERSTR JRST ERRERR ;UNKNOWN ERROR JRST ERRERR ;PROBLEM MOVE T1,[-1,,CRLFST] ;ADD CRLF PSOUT JRST ERRST ;TAKE IT FROM THE TOP ;ERROR HANDLING ERROR ERRERR: MOVE T1,[POINT 7,UNKFLE] PSOUT JRST ERRST ;RESTART UNKFLE: ASCIZ /FILE ERROR - UNKNOWN / CRLFST: ASCIZ / / FLEHDR: ASCIZ /?FTNFER / ;ERROR MESSAGE PREFIX ;**[560] INSERT BEFORE ERRST SJW 6-APR-77 ;[560] ROUTINE TO PROCESS WILD PPN ERRORS E.WILD: MOVE T1,[POINT 7,WLDERR] ;[560] GET ERROR MESSAGE PSOUT ;[560] DISPLAY IT JRST ERRST ;[560] GET OUT WLDERR: ASCIZ /?FTNNWD Incorrect use of * or % in ppn / ;[560] ;[560] PROJECT # MUST = 4 FOR DIRST JSYS ON TOPS-20 V1B PPN4ER: ;[560] MOVE T1,[POINT 7,PRJERR] ;[560] GET ERROR MESSAGE PSOUT ;[560] DISPLAY IT JRST ERRST ;[560] GET OUT PRJERR: ASCIZ /?FTNPN4 Project number must be 4 in ppn / ;[560] ERRST: ;ERROR ENTRY SKIPE T1,CCLSW JRST COMND JRST FORTR1 ;LOOP BACK ;SUBROUTINE TO OPEN INCLUDE FILES ;CHECK TO SEE THAT THEY ARE DISK ;CALL WITH ; ICLPTR = ASCIII FILE SPEC POINTER ; PUSHJ P,OPNICL ; RETURN HERE ; VREG = 0 - OK ; OR ; VREG = ASCII ERROR STRING MESSAGE POINTER OPNICL:: PUSH P,T1 PUSH P,T2 PUSH P,T3 HRRZI T1,ICLTAB ;LONG GTJFN INCLUDE FILE TABLE MOVE T2,ICLPTR ;SPEC POINTER GTJFN JRST ICLNUL ;TRY WITHOUT DEFAULT "FOR" NULX: MOVEM T1,ICLJFN ;SAVE JFN MOVEM T2,ICLPTR ;SAVE POINTER TO LOOK FOR SWITCHES ;CHECK FOR DSK: HRRZ T1,T1 ;ZERO LEFT DVCHR HLRZ T1,T1 ;GET DEVICE CODE CAIE T1,DSKCOD ;DSK:? JRST NOTDSK ;NO HRRZ T1,ICLJFN ;GET JFN AGAIN MOVE T2,[XWD INBYT,READ] ;SETUP FOR OPEN OPENF JRST ICLERR ;PROBLEMS MOVEI VREG,0 ;GOOD RETURN ICLRET: POP P,T3 POP P,T2 POP P,T1 POPJ P, ;TRY WITHOUT DEFAULT "FOR" ICLNUL: HRLZI T1,SHORT!OLDFILE ;FLAGS MOVE T2,ICLPTR## ;FILE SPEC POINTER GTJFN JRST ICLERR ;DIDN'T HELP JRST NULX ;OK GOT IT NOTDSK: MOVE VREG,[POINT 7,NODSK] ;NOT DSK MESSAGE JRST ICLRET NODSK: ASCIZ /DEVICE MUST BE DISK/ ICLERR: MOVE T1,[POINT 7,ICLEST] ;MESSAGE STORE AREA HRLOI T2,400000 ;CURRENT FORK,CURRENT ERROR HRLZI T3,-^D100 ;MESSAGE LIMIT ERSTR JRST ICLERR ;UNKNOWN JRST ICLERR ;PROBLEM MOVE VREG,[POINT 7,ICLEST] ;MESSAGE POINTER JRST ICLRET ICLEER: MOVE VREG,[POINT 7,UNKFLE] ;UNKNOWN ERROR JRST ICLRET ;ROUTINE TO CLOSE THE ICL FILE ;CALL WITH ; PUSHJ P,CLOICL ; RETURN HERE CLOICL:: PUSH P,T1 HRRZ T1,ICLJFN ;GET JFN CLOSF JFCL 0,0 POP P,T1 POPJ P, ;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 ; 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 F.SLEN==.-F.DIR-1 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 CINPTR: BLOCK 1 ;CURRENT SPEC POINTER 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##+<*TBLMAX>+B >>> BUFHDR (,) FILSPC: BLOCK 10 ;BUILD AREA FOR FILE SPEC ICLEST: BLOCK 24 ;STORE AREA FOR INCLUDE FILE ERROR MESSAGE LASZER==.-1 > ;END TOPS-20 COMMAND PROCESSOR END FORTRAN