mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 09:21:15 +00:00
2865 lines
92 KiB
Plaintext
2865 lines
92 KiB
Plaintext
TITLE LNKWLD - SWITCH HANDLER FOR LINK
|
||
SUBTTL D.M.NIXON/DMN/JLd/SRM/JBC/JNG/MCHC/PAH/DZN/PY/JBS/HD/RJF 5-Feb-88
|
||
|
||
;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==2417 ;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.
|
||
|
||
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
|
||
TXNE T2,DV.DIR ;IF NON-DIRECTORY DEVICE
|
||
JRST NOTSPC ;NO, SO NOT A FILE SPEC
|
||
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
|
||
SETOM NULSPC ;[2277] THROW AWAY THIS FILESPEC
|
||
SETZM F.NAME(P1) ;[2277]
|
||
TRO FL,L.SYM ;[2277] LOAD LOCALS
|
||
JRST LNKWLD] ;[2277] THAT'S ALL, CONTINUE COMMANDS
|
||
> ;[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 LNKWLD ;AND TRY AGAIN
|
||
|
||
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
|
||
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
|
||
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: SKIPA T1,[0,,SS.SHR]
|
||
%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
|