Trailing-Edge
-
PDP-10 Archives
-
BB-KL11L-BM_1990
-
lngsrc/lnkwld.mac
There are 48 other files named lnkwld.mac in the archive. Click here to see a list.
TITLE LNKWLD - SWITCH HANDLER FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/SRM/JBC/JNG/MCHC/PAH/DZN/PY/JBS/HD/RJF 30-MAR-90
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;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.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,<SEARCH MACSYM,MONSYM>
SALL
ENTRY LNKWLD
EXTERN LNKFIO,LNKCOR,LNKLOG,LNKMAP,TTYCHK
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2424 ;DEC EDIT VERSION
SEGMENT
;CALLING SEQUENCE
;PUSHJ P,LNKWLD
;RETURN
;END OF LIST NOTHING LEFT
;ALL I/O SETUP SO SOSGE LOOP WILL GET DATA
;CALLS LNKFIO TO TAKE CARE OF ALL OUTPUT FILE I/O
;OUTPUT FILES MUST BE FIRST IN LIST
;ALSO HANDLES ALL SWITCHES
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;41 ADD LNKFSI MESSAGE
;45 HASH INITIAL SYMBOLS AT ASSEMBLY TIME
;46 ADD KLUDGE FEATURE
;52 ADD ASCII TEXT BLOCK
;54 ADD KIONLY D.P. INST
;60 ADD /VERSION SWITCH
;63 ADD EXTERNAL START ADDRESS IN BLOCK TYPE 7
;65 TENEX SPEEDUPS
;71 MAKE ALL MESSAGES STANDARD FORM
;74 (11389) FIX ILL MEM REF ON FILE/SYSLIB
;103 RESTORE BOTH HALVES OF FL AFTER EDITED LOOKUP ERROR
;105 MAKE BLOCK TYPE 12 WORK
;106 REMOVE HIORG, REPLACE WITH EITHER LL.S2 OR SO.S2
;107 REPLACE KLUDGE BY MIXFOR
;110 ILL MEM REF ON /BASKSPACE:1
;114 MAKE /LOG WORK IF DEVICE NOT 'LOG' OR TTY
;115 MAKE /NOSYMBOLS WORK CORRECTLY
;120 /SYMSEG:HIGH WITH NO HIGH CODE GIVES ILL MEM REF
;START OF VERSION 1B
;122 (11940) ADD COPYP1 TO HANDLE /M/SSA=PROG
;124 ADD /ONLY SWITCH
;132 (12304) FIX TO EDIT 122
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;137 ADD SUPPORT FOR PLOT PACKAGE
;141 TURN ON AND FIX BUGS IN ASCII TEXT BLOCKS
;145 IMPLEMENT /USERLIB & /NOUSERLIB SWITCHES
;153 FIX BUG IN EDITS 122 AND 132
;156 MAKE FOO/DEBUG WORK RIGHT
;161 ADD LANGUAGE SPECIFICATION TO /USERLIB
;167 CHANGE ARGUMENTS TO /OTSEGMENT
;170 MAKE PLOT SWITCH WORK
;201 MAKE FORDDT WORK
;216 (13559) ADD ZSV ERROR CHECK AND MESSAGE
;START OF VERSION 2B
;225 ADD SUPPORT FOR PSECT (MACRO VERSION 51)
;245 CHANGED CALLING SEQUENCE TO DVLKP.
;247 Rework the use of the DEBUGSW; set .LOCALS before main
; program is loaded.
;253 Make multiple line ASCII text blocks work
;254 Disconnect from the file spec. switches deferred until
; after the file is open so won't dispatch off of PC
; if the file spec. is edited.
;256 Add a zero entry to the key word table, incase the
; user types "/<switch>:" without a key word
;262 Make SYSLB1 a global routine to force a LIBRARY search
;272 Correctly force rehashing if /HASHSIZE seen
;277 Control stack so can continue after editing file spec.
;302 MAKE TENEX DDT WORK RIGHT
;307 MAKE LOCAL ASCII BLOCK SWITCHES WORK RIGHT
;343 INCLUDE EDITS 302,307 IN MAINTENANCE SOURCES
;353 REMOVE EDIT 225
;377 Fix some bugs in the handling of the /SET switch.
;400 Default the PPN correctly on /DEFAULT
;406 Make DDT default for /TEST: and /DEBUG:
;411 Implement /K to correct ASCII text processing
;421 Give %LNKMSN and %LNKSSN if can't act as requested.
;431 Make the /ESTIMATE switch work.
;START OF VERSION 2C
;464 Implement the /MISSING switch.
;471 Add code for ALGOL debugging system.
;472 Update HL.S1 on the /COMMON switch, and fix the map.
;530 Define triplet flags bits correctly.
;534 Fix problems with .OSCAN and ASCII text.
;544 SOUP in LINK version 3 stuff for TOPS-20.
;551 Change /SYMBOL to /SYFILE
;557 Clean up the listing for release.
;START OF VERSION 3
;446 CHANGE TO LOAD SYS:UDDT.EXE FOR TENEX
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;605 Use OUTSTR's in various messages.
;610 Handle defaulting of ersatz devices correctly.
;615 Never try to load empty SCAN blocks.
;617 Fix edits 610 and 615.
;620 Don't overwrite old device when merging file specs
;621 /SAVE and /SSAVE generate an EXE file.
;653 Make /SYSLIB with an argument work.
;655 Clear start address module name on /START.
;677 Don't default to /SYMSEG:LOW if loading overlays.
;705 Wait for the file to be loaded first for /SYMSEG
;706 /SET to build RC.NTB
;714 Add psect-name as a global symbol with origin as value.
;715 Modify SYMSEG to take psect name.
;721 Implement /SYMSEG:PSECT:psectname.
;723 Add /UPTO.
;727 Adjust SYMLIM with /SET:.HIGH. /SYMSEG:HIGH & /SYMSEG:LOW.
;730 Save /DEBUG file spec for /LINK.
;731 SEARCH MACTEN,UUOSYM
;740 Remove %VERSION code.
;757 Type out RC.HL instead of RC.CV value for overlayable PSECT for /COUNTER.
;761 Clear AT.RP(relocatable PSECT bit) in /SET switch.
;763 Common code in .SET0 for creating reloc counter for block 22,24.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF VERSION 4A
;775 Make sure /DEBUG:FORTRAN loads the starting address of FORDDT.
;1002 Give undefined messages with long symbol names.
;1101 Set LSTBLK and DTAFLG correctly on new input files.
;1107 Fix bug with .SETEX routine to expand RC.TB and RC.NTB tables.
;1117 Add /NOINCLUDE switch and make /INCLUDE:args set include mode.
;1122 Remove edit 740.
;1132 Allow loading of PSECTs above the high segment.
;1142 Fix problems with /SET introduced by edit 1132.
;1144 Remember if we mapped in DDT as a result of /DEBUG:DDT on TOPS-20.
;1145 Load locals if /DEBUG:DDT on TOPS-20. Broken by edit 1144.
;1155 Store PSECT properties even if PSECT name is .HIGH.
;1157 Suppress the PSECT name global symbols to DDT typeout.
;1163 Fix edit 1155 to not mark .HIGH. as relocatable.
;1172 Don't change SYMLIM on /SET to .HIGH..
;1173 Update RC.HL on /COMMON.
;1174 Label and clean up all error messages.
;1175 Don't lookup symbolic argument to /START until /GO, move USA message.
;1176 Disallow /SYMSEG:PSECT:name if loading overlays.
;1177 Make global /VERSION not lose local switches.
;1201 Change $SEGxxx to $SSGxxx.
;1203 Add support for extended FORTRAN.
;1204 Check for program growing too far and give LNKPTL.
;1211 Fix typo in LNKDRC.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;START OF VERSION 4B
;1225 Allow for extra argument in X macro in PROCESSORS macro.
;1230 Delete definitions of $SYM?? symbols (moved to LNKPAR) and set up
; /SYFILE: channel properly.
;1240 Fix /CPU switch to use bits instead of values.
;1241 Make /SET produce LNKZSV if no arguments.
;1246 Don't set up high segment yet if /SYMSEG:HIGH found.
;1255 Restore R in case SY.GS found references to PSECT name.
;1267 Teach /DEBUG and /TEST switches about ALGDDT.
;1270 Make /START: request the symbol in case symbol is in a library
;1300 Add /LIMIT switch and RC.LM
;1301 Change /VERBOSITY to bits.
;1304 Build RC.MAP entries along with RC.TB and RC.NTB
;1307 Add /SUPPRESS switch
;1313 Reset flag when debugger is loaded so /LINK won't be confused.
;1321 Make SIMDDT not load a file.
;1324 Use compiler type bits in /USERLIB.
;Start of Version 5
;1423 Add support for /PVBLOCK and /PVDATA
;1431 Fix typo in /PVDATA support
;1435 PASCAL debugger support added.
;1442 /EXTEND switch added.
;1450 Remove /EXTEND
;Start of Version 5A
;1500-1677 Reserved for Maintenance
;1505 Set correct uppermost default limit for section-crossing PSECTs.
;1705 Treat PASDDT like FORDDT.
;1736 Strip unsupported FMXFOR code.
;2006 Zero ENTLEN if /START switch seen.
;2011 Add /PLTTYP to specify type of plot to produce.
;2026 Update copyright notice, clean up listings.
;2077 Set RC.HL in .NEWPAGE.
;Start of Version 6
;2202 Remove FTFRK2 conditional.
;2205 Allow common blocks larger than one section.
;2211 Add /NOJOBDAT switch to suppress JOBDAT (hiseg and loseg).
;2216 Type long symbols correctly in /ENTRY and /UNDEFINED.
;2220 Add long symbol typein support for switches.
;2222 Don't mess up the attributes with /SET.
;2223 Add /REDIRECT for psect redefinition.
;2225 Fix /PVDATA:VERSION:SYMBOL, broken by edit 2220.
;2227 Add /PSCOMMON to specify psect for /COMMON switch.
;2234 Fix /PVDATA:VERSION:CONSTANT, broken by edit 2220.
;2245 Fix PDV length word.
;2247 Improve typeout from /COUNTERS.
;2252 Don't clobber the symbol bits in STRLSW.
;2272 Default psects for /REDIRECT to .LOW. and .HIGH.
;2276 Teach /COUNTERS to tab long symbols and big addresses.
;2277 Implement new /DEBUG code.
;2300 Remove F40 code.
;2306 Implement long PDV names, /PVDATA:EXPORT.
;2341 Handle /SET:PSECT:OCTAL correctly if octal is very big.
;2356 Move NAMCMP to LNKSUB, remove unnecessary TOPS20 conditionals.
;2366 Turn off /NOJOBDAT on TOPS-10.
;2403 New corporate copywrite statement.
;2417 Update copywrite statement to 1988.
;2423 Allow LOOKUPs on specs with no filename for PATH FOO:=dev:filename.
; Allow the /SSAVE switch on TOPS20 so .CTL files are compatible.
;2424 Edit 2423 broke some switches on the -10 & -20 since we make dummy
; scan blocks that have no spec but never turn on FX.NDV in F.MOD.
; Hence, we did not ignore then as null specs.
SUBTTL ENTER HERE FROM LNKLOD TO GET A FILE TO LOAD
LNKWLD: SETZM NULSPC ;CLEAR NULL FILE SPEC FLAG
SKIPE P1,F.EDIT ;DID WE JUST DO AN EDIT CORRECTION?
JRST MERGE ;YES, BUILD THE TRUE FILE SPEC
MOVEM P,MARKWP ;MARK STACK INCASE LOOKUP ERROR
IFN .ASBLK,<
SKIPE F.ASCI ;READING INCORE TEXT?
JRST ASCMRG ;YES
>
SKIPE SWFLAG ;CHECK FOR DEFERED SWITCHES FROM LAST FILE
PUSHJ P,DEFLSW ;YES, GO DO THEM FIRST
SKIPE P1,F.INZR ;GET NEXT FILE SPEC
JRST NXTSPC ;YES THERE IS ONE
SKIPE GOTO ;NO, BUT SHOULD WE TERMINATE
JRST @GOTO ;YES, DO FINAL DEFAULTS ETC.
SKIPG P1,S.INZR ;JUST FINISH A /LINK SWITCH?
JRST URET ;NO, RETURN TO USER
MOVEM P1,F.INZR ;YES, RESTART COMMAND STRING
HLLZ FL,S.LHFL ;PUT THINGS BACK AS THEY WERE
HLR FL,FL ;DEFAULT SWITCHES FOR THIS FILE
SETZM S.INZR ;CLEAR SPECIAL KLUDGE FLAGS
SETZM S.LHFL ;..
;HERE TO LOOK FOR SWITCHES
NXTSPC: HLRZ P2,F.SWP(P1) ;GET LIST OF GLOBAL SWITCHES
JUMPE P2,.+3 ;NONE THERE
PUSHJ P,XCTGSW ;DO SWITCH
MOVE P1,F.INZR ;RELOAD P1
HRRZ P2,F.SWP(P1) ;GET LIST OF LOCAL SWITCHES
JUMPE P2,.+3 ;NONE
PUSHJ P,XCTLSW ;DO SWITCH
MOVE P1,F.INZR ;RELODE P1 AGAIN
IFN .ASBLK,<
SKIPE F.ASCI ;READING INCORE TEXT?
JRST ASCRET## ;YES, FINISH IT
>
SKIPN NULSPC ;NULL FILE SPEC (SWITCHES ONLY)
JRST DEFILL ;NO, REAL FILE SPEC HERE
NOTSPC: PUSHJ P,RETFSP ;JUST A DUMMY DATA BLOCK
JFCL ;INCASE NON-SKIP RETURN
JRST LNKWLD ;INCASE ANY DEFERED SWITCHES
;HERE TO FILL IN DEFAULTS FOR INPUT DEVICE
DEFILL: MOVE T3,F.MOD(P1) ;GET MODIFIER WORD
MOVE T2,G.NAM ;DEFAULT FILE NAME
SKIPN F.NAME(P1)
MOVEM T2,F.NAME(P1)
MOVE T2,G.EXT ;DEFAULT EXTENSION
SKIPN F.EXT(P1) ;EXT SPECIFIED?
TXNN T3,FX.NUL ;ONLY REPLACE NULL EXT
CAIA ;NO IF 0 OR IF GIVEN
MOVEM T2,F.EXT(P1)
MOVE T1,F.DIR(P1) ;GET SPECIFIED [PPN]
MOVE T2,G.DIR ;AND DEFAULT [PPN]
TXNN T3,FX.DIR ;SKIP IF DIRECTORY SPECIFIED
JRST DEFDIR ;FILL IN FULL DEFAULT DIRECTORY
TLNN T1,-1 ;PROJ GIVEN?
HLL T1,MYPPN ;[610] NO, USE DEFAULT
TRNN T1,-1 ;PROG?
HRR T1,MYPPN ;[610] NO
MOVEM T1,F.DIR(P1) ;[610] STORE UPDATED UFD
JRST DEFDEV ;[610]
;HERE TO DEFAULT THE DIRECTORY. MUST NOT USE DEFAULT DIRECTORY
;IF NO DIRECTORY SPECIFIED BUT DEVICE SPECIFIED WAS ERSATZ.
DEFDIR: MOVE T3,F.MODM(P1) ;GET MOD MASK
TXNE T3,FX.DIR ;TEST FOR [-]
JRST DEFDEV ;[610] YES, LEAVE DIR ALONE AS ZERO
MOVE T1,[3,,T2] ;[610] NO DIR SPECIFIED, BUT WAS
MOVE T2,F.MOD(P1) ;[610] DEVICE SPECIFIED ERSATZ?
TXNN T2,FX.NDV ;[610] NOT IF NO DEVICE WAS SPECIFIED!
SKIPN T2,F.DEV(P1) ;[610] SHOULD BE ONE, MAKE SURE
JRST DEFDR1 ;[610] NO DEVICE, USE G.DIR PATH
PATH. T1, ;[610] USER TYPED A DEVICE, ERSATZ?
SETZ T3, ;[610] PROBABLY NOT
TXNE T3,PT.IPP ;[610] WAS THE DEVICE ERSATZ?
JRST DEFDEV ;[610] YES, LEAVE THE PATH ALONE
DEFDR1: HRLI T2,G.DIR ;[610] NO, FORM BLT POINTER
HRRI T2,F.DIR(P1)
BLT T2,F.DIR+2*.FXLND-1(P1)
;HERE TO DEFAULT THE DEVICE. CAN'T USE DEFAULT DEVICE IF IT'S
;ERSATZ AND USER GAVE AN EXPLICIT PATH.
DEFDEV: MOVSI T2,'DSK' ;[617] UNIT DEFAULT DEVICE
SKIPN F.DEV(P1) ;[617] NONE SPECIFIED?
MOVEM T2,F.DEV(P1) ;[617] MAKE SURE THERE IS ONE
MOVE T2,F.MOD(P1) ;[610] PICKUP MOD WORD
TXNE T2,FX.NDV ;[610] USER TYPE AN EXPLICIT DEVICE?
SKIPN T2,G.DEV ;[610] NO, BUT IS THERE A DEFAULT?
JRST LDDS ;[610] EXPLICIT DEVICE OR NO DEFAULT
MOVE T1,[3,,T2] ;[610] BUT IS THE DEFAULT DEVICE ERSATZ?
PATH. T1, ;[610] FIND OUT VIA PATH UUO
SETZ T3, ;[610] PROBABLY NOT
MOVE T2,G.DEV ;[610] RESTORE CORRECT DEVICE
MOVE T1,F.MODM(P1) ;[610] GET MOD MASK
TXNE T1,FX.DIR ;[610] WAS A DIRECTORY SPECIFIED?
TXNN T3,PT.IPP ;[610] YES, WAS THE DEVICE ERSATZ?
MOVEM T2,F.DEV(P1) ;[610] NO DIR OR G.DEV NOT ERSATZ
;HERE TO GET DEVICE AND DO OPEN IF DEVICE DIFFERENT FROM LAST ONE
LDDS: MOVEI T2,DC ;GET DATA CHAN
CAME T2,IO.CHN ;SAME AS CURRENT?
SETZM IO.CHR ;NO, SO DEVCHR MUST BE INVALID
MOVEM T2,IO.CHN ;INCASE DEFERED SWITCHES
MOVE T2,F.DEV(P1) ;GET DEVICE
EXCH T2,FSTR ;MAKE SURE NEW STORED INCASE OF ERROR
CAMN T2,FSTR ;SAME AS PREV DEVICE?
JRST LDFS ;YES, BYPASS INIT
SETZM FILNUM ;START AGAIN ON NEW DEVICE
PUSHJ P,DVCHK.## ;SEE IF DEVICE EXISTS AND CAN SUPPORT MODE
PUSHJ P,DVOPN.## ;DO OPEN
LDFS: SKIPN IO.CHR ;VALID DEVCHR YET?
PUSHJ P,DVCHK.## ;NO, GET IT INCASE NULL FILE NAME
SKIPE F.NAME(P1) ;IF NO NAME GIVEN?
JRST LDFS1 ;OK IT WAS
MOVE T2,IO.CHR ;GET DEVCHR BIT
TXNN T2,DV.DIR ;[2423] IF NON-DIRECTORY DEVICE
JRST LDFS0 ;[2423] YES, GO MAKE A FILENAME
MOVE T2,F.MOD(P1) ;[2423] PICKUP MOD WORD
TXNN T2,FX.NDV ;[2423] USER TYPE AN EXPLICIT DEVICE?
JRST LDFS1 ;[2423] YES, MAYBE PATH WITH IMPLIED FILENAME
JRST NOTSPC ;NO, SO NOT A FILE SPEC
LDFS0: AOS T1,FILNUM ;GET FILE NUMBER
SETZ T3, ;RECEIVE IT HERE
IDIVI T1,^D10
ADDI T2,'0' ;[617] DIGITIZE
LSHC T2,-6 ;SHIFT IN
JUMPN T1,.-3 ;[617] UNTIL ALL DONE
MOVEM T3,F.NAME(P1) ;SO WE KNOW WHICH FILE IF ERROR
LDFS1: PUSHJ P,DVINP.## ;BUILD INPUT SPEC
PUSHJ P,DVLKP.## ;AND LOOKUP
PUSHJ P,E01FLE## ;[1174] GIVE ERROR MESSAGE
SETZM LSTBLK ;[1101] ASSUME BLOCK 0
SETZM DTAFLG ;[1101] AND ON DISK (NORMAL CASE)
MOVE T1,IO.CHR ;[1101] GET DEV CHARACTERISTICS
TXNN T1,DV.DTA ;[1101] ON DECtape?
JRST RETFSP ;RETURN SPACE
SETOM DTAFLG ;[1101] ON DECtape, REMEMBER THAT
SETOM LSTBLK ;[1101] FLAG FOR D.CNT IN LNKLOD
JRST RETFSP ;[1101] DONE, GO RETURN SPACE
;HERE TO MERGE NEW FILE SPEC WITH PREVIOUS ONE
MERGE: HLRZ T1,P1 ;GET POINTER TO FLAGS
MOVE FL,(T1) ;RESTORE THEM AS THEY WERE
MOVEI T2,1 ;GIVE BACK SPACE
PUSHJ P,DY.RET##
MOVE P2,F.INZR ;GET NEW SPEC
MOVE T4,F.MOD(P2) ;GET MODIFIER WORD
MOVE T1,F.DEV(P1) ;GET OLD DEVICE
MOVE T2,F.MOD(P1) ;[620] OLD MOD WORD
TXNE T2,FX.NDV ;[620] WAS THERE AN OLD DEVICE?
JRST .+3 ;[620] NO, USE NEW ONE ALWAYS
TXZE T4,FX.NDV ;[620] USER SUPPLIED NEW?
MOVEM T1,F.DEV(P2) ;NO, USE PREVIOUS
SKIPE F.NAME(P2) ;NEW NAME SUPPLIED?
JRST MERGE0 ;YES, USE IT
DGET T1,F.NAME(P1),F.NAMM(P1) ;NO, USE PREVIOUS & MASK
DSTORE T1,F.NAME(P2),F.NAMM(P2)
MERGE0: MOVE T1,F.EXT(P1)
MOVE T2,F.MOD(P1) ;GET OLD MOD WORD
TXNE T2,FX.NUL ;WAS OLD EXT VALID?
JRST .+3 ;NO, USE NEW ALWAYS
TXZE T4,FX.NUL ;SEE IF USER SUPPLIED NEW EXT
MOVEM T1,F.EXT(P2)
TXNN T4,FX.DIR ;NEW DIRECTORY?
JRST [MOVE T3,F.MODM(P2) ;NO, BUT CHECK FOR [-]
TXNE T3,FX.DIR ;WILL BE SET IF SO
JRST MERGE1 ;YES, SO LEAVE PPN = 0
HRLZI T1,F.DIR(P1) ;NO, USE OLD PPN
HRRI T1,F.DIR(P2)
BLT T1,F.LEN-1(P2) ;COPY SFDS ALSO
JRST MERGE1]
MOVE T1,F.DIR(P1) ;GET PREVIOUS PPN
MOVE T2,F.DIRM(P2) ;AND THIS MASK
TLNN T2,-1 ;PROJ SPECIFIED?
HLLM T1,F.DIR(P2) ;NO, USE PREV
TRNN T2,-1 ;PROG SPECIFIED?
HRRM T1,F.DIR(P2) ;NO
MERGE1: MOVEM T4,F.MOD(P2) ;STORE MODIFIED MOD WORD
MOVE T2,P2 ;USER MAY HAVE SUPPLIED EXTRA FILE SPECS
SKIPN F.NXT(T2) ;SO LOOK FOR END (0)
JRST .+3 ;GOT IT
MOVE T2,F.NXT(T2) ;NOT YET
JRST .-3
MOVE T1,F.NXT(P1) ;GET NEXT FILE SPEC
MOVEM T1,F.NXT(T2) ;LINK IN CHAIN
;NOW FOR SWITCHES
;LINK OLD SWITCHES IN FIRST SO NEW ONES CAN
;TURN THEM OFF
HLRZ T1,F.SWP(P1) ;GET POINTER
JUMPE T1,MERGE2 ;NONE
HRRZ T2,0(T1) ;GET POINTER TO NEXT
JUMPE T2,.+3 ;GOT LAST
MOVE T1,T2 ;NO
JRST .-3 ;KEEP TRYING
HLLZ T2,F.SWP(P2) ;GET FIRST NEW SWITCH
HLLM T2,0(T1) ;LINK IN
HLLZ T1,F.SWP(P1) ;GET START OF CHAIN
HLLM T1,F.SWP(P2) ;POINT TO NEW CHAINED LIST
MERGE2: ;NOW FOR AFTER SWITCHES
HRRZ T1,F.SWP(P1) ;GET POINTER
JUMPE T1,MERGE3 ;NONE
HRRZ T2,0(T1) ;GET POINTER TO NEXT
JUMPE T2,.+3 ;GOT LAST
MOVE T1,T2 ;NO
JRST .-3 ;KEEP TRYING
HRRZ T2,F.SWP(P2) ;GET FIRST NEW SWITCH
HRRM T2,0(T1) ;LINK IN
HRRZ T1,F.SWP(P1) ;GET START OF CHAIN
HRRM T1,F.SWP(P2) ;POINT TO NEW CHAINED LIST
MERGE3: MOVEI T1,0(P1) ;NOW REMOVE OLD
MOVEI T2,F.LEN
PUSHJ P,DY.RET##
SETZM F.EDIT ;SO WE DON'T LOOP
MOVE P,MARKWP ;RESET STACK TO POINT OF ERROR
JRST LNKWLD ;NOW TRY IT
SUBTTL HERE FOR ASCII TEXT BLOCK
;ENTER HERE TO MERGE ASCII TEXT BLOCK WITH CURRENT COMMAND TREE
;THERE ARE TWO POSSIBILITIES
;IF THE FIRST BLOCK HAS NO FILE SPEC, THEN THE SWITCHES APPLY TO
;THE CURRENT FILE BEING LOADED AS IF THEY HAD BEEN TYPED AFTER
;THE FILE NAME IN THE COMMAND LINE
;IF A FILE SPEC IS SEEN THEN THE NEW TREE IS ADDED TO THE IN CORE
;ONE AFTER THE CURRENT FILE, THE GLOBAL SWITCHES OF THIS DO NOT
;APPLY TO THE CURRENT FILE BEING LOADED
IFN .ASBLK,<
ASCMRG: SKIPE P1,F.INZR ;ANYTHING TO DO
SKIPE F.NAME(P1) ;ANY SWITCHES FOR THIS FILE?
JRST ASCRET## ;NO, RETURN TO FIXUP LISTS AND STACK
HRRZ T1,F.ASZR ;FIRST LINE OF .TEXT BLOCK?
JUMPN T1,ASCRET## ;NO, DON'T PROCESS IT NOW
MOVSS F.SWP(P1) ;FIRST MAKE THE SWITCHES LOCAL
SETOM NULSPC ;MAKE SURE WE DON'T LOAD ANYTHING
JRST NXTSPC ;YES, DO THEM NOW
>;END IFN .ASBLK
;HERE TO RETURN FILE SPACE TO POOL
;CALLS DY.RET WITH
;T1 = ADDRESS
;T2 = LENGTH
RETFSP: MOVE T2,F.NXT(P1) ;GET NEXT BLOCK
MOVEM T2,F.INZR ;ADVANCE POINTER
HRRZ T1,P1 ;SET ADDRESS
MOVEI T2,F.LEN ;SET LENGTH
PUSHJ P,DY.RET## ;GIVE BACK SPACE
SKIPL S.INZR ;LAST BLOCK CONTAIN /LINK?
JRST DEFGSW ;NO, PROCEED
MOVE T1,F.INZR ;SAVE REST OF COMMAND LINE
HRRZM T1,S.INZR ; UNTIL /LINK PROCESSING DONE
MOVEM FL,S.LHFL ;SAVE GLOBAL DEFAULTS TILL LATER
SETZM F.INZR ;FOR NOW, PRETEND EOL
SETZM F.NXZR ; SO GOTO NON-ZERO WILL BE NOTICED
;HERE TO HANDLE DEFERED SWITCHES
;SWITCHES ARE LINKED TO SWFLAG
;SKIP RETURNS ALWAYS
DEFGSW: HLRZ P2,SWFLAG ;GET SWITCHES BEFORE FILE NAME FIRST
JUMPE P2,CPOPJ1 ;NONE, GIVE UP FOR NOW
HRRZ T1,(P2) ;GET NEXT ADDRESS
HRLM T1,SWFLAG ;REMOVE FROM LIST
MOVE T2,2(P2) ;GET VALUE
PUSHJ P,@1(P2) ;RETURN TO SWITCH ACTION
HRRZ T1,P2 ;ADDRESS OF SWITCH BLOCK
HLRZ T2,(P2) ;SIZE
PUSHJ P,DY.RET## ;RESTORE SPACE TO POOL
JRST DEFGSW ;SEE IF ANY MORE
;HERE FOR DEFERED SWITCHES AFTER FILE NAME
;THEY GET EXECUTED JUST BEFORE NEXT FILE SPEC IS FOUND
DEFLSW: HRRZ P2,SWFLAG ;GET SWITCHES AFTER FILE NAME
JUMPE P2,CPOPJ ;NONE, GIVE UP
HRRZ T1,(P2) ;GET NEXT ADDRESS
HRRM T1,SWFLAG ;REMOVE FROM LIST
MOVE T2,2(P2) ;GET VALUE
PUSHJ P,@1(P2) ;RETURN TO SWITCH ACTION
HRRZ T1,P2 ;ADDRESS OF SWITCH BLOCK
HLRZ T2,(P2) ;SIZE
PUSHJ P,DY.RET## ;RESTORE SPACE TO POOL
JRST DEFLSW ;SEE IF ANY MORE
;HERE TO GIVE GOOD RETURN ALL DONE WITH LNKFIO FOR NOW
URET1: AOS (P) ;SKIP RETURN
URET: MOVE T1,MAPSW ;SEE IF A MAP TO DO
CAIN T1,$MAPNOW ;ONLY CASE WE CARE ABOUT
PJRST LNKMAP ;YES
POPJ P,
;USUAL RETURN SEQUENCE
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P,
;HERE TO HANDLE SWITCHES
;GLOBAL SWITCHES (LHS)
XCTGSW: DMOVE T1,1(P2) ;GET TOKEN # & VALUE
HLRZ T1,XCTSWT(T1) ;GET JUMP ADDRESS
PUSHJ P,(T1) ;DO SWITCH ACTION
PUSHJ P,XCTRET ;[2220] RETURN SWITCH SPACE
HRLM P2,F.SWP(P1) ;POINT TO NEW LINK (IN CASE REQUIRED)
JUMPN P2,XCTGSW ;XCT THIS SWITCH
POPJ P, ;RETURN END OF GLOBAL SWITCH CHAIN
;LOCAL SWITCHES (RHS)
XCTLSW: DMOVE T1,1(P2) ;GET TOKEN # & VALUE
HRRZ T1,XCTSWT(T1) ;GET JUMP ADDRESS
PUSHJ P,(T1) ;DO SWITCH ACTION
JUMPE P2,XCTLXX ;[730] JUMP IF NOTHING TO GIVE BACK
PUSHJ P,XCTRET ;[2220] RETURN SWITCH SPACE
HRRM P2,F.SWP(P1) ;POINT TO NEW SWITCH
JUMPN P2,XCTLSW ;XCT THIS SWITCH
XCTLXX: POPJ P, ;[730] RETURN END OF GLOBAL SWITCH CHAIN
;[2220] Here to return switch space. May contain long symbol blocks.
XCTRET: MOVE T1,1(P2) ;[2220] Get the flags
TXNN T1,SWT.S1 ;[2220] First argument a symbol?
JRST XCTRT1 ;[2220] No, check second
HLRZ T2,2(P2) ;[2220] Yes, get the count
TRNE T2,770000 ;[2220] Long symbol?
JRST XCTRT1 ;[2220] No, check second
JUMPE T2,XCTRT1 ;[2220] Don't return if zero length
HRRZ T1,2(P2) ;[2220] Yes, Get the address
PUSHJ P,DY.RET## ;[2220] Give back the space
MOVE T1,1(P2) ;[2220] Get the flags back
XCTRT1: TXNN T1,SWT.S2 ;[2220] Second argument a symbol?
JRST XCTRT2 ;[2220] No, return the block
HLRZ T2,3(P2) ;[2220] Yes, get the length
TRNE T2,770000 ;[2220] Long symbol?
JRST XCTRT2 ;[2220] No, return the block
JUMPE T2,XCTRT2 ;[2220] Don't return if zero length
HRRZ T1,3(P2) ;[2220] Yes, get the length
PUSHJ P,DY.RET## ;[2220] Give back the space
XCTRT2: HRRZ T1,P2 ;[2220] Setup address of this switch
HLRZ T2,(P2) ;[2220] And size
HRRZ P2,(P2) ;[2220] Get next switch
PJRST DY.RET## ;[2220] Return space
;HERE TO STORE SWITCHES THAT CAN NOT BE EXECUTED UNTIL FILE IS OPENED
;THE SWITCHES ARE STORED IN LINKED LISTS ANCHORED TO SWFLAG
;SWITCHES BEFORE FILE NAME ARE IN LEFT HALF
;SWITCHES AFTER FILE NAME IN RIGHT HALF
STRGSW: POP P,1(P2) ;STORE RETURN OVER TOKEN #
POP P,T1 ;REMOVE RETURN ADDRESS
MOVEI T2,SWFLAG ;START OF LIST
MOVE T1,T2 ;SAVE LAST ADDRESS
HLRZ T2,(T1) ;GET FIRST LINK ADDRESS
JUMPE T2,[HRLM P2,(T1) ;LINK FIRST ONE TO LEFT HALF
JRST STRGS1] ;REST TO RIGHT HALF
MOVE T1,T2 ;SAVE LAST
HRRZ T2,(T1) ;REST OF ADDRESS FROM RIGHT HALH
JUMPN T2,.-2 ;LOOK FOR END OF LIST
HRRM P2,(T1) ;LINK THIS BLOCK IN
STRGS1: MOVE T1,P2 ;SAVE ADDRESS
HRRZ P2,(P2) ;GET NEXT SWITCH BLOCK
HRLM P2,F.SWP(P1) ;ADVANCE TO NEXT SWITCH
HLLZS (T1) ;SET END OF CHAIN
JUMPN P2,XCTGSW ;HANDLE THIS ONE
POPJ P, ;END OF GLOBAL SWITCHES
;HERE FOR SWITCHES AFTER FILE NAME
STRLSW::POP P,T1 ;[2252] GET THE RETURN ADDRESS
HRRM T1,1(P2) ;[2252] STORE RETURN OVER TOKEN #
POP P,T1 ;REMOVE RETURN ADDRESS
MOVEI T2,SWFLAG ;START OF LIST
MOVE T1,T2 ;SAVE LAST ADDRESS
HRRZ T2,(T1) ;GET LINK ADDRESS
JUMPN T2,.-2 ;LOOK FOR END OF LIST
HRRM P2,(T1) ;LINK THIS BLOCK IN
MOVE T1,P2 ;SAVE ADDRESS
HRRZ P2,(P2) ;GET NEXT SWITCH BLOCK
HRRM P2,F.SWP(P1) ;DISCONNECT FROM THIS SWITCH
HLLZS (T1) ;SET END OF CHAIN
JUMPN P2,XCTLSW ;HANDLE THIS ONE
POPJ P, ;END OF GLOBAL SWITCHES
SUBTTL DISPATCH TABLE FOR SWITCHES
;XCTSWT IS A TABLE OF DISPATCH ADDRESSES FOR SWITCHES
;ONE WORD PER TOKEN #
;LHS=GLOBAL , RHS=LOCAL
DEFINE SWMAC (A,B,C,D,E,F,G,H,I)<
IF1,<BLOCK 1>
IF2,<
IFNDEF %'B,<EXTERN %'B>
IFNB <G>,<
IFNDEF .'B,<EXTERN .'B>
XWD .'B,%'B
>
IFB <G>,<
XWD %'B,%'B
>>>
;***** MUST USE XWD NOT ,, SINCE ".COMMON" IS A PSEUDO-OP IN MACRO.50
EXTERN .REQUEST ;SO IS .REQUEST
XALL
XCTSWT: SWTCHS
SALL
SUBTTL SWITCH ACTION -- /COMMON:name:len
%COMNM: SIXBIT \DEFINED-BY-SWITCH\ ;AVOID FORWARD REFERENCE AT DMOVE
%COMMON:
PUSHJ P,STRLSW ;WAIT TIL FILE IS LOADED
.COMMON:
PUSHJ P,.SAVE4## ;PRESERVE P1-P4
SKIPN W2,T2 ;SYMBOL
MOVE W2,['.COMM.'] ;BLANK COMMON IF NULL
SKIPN W1,CPSECT ;[2227] Get the psect information
JRST COMPSN ;[2227] None, ignore it
COMPSL: MOVE T2,PC.CMN(W1) ;[2227] Get a common block name
PUSHJ P,NAMCMP## ;[2356] Check for same name
JRST COMPSP ;[2227] Found it, go look for psect name
MOVE W1,PC.LNK(W1) ;[2227] Get pointer to next
JUMPN W1,COMPSL ;[2227] Check it if there is one
JRST COMPSN ;[2227] No /PSCOMMON for this block
COMPSP: MOVE W2,PC.PSC(W1) ;[2227] Get the psect name
MOVE R,RC.NO ;[2227] Start with the last psect
COMPPL: MOVE T1,@RC.TB ;[2227] Point the RC block
MOVE T2,RC.NM(T1) ;[2227] Get the name
PUSHJ P,NAMCMP## ;[2356] Check for same psect
JRST COMPPS ;[2227] Found it
SOJG R,COMPPL ;[2227] Not this one, try again
MOVE T1,W2 ;[2227] Get name in T1
PUSHJ P,E$$SRP## ;[2227] Complain about missing psect
COMPPS: MOVEM R,RC.CUR ;[2227] Note this is the psect index
SETOM MODTYP ;[2227] Make T.COMR think we're doing psects
MOVE W2,PC.CMN(W1) ;[2227] Restore the common block name
COMPSN: MOVE W1,3(P2) ;[2205] LENGTH OF COMMON
PUSH P,LSYM ;[2220] SAVE CURRENT SYMBOL POINTER
PUSHJ P,T.COMR## ;STORE IN GLOBAL TABLE
JRST [SETZM MODTYP ;[2227] NO FAKING PSECTS
SETZM RC.CUR ;[2227] FOR SETTING THE COMMON BLOCK
POP P,0(P) ;[2220] CLEAR THE AC
POPJ P,] ;[2220] WAS ALREADY THERE
;[2220] Here if new COMMON name. Remove the LS area triplets put in before,
;[2220] And put in a fake title block first.
MOVE T1,LSYM ;[2220] Get the new value
POP P,LSYM ;[2220] Restore the old last
SUB T1,LSYM ;[2220] Get the size
MOVNS T1 ;[2220] Negate it
ADDM T1,LS.PT ;[2220] Reset LS.PT
ADDM T1,LS.FR ;[2220] Account for it
PUSH P,W2 ;[2220] Save the (possibly long) name
MOVX W1,PT.SGN!PT.EXT!PT.TTL!PT.FAK
MOVEI W3,4*.L ;[2220] Get the size of this "program"
TLNE W2,770000 ;[2220] Long name?
JRST COMM1 ;[2220] No
HLRZ T1,W2 ;[2220] Get the length
LSH T1,-1 ;[2220] Find out how many extra secondaries
IMULI T1,.L ;[2220] Make it in words
ADD W3,T1 ;[2220] Account for them
COMM1: MOVE W2,%COMNM ;FIRST 6 CHARS
ADD W3,LSYM ;POINT TO WHERE FIRST TRIPLET WILL GO
PUSHJ P,LS.ADD## ;PUT IN LOCAL TABLE
MOVX W1,S.TTL!S.LST ;EXTENDED TITLE
DMOVE W2,%COMNM+1 ;REST OF NAME
PUSHJ P,LS.ADD##
POP P,W2 ;[2220] Get back the name
HRRZ P1,@HT.PTR ;SETUP P1 TO POINT TO SYMBOL
ADD P1,NAMLOC ;IN CORE
PUSH P,.L+2(P1) ;SAVE 2ND TRIPLET INFO
PUSH P,.L+0(P1)
MOVE W1,0(P1) ;[2220] Get the flags
MOVE W3,2(P1) ;[2220] And the value
PUSHJ P,LS.ADD## ;PUT IN LOCAL TABLE
POP P,W1 ;GET SECONDARY
POP P,W3 ;LENGTH
SKIPN R,RC.CUR ;[2227] DOING PSECTS?
MOVEI R,1 ;[2227] NO, PUT IT IN LOW SEGMENT
MOVE T1,@RC.TB ;[2227] GET RELOC TABLE
MOVE T2,W3 ;GET A DISPOSABLE COPY
ADDB T2,RC.CV(T1) ;BUMP CURRENT RC
CAMLE T2,RC.HL(T1) ;[1173] NEVER DECREASE
MOVEM T2,RC.HL(T1) ;[1173] UPDATE HIGHEST LOCATION IN THIS PSECT
MOVE T1,RC.SG(T1) ;[2227] GET THE SEGMENT NUMBER
CAML T2,HL.S0(T1) ;[2227] NEVER DECREASE HL.S1
MOVEM T2,HL.S0(T1) ;[2227] UPDATE HIGHEST LOCATION LOADED
SETZM MODTYP ;[2227] SET BACK TO NORMAL MODE
SETZM RC.CUR ;[2227] NO MORE PSECTS
PJRST LS.ADD## ;STORE AND RETURN
SUBTTL SWITCH ACTION -- /CORE:n
IFE TOPS20,<
%CORE:
CAIGE T2,1000 ;IN WORDS ALREADY?
LSH T2,^D10 ;NO, ASSUME K
SUBI T2,1 ;GET HIGHEST ADD
MOVE T1,HIORGN ;[650] HISEG ORIGIN
SUBI T1,1001 ;[650] HIGHEST LEGAL (1P FOR HELPER)
CAMG T2,T1 ;[650] REQUEST TOO BIG?
CAMG T2,.JBREL ;[650] OR TOO SMALL?
POPJ P, ;[650] YES, DON'T DO CORE UUO
MOVE T1,T2 ;[650] KEEP A COPY
CORE T2,UU.PHY ;[650] EXPAND, PHYSICALLY
CAIA ;[650] FAILED, SEE WHY
JRST E02EXP ;[1174] OK, TELL USER
MOVE T2,T1 ;[650] NOW TRY VIRTUALLY
PUSH P,.JBREL## ;[650] FIRST SAVE OLD SIZE
CORE T2, ;[650] CAN WE GET IT?
JRST [POP P,(P) ;[650] NO, CLEAR STACK
POPJ P,] ;[650] AND GIVE UP
POP P,T2 ;[650] NOW GIVE BACK VM PAGES
CORE T2, ;[650] TO GET SOME PHYSICALLY
JFCL ;[650] ??
MOVE T3,T1 ;[650] START AT USERS REQUEST
CORE1: SUB T3,.PGSIZ ;[650] TRY FOR ONE LESS
CAMG T3,.JBREL## ;[650] MAYBE WERE ALREADY AT LIMIT
JRST CORE2 ;[650] YEP, GIVE UP
MOVE T2,T3 ;[650] TEMP COPY
CORE T2,UU.PHY ;[650] GET IT?
JRST CORE1 ;[650] NO, TRY SMALLER
CORE2: CORE T1, ;[650] GET THE REST VIRTUALLY
JFCL ;[650] MONITOR BUG IF FAILS
E02EXP::.ERR. (MS,.EC,V%L,L%I,S%I,EXP) ;[1174]
.ETC. (COR,.EP,,,,.JBREL)
MOVE T2,.JBREL ;NEW TOP OF CORE
MOVEI T1,HG.TAB ;START AT TOP
SKIPN TAB.LB(T1) ;AND FIND AREA IN USE
SOJA T1,.-1 ;WILL FIND ONE EVENTUALLY
MOVEM T2,TAB.UB(T1) ;GIVE TOP AREA ALL FREE SPACE
PUSHJ P,.SAVE2## ;SAVE P1 AND P2
SETZB P1,P2 ;INDICATE JUST SHUFFLING
PUSHJ P,LNKCOR## ;NOW ADJUST ALL AREAS
JFCL ;NEVER FAILS
POPJ P, ;RETURN
> ;END OF IFE TOPS20
SUBTTL SWITCH ACTION -- /COUNTER
;/COUNTER CAUSES LINK TO PRINT A LIST OF ALL CURRENT RELOCATION COUNTERS, THEIR
;INITIAL VALUES AND THEIR CURRENT VALUES. THIS IS DONE BY USING A .ETC. MACRO
;LOOP TO PRINT EACH COUNTER LINE.
%COUNTER:
PUSHJ P,STRLSW ;WAIT TIL FILE LOADED
.COUNTER:
MOVEI R,1 ;[1174] START AT 1 (COUNTER .LOW.)
MOVE T1,@RC.TB ;[2247] LOOK AT .LOW.
SKIPGE RC.AT(T1) ;[2247] IS IT STILL RELOCATABLE?
MOVEI R,2 ;[2247] YES, START AT SECOND PSECT
E$$RLC::.ERR. (MS,.EC!.EN,V%L,L%F,S%I,RLC) ;[2247] TYPE THE HEADER
.ETC. (XCT,.EC,,,,<[CAMLE R,RC.NO]>) ;[2247] ANY COUNTERS?
.ETC. (JMP,.EC,,,,COUNNC) ;[2247] NO, TELL USER NO COUNTERS
.ETC. (STR,.EC,,,,,<Reloc. ctr. initial value current value limit value>) ;[2247]
COUNEX: .ETC. (XCT,.EC,,,,<[PUSHJ P,COUNGT]>) ;[1174] ANY MORE TO PRINT?
.ETC. (JMP,.EC,,,,COUNDN) ;[1174] NO--DONE
.ETC. (NLN,.EC) ;[1174] YES--NEW LINE FOR IT
.ETC. (SBX,.EC!.EP,,,,W1) ;[1174] RELOCATION COUNTER NAME
.ETC. (XCT,.EC,,,,<[PUSHJ P,COUNTB]>) ;[2276] GET HOW MANY TABS
.ETC. (NLN,.EC) ;[2276] LONG SYMBOL - NEEDS NEW LINE
.ETC. (STR,.EC,,,,W1) ;[2276]
.ETC. (OCT,.EC!.EP,,,,W2) ;[1174] INITIAL VALUE
.ETC. (XCT,.EC,,,,<[TLNN W2,^-7]>) ;[2276] TWO DIGIT SECTION NUMBER?
.ETC. (STR,.EC,,,,,< >) ;[2276] NO, NEED TWO TABS
.ETC. (STR,.EC,,,,,< >) ;[2276] TYPE A TAB
.ETC. (OCT,.EC!.EP,,,,W3) ;[1174] CURRENT VALUE
.ETC. (XCT,.EC,,,,<[TLNN W3,^-7]>) ;[2276] TWO DIGIT SECTION NUMBER?
.ETC. (STR,.EC,,,,,< >) ;[2276] NO, NEED TWO TABS
.ETC. (STR,.EC,,,,,< >) ;[2276] TYPE A TAB
.ETC. (OCT,.EC!.EP,,,,R2) ;[1300] LIMIT VALUE
.ETC. (JMP,.EC,,,,COUNEX) ;[1174] LOOP FOR REST
COUNNC: .ETC. (STR,.EC,,,,,<No relocation counters set>) ;[2247]
COUNDN: .ETC. (XCT,.EC,,,,<[PUSHJ P,COUNAB]>) ;[2247] ANY ABSOLUTE CODE?
.ETC. (JMP,.EC,,,,COUNNA) ;[2247] NO--DONE
.ETC. (NLN,.EC) ;[2247] YES--NEW LINE FOR IT
.ETC. (STR,.EC,,,,,<Absolute code loaded>) ;[2247]
COUNNA: .ETC. (NOP) ;[2247] NO-OP TO JUMP TO
POPJ P, ;[1174] DONE
;[2247] COUNAB IS CALLED TO CHECK FOR ABSOLUTE CODE
;[2247] SKIP RETURNS IF ABSOLUTE CODE HAS BEEN LOADED
COUNAB: SETZ R, ;[2247] WANT .ABS. PSECT
MOVE R,@RC.TB ;[2247] GET RC BLOCK POINTER
SKIPE RC.HL(R) ;[2247] ANYTHING THERE?
AOS 0(P) ;[2247] YES, SKIP RETURN
POPJ P, ;[2247] NO, RETURN
;COUNGT IS CALLED FROM THE ABOVE LNKRLC MESSAGE TO FIND THE NEXT RELOCATION
;COUNTER VALUES, IF ANY.
;
;CALL:
; R/ RELOCATION COUNTER TO CHECK
;RETURNS NON-SKIP IF NO MORE, OR SKIP WITH:
; W1/ NAME OF RELOCATION COUNTER
; W2/ INITIAL VALUE
; W3/ CURRENT VALUE
; R/ INCREMENTED FOR NEXT TIME
COUNGT: CAMG R,RC.NO ;[1174] ANY MORE?
SKIPN R2,@RC.TB ;[1174] ..
POPJ P, ;[1174] NO--NON-SKIP RETURN
MOVE W1,RC.NM(R2) ;[1174] FETCH RELOCATION COUNTER NAME
MOVE W2,RC.IV(R2) ;[1174] FETCH INITIAL VALUE
MOVE T1,RC.AT(R2) ;[1174] IF OVERLAID PSECT
TXNE T1,AT.OV ;[1174] ..
SKIPN W3,RC.HL(R2) ;[1174] THEN TRY HIGHEST SEEN SO FAR
MOVE W3,RC.CV(R2) ;[1174] ELSE JUST USE CURRENT VALUE
MOVE R2,RC.LM(R2) ;[1300] FETCH LIMIT VALUE
AOJA R,CPOPJ1 ;[1174] ADV TO NEXT AND GIVE SKIP RETURN
;[2276] COUNTB is called to figure out how many tabs are needed after
;[2276] after the psect name. Returns non-skip if needs a new line,
;[2276] pointer to tab string in W1.
COUNTB: MOVE T2,VERLVL ;[2276] Get the verbosity bits
TLNN W1,770000 ;[2276] Long symbol?
JRST COUNTL ;[2276] Yes
TXNN T2,M%P ;[2276] Doing prefix?
TRNN W1,77 ;[2276] No, six characters long?
SKIPA W1,[ASCIZ / /] ;[2276] No, use two tabs
MOVX W1,<ASCIZ / /> ;[2276] Yes, use one tab
JRST CPOPJ1 ;[2276] And no CRLF
COUNTL: HLRZ T1,W1 ;[2276] How many words
CAIG T1,2 ;[2276] Lots?
JRST COUNTM ;[2276] No, in the middle
MOVX W1,<ASCIZ / /> ;[2276] Yes, use two tabs
POPJ P, ;[2276] And a CRLF
COUNTM: MOVE T1,1(W1) ;[2276] Get the second word
TXNE T2,M%P ;[2276] Doing prefix?
TXNE T1,<7777777777> ;[2276] Yes, Last five characters set?
SKIPA W1,[ASCIZ / /] ;[2276] Need only one tab
MOVX W1,<ASCIZ / /> ;[2276] Need two tabs
JRST CPOPJ1 ;[2276] And no CRLF
COUNTN:
SUBTTL SWITCH ACTION -- /CPU:key, /CRLF:n
%CPU:
MOVE T1,CPUTBL-1(T2) ;[1240] GET CPU BIT
IORM T1,CPUTGT ;[1240] ADD NEW CPU
POPJ P,
%CRLF:
PUSHJ P,STRLSW ;WAIT TILL FILE IS LOADED
.CRLF:
SKIPN T2 ;IS THIS END OF ASCII BLOCK?
MOVE T2,FLAGS ;NO, MIDDLE OF ASCII BLOCK.
;RESET TO GLOBAL FLAGS (NEW LINE)
HLLZ FL,T2 ;STORE CORRECT GLOBAL FLAGS IN FL
HLR FL,FL ;LOCALS SAME AS GLOBALS SO FAR
POPJ P,
SUBTTL SWITCH ACTION -- /DEBUG:name, /TEST:name
.DEBUG:
SETOM DEBUGSW ;SIGNAL DEBUG START
SETOM EXECSW ;AND SIGNAL EXECUTION REQUIRED
.TEST:
SETZM S.DEBG ;[1313] RESET SO /LINK WILL WORK
SOSG T1,2(P2) ;NEED TO MAKE SPECIAL CASE CHECKS
SKIPE T1,DDEBUG ;TRY DEFAULT
SUBI T1,1 ; FOR COBDDT AND FORDDT
LSH T1,-1 ; SINCE THEY MUST BE LOADED AFTER MAIN
HRRM T1,DEBUGSW ;STORE INDEX IN THE FLAG
MOVE T1,DEBTBL(T1) ;NAME OF DEBUG PROGRAM
CAME T1,['FORDDT']
CAMN T1,['COBDDT']
JRST SPCDDT ;ITS A SPECIAL DDT
CAMN T1,['PASDDT'] ;[1435] PASCAL IS ALSO SPECIAL
JRST SPCDDT ;[1705] AS FOR FORDDT
DEBUG1: MOVEI T2,F.LEN ;GET A BLOCK OF SPACE FOR FILE SPECS
PUSHJ P,DY.GET## ;IN DYNAMIC AREA
HRRM P1,(T1) ;LINK INTO LIST TO DO
HRRM T1,F.INZR ;PUT DEBUG FIRST
HRLZ T2,(P2) ;GET NEXT SWITCH
HLLM T2,1(P1) ;FIX LIST OF SWITCHES TO DO
MOVE P1,T1 ;FORGET OTHER FILE SPEC FOR NOW
MOVSI T1,'SYS'
MOVEM T1,F.DEV(P1) ;COMES FROM SYS
HRRZ T1,DEBUGSW ;GET INDEX TO DEBUGGER
MOVE T1,DEBTBL(T1) ;PICK UP REQUIRED PROG
MOVEM T1,F.NAME(P1) ;STORE NAME
SETOM F.NAMM(P1) ;AND MASK
MOVSI T1,'REL' ;ASSUME EXT
HLLOM T1,F.EXT(P1) ;AND MASK
SUB P,[2,,2] ;ADJUST STACK
MOVE T1,P2 ;ADDRESS OF SWITCH BLOCK
HLRZ T2,(P2) ;SIZE
PUSHJ P,DY.RET## ;GIVE IT BACK
MOVSI T1,L.SYM ;MAKE LOCAL SYMBOLS DEFAULT
IORM T1,FLAGS
PUSHJ P,.LOCALS ;TURN ON LOAD LOCAL SYMBOLS
MOVE T1,F.NAME(P1) ;SEE IF ITS FORDDT
CAMN T1,['FORDDT'] ;[775] SINCE IT NEED ITS SYMBOLS
JRST [MOVSI T2,L.ISA ;[775] FORCE /NOSTART ON NEW LINES
IORM T2,FLAGS ;[775] ..
PUSHJ P,.NOSTART ;[775] AND ON THIS LINE
TRZ FL,R.ISA ;[775] BUT USE FORDDT'S START
JRST .+2] ;[775] LOAD FORDDT'S LOCALS
PUSHJ P,%NOLOCAL ;BUT NOT FOR THIS FILE
TRZ FL,R.LIB ;TURN OFF LIB SEARCH MODE
IFN TOPS20,< ;[2277]
CAMN T1,['DDT '] ;[2277] ONLY DDT IS SPECIAL
JRST [SETOM GETDDT ;[2277] REMEMBER TO MAP REAL DDT LATER
JRST ALGDDT] ;[2424] PUNT THIS SCAN BLOCK
> ;[2277] END IFN TOPS20
CAMN T1,['SIMDDT'] ;[1321] IS IT SIMDDT
JRST ALGDDT ;[1321] YES, SPECIAL CASE LIKE ALGDDT
CAME T1,['ALGDDT'] ;[1267] CHECK FOR ALGDDT
JRST LNKWLD ;[1267] NOT ALGDDT
ALGDDT: SETOM NULSPC ;[1321] IT'S ALGDDT - DONT LOAD ANYTHING
SETZM F.NAME(P1) ;[1267] SINCE ALGDDT IS PART OF ALGOTS
TRO FL,L.SYM ;[1267] TURN ON SYMBOLS
JRST NXTSPC ;[2424] GO BACK AND DON'T LOAD ANYTHING
SPCDDT: SKIPN MNTYPE ;HAVE WE LOADED A MAIN PROGRAM YET?
SKIPN F.NAME(P1) ; OR NO PROGRAM IN THIS SPEC
JRST DEBUG1 ;YES, SO IT'S OK TO LOAD ???DDT
PUSHJ P,.LOCALS ;LOAD MAIN PROG WITH LOCALS
AOS 2(P2) ;PUT BACK TOKEN VALUE
HRRZ T1,(P2) ;GET NEXT SWITCH
HRLM T1,F.SWP(P1) ;INTO TABLE
HRRZ T1,F.SWP(P1) ;GET NEXT RHS SWITCH
HRRM T1,(P2) ;LINK IN
HRRM P2,F.SWP(P1) ;AND IN SWITCH LIST
HLRZ P2,F.SWP(P1) ;GET NEXT LHS SWITCH
POP P,T1 ;GET RETURN OFF STACK
JUMPN P2,XCTGSW ;DO IT
POPJ P, ;ALL DONE
%DEBUG:
%TEST:
PUSHJ P,.LOCALS ;GET SYMBOLS FOR PROGRAM
HLRZ T2,0(P2) ;GET SPACE FOR SWITCH
ADDI T2,F.LEN ;AND FILE SPEC
PUSHJ P,DY.GET## ;IN DYNAMIC AREA
MOVX T2,FX.NDV ;[2424] REMEMBER USER DIDN'T REALY
IORM T2,F.MOD(T1) ;[2424] TYPE ANY SPEC HERE (IE. NO DEVICE).
HLLZ T2,(P2) ;GET LENGTH
MOVEM T2,F.LEN(T1) ;STORE IN SWITCH
DMOVE T2,1(P2) ;GET REST OF SWITCH
DMOVEM T2,F.LEN+1(T1)
MOVEI T2,F.LEN(T1) ;ADDRESS OF SWITCH BLOCK
MOVSM T2,F.SWP(T1) ;STORE AS GLOBAL
HRRZ T2,(P1) ;GET NEXT BLOCK
MOVEM T2,(T1) ;PUT DEBUG BEFORE IT
HRRM T1,S.DEBG ;[730] SAVE IT, IN CASE OF /LINK
HRRM T1,(P1) ;LINK DEBUG IN
POPJ P, ;RETURN
;TABLE OF NAMES OF DEBUGGING AIDS
DEFINE KEYMAC (A,B)<
IFIDN <A><DEB>,<
.ZZ==-1
IRP B,<
IFGE .ZZ,<
IFN .ZZ&1,<
IFNB <B>,<
SIXBIT \B\
>
IFB <B>,<
SIXBIT \DDT\
>>>
.ZZ==.ZZ+1
>>
PURGE .ZZ
>
XALL ;[1174]
DEBTBL: KEYWORDS
SALL ;[1174]
SUBTTL SWITCH ACTION -- /DDEBUG:name, /DEFINE:sym:val
%DDEBUG::
JUMPE T2,CPOPJ ;CHECK FOR NO ARGUMENT
SUBI T2,1 ;IGNORE DEFAULT
MOVEM T2,DDEBUG ;SAVE VALUE
POPJ P,
%DEFINE:
PUSHJ P,.SAVE4## ;SAVE P1-P4
MOVX W1,PT.SGN!PT.SYM
SKIPN W2,T2 ;GET SYMBOL
JRST E$$ZSV ;[1174] ZERO IS INVALID
MOVE W3,3(P2) ;AND VALUE
PJRST SY.GS## ;DEFINE SYMBOL
SUBTTL SWITCH ACTION -- /ENTRY
%ENTRY:
PUSHJ P,STRLSW ;WAIT TIL AFTER FILE LOADED
.ENTRY:
MOVE T1,[PUSHJ P,ENTNXT] ;[1174] SET UP NEXT SYMBOL ROUTINE
MOVEM T1,NXTGLB ;[1174] ..
MOVE W3,HT.PRM ;[1174] GET INDEX TO HASH TABLE
ADDI W3,1 ;[1174] START 1 UP FOR SOSGE BELOW
PUSHJ P,ENTNXT ;[1174] GET NEXT (FIRST) ENTRY POINT
PJRST E01LSS ;[1174] NONE THERE--GO SAY SO
E$$LSS::.ERR. (MS,.EC!.EN,V%L,L%F,S%I,LSS) ;[1174]
.ETC. (STR,.EC,,,,,<Library search symbols (entry points)>) ;[1174]
.ETC. (JMP,.EC,,,,.ETSAV##) ;[1174] GO PRINT SYMBOLS AND VALUES
;ENTNXT IS CALLED FROM THE ABOVE .ERR. TO RETURN THE NEXT ENTRY POINT SYMBOL AND
;VALUE.
;
;CALL:
; W3/ NEXT HASH TABLE INDEX TO LOOK AT
;RETURNS WITH NON-SKIP IF NO MORE, OTHERWISE SKIP RETURN WITH:
; W1/ NAME OF NEXT ENTRY POINT
; W2/ VALUE OF ABOVE
; W3/ UPDATED
ENTNXT: PUSHJ P,.SAVE4## ;[1174] SAVE LNKLOG'S P ACS
ENTLUP: SOSGE P2,W3 ;[1174] ANY MORE TABLE TO CHECK?
POPJ P, ;[1174] NO--DONE WITH NON-SKIP RETURN
SKIPN P3,@HT.PTR ;[1174] GET POINTER TO GS TRIPLET
JRST ENTLUP ;[1174] NONE THERE--TRY NEXT POINTER
ADD P3,GS.LB ;[1174] RELOCATE IN CASE IT MOVED
MOVE T1,0(P3) ;[1174] DO FLAGS SAY SYMBOL AND ENTRY?
TXNE T1,PT.SYM ;[1174] ..
TXNN T1,PS.ENT ;[1174] ..
JRST ENTLUP ;[1174] NO--TRY NEXT POINTER
MOVE W1,1(P3) ;[1174] YES--A WINNER! SET UP SYMBOL NAME
MOVE W2,2(P3) ;[1174] AND VALUE
TLNN W1,770000 ;[2216] LONG SYMBOL?
ADD W1,GS.LB ;[2216] YES, RELOCATE POINTER TO NAME
JRST CPOPJ1 ;[1174] DONE WITH SKIP RETURN
E01LSS::.ERR. (MS,.EC,V%L,L%F,S%I,LSS) ;[1174]
.ETC. (STR,,,,,,<No library search symbols (entry points)>) ;[1174]
POPJ P, ;[1174] DONE
SUBTTL SWITCH ACTION -- /ESTIMATE:n, /ERRORLEVEL:n, /EXECUTE
%ESTIMATE:
MOVEM T2,FEST ;STORE ESTIMATED LENGTH
SKIPE T1,IO.CHN ;WE MAY BE TOO LATE
SKIPL T1,IO.PTR(T1) ;FILE OPENED YET?
POPJ P, ;YES, GIVE IT UP
MOVEM T2,I.EST(T1) ;NO, STORE IN ENTER BLOCK
POPJ P,
%ERRORLEVEL:
MOVEM T2,ERRLVL ;STORE ERROR LEVEL
POPJ P,
%EXECUTE:
SETOM EXECSW ;SIGNAL EXECUTION REQUIRED
POPJ P,
SUBTTL SWITCH ACTION -- /FRECORE:n
%FRECORE:
MOVEM T2,FRECOR
POPJ P,
SUBTTL SWITCH ACTION -- /GO, /HASHSIZE:n
%GO:
MOVEI T1,GO## ;GET ADDRESS TO RETURN TO
IFN FTOVERLAY,<
SKIPL LNKMAX ;ANY OVERLAYS SEEN?
MOVEI T1,LINKGO## ;YES, DO FINAL STUFF
>
MOVEM T1,GOTO ;SIGNAL TERMINATION AFTER THIS LINE ENDS
POPJ P, ;RETURN
%HASHSIZE:
CAMG T2,HT.PRM ;SEE IF BIGGER THAN CURRENT SIZE
POPJ P, ;NO, LEAVE WELL ALONE
MOVEM T2,HASHSZ ;STORE NEW HASH SIZE
SETOM HSPACE ;CAUSE REHASH TO TAKE PLACE
POPJ P,
SUBTTL SWITCH ACTION -- /EXCLUDE:name, /INCLUDE:name, /NOINCLUDE
;INCLUDE/EXCLUDE SWITCHES
;HAVE STORED LIST OF PERM,,TEMP NAMES
;PERMANENT NAMES LAST UNTIL CLEARED OR END OR LINK
;TEMP NAMES ARE CLEARED AT END OF FILE
.EXCLUDE:
MOVSS EXCPTR ;SWAP PTR TO PUT PERMANENT PART INTO RH
MOVSS INCPTR
PUSHJ P,%EXCLUDE ;STORE NAME
MOVSS EXCPTR ;SWAP BACK
MOVSS INCPTR
MOVEI T1,INCPTR
PJRST EXCL0 ;REMOVE FROM TEMP ALSO
%EXCLUDE:
SKIPN W2,T2 ;GET SYMBOL IN SAFE PLACE
JRST E$$ZSV ;[1174] ZERO IS INVALID
MOVEI T1,EXCPTR ;GET INITIAL POINTER
PUSHJ P,INCL0 ;ADD THIS SYMBOL TO TABLE
MOVEI T1,INCPTR
PJRST EXCL0 ;AND REMOVE FROM OTHER TABLE
.INCLUDE:
TDO FL,[L.INC,,R.INC] ;[1117] ALWAYS SET INCLUDE MODE
SKIPN T2 ;[1117] SEE IF ANY ARGS TO STORE
POPJ P, ;[1117] NO--JUST RETURN
MOVSS EXCPTR ;SWAP PTR TO PUT PERMANENT PART INTO RH
MOVSS INCPTR
PUSHJ P,%INCLUDE ;STORE NAME
MOVSS EXCPTR ;SWAP BACK
MOVSS INCPTR
MOVEI T1,EXCPTR
PJRST EXCL0 ;REMOVE FROM TEMP ALSO
%INCLUDE:
TRO FL,R.INC ;TURN ON SPECIAL /INC MODE
SKIPN W2,T2 ;GET SYMBOL IN SAFE PLACE
POPJ P, ;DONE IF JUST FOO/INCLUDE
MOVEI T1,INCPTR ;GET INITIAL POINTER
PUSHJ P,INCL0 ;ADD THIS SYMBOL TO TABLE
MOVEI T1,EXCPTR
PJRST EXCL0 ;AND REMOVE FROM OTHER TABLE
.NOINCLUDE:
TDZ FL,[L.INC,,R.INC] ;[1117] TURN OFF INCLUDE MODE
POPJ P, ;[1117] CAN BE TURNED ON BY LATER /INCLUDE
%NOINCLUDE:
TRZ FL,R.INC ;[1117] TURN OFF LOCAL INCLUDE MODE
POPJ P, ;[1117] DONE
;ROUTINES TO SEARCH THE INCLUDE/EXCLUDE BLOCKS FOR A MATCH.
;CALL IS:
; MOVEI T1,ADDR OF LINK TO BLOCKS TO SEARCH
; MOVE W2,NAME OR LEN,,ADDR IF LONG
; PUSHJ P,INCL0/EXCL0/EXCL.0
; ONLY RETURN
;USES T1-T4, EXPECTS W2 SET UP. PRESERVES ALL OTHER AC'S.
;INCL0 INSERTS THE NAME IF NOT FOUND, EXCL0 DELETES IT IF FOUND.
INCL0: HRRZ T2,(T1) ;ANYTHING THERE?
JUMPE T2,INCNXT ;FIRST TIME
INCL1: HRRZ T1,(T1) ;GET POINTER TO NEXT BLOCK
ADD T1,[-.EXC+1,,1] ;FORM AOBJN PTR
INCL2: SKIPN T2,(T1) ;NOT IN TABLE IF ZERO
SOJA T1,INCL3 ;JUST ENTER
PUSHJ P,NAMCMP## ;[2356] DOES IT MATCH?
POPJ P, ;YES, SO ALREADY THERE
AOBJN T1,INCL2 ;TRY NEXT
SUBI T1,.EXC ;BACKUP
HRRZ T2,(T1) ;IF ZERO THIS IS END
JUMPN T2,INCL1 ;TRY AGAIN
; JRST INCNXT ;GET NEW BLOCK
INCNXT: PUSH P,T1 ;AND WHERE WE ARE
MOVEI T2,.EXC ;SIZE WE NEED
PUSHJ P,DY.GET## ;IN DYNAMIC AREA
POP P,T2 ;BACK POINTER
HRRM T1,(T2) ;LINK TO NEW
HRLZM T2,(T1) ;AND BACK TO OLD
INCL3:
SETOM 2(P2) ;[2220] DON'T RETURN LONG NAME BLOCK
MOVEM W2,1(T1) ;AND STORE THIS NAME
POPJ P,
EXCL.0:: ;ENTRY FROM T.6
EXCL0: HRRZ T2,(T1) ;ANYTHING THERE?
JUMPE T2,CPOPJ ;NO
EXCL1: HRRZ T1,(T1) ;GET POINTER TO NEXT BLOCK
ADD T1,[-.EXC+1,,1] ;FORM AOBJN PTR
EXCL2: SKIPN T2,(T1) ;NOT IN TABLE IF ZERO
POPJ P, ;RETURN
PUSHJ P,NAMCMP## ;[2356] SEE IF MATCHES
JRST EXCL3 ;YES, SO REMOVE
AOBJN T1,EXCL2 ;TRY NEXT
SUBI T1,.EXC ;BACKUP
HRRZ T2,(T1) ;IF ZERO THIS IS END
JUMPE T2,CPOPJ
JRST EXCL1 ;TRY AGAIN
EXCL3: HLRO T2,T1 ;GET NUMBER LEFT IN BLOCK
ADDI T2,.EXC ;AND SO NUMBER USED
MOVN T2,T2
ADDI T2,(T1) ;BACKUP TO LINK POINTER
HRRZ T3,(T2) ;NULL LINK IS END
JUMPE T3,EXCL4 ;GOT IT
HRRZ T2,(T2) ;GET NEXT POINTER
JRST .-3 ;LOOP
;HERE WHEN FOUND A BLANK ENTRY.
EXCL4: SKIPN 2(T2) ;IF ONLY ONE NAME IN BLOCK
JRST EXCL5 ;DELETE BLOCK ALSO
ADD T2,[-.EXC+1,,1] ;FORM AOBJN POINTER
SKIPE (T2) ;LOOK FOR NULL
AOBJN T2,.-1 ;OR END
MOVE T3,-1(T2) ;GET THIS MODULE NAME
EXCH T3,(T1) ;OVERWRITE PREV ONE
SETZM -1(T2) ;AND DELETE THIS
TLNE T3,770000 ;THIS A POINTER OR SYMBOL
POPJ P, ;SYMBOL, JUST RETURN
MOVEI T1,(T3) ;POINTER, MUST FREE BLOCK
MOVE T2,(T1) ;GET ADDR IN T1 AND LEN IN T2
ADDI T2,1 ;ACCOUNT FOR LENGTH WORD
PUSHJ P,DY.RET## ;FREE THE BLOCK AND RETURN
POPJ P,
EXCL5: MOVE T3,1(T2) ;GET ONLY NAME IN BLOCK
EXCH T3,(T1) ;OVERWRITE OLD
PUSH P,T2 ;SAVE POINTER TO BLOCK TO DELETE
TLNE T3,770000 ;IS THIS A SYMBOL OR POINTER
JRST EXCL6 ;JUST SYMBOL, DON'T DELETE SUB-BLOCK
MOVEI T1,(T3) ;SET UP FOR DY.RET
MOVE T2,(T1)
ADDI T2,1
PUSHJ P,DY.RET## ;FREE THE SUB-BLOCK
EXCL6: POP P,T1 ;RESTORE BLOCK PTR INTO T1
HLRZ T2,(T1) ;GET BACK LINK
HLLZS (T2) ;BREAK LINK
MOVEI T2,.EXC ;BLOCK SIZE
PJRST DY.RET## ;RETURN BLOCK
SUBTTL SWITCH ACTION -- /K, /LOGLEVEL:n, /MAXCORE:n
%K==CPOPJ ;/K IS JUST A KOMMAND, NO ACTION
%LOGLEVEL:
MOVEM T2,LOGLVL ;STORE LOG FILE MESSAGE LEVEL
POPJ P,
%MAXCORE:
CAIGE T2,1000 ;IN WORDS ALREADY?
IFE TOPS20,<
LSH T2,^D10 ;NO, ASSUME K
>
IFN TOPS20,<
LSH T2,9 ;NO, ASSUME P
>
SUBI T2,1 ;GET HIGHEST ADDRESS
MOVE T1,DY.AB ;SEE HOW MUCH WE ABSOLUTELY NEED
ADD T1,GS.AB
SUB T1,GS.LB ;+GLOBAL AREA
ADD T1,FX.AB
SUB T1,FX.LB ;+FIXUPS
IFN FTOVERLAY,<
ADD T1,RT.AB ;[650]
SUB T1,RT.LB ;[650] +RELOCATION TABLES
ADD T1,BG.AB ;[650]
SUB T1,BG.LB ;[650] +BOUND GLOBALS
> ;END IFN FTOVERLAY
ADDI T1,2*.IPS ;SYMBOLS + LOW CODE
SKIPE HC.LB
ADDI T1,.IPS ;+ HIGH CODE
SKIPE AS.LB ;[650]
ADDI T1,.IPS ;[650]
IOR. T1,.PGSIZ ;[650]
CAMGE T2,T1 ;GIVE WARNING
JRST E$$MTS ;[1174] AND IGNORE IF TOO SMALL
MOVEM T2,MAXCOR ;STORE MAXIMUM INCORE SIZE
MOVE T2,HIORGN ;GET START OF HISEG
SUBI T2,1001 ;MAX LOWSEG (1P FOR HELPER)
CAML T2,MAXCOR ;MAXCOR TOO BIG?
POPJ P, ;NO
MOVEM T2,MAXCOR ;YES, SET TO MAX ALLOWED
E$$MTB::.ERR. (MS,.EC,V%L,L%W,S%W,MTB,</MAXCOR: too big, >) ;[1174]
.ETC. (COR,.EC!.EP,,,,T2)
.ETC. (STR,,,,,,< used>)
POPJ P,
E$$MTS::.ERR. (MS,.EC,V%L,L%W,S%W,MTS,</MAXCOR: too small, at least >) ;[1174]
.ETC. (COR,.EC!.EP,,,,T1)
.ETC. (STR,,,,,,< is required>)
POPJ P,
SUBTTL SWITCH ACTION -- /MISSING
%MISSING:
PUSHJ P,STRLSW ;WAIT UNTIL CURRENT FILE IS LOADED
.MISSING:
PUSHJ P,.SAVE4## ;SAVE ALL P ACS IN CASE NEEDED
HLRO P1,INCPTR ;LH LT 0 MEANS NOT AN ERROR
MOVEI T1,[ASCIZ \[LNKIMM \] ;POINT TO PREFIX
MISNG1::PUSH P,T1 ;SAVE PREFIX ADDRESS
HRRZ T1,LOWSUB ;[605] ADDRESS OF TTY OUTSTR ROUTINE
PUSHJ P,.TYOCH## ;TELL SCAN
EXCH T1,0(P) ;SAVE OLD VALUE, RESTORE PREF ADDR
PUSHJ P,.TSTRG## ;TYPE PREFIX
MOVEI P2,(P1) ;GET ADDR OF INCLUDE CHAIN
JUMPE P2,MISNG5 ;IF NO CHAIN, NO INCLUDES
SETZ T1, ;INITIALIZE COUNT OF INCLUDES
MOVEI T2,(P1) ;T2 POINTS TO CURRENT BLOCK
MISNG2: HRRZ T3,(T2) ;GET THIS BLOCK'S LINK WORD
JUMPE T3,MISNG3 ;IF NOT FULL, GO FINISH LAST BLOCK
ADDI T1,.EXC-1 ;IT IS, ADD IN SIZE OF FULL BLOCK
MOVEI T2,(T3) ;POINT T2 TO NEXT BLOCK
JRST MISNG2 ;AND KEEP COUNTING
MISNG3: TLO T2,-.EXC+1 ;MAKE AOBJN-1 POINTER TO LAST BLOCK
MISNG4: SKIPE 1(T2) ;NEXT LOCATION FULL?
ADDI T1,1 ;YES, BUMP COUNT ONE MORE
AOBJN T2,MISNG4 ;LOOP OVER ENTIRE LAST BLOCK
SKIPE P2,T1 ;UNLESS ZERO....
PUSHJ P,.TDECW## ;OUTPUT NUMBER MISSING MODULES
CAILE P2,2 ;LEAVE 0 OR 1 ALONE
MOVEI P2,2 ;BUT MAP GT 2 INTO 2
MISNG5: MOVE T1,MISTAB(P2) ;GET ADDR OF CORRECT MESSAGE
PUSHJ P,.TSTRG## ;TYPE IT
TLNE P1,-1 ;LH NON-ZERO MEANS NO FILE SPEC
JRST MISNG6 ;THERE ISN'T ONE
MOVEI T1,[ASCIZ \ from file \]
PUSHJ P,.TSTRG## ;TYPE MORE OF MESSAGE
HRRZ T1,IO.PTR+DC ;POINT TO LAST .REL FILE LOADED
PUSHJ P,.TEBLK## ;TYPE OUT THE FILESPEC
MISNG6: JUMPGE P1,MISNG7 ;LH NON-NEG MEANS WAS AN ERROR
MOVEI T1,"]" ;OTHERWISE, JUST INFORMATIONAL
PUSHJ P,.TCHAR## ;SO TYPE A "]"
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MISNG7: PUSHJ P,.TCRLF## ;END MESSAGE GRACEFULLY
JUMPE P2,MISNGE ;DONE IF NONE MISSING
TLZ P1,-1 ;OTHERWISE MUST TYPE THEM ALL
MISNG8: TLO P1,-.EXC+1 ;FORM AOBJN-1 POINTER TO THIS BLOCK
MISNG9: SKIPN P3,1(P1) ;PICK UP NEXT NAME OR POINTER
JRST MISNGD ;ZERO?? SNH---JUST IGNORE
PUSHJ P,.TTABC## ;TAB OVER FOR NAME
MOVE T1,P3 ;PUT NAME IN PROPER AC
PUSHJ P,.TSYMB## ;[2220] PRINT IN SIXBIT
PUSHJ P,.TCRLF## ;[2220] END THE LINE
MISNGD: AOBJN P1,MISNG9 ;LOOP FOR THE ENTIRE INCLUDE BLOCK
HRRZ P1,-.EXC+1(P1) ;GET NEXT ADDRESS IF ANY
JUMPN P1,MISNG8 ;ANOTHER BLOCK -- GO PROCESS
MISNGE: POP P,T1 ;RESTORE OLD TYPE OUT ADDRESS
PJRST .TYOCH## ;REPLACE IT AND RETURN
;TABLE OF MESSAGES, DEPENDING ON NUMBER OF MODULES MISSING
MISTAB: [ASCIZ \No included modules missing\]
[ASCIZ \ included module missing\]
[ASCIZ \ included modules missing\]
SUBTTL SWITCH ACTION -- /MPSORT:key, /NOINITIAL, /NOJOBDAT
%MPSORT:
MOVEM T2,MAPSRT ;SAVE TYPE REQUIRED
JRST @MPSTBL-1(T2) ;DISPATCH TO RIGHT FUNCTION
%NOINITIAL:
IFN FTOVERLAY,<
SKIPL LNKMAX ;CAN ONLY SET IN ROOT LINK
POPJ P, ;JUST IGNORE, ITS TOO LATE
>
MOVE T1,GSYM ;GET CURRENT COUNT OF GLOBAL SYMBOLS
MOVE T2,LSYM ;AND LOCALS
CAMN T1,@GS.LB ;TEST AGAINST INITIAL
CAME T2,@LS.LB ;FOR BOTH GLOBAL & LOCAL
JRST E$$TDS ;[1174] TOO LATE TO CHANGE NOW
;RESET GLOBAL SPACE
MOVE T1,GS.LB ;GET BASE OF GLOBALS
SETZM (T1) ;CLEAR FIRST WORD
HRL T2,T1
HRRI T2,1(T1) ;FORM BLT PTR
BLT T2,@GS.PT ;UP TO FREE SPACE
ADDI T1,1 ;PRE-ALLOCATE FIRST WORD
HRRZ T2,HT.PTR ;START OF SPACE FOR HASH TABLE
SUBI T2,(T1) ;LENGTH OF ORIGINAL SYMBOL TRIPLETS
PUSHJ P,GS.RET## ;RETURN IT
SETZM GSYM ;NO SYMBOLS NOW
MOVEI T1,I.PRM ;INITIAL SYMBOLS
IMULI T1,.HS% ;HOW MUCH TO FILL
IDIVI T1,^D100
MOVEM T1,HSPACE ;HASH TABLE FULL ENOUGH AT THIS POINT
;NOW FOR LOCAL SYMBOLS
MOVE T1,LS.LB ;GET BASE
SETZM (T1) ;CLEAR FIRST WORD
HRL T2,T1
HRRI T2,1(T1) ;FORM BLT PTR
BLT T2,@LS.PT ;CLEAR UPTO FREE SPACE
MOVEI T2,1 ;PRE-ALLOCATE FIRST WORD
MOVEM T2,(T1)
MOVEM T2,LSYM
ADDI T1,1
MOVEM T1,LS.PT ;NEW FREE SPACE POINTER
SUB T1,LS.AB ;- FREE SPACE
MOVMM T1,LS.FR ;+
POPJ P,
E$$TDS::.ERR. (MS,,V%L,L%W,S%W,TDS,<Too late to delete initial symbols>) ;[1174]
POPJ P,
IFN TOPS20,< ;[2366]
%NOJOBDAT: ;[2211] SUPPRESS JOBDAT LOADING IN HI AND LOSEG
SETOM NOJBDA ;[2211] SPECIFY NO JOBDAT TO BE CREATED
POPJ P, ;[2211]
>;[2366] IFN TOPS20
SUBTTL SWITCH ACTION -- /LOCALS, /NOLOCAL, /NOSEARCH, /NOSTART
.LOCALS:
TLO FL,L.SYM ;LOAD WITH LOCAL SYMBOLS
%LOCALS:
TRO FL,R.SYM ;LOAD WITH LOCAL SYMBOLS (1 FILE ONLY)
SKIPN NOSYMS ;IF /NOSYM FALL INTO .NOLOCAL
POPJ P,
.NOLOCAL:
TLZ FL,L.SYM ;DON'T LOAD LOCAL SYMBOLS
%NOLOCAL:
TRZ FL,R.SYM ;DON'T LOAD LOCAL SYMBOLS (1 FILE ONLY)
POPJ P,
.NOSEARCH:
TLZ FL,L.LIB ;OUT OF LIBRARY SEARCH MODE
%NOSEARCH:
TRZ FL,R.LIB ;OUT OF LIBRARY SEARCH MODE (1 FILE ONLY)
POPJ P,
.NOSTART:
TLO FL,L.ISA ;IGNORE STARTING ADDRESSES
%NOSTART:
TRO FL,R.ISA ;IGNORE THIS STARTING ADDRESS
POPJ P,
SUBTTL SWITCH ACTION -- /NOSYMBOL, /OTSEGMENT:key, /PATCHSIZE:n,/PLTTYP:(DEFAULT,PLOTTER,PRINTER)
%NOSYMBOL:
SETOM NOSYMS ;DON'T WANT ANY SYMBOL TABLES
SETZM SYMFRM ;DON'T WANT
SETZM SYMSEG ;...
HRRZ T1,IO.PTR+%SC ;INCASE /SYMBOL
JUMPE T1,.NOLOCAL ;NO, BUT CLEAR FLAGS
SETZM IO.PTR+%SC ;SO WE DON'T OUTPUT THEM
MOVEI T2,F.LEN ;GIVE BACK SPACE
PUSHJ P,DY.RET##
JRST .NOLOCAL ;AND CLEAR JUST INCASE
%OTSEGMENT:
SUBI T2,1 ;DEFAULT IS 0
CAILE T2,2 ;NEW ARGS ARE 1 & 2
SUBI T2,2 ;ALLOW FOR LOW & HIGH
IFN FTOVERLAY,<
SKIPGE LNKMAX ;CAN ONLY SET IN ROOT LINK
>
MOVEM T2,OTSEG ;STORE INDEX TO EITHER LC OR HC
POPJ P,
%PATCHSIZE:
MOVEM T2,PATSPC ;SAVE PATCH SIZE
POPJ P,
%PLTTYP:: ;[2011]
JUMPE T2,E$$ZSV ;[2011] CHECK FOR ZERO SWITCH
MOVEM T2,PPTYPE ;[2011] STORE VALUE
POPJ P, ;[2011] DONE
SUBTTL SWITCH ACTION -- /REDIRECT:sym:sym
%REDIRECT: PUSHJ P,STRLSW ;[2223] Wait til file loaded
.REDIRECT: DMOVE W2,2(P2) ;[2223] Get both symbols
SKIPE W2 ;[2223] Low segment psect?
EXCH W2,REDLO ;[2223] Yes, store it and get old
SKIPE W3 ;[2223] High segment psect?
EXCH W3,REDHI ;[2223] Yes, store it and get old
DMOVEM W2,2(P2) ;[2223] Give back old symbols
MOVE T1,['.LOW. '] ;[2272] Get the default low seg psect
SKIPN REDLO ;[2272] Is there a low seg psect?
MOVEM T1,REDLO ;[2272] No, default it
MOVE T1,['.HIGH.'] ;[2272] Get the default high seg psect
SKIPN REDHI ;[2272] Is there a high seg psect?
MOVEM T1,REDHI ;[2272] No, default it
POPJ P, ;[2223] Done
SUBTTL SWITCH ACTION -- /REQUIRE:sym, /RUNCORE:n, /RUNAME:sym, /SEARCH
%REQUIRE:
PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVX W1,PT.SYM!PT.SGN ;SOME FLAGS
SKIPN W2,T2 ;PUT SYMBOL IN EXPECTED AC
JRST E$$ZSV ;[1174] ZERO IS INVALID
SETZ W3, ;ZERO VALUE FOR DUMMY REQUEST
PJRST SY.RQ## ;PUT IN REQUEST
%RUNCORE:
CAIGE T2,1000 ;IN WORDS ALREADY?
IFE TOPS20,<
LSH T2,^D10 ;NO, ASSUME K
>
IFN TOPS20,<
LSH T2,9 ;NO, ASSUME P
>
SUBI T2,1 ;HIGHEST ADDRESS
MOVEM T2,RUNCOR ;STORE SIZE FOR RUN UUO
SKIPN T2,3(P2) ;HIGH SEG SPECIFIED?
POPJ P, ;NO
CAIGE T2,1000 ;IN WORDS ALREADY?
IFE TOPS20,<
LSH T2,^D10 ;NO, ASSUME K
>
IFN TOPS20,<
LSH T2,9 ;NO, ASSUME P
>
SUBI T2,1 ;HIGHEST ADDRESS
MOVEM T2,RUNCOR+1 ;STORE SIZE FOR RUN UUO
POPJ P,
%RUNAME:
MOVEM T2,RUNAME ;STORE CORE IMAGE NAME
POPJ P,
.SEARCH:
TLO FL,L.LIB ;ENTER LIBRARY SEARCH MODE
%SEARCH:
TRO FL,R.LIB ;ENTER LIBRARY SEARCH MODE (1 FILE ONLY)
POPJ P,
SUBTTL SWITCH ACTION -- /NEWPAGE, /ONLY:key
%NEWPAGE:
PUSHJ P,STRLSW ;WAIT TIL FILE IS LOADED
.NEWPAGE:
HRRZ R1,HYLTBL-1(T2) ;GET SEGMENT #
MOVE R1,@SG.TB ;POINT TO DATA BLOCK
SKIPN T1,RC.CV(R1) ;GET CURRENT VALUE
POPJ P, ;NOT YET SETUP!
ADDI T1,777
ANDCMI T1,777 ;NEXT PAGE BOUND
MOVEM T1,RC.CV(R1) ;WRITE IT BACK
MOVEM T1,RC.HL(R1) ;[2077] STORE ALSO IN HIGHEST LOC LOADED
POPJ P,
$HYLLOW==1 ;LOW SEG
$HYLHIGH==2 ;HIGH SEG
.ONLY:
PUSHJ P,SETONL ;SET UP T1 AND T2
TLZ FL,(T1) ;CLEAR THESE FLAGS
TLOA FL,(T2) ;AND SET THESE
;SKIP NEXT INST.
%ONLY:
PUSHJ P,SETONL
TRZ FL,(T1) ;CLEAR
TRO FL,(T2) ;SET
POPJ P,
SETONL: HLRZ T1,ONLTAB-1(T2) ;GET FLAGS TO CLEAR
HRRZ T2,ONLTAB-1(T2) ;AND SET
POPJ P,
; CLEAR SET
ONLTAB: R.HSO!R.LSO,, 0 ;0
R.HSO,, R.LSO ;1
R.LSO,, R.HSO ;2
SUBTTL SWITCH ACTION -- /PSCOMMON:PSECT:COMMON
%PSCOMMON:
PUSHJ P,STRLSW ;[2227] Wait til file is loaded
.PSCOMMON:
MOVEI T2,PC.SIZ ;[2227] Need a block
PUSHJ P,DY.GET ;[2227] Get it
DMOVE W1,2(P2) ;[2227] psect in W1 Common in W2
SKIPN W2 ;[2227] Got a common block name?
MOVE W2,['.COMM.'] ;[2227] Blank common if null
JUMPE W1,E$$ZSV ;[2227] Must have a psect name
MOVE T2,CPSECT ;[2227] Get linked list pointer
MOVEM T2,PC.LNK(T1) ;[2227] Put it in the block
DMOVEM W1,PC.PSC(T1) ;[2227] Put the psect and common name in
SETOM 2(P2) ;[2227] Don't give back long psect name
SETOM 3(P2) ;[2227] Or long common block name
MOVEM T1,CPSECT ;[2227] Save pointer to block
POPJ P, ;[2227] Done
SUBTTL SWITCH ACTION -- /PVBLOCK:KEYWORD[:VALUE],/PVDATA:KEYWORD:VALUE
IFN TOPS20,<
%PVBLOCK:
IFN FTOVERLAY,<
SKIPN OVERLW ;[1423] USER TYPE /OVERLAY?
JRST %PVSG0 ;[1423] NO, PROCEED
CAIE T2,$SSGNONE ;[1423] NO PDV?
CAIN T2,$SSGLOW ;[1423] PDV IN LOW SEGMENT?
JRST %PVSG0 ;[1423] YES, ONLY LEGIT CASE
E$$OPL::.ERR. (MS,,V%L,L%W,S%W,OPL,<Overlaid program data vector must be in low segment>) ;[1423]
MOVEI T2,$SSGLOW ;[1423] PUT IT IN LOW SEG
%PVSG0:>
CAIN T2,$SSGPSECT ;[2306] IF PSECT, SIGNAL -1
SETO T2, ;[2306]
HRLM T2,PRGPDV ;[2306] STORE THE KEYWORD
JUMPGE T2,CPOPJ ;[1423] DONE UNLESS PSECT SPECIFIED
MOVE W2,3(P2) ;[1423] PICK UP PSECT NAME
EXCH W2,PVPNAM ;[2306] STASH AWAY FOR LATER, GET PREVIOUS
MOVEM W2,3(P2) ;[2306] RETURN PREVIOUS (IF ANY)
POPJ P,
%PVDATA:
HRRZ T4,PRGPDV ;[2306] GET THE PDV POINTER
SKIPN T4 ;[2306] CHECK PDV POINTER
PUSHJ P,PVFIX ;[1423] IF NONE, CONJURE ONE UP
DMOVE T1,2(P2) ;[2306] GET KEYWORD AND VALUE
CAIE T1,$PDVNAME ;[2306] IS THIS AN ASCII NAME?
JRST PDV0 ;[1423] MUST BE SYMBOLIC OR OCTAL ADDRESS
MOVE T4,PRGPDV ;[2306] SET UP T4 AS BLOCKPOINTER
EXCH T2,.PVNAM(T4) ;[2306] STORE THE POINTER IN THE NAME FIELD
JUMPE T2,CPOPJ ;[2306] EXIT IF NO OLD NAME
HRRZ T1,T2 ;[2306] GET THE ADDRESS OF THE OLD NAME
HLRZS T2 ;[2306] AND THE LENGTH
PUSHJ P,DY.RET## ;[2306] RETURN IT
POPJ P, ;[2306] DONE
PDV0: MOVE T3,1(P2) ;[2306] GET THE SYMBOL FLAGS
TXNN T3,SWT.S2 ;[2306] SECOND ARGUMENT A SYMBOL?
JRST PDV2 ;[1423] NO, MUST BE ABSOLUTE ADDRESS
MOVX W1,PT.SGN!PT.SYM!PS.GLB
;[1423] GO LOOK FOR SYMBOL
MOVE W2,3(P2) ;[2225] GET THE SYMBOL
PUSH P,P2 ;[1423] SAVE BLOCK POINTER
PUSHJ P,TRYSYM## ;[1423] GO FIND IT
JRST E$$USS ;[1423] COMPLAIN
JRST E$$USS ;[1423] COMPLAIN
MOVE T2,2(P1) ;[2306] SYMBOL VALUE FOUND
POP P,P2 ;[2306] GET THE BLOCK POINTER
MOVE T1,2(P2) ;[2306] RESTORE THE KEYWORD
PDV2: MOVE T4,PRGPDV ;[2306] SET UP T4 AS BLOCKPOINTER
CAIN T1,$PDVVERSION ;[2306] VERSION?
MOVEM T2,.PVVER(T4) ;[2306]
CAIE T1,$PDVEXPORT ;[2306] EXPORT ADDRESS
CAIN T1,$PDVSTART ;[2306] OR START ADDRESS?
MOVEM T2,.PVSTR(T4) ;[2306]
CAIN T1,$PDVPROGRAM ;[2306] PROGRAM BLOCK?
MOVEM T2,.PVPRG(T4) ;[2306]
CAIN T1,$PDVCBLOCK ;[2306] CUSTOMER BLOCK?
MOVEM T2,.PVCST(T4) ;[2306]
CAIE T1,$PDVMEMORY ;[2306] MEMORY BLOCK?
POPJ P, ;[2306] NO, DONE
MOVEM T2,.PVMEM(T4) ;[2306]
SETOM NOPDMP ;[2306] REMEMBER NO DEFAULT MAP
POPJ P,
PVFIX:: MOVEI T2,PV.LEN ;[1423] ASK FOR PDV STORAGE SPACE
PUSHJ P,DY.GET## ;[1423]
HRRM T1,PRGPDV ;[2306] KEYWORD,,PDV TEMP STORAGE
MOVEM T2,.PVCNT(T1) ;[1423] NOTE LENGTH OF PDV
MOVE T2,.JBVER ;[2306] LINK'S VERSION NUMBER
MOVEM T2,.PVLVR(T1) ;[2306] GOES INTO THE PDV
MOVE T2,DATIME ;[2306] GET SYSTEM DATE/TIME
MOVEM T2,.PVLTM(T1) ;[2306] STORE LINK TIME INTO PDV
POPJ P, ;[2306] AND CONTINUE DOING THE /PVDATA
;HERE IF THE SYMBOL IS UNDEFINED.
E$$USS::.ERR. (MS,.EC,V%L,L%W,S%W,USS,<Undefined symbol specified for /PVDATA: >)
.ETC. (SBX,.EP,,,,W2)
POP P,P2 ;[2306] RESTORE THE BLOCK POINTER
POPJ P, ;[2306] RETURN
> ;IFN TOPS20
SUBTTL SWITCH ACTION -- /SEGMENT:key
.SEGMENT:
PUSHJ P,SETSEG ;SET UP T1 AND T2
TLZ FL,(T1) ;CLEAR THESE FLAGS
TLOA FL,(T2) ;AND SET THESE
;SKIP NEXT INST.
%SEGMENT:
PUSHJ P,SETSEG
TRZ FL,(T1) ;CLEAR
TRO FL,(T2) ;SET
POPJ P,
SETSEG: HLRZ T1,SEGTAB-1(T2) ;GET FLAGS TO CLEAR
HRRZ T2,SEGTAB-1(T2) ;AND SET
IFN FTOVERLAY,<
;***** TEMP PATCH *****
SKIPL LNKMAX ;CAN ONLY SET IN ROOT LINK
CAIN T2,R.FLS ;BUT CAN SET FORCED LOW SEG
CAIA ;LEAVE AS IS
SETZB T1,T2 ;OTHERWISE IT CAUSES GREAT CONFUSION
;***** FIND BETTER FIX LATER *****
>
POPJ P,
; CLEAR SET
SEGTAB: R.FNS!R.FHS,,R.FLS ;[1201] LOW
R.FNS!R.FLS,,R.FHS ;[1201] HIGH
R.FLS!R.FHS,,R.FNS ;[1201] DEFAULT
R.FLS!R.FHS,,R.FNS ;[1201] NONE
SUBTTL SWITCH ACTION -- /SET:name:val
%SET:
PUSHJ P,STRLSW ;WAIT TIL FILE LOADED
.SET:
DMOVE W2,2(P2) ;SYMBOL & VALUE
JUMPE W2,E$$ZSV ;[1241] TEST FOR NO ARGUMENT
SETZB W1,RC.SET ;[2222] 0 IF COME HERE BY /SET SWITCH
MOVE T1,1(P2) ;[2220] GET THE SYMBOL FLAGS
TXNE T1,SWT.S2 ;[2220] SECOND ARGUMENT A SYMBOL?
JRST SET0A ;[2220] YES
JRST SET0B ;[2341] NO
.SET0:: MOVEM W1,RC.SET ;[763] KEEP ATTRIBUTES IN RC.SET
TLNN W3,770000 ;SYMBOLIC IF LEFT JUSTIFIED
JRST SET0B ;NO, MUST BE OCTAL
SET0A: MOVX W1,PT.SGN!PT.SYM ;SET FLAGS (NOT PT.EXT)
EXCH W2,W3 ;PUT SYMBOL IN W2 & SAVE W3
PUSHJ P,.SAVE4## ;SAVE P1-P4
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST SETUND ;[1174] NOT DEFINED
JRST SETUND ;[1174]
MOVE W2,W3 ;RECOVER W2
MOVE W3,2(P1) ;GET VALUE
SET0B: MOVEI R1,1 ;START AT 1 (.LOW.)
SET1: SKIPN R2,@RC.TB ;GET POINTER TO IT
JRST SET3 ;NON-LEFT, JUST INSERT
MOVE T2,RC.NM(R2) ;[2220] GET THE NAME
PUSHJ P,NAMCMP## ;[2356] SAME?
CAIA ;[2220] YES
JRST SET2 ;NO
CAMN W3,RC.CV(R2) ;YES, BUT SAME VALUE?
POPJ P, ;YES, GIVE UP
MOVE R,R2 ;SETUP RC POINTER
CAML W3,RC.CV(R2) ;NO, BUT ARE WE TRYING TO DECREASE VALUE?
JRST SET4 ;NO, OK TO INCREASE IT
MOVE W1,RC.IV(R2) ;GET INITIAL VALUE
CAMGE W3,W1 ;THIS /SET BELOW INITIAL?
JRST E$$SRB ;[1174] YES, DO NOT ALLOW IT
MOVE W1,RC.CV(R2) ;GET VALUE
E$$DRC::.ERR. (MS,.EC,V%L,L%W,S%W,DRC,<Decreasing relocation counter >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (STR,.EC,,,,,< from >)
.ETC. (OCT,.EC!.EP,,,,W1)
.ETC. (STR,.EC,,,,,< to >)
.ETC. (OCT,.EC!.EP,,,,W3) ;[1211]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
JRST SET4 ;AND CONTINUE
SET2: CAMGE R1,RC.NO ;[1132] CHECKED ALL WE'VE SET UP?
AOJA R1,SET1 ;NO
ADDI R,1 ;[1142] NOT THERE - INSERT IN NEXT FREE SLOT
SET3: PUSHJ P,.SAVE4## ;[1142] SAVE P1-P4
MOVX W1,PT.SGN!PT.SYM!PS.DDT ;[1157] SET FLAGS
PUSHJ P,SY.GS## ;[714] ADD TO GLOBAL SYMBOL TABLE.
CAMN W2,['.HIGH.'] ;THIS IS SPECIAL
JRST [MOVE W1,W3 ;AS IT CAUSES HIGH SEG TO APPEAR
PUSHJ P,SETRC## ;[1155] SETUP HIGHSEG RC BLOCK ETC.
MOVEI R,2 ;[1155] GET POINTER TO NEW RC BLOCK
MOVE R,@SG.TB ;[1155] ..
MOVE T1,RC.SET ;[1155] GET ATTRIBUTES
TXZ T1,AT.RP ;[1163] .HIGH. ALWAYS HAS AN ORIGIN
MOVEM T1,RC.AT(R) ;[1155] STORE
POPJ P,] ;[1155] RETURN
TLNE W2,770000 ;[2220] Long symbol?
JRST SET3A ;[2220] No
HLRZ T2,W2 ;[2220] Yes, get the length
PUSHJ P,DY.GET## ;[2220] Allocate space for it
HRL T1,W2 ;[2220] Build a BLT pointer
HRR W2,T1 ;[2220] Remember where it's going
ADDI T2,-1(T1) ;[2220] End for BLT
BLT T1,(T2) ;[2220] Copy the block
SET3A: SOSGE RC.FRE ;[2220] ANY FREE SLOTS
PUSHJ P,.SETEX ;NO, ALL USED
AOS R,RC.NO ;[1255] GET NEXT FREE
MOVEI T2,RC.INC ;SIZE WE WANT
PUSHJ P,DY.GET## ;GET IT
MOVEM T1,@RC.TB ;STORE POINTER
MOVEM T1,@RC.NTB ;[706]
HRL R,R ;[1304] RC.NTB,,RC.TB POINTERS
MOVEM R,@RC.MAP ;[1304] MAP INITIALLY TO SAME SLOT
MOVE R,T1 ;R POINTS TO RC BLOCK
MOVEI T1,1 ;[1142] ALL PSECTS ARE IN THE LC AREA
MOVEM T1,RC.SG(R) ;[1132] SEGMENT NUMBER
SET4: MOVE T1,RC.SG(R) ;[1142] FETCH SEGMENT NUMBER
EXCH R,T1 ;SWAP, PUT SEG # IN R
MOVE R,@SG.TB ;GET POINTER TO RC TABLE (.LOW. OR .HIGH.)
MOVE T3,RC.AT(T1) ;[763]
MOVE T2,T3 ;[1300] SAVE CURRENT ATTRIBUTES
IOR T3,RC.SET ;[763] ACCUMULATE THE ATTRIBUTES
SKIPL RC.SET ;[763] IF CURRENT ATTR INDICATED FIXED ORIGIN
TXZ T3,AT.RP ;[763] THAN CLEAR RELOC-PSECT BIT
TLNN W3,-1 ;[2247] NONZERO SECTION?
TXOA T3,AT.NC ;[2247] NO? SET NOCROSS
TXO T3,AT.NZ ;[1425] YES! SET NONZERO
MOVEM T3,RC.AT(T1) ;[763] UPDATE
CAMN R,SG.TB+1 ;[2247] IS THIS .LOW.?
TXZ T2,AT.RP ;[2247] YES, THEN IT IS NOT REALLY RELOCATABLE
TXNN T2,AT.RP ;[1300] PREVIOUSLY RELOCATABLE, OR
SKIPN RC.NM(T1) ;SETTING UP A NEW RC?
MOVEM W3,RC.IV(T1) ;YES, SET INITIAL VALUE
MOVEM W2,RC.NM(T1) ;SET UP RC NAME
MOVEM W3,RC.CV(T1) ;ALSO CURRENT
CAMLE W3,RC.HL(T1) ;[1132] HIGHEST LOCATION SO FAR?
MOVEM W3,RC.HL(T1) ;[1132] YES, STORE IT
MOVE T2,RC.LB(R) ;BASE OF AREA
MOVEM T2,RC.LB(T1)
DGET T2,RC.WD(R),RC.PG(R) ;LOWER CORE WINDOW & UPPER CORE WINDOW
DSTORE T2,RC.WD(T1),RC.PG(T1)
; IF THERE IS ALREADY A LIMIT, LEAVE IT ALONE.
; OTHERWISE, IF AT.NC=1, BOUND AT NEXT SECTION.
; IF AT.NC=0, BOUND AT 40,,0.
SKIPE RC.LM(T1) ;[1425] LIMIT ALREADY SET?
JRST SET5 ;[1425] LEAVE IT ALONE
HLLZ T2,RC.IV(T1) ;[1425] PICK UP CURRENT STARTING SECTION
ADD T2,[1,,0] ;[1425] SET NEXT SECTION AS LIMIT
MOVE T3,RC.AT(T1) ;[1425] CHECK BITS
TXNN T3,AT.NC ;[1425] BOUND AT NEXT SECTION?
MOVX T2,<40,,0> ;[1505] NOPE, END OF THE WORLD
MOVEM T2,RC.LM(T1) ;[1425] NO, SET DEFAULT LIMIT
SET5:
POPJ P,
SETUND: MOVEI T1,[ASCIZ /SET:/] ;[1174] SIGNAL UNDEFINED SYMBOL ERROR
PJRST E$$USI ;[1174] ..
E$$SRB::.ERR. (MS,.EC,V%L,L%W,S%W,SRB,<Attempt to set relocation counter >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (STR,.EC,,,,,< below initial value of >)
.ETC. (OCT,.EC!.EP,,,,W1) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
POPJ P, ;IGNORE SWITCH
.SETEX::MOVE T2,RC.NO ;GET NUMBER IN USE - 1
ADDI T2,RC.INC+1 ;GET SOME MORE
PUSH P,T2 ;[706]
PUSHJ P,DY.GET## ;[706] FROM FREE SPACE
HRLZ T3,RC.NTB ;[706] COPY FROM
HRR T3,T1 ;[706] TO
ADDI T2,(T1) ;[706] LIMIT
BLT T3,-1-RC.INC(T2);[706]
SUBI T2,RC.INC(T1) ;[1107] GET OLD LENGTH
MOVE T3,RC.NTB ;[1107] CURRENT POSITION
HRRM T1,RC.NTB ;[1107] NEW
HRRZ T1,T3 ;[1107] OLD
PUSHJ P,DY.RET ;[1107] RETURN SPACE
MOVE T2,0(P) ;[1304]
PUSHJ P,DY.GET## ;FROM FREE SPACE
HRLZ T3,RC.TB ;COPY FROM
HRR T3,T1 ;TO
ADDI T2,(T1) ;LIMIT
BLT T3,-1-RC.INC(T2)
SUBI T2,RC.INC(T1) ;GET OLD LENGTH
MOVE T3,RC.TB ;CURRENT POSITION
HRRM T1,RC.TB ;NEW
HRRZ T1,T3 ;OLD
PUSHJ P,DY.RET ;[1304] RETURN SPACE
POP P,T2 ;[1304]
PUSHJ P,DY.GET ;[1304] GET SPACE
HRLZ T3,RC.MAP ;[1304] COPY FROM
HRR T3,T1 ;[1304] TO
ADDI T2,(T1) ;[1304] LIMIT
BLT T3,-1-RC.INC(T2) ;[1304]
SUBI T2,RC.INC(T1) ;[1304] GET OLD LENGTH
MOVE T3,RC.MAP ;[1304] CURRENT POSITION
HRRM T1,RC.MAP ;[1304] NEW
HRRZ T1,T3 ;[1304] OLD
MOVEI T3,RC.INC-1 ;NUMBER NOW FREE
MOVEM T3,RC.FRE
PJRST DY.RET## ;RETURN SPACE
%LIMIT: ;[1300]
PUSHJ P,STRLSW ;[1300] WAIT TIL FILE LOADED
.LIMIT:
DMOVE W2,2(P2) ;[1300] SYMBOL & VALUE
JUMPE W2,E$$ZSV ;[1300] TEST FOR NO ARGUMENT
MOVE T1,1(P2) ;[2220] GET THE SYMBOL FLAGS
TXNE T1,SWT.S2 ;[2220] SECOND ARGUMENT A SYMBOL?
JRST LIM0A ;[2220] YES
.LIM0:: TLNN W3,770000 ;[1300] SYMBOLIC IF LEFT JUSTIFIED
JRST LIM1 ;[1300] NO, MUST BE OCTAL
LIM0A: MOVX W1,PT.SGN!PT.SYM ;[2220] SET FLAGS (NOT PT.EXT)
EXCH W2,W3 ;[1300] PUT SYMBOL IN W2 & SAVE W3
PUSHJ P,.SAVE4## ;[1300] SAVE P1-P4
PUSHJ P,TRYSYM## ;[1300] SEE IF DEFINED
JRST LIMUND ;[1300] NOT DEFINED
JRST LIMUND ;[1300]
MOVE W2,W3 ;[1300] RECOVER W2
MOVE W3,2(P1) ;[1300] GET VALUE
LIM1: MOVE R1,RC.NO ;[1300] SET UP FOR PSECT SEARCH
LIM2: SKIPN R2,@RC.TB ;[1300] GET POINTER TO IT
JRST LIM3 ;[1300] NON-LEFT, JUST INSERT
MOVE T2,RC.NM(R2) ;[2220] GET THE NAME
PUSHJ P,NAMCMP## ;[2356] SAME?
JRST LIM4 ;[1300] YES, GO PUT IN NUMBER
SOJG R1,LIM2 ;[1300] NO
LIM3: MOVX W1,AT.RP ;[1300] PSECT DOES NOT EXST YET
PUSH P,W3 ;[1300] REMEMBER THE LIMIT
SETZ W3, ;[1300] CLEAR IT SO NO LNKSRB
PUSHJ P,.SET0 ;[1300] CREATE IT AS RELOCATABLE
POP P,W3 ;[1300] GET IT BACK
JRST LIM1 ;[1300] TRY NOW TO FIND PSECT
LIM4: MOVEM W3,RC.LM(R2) ;[1300] GOT PSECT, STORE THE LIMIT
POPJ P, ;[1300] AND RETURN
LIMUND: MOVEI T1,[ASCIZ /LIMIT:/] ;[1300] SIGNAL UNDEFINED SYMBOL ERROR
PJRST E$$USI ;[1300]
SUBTTL SWITCH ACTION -- /SEVERITY:n, /START:n
%SEVERITY:
MOVEM T2,SEVLVL ;SAVE SEVERITY LEVEL
POPJ P,
.START:
TLZ FL,L.ISA ;BACK TO READING STARTING ADDRESSES
%START:
TRZ FL,R.ISA ;FOR THIS FILE ONLY
JUMPE T2,CPOPJ ;SPECIAL IF ADDRESS GIVEN
CAIN T2,.C ;CHECK FOR DEFAULT ARG
POPJ P, ;AND IGNORE IT
SETZM ENTLEN ;[2006] DEFAULT ARGUMENT LENGTH
SETZ T3, ;[1175] ASSUME SYMBOL NAME IS ZERO
MOVE T1,1(P2) ;[2220] GET THE SYMBOL FLAGS
TXNE T1,SWT.S1 ;[2220] ARGUMENT A SYMBOL?
EXCH T2,T3 ;[1175] SYMBOL, MAKE OFFSET BE ZERO
MOVEM T2,STADDR ;[1175] STORE FOR END OF LOADING
EXCH T3,STADDR+1 ;[2220] AND NAME (IF ANY), GET OLD
MOVEM T3,2(P2) ;[2220] STORE BACK SO SPACE WILL BE RETURNED
SETZM STANAM ;[655] DON'T KNOW MODULE NAME
PUSHJ P,.NOSTART ;[1270] AND IGNORE ALL OTHER STARTING ADDRESSES
JUMPE T3,CPOPJ ;[1270] DONE IF NOT SYMBOLIC
EXCH T2,T3 ;[1270] PUT SYMBOL NAME IN T2
PJRST %REQUIRE ;[1270] REQUEST SYMBOL IN CASE SEARCH
%SUPPRESS: ;[1307]
PUSHJ P,.SAVE4## ;[1307] SAVE ACS
MOVX W1,PT.SGN!PT.SYM!PS.REQ ;[1307] GET NEW BITS
SKIPN W2,T2 ;[1307] IS NAME ZERO?
JRST E$$ZSV ;[1307] YES, ERROR
PUSHJ P,TRYSYM ;[1307] FIND SYMBOL
POPJ P, ;[1307] SYMBOL UNKNOWN
POPJ P, ;[1307] SYMBOL UNDEFINED
AOS USYM ;[1307] ONE MORE UNDEFINED SYMBOL
MOVEM W1,0(P1) ;[1307] STORE NEW BITS
SETZM 2(P1) ;[1307] ZERO ADDRESS FIELD
POPJ P, ;[1307] RETURN
SUBTTL SWITCH ACTION -- /SYMSEG:name[:name], /SYSORT:key, /UPTO:n, /VERBOSITY:n
%SYMSEG:PUSHJ P,STRLSW ;[705] WAIT TIL FILE LOADED
.SYMSEG: ;[705]
CAIN T2,$SSGDEFAULT ;[1201] /SYMSEG:DEFAULT?
JRST [SETZM SYMSEG ;[1201] YES, DO IT
POPJ P,] ;[1201] GET OUT
IFN FTOVERLAY,<
SKIPN OVERLW ;[1176] USER TYPE /OVERLAY?
JRST %SYMSG ;[1176] NO, PROCEED
CAIE T2,$SSGLOW ;[1201] USER WANT LOW SEGMENT?
CAIN T2,$SSGNONE ;[1201] OR NO SYMBOLS?
JRST %SYMSG ;[1176] YES, ONLY POSSIBILITIES WITH OVERLAYS
E$$OSL::.ERR. (MS,,V%L,L%W,S%W,OSL,<Overlaid program symbols must be in low segment>) ;[1174]
MOVEI T2,$SSGLOW ;[1201] PUT THEM IN LOW SEG
%SYMSG:>
CAIN T2,$SSGPSECT ;[1201] A PSECT SPECIFIED?
JRST SYMS1 ;[721]
MOVEM T2,SYMSEG ;STORE INDEX TO EITHER LC OR HC
POPJ P, ;[1246]
SYMS1: SETOM SYMSEG ;[721]
MOVE W2,3(P2) ;[721] GET PSECT NAME
EXCH W2,SSGNAM ;[2220] STORE IT AWAY, GET THE OLD ONE
MOVEM W2,3(P2) ;[2220] GIVE IT BACK TO BE DELETED
POPJ P, ;[721] RETURN
%SYSORT:
JRST @SYSTBL-1(T2) ;DISPATCH TO RIGHT FUNCTION
POPJ P,
%UPTO: EXCH T2,SYMLIM ;[723] Save symbol table upper limit, get old
SKIPN SYMLMS ;[2220] Old limit symbolic?
JRST UPTO1 ;[2220] No
TLNE T2,-1 ;[2220] Length zero (or non-existant)?
TLNE T2,770000 ;[2220] Or a short symbol?
JRST UPTO1 ;[2220] Yes
HRRZ T1,T2 ;[2220] Get the address
HLRZ T2,T2 ;[2220] And the length
PUSHJ P,DY.RET## ;[2220] Give it back
SETZM SYMLMS ;[2220] Clear the flag
UPTO1: MOVE T1,1(P2) ;[2220] Get the symbol flags
TXNE T1,SWT.S1 ;[2220] Argument a symbol?
SETOM SYMLMS ;[2220] Yes, set the flag
SETOM 2(P2) ;[2220] Don't leave long symbol in block
POPJ P, ;[723]
%VERBOSITY:
MOVE T2,VERTBL-1(T2) ;GET VALUE
MOVEM T2,VERLVL ;SAVE VERBOSITY LEVEL
POPJ P,
$VERSHORT==M%P ;[1301] PREFIX ONLY
$VERMEDIUM==M%P!M%F ;[1301] PREFIX AND FIRST LINE
$VERLONG==M%P!M%F!M%C ;[1301] PREFIX, FIRST, AND CONTINUATION
SUBTTL SWITCH ACTION -- /UNDEFINED
%UNDEFINED:
PUSHJ P,STRLSW ;WAIT TIL AFTER FILE IS LOADED
.UNDEFINED:
MOVE T1,[PUSHJ P,UNDNXT] ;[1174] SET UP NEXT SYMBOL ROUTINE
MOVEM T1,NXTGLB ;[1174] ..
MOVE W3,HT.PRM ;[1174] SET UP INDEX TO HASH TABLE
ADDI W3,1 ;[1174] SET UP BY 1 FOR SOSGE BELOW
E$$UGS::.ERR. (MS,.EC!.EN,V%L,L%F,S%I,UGS) ;[1174]
.ETUGS::.ETC. (XCT,.EC,,,,<[PUSHJ P,UNDHDR]>) ;[1174] PRINT HEADER AND SEE IF ANY SYMBOLS
.ETC. (JMP,.EC,,,,.ETDON##) ;[1174] NO UNDEFINED SYMBOLS
.ETC. (JMP,,,,,.ETSAV##) ;[1174] GO PRINT SYMBOLS AND VALUES
;UNDHDR PRINTS THE APPROPRIATE HEADER FOR THE LNKUGS MESSAGE (EITHER NO, 1 OR N
;UNDEFINED GLOBALS). THE CARDINALITY OF THE HEADER IS DETERMINED BY LOOKING AT
;USYM, WHICH SOMETIMES GETS OUT OF SYNC WITH THE ACTUAL GS TABLE. BUT UNDNXT
;(BELOW) PRINTS ALL UNDEFINED GLOBALS REGARDLESS.
UNDHDR: SKIPN T1,USYM ;[1174] ANY SYMBOLS TO PRINT?
JRST UNDHD1 ;[1174] NO--PRINT 'NO' INSTEAD OF '0'
OUTVIA .TDECW## ;[1174] PRINT NUMBER OF UNDEFINED GLOBALS
UNDHD1: MOVE T1,USYM ;[1174] GET NUMBER OF UNDEFS BACK
CAILE T1,2 ;[1174] TURN MANY INTO 2 FOR HEADER MESSAGE
MOVEI T1,2 ;[1174] ..
MOVE T1,UNDTAB(T1) ;[1174] GET PROPER HEADER MESSAGE
OUTVIA .TSTRG## ;[1174] PRINT IT
PJRST UNDNXT ;[1174] RETURN, SETTING UP FIRST SYMBOL
;UNDNXT RETURNS THE NEXT UNDEFINED SYMBOL AND ITS VALUE.
;
;CALL:
; W3/ NEXT HASH TABLE INDEX TO CHECK
;RETURNS WITH A NON-SKIP RETURN IF NO MORE SYMBOLS. OTHERWISE, RETURNS WITH A
;SKIP RETURN WITH:
; W1/ SIXBIT SYMBOL NAME
; W2/ OCTAL VALUE
; W3/ UPDATED
UNDNXT::PUSHJ P,.SAVE4## ;[1174] SAVE LNKLOG'S P ACS
UGSLUP: SOSGE P2,W3 ;[1174] ANY MORE SYMBOLS TO CHECK?
POPJ P, ;[1174] NO--NON-SKIP RETURN
SKIPN P3,@HT.PTR ;[1174] ANY SYMBOL HERE?
JRST UGSLUP ;[1174] NO--TRY NEXT
ADD P3,GS.LB ;[1174] YES--RELOCATE SO WE CAN LOOK AT IT
MOVE T1,0(P3) ;[1174] GET SYMBOL'S FLAGS
TXNE T1,PT.SYM ;[1174] MUST BE A SYMBOL AND UNDEFINED
TXNN T1,PS.UDF!PS.REQ;[1174] ..
JRST UGSLUP ;[1174] NO--TRY NEXT
MOVE W1,1(P3) ;[1174] YES--A WINNER!! SET UP SYMBOL'S NAME
MOVE W2,2(P3) ;[1174] AND VALUE
TLNN W1,770000 ;[2216] LONG SYMBOL?
ADD W1,GS.LB ;[2216] YES, RELOCATE POINTER TO NAME
JRST CPOPJ1 ;[1174] DONE--GIVE SKIP RETURN
UNDTAB: [ASCIZ /No undefined global symbols/]
[ASCIZ / undefined global symbol/]
[ASCIZ / undefined global symbols/]
SUBTTL SWITCH ACTION -- /SYSLIBRARY, /NOSYSLIBRARY
%SYSLIBRARY:
PUSHJ P,STRLSW ;WAIT TIL FILE IS LOADED
.SYSLIBRARY:
SOJE T2,SYSLB1 ;DEFAULT ACTION IF INDEX WAS 1
; LOAD FROM LIBRARIES AND RETURN
; FROM /SYSLIBRARY (SOJ/PJUMPE)
MOVE T1,LIBTBL(T2) ;GET REQUIRED BIT
IORM T1,LIBPRC ;[653] REMEMBER TO SEARCH THIS LIBRARY
ANDCAM T1,NOLIBS ;AND TURN OFF THIS BIT INCASE /NOSYSL
POPJ P, ;AND RETURN
;WILL LOAD AT DEFAULT TIME
;ROUTINE TO CAUSE ALL SPECIFIED AND DEFAULT LIBRARIES
;TO BE SEARCHED, AND ANY MODULES WHICH MATCH TO BE LOADED.
;CALLED BY
; PUSHJ P,SYSLB1
; RETURN
;NO PARAMETERS ARE PASSED OR RETURNED IN THE AC'S
;P1 THROUGH P4 ARE PRESERVED
SYSLB1::PUSHJ P,.SAVE4## ;PRESERVE P1-P4
PUSH P,FL ;SAVE FLAGS
PUSH P,F.INZR ;AND CURRENT
PUSH P,F.NXZR ;AND PENDING FILE SPECS
SETZM F.INZR ;CLEAR LIST
SETZM F.NXZR ;SO WE JUST LOAD DEFAULTS
PUSH P,GOTO ;SAVE INCASE EOL SEEN
PUSH P,[LODTST##] ;FAKE RETURN TO LOAD ROUTINE
PUSHJ P,LIBRARY## ;LOAD DEFAULT LIBS
POP P,GOTO ;RESTORE EOL INTERCEPT
POP P,F.NXZR ;RESTORE PENDING FILE SPECS
POP P,F.INZR
POP P,FL ;AS WE WERE
POPJ P,
%NOSYSLIBRARY:
SOSE T2 ;DEFAULT ACTION IF WAS 1
SKIPA T1,LIBTBL(T2) ;NO
SETO T1, ;YES, TURN THEM ALL OFF
IORM T1,NOLIBS ;DON'T WANT THESE DEFAULT LIBS
POPJ P,
SUBTTL SWITCH ACTION -- /USERLIBRARY:key
%USERLIBRARY:
MOVEI T2,F.LEN ;SPACE TO STORE FILE SPEC
PUSHJ P,DY.GET##
ADDI T2,-1(T1) ;END OF BLT
HRLZI T3,1(P1) ;FROM
HRRI T3,1(T1) ;TO
BLT T3,(T2) ;ALL EXCEPT FIRST WORD
SOSLE T2,2(P2) ;[1324] IS IT /USERLIB:ANY?
SKIPA T2,LIBTBL(T2) ;[1324] NO, GET COMPILER TYPE BIT
SETO T2, ;[1324] YES, SET ALL THE BITS
MOVEM T2,1(T1) ;SAVE IN SWITCH FIELD
EXCH T1,USEPTR ;POINT TO LATEST ENTRY
MOVEM T1,@USEPTR ;AND LINK IT IN
ZFPOPJ: HRLZI T1,2(P1)
HRRI T1,3(P1)
SETZM 2(P1)
BLT T1,F.LEN-1(P1) ;ZERO FILE SPEC
MOVX T1,FX.NDV ;[2424] REMEMBER USER DIDN'T REALY
IORM T1,F.MOD(P1) ;[2424] TYPE ANY SPEC HERE (IE. NO DEVICE).
POPJ P,
SUBTTL SWITCH ACTION -- /NOUSERLIBRARY
%NOUSERLIBRARY:
MOVEI T1,USEPTR ;START OF CHAIN
NOUSE1: HRL T1,T1 ;SAVE LAST
HRR T1,(T1) ;GET NEXT
TRNN T1,-1 ;0 IS END
JRST ZFPOPJ ;NOT FOUND
SKIPN F.NAME(P1) ;SPECIAL IF NO FILE NAME
JRST NOUSE3 ;AS IT MEANS DELETE ALL
DMOVE T2,F.DEV(T1) ;GET DEV & FILE
CAMN T2,F.DEV(P1)
CAME T3,F.NAME(P1)
JRST NOUSE1 ;NOT SAME
MOVE T2,F.EXT(T1)
MOVE T3,F.DIR(T1)
CAMN T2,F.EXT(P1)
CAME T3,F.DIR(P1)
JRST NOUSE1
MOVEI T3,F.DIR+2(T1) ;NOW FOR SFDS
MOVEI T4,F.DIR+2(P1)
HRLI T4,-5
NOUSE2: MOVE T2,(T3)
CAME T2,(T4)
JRST NOUSE1 ;DIFFERENT
ADDI T3,2 ;GET NEXT
ADDI T4,1
AOBJN T4,NOUSE2 ;NOT YET DONE
MOVE T2,(T1) ;NOW REMOVE IT BUT FIRST
MOVS T1,T1 ; LINK IN NEXT PTR
MOVEM T2,(T1)
HLRZ T1,T1
MOVEI T2,F.LEN
PUSHJ P,DY.RET##
JRST ZFPOPJ ;AND DELETE FILE SPEC
NOUSE3: MOVE T2,(T1) ;NOW REMOVE IT BUT FIRST
MOVS T1,T1 ; LINK IN NEXT PTR
MOVEM T2,(T1)
HLRZ T1,T1
MOVEI T2,F.LEN
PUSHJ P,DY.RET##
SKIPE USEPTR ;ANY MORE?
JRST %NOUSERLIB ;YES
JRST ZFPOPJ ;NO, DELETE FILE SPEC
SUBTTL SWITCH ACTION -- /VALUE:sym
;/VALUE:SYMBOL PRINTS THE VALUE OF THE SYMBOL (IF IT HAS ONE YET), ALONG WITH
;SOME STATUS INFORMATION (E.G., COMMON).
%VALUE:
PUSHJ P,STRLSW ;WAIT TIL FILE LOADED
.VALUE:
MOVX W1,PT.SGN!PT.SYM ;SET FLAGS
SKIPN W2,T2 ;[1174] SET UP SYMBOL FOR TRYSYM AND CHECK FOR 0
JRST E$$ZSV ;[1174] ZERO IS INVALID
SETZ W3, ;[605] VALUE 0 UNLESS LONG SYMBOL
E$$VAL::.ERR. (MS,.EC,V%L,L%F,S%I,VAL,<Symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2) ;[1174]
.ETC. (ASC,.EC,,,,.CHTAB) ;[1174]
.ETC. (XCT,,,,,<[PUSHJ P,VALOUT]>) ;[1174] THE REST IS COMPLEX
POPJ P, ;[1174] DONE
;VALOUT IS CALLED FROM THE MIDDLE OF THE ABOVE .ERR. MESSAGE TO PRINT THE
;VARIABLE PORTION OF THE MESSAGE.
VALOUT: PUSHJ P,.SAVE4## ;[1174] SAVE LNKLOG'S P ACX
PUSHJ P,TRYSYM## ;SEE IF IN TABLE
JRST VALOND ;[1174] SYMBOL NEVER DEFINED
JRST VALOUN ;[1174] SYMBOL UNDEFINED
MOVE T1,2(P1) ;[1174] PRINT VALUE IN OCTAL
OUTVIA .TOCTW## ;[1174] ..
MOVE T1,0(P1) ;[1174] CHECK FOR COMMON BLOCKS
TXNE T1,PS.COM ;[1174] ..
JRST VALOCM ;[1174] GO PRINT LENGTH OF COMMON
MOVEI T1,[ASCIZ / defined/] ;[1174] OTHERWISE JUST ORDINARY SYMBOL
VALOST: OUTVIA .TSTRG## ;[1174] PRINT STATUS OF SYMBOL
POPJ P, ;[1174] DONE
VALOCM: MOVEI T1,[ASCIZ / common, length /] ;[1174] START STATUS OF SYMBOL
OUTVIA .TSTRG## ;[1174] ..
MOVE T1,.L+2(P1) ;[1174] PRINT LENGTH IN DECIMAL
OUTVIA .TDECW## ;[1174] ..
MOVEI T1,[ASCIZ /./] ;[1174] A DOT TO INDICATE DECIMAL
PJRST VALOST ;[1174] GO PRINT STATUS AND RETURN
VALOND: MOVEI T1,[ASCIZ /unknown/] ;[1174] HAVEN'T SEEN THE SYMBOL YET
PJRST VALOST ;[1174] GO PRINT STATUS AND RETURN
VALOUN: MOVE T1,2(P1) ;[1174] PRINT VALUE IN OCTAL
OUTVIA .TOCTW## ;[1174] ..
MOVEI T1,[ASCIZ / undefined/] ;[1174] ONLY SEEN REFERENCES SO FAR
PJRST VALOST ;[1174] GO PRINT STATUS AND RETURN
SUBTTL SWITCH ACTION -- /VERSION:ver
%VERSION:
PUSHJ P,STRLSW ;[1122] WAIT TIL FILE INITED
.VERSION:
MOVE T2,2(P2) ;[1122] GET VALUE
SKIPE T1,IO.CHN ;[1122] GET CURRENT CHAN#
CAIN T1,DC ;[1122] IF 0 OR INPUT CHAN
JRST [MOVEM T2,VERNUM ;[1122] STORE VERSION NUMBER
POPJ P,] ;[1122] IN CORE
MOVE T1,IO.PTR(T1) ;[1122] IF OUTPUT SPEC
MOVEM T2,I.VER(T1) ;[1122] SAVE IN DATA BLOCK
POPJ P, ;[1122]
SUBTTL SWITCH ACTION -- /SSAVE, /SAVE
IFN FTEXE,<
%SSAVE:
IFE TOPS20,< ;[2423] /SSAVE = /SAVE FOR TOPS20
SKIPA T1,[0,,SS.SHR] ;[2423] SET SHARABLE FOR TOPS10
> ;END IFE TOPS20 ;[2423]
%SAVE: SETZ T1,
MOVEM T1,SSEXT
PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
IFN TOPS20,<
SKIPN T1,F.EXT(P1) ;USER SUPPLY EXT?
> ;END IFN TOPS20
MOVSI T1,'EXE' ;NO, DEFAULT EXT
HLLM T1,SSEXT ;SAVE EXT
HLLOM T1,F.EXT(P1) ;UPDATE EXT
MOVE T1,F.NAME(P1) ;GET REAL NAME
MOVEM T1,SSNAME ;AND SAVE IT
PUSHJ P,DVOUT.## ;SET UP DATA BLOCK
%VC,,.IODPR ;USE DUMP MODE
PJRST RESTP1 ;RETURN THIS BLOCK NOW
>;END OF IFN FTEXE
IFE FTEXE,<
%SAVE:
MOVSI T1,'HGH' ;STORE NON-SHARABLE EXTENSION
JRST SSAVE
%SSAVE:
MOVSI T1,'SHR' ;SHARABLE HIGH SEG EXT
SSAVE: PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
HLR T1,F.EXT(P1) ;INCASE USER SUPPLIED LOW EXT
MOVEM T1,SSEXT ;SAVE REAL EXT FOR LATER
HLLOM T1,F.EXT(P1) ;STORE DEFAULT EXT
MOVE T1,F.NAME(P1) ;GET REAL NAME
MOVEM T1,SSNAME ;AND SAVE IT
PUSHJ P,DVOUT.## ;SETUP DATA BLOCK
%VC,,.IODPR ;USE DUMP MODE
PJRST RESTP1 ;RETURN THIS BLOCK NOW
>;END OF IFE FTEXE
SUBTTL SWITCH ACTION -- /SYFILE:key
%SYFILE:
SKIPE NOSYMS ;IF NOT WANTED
PJRST DEFRET ;DON'T DO IT
PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
MOVE T1,SYMTBL-1(T2) ;GET FLAG
MOVEM T1,SYMFRM ;SHOW WHICH ONE
MOVSI T1,'SYM' ;FILE EXT
MOVEM T1,F.EXT(P1)
PUSHJ P,DVOUT.## ;SET UP DATA BLOCK
%SC,,.IODPR
MOVE T1,IO.PTR+%SC ;[1230] USE PROPER CHANNEL FOR PROPER
MOVE T2,SYMFRM ;[1230] SYMBOL FILE
MOVE T2,[EXP <Z MC,>,<Z MC,>,<Z SC,>,<Z AC,>]+1(T2) ;[1230] ..
MOVEM T2,I.CHN(T1) ;[1230] ..
PJRST RESTP1
SUBTTL SWITCH ACTION -- /XPN, /MAP:key
%XPN:
PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
MOVSI T1,'XPN' ;EXPANDED SAVE FILE
MOVEM T1,F.EXT(P1) ;IE CORE IMAGE
PUSHJ P,DVOUT.## ;SETUP DATA BLOCK
%XC,,.IODPR
PJRST RESTP1
%MAXNODE::
.MAXNODE::
CAIG T2,.DBS ;[1424] AT LEAST ^D128
MOVEI T2,.DBS ;[1424] IGNORE SILLY REQUEST
HRRM T2,L.MAX ;[1424] SET MAXIMUM NUMBER OF LINKS
POPJ P, ;[1424] AND RETURN
%MAP:
PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
MOVE T1,MAPTBL-1(T2) ;GET CODE
MOVEM T1,MAPSW ;SAVE IT
JUMPGE T1,MAPOK ;-1 NOT YET AVAILABLE
E$$IMA::.ERR. (MS,0,V%L,L%W,S%W,IMA,<Incremental maps not yet available>) ;[1174]
MAPOK: MOVSI T1,'MAP' ;DEFAULT EXT
SKIPN F.EXT(P1) ;ALREADY SET
HLLOM T1,F.EXT(P1) ;NO
PUSHJ P,DVOUT.## ;SET UP DATA BLOCK
MC,,.IOASC
PJRST RESTP1 ;RETURN, BUT DON'T LOAD THIS FILE
;ROUTINE COPYP1 - COPIES THE DATA BLOCK POINTED TO BY P1 TO A NEW BLOCK
;STORES THE OLD P1 IN LH P1 AND NEW BLOCK PTR IN RH P1
COPYP1::PUSH P,T1 ;SAVE EXT
PUSH P,T2 ;SAVE ARG
MOVEI T2,F.LEN ;LENGTH OF A DATA BLOCK
PUSHJ P,DY.GET##
HRL T1,P1 ;FORM BLT PTR
MOVE P1,T1 ;SETUP P1 TO SAVE OLD AND POINT TO NEW
ADDI T2,-1(T1) ;END OF BLT
BLT T1,(T2) ;COPY BLOCK
POP P,T2 ;RESTORE ARG
POP P,T1 ;...
POPJ P,
;ROUTINE RESTP1 - DELETES DATA BLOCK POINTED TO BY P1
;AND RESTORES THE OLD P1
RESTP1::HRRZ T1,P1 ;ADDRESS OF BLOCK
MOVEI T2,F.LEN ;LENGTH OF IT
HLRZ P1,P1 ;RESTORE P1
SETOM NULSPC ;FAKE A NULL BLOCK (SAME AS DEFRET)
PJRST DY.RET## ;GIVE BACK AND RETURN
SUBTTL SWITCH ACTION -- /LOG
%LOG:
PUSHJ P,.SAVE2## ;GET A SAFE AC BUT NOT P1
PUSHJ P,COPYP1 ;MAKE A NEW DATA BLOCK
SETZ P2, ;ZERO IF NOT ALREADY A LOG FILE
SKIPN LOGSUB ;NON-ZERO IF LOG DEVICE OTHER THAN TTY
SKIPE LOGTTY ;OR TTY AS LOG
SETO P2, ;-1 FOR ALREADY A LOG DEV
MOVSI T1,'LOG' ;DEFAULT EXT
SKIPN F.EXT(P1) ;UNLESS ALREADY SET
HLLOM T1,F.EXT(P1)
PUSHJ P,DVOUT.##
%RC,,.IOASC
PUSHJ P,DVNAM.## ;MAKE SURE NAME IS SETUP
SKIPL LOGTTY ;IS CURRENT LOG DEVICE USERS TTY?
JRST LOG2 ;NO
MOVE T1,IO.CHR ;GET DEVCHR WORD
TXNN T1,DV.TTA ;IS IT USERS TTY
JRST LOG1 ;NO, TELL USER WHERE NEW LOG IS AT
LOG0: MOVEI T1,%RC ;DON'T NEED THIS BLOCK NOW
MOVEM T1,IO.CHN
PUSHJ P,DVZAP.## ;SO REMOVE IT
JRST RESTP1 ;AND RETURN
LOG1: PUSHJ P,E$$CLF ;[1174] OUTPUT INFO MESSAGE
SETZM LOGTTY ;CLEAR IT
HLRZ T1,LOWSUB ;GET LOG SUB ADDRESS
MOVEM T1,LOGSUB ;POINT TO IT
PUSHJ P,.TYOCH## ;INITIALIZE
JRST LOG4 ;AND DO REST OF SETUP
LOG2: MOVE T1,IO.CHR ;DEVCHR WORD FOR NEW LOG DEV
TXNN T1,DV.TTA ;WANTS TTY FOR LOG?
JRST LOG3 ;NO
PUSHJ P,DVCHN.## ;POINT T1 TO DATA BLOCK
SETZM I.EXT(T1) ;CLEAR .LOG EXT FOR MESSAGE
SKIPE P2 ;IF THERE WAS ALREADY A LOG FILE
PUSHJ P,LOG5 ; GIVE MESSAGE
SETZM LOGSUB ;CLEAR OLD LOG OUTPUT ROUTINE
SETOM LOGTTY ;SIGNAL TO USE TTY
HRRZ T1,LOWSUB ;GET IT
PUSHJ P,.TYOCH## ;INITIALIZED
JUMPL P2,E$$LFC ;[1174] BEEN INITIALIZED ONCE
E$$LFI::.ERR. (MS,0,V%L,L%I,S%I,LFI,<Log file initialization>) ;[1174]
PJRST LOG0 ;AND REMOVE DATA BLOCK
E$$LFC::.ERR. (MS,0,V%L,L%I,S%I,LFC,<Log file continuation>) ;[1174]
PJRST LOG0
LOG3: SKIPN IO.PTR+RC ;ALREADY A LOG FILE?
JRST LOG4 ;NO
MOVE T1,IO.PTR+RC ;YES, GET CURRENT PTR
MOVE T2,IO.PTR+%RC ;AND NEW PTR
MOVE T3,I.DEV(T2) ;GET DEVICE
CAMN T3,I.DEV(T1) ;SEE IF SAME
JRST RESTP1 ;YES, DO RENAME AT END
MOVE T4,I.DEV(T1) ;NOW TRY PHYSICAL NAMES
DEVNAM T3, ;SINCE LOGICAL = PHYSICAL IS OK
JRST LOG4A ;UUO FAILED
DEVNAM T4,
JRST LOG4A
CAME T3,T4 ;DO WE NOW MATCH?
JRST LOG4A ;NO
MOVE T3,I.DEV(T1) ;MAKE DEVICES THE SAME
MOVEM T3,I.DEV(T2) ;FOR RENAME CODE
JRST RESTP1 ;AND DO IT LATER
LOG4A: PUSHJ P,LOG5 ;OUTPUT MESSAGE AND DELETE I/O BLOCK
LOG4: MOVE T1,IO.PTR+%RC ;GET NEW PTR
MOVEM T1,IO.PTR+RC
SETZM IO.PTR+%RC
MOVSI T2,(Z RC,) ;GET CHAN#
MOVEM T2,I.CHN(T1)
MOVEI T1,RC ;SETUP AGAIN
MOVEM T1,IO.CHN
PUSHJ P,DVCHK.## ;GET DEVCHR WORD
PUSHJ P,DVOPN.## ;OPEN
PUSHJ P,DVENT.## ;ENTER FILE NAME
HLRZ T1,LOWSUB ;GET ADDRESS OF OUTPUT ROUTINE
MOVEM T1,LOGSUB ;SAVE IT FOR LOG FILE
PUSHJ P,.TYOCH## ;LET SCAN KNOW
JUMPL P2,E01LFC ;[1174] BEEN INITIALIZED
E01LFI::.ERR. (MS,0,V%L,L%I,S%I,LFI) ;[1174]
JRST RESTP1 ;AND RETURN
E01LFC::.ERR. (MS,0,V%L,L%I,S%I,LFC) ;[1174]
PJRST RESTP1
LOG5: PUSHJ P,E$$CLF ;[1174] OUTPUT MESSAGE
RELEASE RC,
MOVEI T1,RC
MOVEM T1,IO.CHN ;FOR I/O ROUTINES
PJRST DVZAP.## ;REMOVE ALL TRACES OF IT
E$$CLF::.ERR. (MS,.EC,V%L,L%I,S%I,CLF,<Closing log file, continuing on file >) ;[1174]
.ETC. (FSP,,,,,%RC)
POPJ P,
SUBTTL SWITCH ACTION -- /BACKSPACE, /REWIND
.BACKSPACE:
PUSHJ P,STRGSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /BACKSPACE/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTBSF. ;FORM INST
MOVE T2,2(P2) ;GET REPEAT COUNT (VALUE)
PUSHJ P,CHKLSW ;SEE IF CHAN OPEN
XCT T1 ;BACKSPACE 1 FILE
SOJG T2,.-1
PJRST MTAPE0
%BACKSPACE:
PUSHJ P,STRLSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /BACKSPACE/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTBSF. ;FORM INST
MOVE T2,2(P2) ;GET REPEAT COUNT (VALUE)
PUSHJ P,CHKRSW ;SEE IF CHAN OPEN
XCT T1 ;BACKSPACE 1 FILE
SOJG T2,.-1 ;LOOP, ALWAYS DO ONCE
PJRST MTAPE0 ;WAIT FOR POSITIONING TO FINISH
.REWIND:
PUSHJ P,STRGSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /REWIND/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTREW. ;FORM INST
SETZ T2,
PUSHJ P,CHKLSW
XCT T1 ;REWIND
JRST MTAPE0 ;WAIT FOR POSITIONING TO FINISH
%REWIND:
PUSHJ P,STRLSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /REWIND/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTREW. ;FORM INST
SETZ T2,
PUSHJ P,CHKRSW
XCT T1 ;REWIND
JRST MTAPE0 ;WAIT FOR POSITIONING TO FINISH
SUBTTL SWITCH ACTION -- /SKIP, /UNLOAD
.SKIP:
PUSHJ P,STRGSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /SKIP/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTSKF. ;FORM INST
MOVE T2,2(P2) ;GET REPEAT COUNT (VALUE)
PUSHJ P,CHKLSW
XCT T1 ;SKIP 1 FILE
SOJG T2,.-1 ;LOOP, ALWAYS DO ONCE
JRST MTAPE0 ;WAIT FOR POSITIONING TO FINISH
%SKIP:
PUSHJ P,STRLSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /SKIP/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTSKF. ;FORM INST
MOVE T2,2(P2) ;GET REPEAT COUNT (VALUE)
PUSHJ P,CHKRSW
XCT T1 ;SKIP 1 FILE
SOJG T2,.-1 ;LOOP, ALWAYS DO ONCE
JRST MTAPE0 ;WAIT FOR POSITIONING TO FINISH
%UNLOAD:
PUSHJ P,STRLSW ;WAIT TIL FILE INITED (AFTER FILE ONLY)
MOVEI T2,[ASCIZ /UNLOAD/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,.MTUNL. ;FORM INST
SETZ T2,
PUSHJ P,CHKRSW
XCT T1 ;UNLOAD FILE
POPJ P,
SUBTTL SWITCH ACTION -- /MTAPE:key
.MTAPE:
PUSHJ P,STRGSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /MTAPE/]
PUSHJ P,DNSCHK ;GET CHAN#
MOVE T2,2(P2) ;GET KEYWORD VALUE
IOR T1,MTPTBL-1(T2) ;GET FUNCTION
SETZ T2,
PUSHJ P,CHKLSW
XCT T1 ;MTAPE CH,#
JRST MTAPE0
%MTAPE:
PUSHJ P,STRLSW ;WAIT TIL FILE INITED
MOVEI T2,[ASCIZ /MTAPE/]
PUSHJ P,DNSCHK ;GET CHAN#
MOVE T2,2(P2) ;GET KEYWORD VALUE
IOR T1,MTPTBL-1(T2) ;GET FUNCTION
SETZ T2,
PUSHJ P,CHKRSW
XCT T1 ;MTAPE CH,#
MTAPE0: HRRI T1,0 ;MTWAT.
XCT T1 ;WAIT FOR POSITIONING TO FINISH
POPJ P,
;TABLE OF MTAPE FUNCTIONS
DEFINE KEYMAC (A,B)<
IFIDN <A><MTP>,<
IRP B,<
.'B: EXP B
>>>
XALL
MTPTBL: KEYWORDS
SALL
SUBTTL SWITCH ACTION -- /ZERO
%ZERO:
PUSHJ P,STRGSW ;WAIT TIL FILE INITED (BEFORE FILE ONLY)
MOVEI T2,[ASCIZ /ZERO/]
PUSHJ P,DNSCHK ;GET CHAN#
IOR T1,[UTPCLR] ;FORM INST
SETZ T2,
PUSHJ P,CHKLSW
XCT T1 ;ZERO DIRECTORY (DTA ONLY)
POPJ P,
DNSCHK: SKIPN T1,IO.CHN ;GET LAST CHAN#
JRST E$$DNS ;[1174] NO CHAN# NO DEVICE!
MOVE T1,IO.PTR(T1) ;POINT TO DATA BLOCK
MOVE T1,I.SCN(T1) ;GET SCAN MODIFIER WORD
TXNE T1,FX.NDV ;SEE IF DEVICE SPECIFIED
JRST E$$DNS ;[1174] NO, DON'T ALLOW DSK BY DEFAULT
HRLZ T1,IO.CHN ;GET LAST I/O CHAN INITED
LSH T1,5 ;INTO AC FIELD
POPJ P, ;RETURN WITH CHAN# SETUP IN T1
E$$DNS::.ERR. (MS,.EC,V%L,L%F,S%F,DNS,<Device not specified for switch />) ;[1174]
.ETC. (STR,.EP,,,,T2)
CHKLSW: MOVE T3,IO.CHN ;GET CHAN
SKIPL IO.PTR(T3) ;NOT INITED YERT
POPJ P, ;YES, JUST RET
PUSH P,T2 ;STACK
PUSH P,T1
MOVEI T2,3 ;NEED 3 WORDS
PUSHJ P,DY.GET##
POP P,1(T1) ;STACK UUO
POP P,2(T2) ;STACK COUNT
MOVE T2,IO.CHN ;SEE WHO FOR
MOVE T2,IO.PTR(T2)
MOVE T3,I.SWT(T2) ;GET SWITCHES TO DO
TLNN T3,-1
JRST [HRLM T1,I.SWT(T2)
JRST POPJP]
HLRZ T2,T3 ;ALREADY SWITCHES TO DO
MOVE T3,(T2) ;GET END OF LIST
TLNE T3,-1
JRST .-3 ;NOT YET
MOVEM T1,(T2)
POPJP: POP P,(P)
POPJ P,
CHKRSW: MOVE T3,IO.CHN ;GET CHAN
SKIPL IO.PTR(T3) ;NOT INITED YET
POPJ P,
PUSH P,T2 ;STACK
PUSH P,T1
MOVEI T2,3 ;NEED 3 WORDS
PUSHJ P,DY.GET##
POP P,1(T1) ;STACK UUO
POP P,2(T2) ;STACK COUNT
MOVE T2,IO.CHN ;SEE WHO FOR
MOVE T2,IO.PTR(T2)
MOVE T3,I.SWT(T2) ;GET SWITCHES TO DO
TRNN T3,-1
JRST [HRRM T1,I.SWT(T2)
JRST POPJP]
HRRZ T2,T3 ;ALREADY SWITCHES TO DO
MOVE T3,(T2) ;GET END OF LIST
TRNE T3,-1
JRST .-3 ;NOT YET
MOVEM T1,(T2)
JRST POPJP
SUBTTL DISPATCH TABLE FOR KEY WORDS
DEFINE KEYTBL (K)<
IRP K,<
DEFINE KEYMAC (A,B)<
IFIDN <K><A>,<
IRP B,< ;GET FIRST AS DEFAULT
EXP $'A'B ;START TABLE
STOPI ;RESET
>
A'TBL:
IRP B,<
EXP $'A'B
>>>
KEYWORDS
>>
XALL
KEYTBL <CPU,DEF,HYL,MAP,MPS,SYM,SYS,VER>
SALL
DEFINE X(A,B,C,D)< ;;[1225] ALLOW FOR EXTRA ARG
EXP $LIB'B
>
XALL ;[1203] EXPAND LISTING
EXP $LIBDEFAULT ;[1203] -1 ENTRY
LIBTBL: PROCESSORS ;[1203] GET LIB TABLE
SALL ;[1203] BACK TO NORMAL
$LIBANY==$LIBDEFAULT
SUBTTL SWITCH ACTION -- /CONTENTS:key
%CONTENT:
CAIN T2,1 ;DEFAULT VALUE?
JRST [MOVE T1,CONTAB ;YES, GET IT
MOVEM T1,MAPCON ;SET IT
POPJ P,] ;AND RETURN
ROT T2,-1 ;CUT IN HALF
MOVE T1,CONTAB(T2) ;GET SWITCH TO CHANGE
JUMPL T2,[ANDCAM T1,MAPCON ;UNSET
POPJ P,]
IORM T1,MAPCON ;SET
POPJ P,
DEFINE KEYMAC (A,B)<
IFIDN <A><CON>,<
IRP B,<
IFN %%&1,<
C%'B
>
%%==%%+1
>>>
%%==0 ;INITIAL VALUE
XALL
CONTAB: C%DEFAULT ;DEFAULT VALUE IS FIRST
KEYWORDS
SALL
PURGE %%
SUBTTL SWITCH ACTION -- /DEFAULT
;NOTE: THIS SWITCH MUST BE LAST EXECUTED
;IF IT IS NOT, RECHAIN SWITCHES SO THAT IT IS
;DEFERED SWITCHES WILL NOT BE EXECUTED
;THEREFORE /SKIP ETC. WILL HAVE NO EFFECT
;CONTROL FINALLY RETURNS TO LNKFIO TO GET NEXT FILE SPEC.
.DEFAULT:
POP P,T1 ;REMOVE RETURN ADDRESS
HRRZ T2,(P2) ;GET NEXT LINK
HRLM T2,F.SWP(P1) ;LINK IN
EXCH P2,T2 ;SETUP TO XCT NEXT SWITCH
HLLZS (T2) ;CLEAR LINK ADDRESS
MOVEI T3,F.SWP(P1) ;ADDRESS OF RIGHT HALF CHAIN
MOVE T1,T3 ;SAVE LAST
HRRZ T3,(T1) ;GET NEXT ADDRESS
JUMPN T3,.-2 ;LOOP TIL END OF CHAIN
HRRM T2,(T1) ;LINK IN
JUMPN P2,XCTGSW ;XCT NEXT GLOBAL SWITCH IF ANY
POPJ P, ;OTHERWISE RETURN
%DEFAULT:
POP P,T1 ;REMOVE RETURN ADDRESS
HRRZ T2,(P2) ;GET NEXT ADDRESS IN CHAIN
HRRM T2,F.SWP(P1) ;LINK IN
JUMPE T2,DEFAULT ;LAST IF ZERO
EXCH P2,T2 ;SETUP TO XCT NEXT SWITCH
HLLZS (T2) ;CLEAR LINK ADDRESS
HRRZ T3,P2 ;GET CURRENT LINK ADDRESS
MOVE T1,T3 ;SAVE LAST
HRRZ T3,(T1) ;GET NEXT ADDRESS
JUMPN T3,.-2 ;LOOP TIL END OF CHAIN
HRRM T2,(T1) ;LINK LAST IN
JRST XCTLSW ;AND XCT FIRST SWITCH IN CHAIN
DEFAULT:
MOVE T2,2(P2) ;LOAD T2 FROM VALUE AGAIN
JRST @DEFTBL-1(T2) ;DISPATCH TO RIGHT FUNCTION
;DEFAULT
$DEFINPUT:
HLLZM FL,FLAGS ;SAVE AS DEFAULT GLOBAL FLAGS
MOVE T2,F.MOD(P1) ;GET MODIFIER WORD
MOVE T1,F.DEV(P1) ;GET NEW DEVICE
TXNN T2,FX.NDV ;IGNORE NULL DEVICE (DSK BY DEFAULT)
MOVEM T1,G.DEV
SKIPN T1,F.NAME(P1) ;NEW FILE?
JRST .+4 ;NO
MOVEM T1,G.NAM
MOVE T1,F.NAMM(P1) ;AND MASK
MOVEM T1,G.NAMM
MOVE T1,F.EXT(P1) ;EXT AND MASK
TXNN T2,FX.NUL ;IGNORE NULL BUT SET ZERO IF FILE.
MOVEM T1,G.EXT
SKIPN T1,F.BFR(P1) ;/BEFORE?
MOVEM T1,G.BFR
SKIPN T1,F.SNC(P1) ;/SINCE
MOVEM T1,G.SNC
TXNN T2,FX.DIR ;DIRECTORY
JRST [MOVE T2,F.MODM(P1) ;NO, BUT MIGHT BE [-]
TXNN T2,FX.DIR ;IF THIS BIT SET
JRST DEFRET ;NO, LEAVE [DIR] AS IT WAS
SETZM G.DIR ;CLEAR FIRST WORD
MOVE T1,[G.DIR,,G.DIR+1]
JRST DFIBLT] ;AND FULL PATH
MOVE T1,F.DIR(P1) ;GET PROPOSED PPN
TLNN T1,-1 ;PROJECT SPECIFIED?
HLL T1,MYPPN ;NO, USE DEFAULT
TRNN T1,-1 ;PROGRAMMER?
HRR T1,MYPPN ;NO, DEFAULT IT.
MOVEM T1,F.DIR(P1) ;AND RESTORE PROPOSED PPN
MOVSI T1,F.DIR(P1) ;FROM ...
HRRI T1,G.DIR ;...TO
DFIBLT: BLT T1,G.DIR+2*LN.DRB-1 ;UNTIL
JRST DEFRET ;ALL DONE
$DEFOUTPUT:
MOVE T2,F.MOD(P1) ;GET MODIFIER WORD
MOVE T1,F.DEV(P1) ;GET NEW DEVICE
TXNN T2,FX.NDV ;IGNORE NULL DEVICE (DSK BY DEFAULT)
MOVEM T1,O.DEV
SKIPN T1,F.NAME(P1) ;NEW FILE?
JRST .+4 ;NO
MOVEM T1,O.NAM
MOVE T1,F.NAMM(P1) ;AND MASK
MOVEM T1,O.NAMM
MOVE T1,F.EXT(P1) ;EXT AND MASK
TXNN T2,FX.NUL ;IGNORE NULL BUT SET ZERO IF FILE.
MOVEM T1,O.EXT
SKIPN T1,F.BFR(P1) ;/BEFORE?
MOVEM T1,G.BFR
SKIPN T1,F.SNC(P1) ;/SINCE
MOVEM T1,G.SNC
TXNN T2,FX.DIR ;DIRECTORY
JRST [MOVE T2,F.MODM(P1) ;NO, BUT MIGHT BE [-]
TXNN T2,FX.DIR ;IF THIS BIT SET
JRST DEFRET ;NO, LEAVE [DIR] AS IT WAS
SETZM O.DIR ;CLEAR FIRST WORD
MOVE T1,[O.DIR,,O.DIR+1]
JRST DFOBLT] ;AND FULL PATH
MOVE T1,F.DIR(P1) ;GET PROPOSED PPN
TLNN T1,-1 ;PROJECT SPECIFIED?
HLL T1,MYPPN ;NO, USE DEFAULT
TRNN T1,-1 ;PROGRAMMER?
HRR T1,MYPPN ;NO, DEFAULT IT.
MOVEM T1,F.DIR(P1) ;AND RESTORE PROPOSED PPN
MOVSI T1,F.DIR(P1) ;FROM ...
HRRI T1,O.DIR ;...TO
DFOBLT: BLT T1,O.DIR+2*LN.DRB-1 ;UNTIL
; JRST DEFRET ;ALL DONE
DEFRET: SETOM NULSPC ;FAKE NULL BLOCK
POPJ P, ;RETSPC WILL RETURN IT
SUBTTL MAP SORTING
$MPSALPHABETICAL:
$MPSNUMERICAL:
E$$MSN::.ERR. (MS,0,V%L,L%W,S%W,MSN,<Map sorting not yet implemented>) ;[1174]
$MPSUNSORTED:
POPJ P,
;SYMBOL SORTING
$SYSALPHABETICAL:
$SYSNUMERICAL:
E$$SSN::.ERR. (MS,0,V%L,L%W,S%W,SSN,<Symbol table sorting not yet implemented>) ;[1174]
$SYSUNSORTED:
POPJ P,
SUBTTL ERROR MESSAGES
E$$ZSV::.ERR. (MS,0,V%L,L%W,S%W,ZSV,<Zero switch value illegal>) ;[1174]
POPJ P,
E$$USI::.ERR. (MS,.EC,V%L,L%F,S%B,USI,<Undefined symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2) ;[1174]
.ETC. (STR,.EC,,,,,< illegal in switch />) ;[1174]
.ETC. (STR,.EP,,,,T1) ;[1174]
POPJ P, ;[1174] RETURNS IF NOT BATCH
E$$NHN::.ERR. (MS,,V%L,L%F,S%F,NHN,<No High Segment in Nonzero Section>)
WLDLIT: END