Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
lnklod.mac
There are 50 other files named lnklod.mac in the archive. Click here to see a list.
TITLE LNKLOD - LOAD MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/RKH/JNG/DCE/MCHC/DZN 24-Aug-79
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL
ENTRY LNKLOD
EXTERN LNKSCN,LNKCOR,LNKWLD,LNKLOG,LNKF40,LNKMAP,LNKXIT
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;DEC EDIT VERSION
VERSION
SEGMENT
;LOCAL ACC DEFINITIONS
INTERN R,RB,WC
R=R1 ;CURRENT RELOCATION COUNTER
RB=R+1 ;RELOCATION BYTE WORD
WC=R3 ;WORD COUNT
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;44 ADD ASCIZ TEXT BLOCK
;45 HASH INITIAL SYMBOLS AT ASSEMBLY TIME
;46 ADD KLUDGE FEATURE
;52 ADD ASCII TEXT BLOCK
;54 ADD KIONLY D.P. INST.
;61 ADD STORE CODE IN FX AREA FOR TWOSEG FORCED HIGH/LOW
;63 STORE MULTIPLY-DEFINED SYMBOLS IN SYMBOL TABLE FOR MAP
;75 ADD ROUTINE TO ADDRESS CHECK A SINGLE WORD
;101 FIXES FOR FAIL CODE WITH UNDEF GLOBALS IN BLOCK 11
;102 ADD TEST FOR END BLOCK NOT SEEN BEFORE EOF
;106 REMOVE HIORG, REPLACE WITH LL.S2 OR SO.S2 AS REQUIRED
;107 REPLACE KLUDGE BY MIXFOR
;111 MAKE MIXFOR WORK EVEN IF NOT IN SEARCH MODE
;112 CHECK PER FILE /SEARCH SWITCH @LODTST
;113 MAKE MIXFOR KNOW ABOUT ARRAY REFERENCES IN ARGS
;115 MAKE /NOSYMS WORK CORRECTLY
;START OF VERSION 1B
;117 (12058) ADD MISSING POPJ P, AT FORKI+2
;130 (12315) PREVIOULY REQUESTED COMMON IS NOT PUT IN LOCAL SYMBOL TABLE CORRECTLY
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;143 ADD TEST FOR /INCLUDE MODE
;145 IMPLEMENT USER LIBRARIES
;147 TURN ON MIXFOR FEATURE
;152 FIX LOOP IF /NOINIT AND UNDEF SYMBOLS
;157 (12640) ONLY PRINT FSI MESSAGE IF /FORSE GIVEN EXPLICITLY
;161 ADD LANGUAGE SPECIFICATION TO /USERLIB
;163 IF /ONLY IS ON DON'T LOAD F-10 CODE INTO LOW SEG BY DEFAULT
;164 MAKE CPU TEST OF REL FILES MORE GENERAL
;166 READ BACK RADIX50 SYMBOL FILES
;167 CHANGE ARGS TO /OTS SWITCH
;172 (13243) BUG IF MORE THAN 1 BLOCK TYPE 16 (OR 17) SEEN
;173 TEST ASCIZ BLOCK TYPE FOR VALID FIRST CHAR
;174 FIX BUGS IN RELOCATABLE OVERLAYS
;176 MAKE START BLOCK (7) BE TWO WORDS LONG
;200 LOAD REENTRANT OVERLAY HANDLER
;204 FIX CORE EXPANSION BUG IN SYMBOL TABLE FIXUPS
;206 FIX RH CHAINED GLOBAL IF NOT ALL OF CHAIN IN CORE
;210 (13461) MORE OF #172, HANDLE TYPE 16 CORRECTLY
;220 HANDLE COMMON REFERENCED BEFORE BEING DEFINED CORRECTLY
;START OF VERSION 2B
;223 FIXUP PRIMARY TRIPLET AFTER ADDITIVE FIXUPS HAVE BEN DONE
;232 (13920) UNRELOCATE POLISH POINTER BEFORE CALL TO T.11EV
;233 (13932) INFINITE LOOP IF UNDEF SYMBOLS AND TYPE 16 BLOCKS
;251 Setup FX before using for temp storage when /SEG:LOW
; and no high seg size in REL file
;275 ADD CODE TO LOAD SIMULA LIBRARY
;305 Correct the test for CPU type so it works.
;325 Don't ever eliminate block 3 when saving TWOSEG REL
; block in DY and FX during force to single segment when
; high segment break is unknown.
;327 Save 2 locations in F40NAM
;341 INCLUDE EDIT 327 IN MAINTENANCE SOURCES. LABEL EDITS 223,232,233
;367 KEEP CORRECT W3 ON POLISH FIXUPS WHEN SYMBOL JUST DEFINED
;375 Make LS.ADE internal for use in LNKOLD.
;376 Give error message if trying to overlay F40 code.
;405 Add routine D.RED1, like D.IN1 but POPJ's on EOF.
;412 Preserve W3 when doing fixups.
;422 Shut off /SEG:??? when processing fixups.
;START OF VERSION 2C
;450 Correct code at F40NAM to give error message if illegal
; mixing of F40 and FORTRAN CODE
;451 Change message for illegal mixing of F40 and Fortran code
;456 Setup P1 in ADCHK. before calling LNKCOR.
;457 REQUEST FORSE. as soon as both FORTRAN's seen so
; library searching will work. Don't wipe out PROCSN when
; searching libraries.
;462 Set up R in .MXFOR after calling SY.RQ, which destroys it.
;464 Implement /MISSING and LNKIMM
;465 Redo some of block type dispatch for block type 100.
;470 Preserve left half of R at SY.FHS for overlays.
;471 Add code for ALGOL debugging system.
;510 Generate correct fixups for relocatable symbols in LS area.
;512 Handle chained fixups (PS.FXC) correctly.
;515 Teach fixup processor about PH.ADD
;517 Change ABLLEN to LN.ABL
;522 Set relocation bit correctly when following paged fixups.
;526 Don't set relocation bits unless loading overlays. fix to 522.
;530 Define triplet flags correctly.
;532 Don't search FORLIB too many times.
;535 Always search user libraries for all links.
;541 Fixup F40 subroutine prologue correctly under /MIXFOR.
;542 Define entry points correctly when paging in MIXFOR processor.
;543 Catch multiple definition for additive second definition.
;544 SOUP in LINK version 3 stuff for TOPS-20.
;555 Always load global symbols into ALGOL programs.
;557 Clean up the listing for release.
;START OF VERSION 3
;445 INSERT OLD EDITS TO POLISH SYMBOL FIXUPS
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;561 Fix the MIXFOR code for F10 subroutines
;572 Make sure LS addr in core before doing fixups
;574 Load OTS into low seg if no high seg and low seg .GT. 128K
;605 Use OUTSTR for ?LNKUGS message.
;611 Support COBOL-74
;612 Fix various polish bugs
;613 Load user libs before system libs to avoid FOROTS screwup.
;614 Re-search a system lib if more modules that want it are seen.
;630 Don't forget INCLUDE/EXCLUDE specs after editing an error.
;632 Fix $LOCATION to always work, add $FIXUP.
;650 Use VM on TOPS-10 if available.
;654 Accept a relative address in LS.ADE incase shuffling.
;661 Make the %LNKMDS message be L%W.
;667 Call correct paging routine to move hi seg up.
;672 Set FX.DIR correctly in PRGLIB.
;673 Change the FON and ILI messages to MSR and IRB.
;677 Don't default to /SYMSEG:LOW if loading overlays.
;704 Order psect reloc table by order of origin before doing map.
;712 Add check for psect index when a global is defined.
;716 Read in smaller of LN.WD or current size when moving window down.
;731 SEARCH MACTEN,UUOSYM
;734 Don't allow mixing of KL & KA, or KL & KI compiled code.
;737 Clear link list pointer after it's given back.
;741 Check fixup address against window range.
;746 Add CHKBND routine to check PSECT overlap after reloc table sort.
;747 Update LOWLOC after reloc table sorted and before going to LNKXIT.
;751 Fix bug with calculation of space to give back in PG.SD.
;752 JFFO cpu-code from Block 6 before dispatching to inconsistancy check.
;760 Expand PSECT overlap checks to check each PSECT with all others.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF LINK 4A
;766 Return cpu table offset in P2 from routine CPUTST.
;777 Comment SY.RF as destroying P1-P4.
;1101 Keep LSTBLK (last block read from current file) up to date.
;1102 Keep window into overflow file in section 0.
;1103 Zero the .REQUEST/.REQUIRE list pointer after freeing its contents.
;1106 Update HL.S1 from RC.CV of the highest PSECT loaded.
;1114 Don't clear COBOL symbols and ALGOL OWNs in LODTST (moved to T.5A).
;1116 When expanding a window in PG.SX, read in any data already in the
; overflow file for the region being created. Broken by 716.
;1120 Remove CPUTST routine (T.6 does it now) and all calls to it.
;1131 Force non-reentrant OTS sooner, if low segment is within 40 pages of 400000.
;1132 Teach SEGCHK about PSECTs above the high segment.
;1135 Make PG.SU expand anyway if request crosses page and window only a page.
;1143 Fake a module name if LS.ADD called with a symbol before a module seen.
;1165 Zero LSTSYM in SY.RLS if the symbol was rejected.
;1174 Label and clean up all error messages.
;1175 Fix /UPTO with a symbolic argument.
;1200 If loading reentrant FOROTS, search SYS:FORLIB/SEGMENT:LOW.
;1201 Change reference to $SEGLOW to LC.IX.
;1203 Support extended FORTRAN.
;1204 Complain if any Psects are too long.
;1207 Make the LNKCMX message continue loading.
;1212 Make LNKIVC and LNKPOV consistent with other messages.
;1213 Respect the FS.MDC bit.
;1215 Use RC.HL instead of RC.CV for the LOWLOC check at CHKLLC.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
SUBTTL LOAD CONTROL
;ENTER HERE FROM LNKSCN
;LNKWLD READS A FILE SPEC FROM LIST POINTED TO BY F.INZR
;NON-SKIP RETURN IS END OF LIST
;SKIP RETURN WITH DEVICE INITED AND FILE OPEN OR ENTERED
LNKLOD: JFCL .+1 ;IN CASE CCL ENTRY
IFN .ASBLK,<
SKIPE F.ASCI ;READING INCORE TEXT?
JRST LNKWLD## ;YES, SEE IF ANY SWITCHES FOR CURRENT SPEC
>
HLLZ FL,FLAGS ;RESET GLOBAL DEFAULTS
E$$LDS::.ERR. (MS,0,V%L,L%I,S%I,LDS,<LOAD segment>) ;[1174]
LODNXT: HLR FL,FL ;CLEAR TEMP FLAGS AND SET FROM GLOBAL ONES
SKIPN F.EDIT ;[630] DON'T IF EDITING AN ERROR
PUSHJ P,Z.INER ;CLEAR LOCAL STORAGE, GIVE ERRORS
PUSHJ P,LNKWLD ;GET NEXT FILE SPEC
JRST LNKSCN ;LIST EMPTY GET MORE
LODTST::JFCL ;INCASE FROM /SYSLIB
HRRM FL,FLAGS ;SAVE LOCAL FLAGS AT START OF FILE
TRNN FL,R.LIB!R.INC ;IN LIBRARY SEARCH MODE OR /INC MODE?
JRST LOAD ;NO
SKIPN USYM ;ANY UNDEFINED SYMBOLS
SKIPE INCPTR ;OR SOME INCLUDES STILL TO DO?
CAIA ;YES
JRST EOF1 ;NO, GET NEXT FILE
SKIPE XBUF ;YES, INDEX IN CORE FOR THIS FILE?
JRST T.14B## ;YES, USE IT TO FIND PROG TO LOAD
JRST LOAD
T.LOAD::HRR FL,FLAGS ;RESTORE LOCAL FLAGS
TRNE FL,R.LIB!R.INC ;IN LIBRARY SEARCH MODE OR /INC MODE?
JRST LODTST ;YES,
; JRST LOAD
SUBTTL READ BLOCK TYPE AND DISPATCH
;LOAD READS THE FIRST WORD OF A BLOCK
;IT PUTS THE LENGTH (NEGATIVE) IN WC AND DISPATCHES TO HANDLING ROUTINE
LOAD:: PUSHJ P,D.IN1 ;READ ONE WORD
MOVNI WC,400000(W1) ;GET NEG BLOCK LENGTH
HLRZ T1,W1 ;GET BLOCK TYPE
CAIG T1,377 ;IS IT OLD BLOCK TYPES
JRST LNKOLD## ;YES, HANDLE THERE
CAIG T1,003777 ;IN RANGE FOR NEW?
CAIGE T1,1000
JRST T.ERR1 ;NO
JRST LNKNEW## ;YES
;UNKNOWN BLOCK TYPES
T.ERR1:
CAILE T1,777 ;IN LNKOLD OR LNKCST?
JRST T.ERR2 ;NO, MUST BE ASCII TEXT
CAIL T1,700 ;DEC-DEFINED SPEC. FILE TYPES?
JRST LNKOLD## ;YES, GO HANDLE
CAIL T1,402 ;402-677 (CUSTOMER TYPES) ?
JRST LNKCST## ;YES, LET CUSTOMER HANDLE
CAIE T1,400 ;ONLY CHOICE LEFT IS F40
JRST T.401## ;SO ITS T.401 IF NOT T.400
JRST T.400## ;USUALLY IS 400
T.ERR2: ;HERE FOR ASCII TEXT OR ILLEGAL
IFN .ASBLK,<
CAIL T1,(<ASCII / />&<-1,,0>)
CAILE T1,(<ASCII /zzz/>&<-1,,0>)
CAIA ;NO
JRST LNKASC## ;VALID ASCIZ BLOCK
>
E$$IRB::.ERR. (MS,.EC,V%L,L%F,S%F,IRB,<Illegal REL block type >) ;[1174]
.ETC. (OCT,.EP!.EC,,,,T1)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SUBTTL CLEAR INCLUDE/EXCLUDE STORAGE
Z.INER: HRRZ P1,INCPTR ;GET POINTER TO FIRST BLOCK
JUMPE P1,Z.EXIN ;NONE, GIVE UP
MOVEI T1,[ASCIZ \?LNKIMM \] ;GET PREFIX
PUSHJ P,MISNG1## ;TYPE IT AND REST OF MESSAGE
Z.INEX::HRRZ P1,INCPTR ;GET FIRST
JUMPE P1,Z.EXIN ;NONE, TRY EXCLUDES
HLLZS INCPTR ;ZERO POINTER SINCE LIST GONE
PUSHJ P,Z.ZAP ;WIPE OUT THIS LIST
;FALL INTO Z.EXIN
Z.EXIN: HRRZ P1,EXCPTR ;GET POINTER TO EXCLUDE LIST
JUMPE P1,CPOPJ ;ALL DONE
HLLZS EXCPTR ;INDICATE LIST ZEROED
Z.ZAP:
IFN .EXSYM,<
ADD P1,[-.EXC+1,,1] ;MAKE AOBJN POINTER TO BLOCK
Z.ZAP1: SKIPE P2,(P1) ;GET NEXT WORD
TLNE P2,770000 ;MUST BE A POINTER
JRST Z.ZAP2 ;NOTHING THERE
MOVEI T1,(P1) ;T1=ADDRESS
AOS T2,(P2) ;T2=SIZE (INC SIZE WORD)
PUSHJ P,DY.RET## ;RETURN THE BLOCK
Z.ZAP2: AOBJN P1,Z.ZAP1 ;LOOP OVER ENTIRE BLOCK
SUBI P1,.EXC ;POINT BACK TO 1ST WORD
> ;END IFN .EXSYM
MOVEI T1,(P1) ;POINT TO FIRST WORD
MOVEI T2,.EXC ;STANDARD SIZE
HRRZ P1,(P1) ;SAVE POINTER WORD
PUSHJ P,DY.RET## ;FREE UP THE CORE
JUMPN P1,Z.ZAP ;LOOP IF MORE
POPJ P, ;ELSE FINISHED
SUBTTL ADDRESS CHECK A SINGLE WORD
;HERE TO MAKE SURE LOCATION IS IN CORE
;ENTER WITH ADDRESS IN P3
;RETURNS NEW ADDRESS (MAYBE) IN P3
;MAY USE P2 (IF PAGING)
;CALLED BY
; MOVE P3,ADDRESS
; MOVEI R,SEGMENT NO.
; PUSHJ P,ADCHK.##
ADCHK.::
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATION TABLE SETUP?
PUSHJ P,RT.P3## ;YES, SET BYTE PTR
CAIN R,1 ;LOW SEG?
SUB P3,PH.ADD ;REMOVE LINK ORIGIN
>
MOVE P2,P3 ;GET A COPY
SKIPE PAG.S0(R) ;PAGING?
JRST ADCHK2 ;YES, SEE IF IN CORE
ADD P2,LC.LB-1(R) ;RELOCATE RELATIVE ADDRESS
CAMG P2,LC.AB-1(R) ;WILL IT FIT IN EXISTING SPACE?
JRST ADCHK1 ;YES
SUB P2,LC.AB-1(R) ;GET EXTRA REQUIRED
MOVEI P1,LC.IX-1(R) ;POINT TO PROPER AREA
PUSHJ P,LNKCOR## ;TRY TO GET MORE SPACE
JRST ADCHK2 ;FAILED BUT MUST BE ON DSK
SUB P3,LW.S0(R) ;INCASE WE DUMPED CORE FOR FIRST TIME
ADCHK1: ADD P3,LC.LB-1(R) ;FINALLY FIX IN CORE
POPJ P, ;RETURN WITH P3 SETUP
ADCHK2: PUSHJ P,@[EXP PG.LSG,PG.HSG]-1(R)
JRST ADCHK1 ;NOW TRY
SUBTTL PAGING CORE CONTROL
;HERE TO CHECK TO SEE IF LOW SEG ADDRESS IS INCORE
;IF NOT CHANGE CORE WINDOW TO INCLUDE NEW ADDRESS
PG.LSG::CAMGE P3,LW.S1 ;IS LOWER ADDRESS IN CORE
PUSHJ P,PG.LSD ;NO, MOVE WINDOW DOWN
CAMLE P2,UW.S1 ;AND UPPER ALSO
PUSHJ P,PG.LSU ;NO, NEED TO MOVE WINDOW UP
SUB P3,LW.S1 ;REMOVE BASE
POPJ P, ;AND CONTINUE
;HERE FOR LOW SEG TO MOVE DOWN
PG.LSD: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX TO LOW SEG
JRST PG.SD ;GENERAL MOVER DOWN
PG.LSU: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX TO LOW SEG
JRST PG.SU ;GENERAL MOVER UP
;HERE TO MOVE THE WINDOW EITHER UP OR DOWN, BUT WITH NO OVERLAPING. FIRST,
;OUTPUT CURRENT WINDOW, THEN READ BACK THE PORTION WE WILL NEED. WINDOW
;(POTENTIALLY) SHRINKS TO SMALLER OF LN.WD OR ITS CURRENT SIZE. IF NEW WINDOW
;ORIGIN PLUS LENGTH EXCEEDS 512P IN THE FILE'S ADDRESS SPACE, SLIDE THE WINDOW
;DOWN JUST ENOUGH SO IT ENDS AT 512P.
PG.SD: HRLZ T1,LW.S0(R) ;SETUP CONTROL WORD
HRR T1,UW.S0(R) ;FIRST,,LAST WORD TO MOVE
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
MOVE T1,P3 ;LOWER ADDRESS WE NEED
ANDCMI T1,.IPM ;MAKE INTO BLOCK BOUND
EXCH T1,LW.S0(R) ;RESET WINDOW
SUB T1,UW.S0(R) ;OLD BASE - OLD UPPER
MOVM T2,T1 ;+LENGTH -1
MOVE T1,T2 ;[751] SPACE TO GIVE BACK
SUBI T1,LN.WD ;[751] IN CASE CURRENT SIZE BIGGER
CAILE T2,LN.WD-1 ;[717] CURRENT SIZE SMALLER?
MOVEI T2,LN.WD-1 ;[717] NO, USE LN.WD
ADD T2,LW.S0(R) ;[717] GET US TO END
TLNE T2,-1 ;[1102] BUT IS WINDOW NOW PAST 512P?
JRST [SUBI T2,-1 ;[1102] YES--COMPUTE HOW MUCH WE'RE OVER
SUB T2,LW.S0(R) ;[1102] MOVE WINDOW DOWN BY THAT MUCH
MOVNM T2,LW.S0(R) ;[1102] ..
MOVEI T2,-1 ;[1102] TOP OF WINDOW IS NOW AT 512P
JRST .+1] ;[1102] CONTINUE WITH SAME WINDOW SIZE
MOVEM T2,UW.S0(R) ;[717]
JUMPL T1,PG.SD2 ;[717] JUMP IF NOTHING TO GIVE BACK
ADD T1,TAB.LB(R) ;FIX IN CORE
PUSHJ P,GBCK.L## ;GIVE BACK TO NEXT LOWER
PG.SD2: HRLZ T1,LW.S0(R) ;RESET CONTROL WORD
HRR T1,UW.S0(R) ; TO DESIRED AREA
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R)
PJRST FIXUP ;FIXUP ALL POSSIBLE CORE CHAINS
;HERE TO MOVE THE WINDOW UP IN MEMORY. IF NECESSARY, DUMP THE LOWER PART OF THE
;WINDOW AND MOVE DOWN THE REST. THEN EXPAND THE END OF THE WINDOW IF NECESSARY
;AND READ IN THE UPPER PART WHICH IS USUALLY ZERO. TRY TO KEEP THE SIZE OF THE
;WINDOW REASONABLE AS A FIRST APPROXIMATION.
PG.SU: MOVE T1,P2 ;[1135] SEE IF REQUEST CROSSES A PAGE BOUNDARY
XOR T1,P3 ;[1135] ..
TXNN T1,^-<.IPS-1> ;[1135] ..
JRST PG.SU1 ;[1135] NO--NO SWEAT
MOVE T1,TAB.AB(R) ;[1135] YES--THEN MAKE SURE AT LEAST 2 PAGES
SUB T1,TAB.LB(R) ;[1135] IN THE WINDOW
CAIGE T1,.IPS ;[1135] ..
JRST PG.SU2 ;[1135] ONLY 1 PAGE--MUST EXPAND
PG.SU1: CAMG P2,TAB.HB(R) ;[1135] THE HIGH ADDR ALREADY OUT ON DISK?
JRST PG.SD ;[716] YES, DON'T BOTHER TO EXPAND
PG.SU2: PUSHJ P,FR.CNT## ;[1135] SEE HOW MUCH FREE SPACE WE HAVE
ADD T1,UW.S0(R) ;IF WE GIVE IT ALL TO THIS AREA
CAMG P2,T1 ;WILL IT NOW FIT?
JRST PG.SX ;YES, JUST EXPAND
;SEE IF BY GIVING AWAY LESSER OF LN.WD OR HALF OF EXISTING AREA
;WE CAN FIT THIS REQUEST IN, IF SO
;DELETE LOWER PART (WRITE OUT FIRST)
;IF NOT, MOVE WINDOW UP AS FAR AS POSSIBLE VIA PG.SD, THEN EXPAND
;AS MUCH AS NEEDED VIA PG.SX
MOVE T2,UW.S0(R) ;TOP OF AREA
SUB T2,LW.S0(R) ;MINUS BOTTOM
ADDI T2,1 ;GET EVEN
LSH T2,-1 ;HALF
ANDCMI T2,.IPM ;KEEP IN BLOCKS
CAILE T2,LN.WD ;USE THE LESSER
MOVEI T2,LN.WD
ADD T1,T2 ;ADD TO PREVIOUS ACCUMULATION
CAMLE P2,T1 ;WIL IT NOW FIT?
JRST PG.SS ;[650] NO, CENTER MINIMAL WINDOW
PUSH P,T2 ;SAVE THE EXCESS
HRRZ T1,LW.S0(R) ;CURRENT LOWEST
ADDI T1,-1(T2) ;HIGHEST TO GET RID OF
HRL T1,LW.S0(R) ;TRANS WORD
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
POP P,T1 ;GET EXCESS BACK
ADDM T1,LW.S0(R) ;NEW LOWER BOUND
ADD T1,TAB.LB(R) ;ADD BASE IN CORE
SUBI T1,1 ;HIGHEST LOC TO GIVE AWAY
PUSHJ P,GBCK.L## ;GIVE EXCESS AWAY
JRST PG.SU ;SHOULD NOW FIT (AFTER A SHUFFLE
;HERE IF WE CAN'T FIT THIS REQUEST INTO CURRENT WINDOW.
;MAKE SURE P3 POINTS INTO BOTTOM PAGE OF WINDOW VIA PG.SD, THEN
;EXPAND WINDOW TO ENCOMPASS P2 VIA PG.SX IF NECESSARY.
PG.SS: MOVE T1,P3 ;[650] LOWEST LOCATION WANTED
ANDCMI T1,.IPM ;[650] WHAT LW WOULD BE AT BEST
CAME T1,LW.S0(R) ;[650] WINDOW AS HIGH AS POSSIBLE?
PUSHJ P,@[EXP PG.LSD,PG.HSD]-1(R) ;[667] NO, MOVE UP
CAMLE P2,UW.S0(R) ;[650] WINDOW BIG ENOUGH?
JRST PG.SX ;[650] NO, EXPAND VIA LNKCOR
JRST RPOPJ ;[650] YES, GOOD ENOUGH
;HERE TO EXPAND CORE BY AS MUCH AS WE NEED
;ALSO CHECK INCASE OVERFLOW FILE ALREADY CONTAINS THE NEW AREA
;IF SO READ IT IN
PG.SX: PUSH P,P1 ;SAVE ACCS USED BY LNKCOR
PUSH P,P2
MOVEI P1,(R) ;WHO WE WANT TO EXPAND
SUB P2,UW.S0(R) ;BY HOW MUCH
PUSHJ P,LNKCOR## ;GET IT
PUSHJ P,E$$MEF## ;[1174] NOT POSSIBLE
POP P,P2 ;RESTORE
POP P,P1
MOVE T1,TAB.AB(R) ;HIGHEST BLOCK IN CORE
SUB T1,TAB.LB(R) ;LENGTH OF INCORE AREA
ADD T1,LW.S0(R) ;LENGTH FROM ORIGIN
EXCH T1,UW.S0(R) ;IS NEW UPPER BOUND
CAML T1,HB.S0(R) ;[1116] HOWEVER IF EVEN BIGGER HAS BEEN SEEN?
JRST RPOPJ ;NO, RESTORE R AND RETURN
HRLZI T1,1(T1) ;[1116] IT MUST BE ON THE DSK
HRR T1,UW.S0(R) ;[1116] SO SETUP TRANSFER REQUEST
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[1116]
PJRST FIXUP ;[1116] AND DO ANY FIXUPS
;SIMILARLY FOR HIGH SEG
PG.HSG::CAMGE P3,LW.S2 ;SAME AS FOR LOW SEG
PUSHJ P,PG.HSD
CAMLE P2,UW.S2
PUSHJ P,PG.HSU
SUB P3,LW.S2 ;REMOVE BASE
POPJ P, ;CONTINUE
;HERE TO CHANGE WINDOW TO HIGH SEG
;HERE TO MOVE WINDOW DOWN
;FIRST OUTPUT THE WINDOW, THEN READ BACK WHAT WE NEED
PG.HSD: PUSH P,R ;SAVE R
MOVEI R,HC.IX ;INDEX TO HIGH
JRST PG.SD ;MOVE DOWN
;HERE TO MOVE WINDOW UP IN CORE
;DUMP LOWER PART OF WINDOW, BLT DOWN AND READ IN TOP PART
;THIS PART IS MOST LIKELY ZERO
PG.HSU: PUSH P,R ;SAVE R
MOVEI R,HC.IX ;INDEX TO HIGH
JRST PG.SU ;MOVE UP
;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR LOW SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4
FIXUPL: PUSH P,R ;NEED TO SAVE IT
MOVEI R,LC.IX ;LOAD INDEX TO LOW
JRST FIXUP ;DO THE FIXUPS
;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR HIGH SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4
FIXUPH: PUSH P,R ;NEED TO SAVE IT
MOVEI R,HC.IX
FIXUP: PUSHJ P,CHKCHN ;SEE IF ANYTHING TO DO
RPOPJ: POP P,R ;RESTORE R
POPJ P,
;CHKCHN - SEE IF ANY FIXUPS EXIST FOR THE NEW CORE WINDOW
;IF SO LINK THEM INTO FXT.S0
;AND DO THEM
;R=2*N+1 FOR LOW, R=2*N+2 FOR HIGH
;DESTROYS R
;USES T1-T4
CHKCHN: SKIPN FX.S0(R) ;ANYTHING TO DO?
POPJ P, ;NO
SETZM FXT.S0 ;CLEAR TEMP PTR
HRRZ T1,FX.S0(R) ;GET PTR TO LOWEST
ADD T1,FX.LB ;+OFFSET
HRRZ T2,1(T1) ;GET ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH.ADD ;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
HLRZ T1,FX.S0(R) ;PTR TO HIGHEST
ADD T1,FX.LB ;+OFFSET
HRRZ T3,1(T1) ;ADDRESS
SUB T3,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T3,PH.ADD ;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAMG T2,UW.S0(R) ;IS LOWEST ADDRESS TOO HIGH?
CAMGE T3,LW.S0(R) ;OR HIGHEST TOO LOW?
POPJ P, ;YES, JUST GIVE UP
;MAKE QUICK TEST INCASE ALL CHAIN IN CORE
;IN WHICH CASE WE NEED NOT CHASE THE CHAIN
CAML T2,LW.S0(R) ;IS LOWEST ADDRESS .GT. LOW WINDOW?
CAMLE T3,UW.S0(R) ;AND HIGHEST ADDRESS .LE. HIGH WINDOW
JRST .+5 ;NO, DO THE SLOW WAY
MOVE T1,FX.S0(R) ;GET POINTER WORD
MOVEM T1,FXT.S0 ;MOVE IT ALL OVER
SETZM FX.S0(R) ;REMOVE FROM LIST TO CONSIDER
JRST FXTLUP ;AND DO IT
MOVEI T1,FX.S0(R) ;GET INITIAL PTR
;START AT BACK SINCE MOST USUAL CASE
;IS TO READ FILE BACKWARDS
CHKCHL: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,CPOPJ ;NOTHING TO DO
ADD T1,FX.LB ;OFFSET
HRRZ T2,1(T1) ;GET ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH.ADD ;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAMG T2,UW.S0(R) ;[741] INCORE?
CAMGE T2,LW.S0(R) ;[741] CHECK AGAINST WINDOW RANGE
JRST CHKCHL ;NO, LOOP
HRRZ T3,(T1) ;GET FORWARD LINK
JUMPE T3,[MOVEI T3,FX.S0(R) ;IF ZERO THIS IS TOP OF CHAIN
JRST CHKCHM] ;SO WE CAN FIXUP
HRL T3,T3 ;STORE UNRELOCATED IN LEFT HALF
ADD T3,FX.LB ;RELOCATED IN RIGHT
HLLZS (T1) ;CLEAR FORWARD PTR OF REMOVED PART
CHKCHM: SUB T1,FX.LB ;-OFFSET
MOVSM T1,FXT.S0 ;TEMP PTR TO HIGHEST TO DO
ADD T1,FX.LB ;+OFFSET
CHKCHH: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,[MOVEI T1,FX.S0(R) ;GET FIRST IF
JRST CHKFIN] ;REACHED END OF CHAIN
ADD T1,FX.LB ;+OFFSET
HRRZ T2,1(T1) ;ADDRESS
SUB T2,LL.S0(R) ;REMOVE ORIGIN
IFN FTOVERLAY,<
CAIN R,1 ;LOW SEGMENT?
SUB T2,PH.ADD ;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
CAML T2,LW.S0(R) ;STILL IN COREE?
JRST CHKCHH ;YES
MOVE T2,T1 ;GET ABS ADDRESS
SUB T2,FX.LB ;REMOVE OFFSET
HRL T1,T2 ;STORE LINK IN LEFT HALF FOR LATER
CHKFIN: HRRZ T2,(T1) ;GET 1ST FIXUP WE CAN DO
HRRM T2,FXT.S0 ;STORE IN PTR
ADD T2,FX.LB ;RELOCATE IN FIXUP BLOCK
HRRZS (T2) ;AND CLEAR BACK LINK
;NOW CLOSE PTRS OVER HOLE
HLRM T3,(T1) ;LINK TOP TO BOTTOM
HLLM T1,(T3) ;AND BOTTOM TO TOP
;NOW TO EXECUTE THE FIXUPS
;STORE R IN LEFT OF FXT.S0 (NOT USED FOR CHAIN PROCESSING)
FXTLUP: PUSH P,W3 ;KEEP W3 INTACT
FXTLP1: SOS FXC.S0(R) ;COUNT 1 LESS
HRRZ T1,FXT.S0 ;GET NEXT PTR
JUMPE T1,[POP P,W3 ;RESTORE W3
POPJ P,] ;ALL DONE FOR THIS LIST
.JDDT LNKLOD,FXTLP1,<<CAMN T1,$FIXUP##>> ;[632]
ADD T1,FX.LB ;+OFFSET
PUSH P,1(T1) ;GET ADDRESS (EXPECTED IN T2)
MOVE W3,2(T1) ;VALUE
HRRZ T2,(T1) ;NEXT PTR
HRRM T2,FXT.S0 ;STORED
MOVEI T2,3 ;SIZE OF BLOCK
PUSHJ P,FX.RET## ;RESTORE NOW (INCASE REQUIRED AGAIN)
POP P,T2 ;ADDRESS IN T2
HLRZ T1,T2 ;GET INDEX
HRRZ T2,T2 ;OUT OF T2
HRLM R,FXT.S0 ;SAVE R SINCE IT WILL POINT TO DATA BLOCK ON RETURN
PUSHJ P,@CHNTAB(T1) ;GO TO RIGHT ROUTINE
HLRZ R,FXT.S0 ;RESTORE R
JRST FXTLP1 ;AND CONTINUE
DEFINE X (A)<
EXP PFF.'A
>
CHNTAB: CFIXUPS
;ROUTINE TO FIND HIGHEST LOCATION TO FIXUP IN EITHER LOW OR HIGH SEG
;CALLED BY
; PUSHJ P,FHA.L/FHA.H
;RETURNS
;T1 = HIGHEST LOC, 0 IF NONE TO DO
;USES T1,T2
FHA.L: TDZA T2,T2 ;INDEX BY 0 FOR LOW
FHA.H: MOVEI T2,1 ;1 FOR HIGH
HLRZ T1,FX.S1(T2) ;GET PTR TO HIGHEST LOC THIS CHAIN
JUMPE T1,CPOPJ ;NOTHING THERE
ADD T1,FX.LB ;+OFFSET
HRRZ T1,1(T1) ;GET VALUE THERE
IFN FTOVERLAY,<
JUMPN T2,CPOPJ ;LOW SEGMENT?
SUB T1,PH.ADD ;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
POPJ P, ;RETURN
;ROUTINE TO READ OVERFLOW FILES BACKWARDS AND DO ALL POSSIBLE CODE FIXUPS
COR.FX::SKIPN FX.S1 ;SEE IF ANY LOW SEG FIXUPS
SKIPE FX.S2 ;OR HIGH
CAIA ;YES
POPJ P,
PUSH P,R ;SAVE R
E$$FCF::.ERR. (MS,0,V%L,L%I,S%I,FCF,<Final code fixups>) ;[1174]
CORFXL: ;HERE FOR LOW SEGMENT
PUSHJ P,FHA.L ;FIND ADDRESS
JUMPE T1,CORFXH ;TRY HIGH
IORI T1,.IPM ;ROUNDED UP TO BLOCK BOUND
MOVEI R,LC.IX ;SET INDEX
PUSHJ P,RDBACK ;READ IN REQUIRED CORE IMAGE
;AND DO ALL FIXUPS WE CAN
JRST CORFXL ;TRY AGAIN
CORFXH: ;HERE FOR HIGH
PUSHJ P,FHA.H ;SEE IF ANY HIGH
JUMPE T1,CORFXT ;TEST TO SEE IF ANY MORE LOW
SUB T1,LL.S2 ;REMOVE ORIGIN
IORI T1,.IPM
MOVEI R,HC.IX ;SET INDEX FOR HIGH
PUSHJ P,RDBACK ;READ IN AND FIXUP
JRST CORFXH ;LOOP
CORFXT: PUSHJ P,FHA.L ;ANY LOW
JUMPN T1,CORFXL ;YES, RECYCLE
POP P,R ;RESTORE R
POPJ P, ;RETURN
;HERE TO DO ACTUAL READ BACK
;ENTER WITH
;R = 1 FOR LOW
;R = 2 FOR HIGH
RDBACK: EXCH T1,UW.S0(R) ;SWAP WITH CURRENT TO SET NEXT UPPER
HRL T1,LW.S0(R) ;WRITE OUT CURRENT IMMAGE
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R)
MOVE T1,UW.S0(R) ;NOW FIND BOTTOM
ADD T1,TAB.LB(R)
SUB T1,TAB.AB(R) ;FOR NEW LW.S0(R)
MOVEM T1,LW.S0(R) ;SET BASE
JUMPGE T1,RDBCK1 ;OK IF NOT TOO MUCH
ADDM T1,TAB.AB(R) ;TOO MUCH, CUT BACK TOP
SETZM LW.S0(R) ;WINDOW NOW ALL IN CORE
MOVE T1,TAB.LB(R) ;TOP WE WILL FILL
HRLI T1,1(T1) ;FORM BLT PTR
HRRI T1,2(T1)
SETZM -1(T1) ;AND CLEAR UP TO .UB
BLT T1,@TAB.UB(R) ;SO WE DON'T LEAVE JUNK BEHIND
RDBCK1: HRLZ T1,LW.S0(R) ;NOW FOR READIN
HRR T1,UW.S0(R)
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R)
PJRST @[EXP FIXUPL,FIXUPH]-1(R) ;AND DO FIXUPS
;HERE TO DO PAGE FAULT FIXUPS
;ADDITIVE FIXUPS
PFF.AR: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRRZ T1,(T2) ;GET RIGHT HALF VALUE
ADD T1,W3 ;PLUS DEFINED SYMBOL
HRRM T1,(T2) ;STORE NEW VALUE
POPJ P,
PFF.AL: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HLRZ T1,(T2) ;GET LEFT HALF VALUE
ADD T1,W3 ;PLUS DEFINED SYMBOL
HRLM T1,(T2) ;STORE NEW VALUE
POPJ P,
PFF.AF: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
ADDM T1,W3 ;PLUS DEFINED SYMBOL
POPJ P,
;CHAINED FIXUPS
IFN FTOVERLAY,<
PFF.CR: SKIPE T1,RT.PT ;IS RT AREA SET UP?
CAMN T1,RT.LB ;MAYBE, IS IT?
PJRST SY.CHR ;NO, NO RELOC BITS TO SET
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
TRNE T1,1 ;RH RELOCATABLE?
TXO R,1B1 ;YES, TELL RT.T2R
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHR ;GO CHASE CHAIN
PFF.CL: SKIPE T1,RT.PT ;ANY RELOC BITS TO WORRY ABOUT?
CAMN T1,RT.LB ;MAYBE, ARE THERE?
PJRST SY.CHL ;NO, GO FOLLOW CHAINS
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
TRNE T1,2 ;LH RELOCATABLE?
TXO R,1B0 ;YES, TELL RT.T2L
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHL ;GO CHASE CHAIN
PFF.CF: SKIPE T1,RT.PT ;RELOC BITS?
CAMN T1,RT.LB ;OR IS RT AREA EMPTY?
PJRST SY.CHF ;EMPTY, DON'T WORRY ABOUT IT
PUSH P,P3 ;SAVE P3 OVER RT.P3
MOVE P3,T2 ;ADDRESS OF CURRENT FIXUP
PUSHJ P,RT.P3## ;SETUP BYTE POINTER
ILDB T1,RT.PT ;PICK UP RELOCATION BITS
LSH T1,-^D34 ;MOVE TO LEFT JUSTIFY
IOR R,T1 ;SET WHERE RT.T2F CAN FIND IT
MOVE T2,P3 ;RESTORE CHAIN ADDRESS
POP P,P3 ;AND PRESERVED AC
PJRST SY.CHF ;GO CHASE CHAIN
> ;END IFN FTOVERLAY
IFE FTOVERLAY,<
PFF.CR==SY.CHR ;USE NORMAL CHAIN-CHASING ROUTINES
PFF.CL==SY.CHL
PFF.CF==SY.CHF
> ;END IFN FTOVERLAY
E$$ANM::.ERR. (MS,,V%L,L%F,S%F,ANM,<Address not in memory>)
;REPLACEMENTS
;RIGHT HALF
PFF.RR: JUMPE T2,CPOPJ
PUSHJ P,SEGCHK
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRRM W3,(T2) ;JUST REPLACE WHATS THERE
POPJ P,
;LEFT HALF
PFF.RL: JUMPE T2,CPOPJ
PUSHJ P,SEGCHK
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
HRLM W3,(T2)
POPJ P,
PFF.RF: JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
MOVEM W3,(T2) ;REPLACE VALUE
POPJ P,
SUBTTL LOCAL SYMBOL STORE
;ROUTINE TO ADD CONTENTS OF W1, W2, W3 TO LOCAL SYMBOLTABLE
;ALSO USED TO PUT GLOBALS AND OTHER STUFF THERE
;CHECKS FOR DSK OVERFLOW ETC
;THIS IS WHERE IT ALL GETS DONE
LSADDX: PUSHJ P,LS.XPN ;NEED TO EXPAND FIRST
LS.ADD::SKIPN @GS.LB ;[1143] USER TYPE /NOINITIAL?
PUSHJ P,LS.CHK ;[1143] YES, SEE IF NEED A DUMMY MODULE NAME
LSADD: MOVE T1,LSYM ;[1143] GET SYMBOL TABLE POINTER
HRRM T1,LSTSYM ;STORE REL POINTER TO NEXT SYMBOL
TXNN W1,PS.GLB ;IF NOT GLOBAL
HRRZS LSTSYM ;CLEAR SPURIOUS GLOBAL POINTER
MOVEI T2,.L ;ALWAYS SINGLE TRIPLET
MOVE T1,LS.FR ;NUMBER OF WORDS FREE
SUBI T1,(T2) ;WE NEED SOME MORE FOR THIS ENTRY
JUMPL T1,LSADDX ;NOT ENOUGH
MOVEM T1,LS.FR ;STORE NEW COUNT
MOVE T1,T2 ;SAME NUMBER OF WORDS
ADDM T2,LSYM ;COUNT EXTRA WORDS
ADDB T1,LS.PT ;NEW ACTUAL BOUND
TMOVEM W1,-3(T1) ;FLAGS, NAME, VALUE
POPJ P,
;HERE IF WE HAVE TO EXPAND
LS.XPN: PUSHJ P,.SAVE2## ;SAVE PRESERVED ACCS
PUSH P,T2 ;SAVE WORD COUNT
MOVEI P1,LS.IX ;LOCAL SYMBOL AREA
MOVE P2,T2 ;NUMBER OF WORDS REQUIRED
SUB P2,LS.FR ;LESS WHAT WE HAVE
PUSHJ P,LNKCOR ;GENERAL CORE EXPANDER
PUSHJ P,E$$MEF## ;[1174] CANNOT EXPAND ANY MORE
POP P,T2
POPJ P,
;HERE TO ADD EXTENDED SYMBOL TRIPLETS (COMMON FOR INSTANCE)
;ENTER WITH P1 CONTAINING A RELATIVE POINTER INTO THE GS AREA
;RETURNS WITH P1 FIXED IN CORE
LSADE1: PUSHJ P,LS.XPN ;NO ENOUGH SPACE
LS.ADE::SKIPN @GS.LB ;[1143] USER TYPE /NOINITIAL?
PUSHJ P,LS.CHK ;[1143] YES, SEE IF NEED TO FAKE A MODULE NAME
MOVE T1,LSYM ;SYMBOL TABLE PTR.
HRRM T1,LSTSYM ;REL PTR. TO NEXT SYMBOL
TXNN W1,PS.GLB ;IF NOT GLOBAL
HRRZS LSTSYM ;CLEAR PTR.
MOVE T1,LS.FR ;NUMBER OF WORDS FREE
SUBI T1,(T2) ;WHAT WE NEED FOR THIS ENTRY
JUMPL T1,LSADE1 ;NO ENOUGH
MOVEM T1,LS.FR ;STORE NEW COUNT
ADDM T2,LSYM ;COUNT EXTRA WORDS
MOVE T1,LS.PT ;FIRST FREE LOCATION
ADDB T2,LS.PT ;TOP OF SYMBOL
ADD P1,GS.LB ;[654] FIX ADDRESS IN CORE
HRL T1,P1 ;SOURCE
BLT T1,-1(T2) ;MOVE
POPJ P,
;HERE IF USER TYPED /NOINITIAL. IF USER TYPES /SET, /COMMON, ETC. BEFORE
;LOADING ANYTHING, THEN WE NEED TO INSERT A MODULE NAME SO SYMBOLS WILL
;NOT OCCUR OUTSIDE OF A MODULE. USE THE SYMBOL NAME FOR THE MODULE NAME.
LS.CHK: MOVE T1,LSYM ;[1143] GET SIZE OF LS AREA SO FAR
CAIN T1,1 ;[1143] EMPTY?
TXNN W1,PT.SYM ;[1143] YES, BUT IS THIS A SYMBOL?
POPJ P, ;[1143] NO, NOT THE SPECIAL CASE
MOVEM T1,NAMPTR ;[1143] CREATING A NEW MODULE
AOS PRGNO ;[1143] REMEMBER ONE MORE
SPUSH <W1,W3,T2> ;[1143] SAVE CALLER'S ARGS
MOVX W1,PT.SGN!PT.TTL ;[1143] THIS IS A TITLE
SETZ W3, ;[1143] NO PREVIOUS PTR
PUSHJ P,LSADD ;[1143] INSERT IN LS AREA
SPOP <T2,W3,W1> ;[1143] RESTORE ACS
SETZM LSTSYM ;[1143] SINCE NOT REALLY A SYMBOL
POPJ P, ;[1143] RETURN TO LS.ADD OR LS.ADE
SUBTTL GLOBAL SYMBOL STORE
;HERE WHEN SYMBOL MUST BE PUT IN TABLE
;POINTERS IN P1 _ P4
;SYMBOL STILL IN W1, W2, W3
SY.GS0::PUSHJ P,INSRT ;PUT CURRENT SYMBOL IN GLOBAL TABLE
MOVEI T2,.L ;ONLY 3 WORDS LONG
IFN FTOVERLAY,<
TXNN W1,PS.BGS ;A BOUND SYMBOL?
>
SKIPE NOSYMS ;NOT IN LOCAL IF NOT WANTED
POPJ P,
PJRST LS.ADD ;PUT IN LOCAL SYMBOL FILE
INSRT:: SKIPE @HT.PTR ;IS THERE A ZERO IN TABLE
JRST E$$SIF ;[1174] NO, ERROR, SHOULD NEVER HAPPEN
INSRT0: AOS GSYM ;COUNT SYMBOL
SOS HSPACE ;AND DECREMENT SPACE IN HASH TABLE
.JDDT LNKLOD,INSRT0,<<CAMN W2,$SYMBOL>> ;ARE WE LOOKING FOR THIS SYMBOL?
TXNE W1,PT.EXT ;LONG SYMBOL?
JRST INSRTL ;YES, JUST MOVE POINTERS
MOVEI T2,.L ;NUMBER OF WORDS REQUIRED
PUSHJ P,GS.GET## ;GO GET THEM
TMOVEM W1,0(T1) ;STORE TRIPLET SYMBOL
INSRT1: SUB T1,NAMLOC ;GET OFFSET TO NAMTAB
HRL T1,P3 ;HASH TOTAL IN LEFT HALF
MOVEM T1,@HT.PTR ;HASH TOTAL,,REL ADDRESS OF SYMBOL
TXNE W1,PS.GLB ;DEFINING A GLOBAL?
HRLZM T1,LSTSYM ;YES, STORE POINTER TO IT
POPJ P, ;RETURN
;HERE IF SYMBOL IS EXTENDED
;SYMBOL IS ALREADY IN CORE POINTER NEED ADJUSTING AND W3 RESET
INSRTL: MOVE T1,W3 ;W3 POINTS TO INCORE BLOCK
ADD T1,NAMLOC ;RELATIVE TO GS.LB
MOVE W3,2(T1) ;RESTORE W3 (VALUE)
JRST INSRT1 ;PUT IN HASH TABLE
E$$SIF::.ERR. (MS,0,V%L,L%F,S%F,SIF,<Symbol insert failure, non-zero hole found>) ;[1174]
SUBTTL SATISFY GLOBAL REQUESTS
;HERE TO SATISFY GLOBAL REQUESTS WITH DEFINED VALUE
;FLAGS IN W1
;VALUE IN W3
;ALL CHAINED REQUESTS ARE RIGHT-HALF FIXUPS
;P1-P4 ARE NOT SAVED BY THIS ROUTINE
SY.RF:: SOSGE USYM ;DECREMENT UNDEFINED GLOBAL COUNT
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
TRNE FL,R.FHS ;ARE RC TABLES SCREWED UP?
JRST SY.FHS ;YES, RESTORE THEM FOR FIXUPS
TRNE FL,R.FLS ;BUT MUST SAVE THEM IF RESTORED
JRST SY.FLS ;SINCE OTHERS DEPEND ON THEM
;BOTH SY.FHS & SY.FLS RETURN HERE WITH A PUSHJ
SY.FXX: IORM W1,0(P1) ;SEE WHAT WE HAVE IN FLAGS
MOVX W1,PS.UDF!PS.REQ ;DON'T NEED THESE NOW
ANDCAB W1,0(P1) ;SO CLEAR FROM MEMORY
MOVE T2,2(P1) ;PICKUP ADDRESS
MOVEM W3,2(P1) ;STORE VALUE
PUSHJ P,SY.CHR ;CHAIN THROUGH RIGHT HALF
MOVEI T2,.L ;STORE SYMBOL BEFORE WE LOSE IT
TXNE W1,PS.COM ;IF COMMON NEED TWO TRIPLETS
JRST [ADDI T2,.L
SUB P1,GS.LB ;[654] MAKE POINTER RELATIVE
PUSHJ P,LS.ADE ;STORE MULTIPLE WORD
JRST .+2] ;SKIP NEXT INST.
PUSHJ P,LS.ADD ;IN LOCAL TABLE
TXNN W1,PS.FXP ;ANY FIXUPS FOR THIS SYMBOL?
POPJ P, ;NO
JRST SY.RF1 ;YES
E$$DUZ::.ERR. (MS,,V%L,L%F,S%F,DUZ,<Decreasing undefined symbol count below zero>) ;[1174]
SY.FHS: SKIPA T1,[1] ;LOW SEG HAS BEEN FAKED
SY.FLS: MOVEI T1,2 ;HI SEG FAKED IF /SEG:LOW
HRR R,T1 ;SETUP R FOR SG.TB; PRESERVE LH
MOVE T1,@SG.TB ;GET REAL VALUE FOR RC TABLE
EXCH T1,@RC.TB ;RESTORE IT, GET FAKE VALUE
PUSH P,T1 ;SAVE FAKE VALUE TO RESTORE LATER
PUSH P,R ;REMEMBER WHICH SEGMENT
PUSH P,LL.S2 ;LL.S2 WAS ALSO FAKED BY T.3
HRRZS LL.S2 ;IF WE ARE LOADING F10, THAT IS
PUSHJ P,SY.FXX ;RE-JOIN SY.RF TILL IT POPJS
;HERE WHEN SY.RF RETURNS. RESTORE FORCED LOADING MODE.
POP P,LL.S2 ;RESTORE LL.S2
POP P,R ;REMEMBER WHICH COUNTER WE GRABBED
POP P,@RC.TB ;AND RESTORE IT
POPJ P, ;RETURN FROM SY.RF
SUBTTL SATISFY ADDDITIVE GLOBALS
;HERE FOR ADDITIVE GLOBALS
;THE ADDDITIVE GLOBAL REQUESTS ARE STORED IN LINKED LISTS IN AREA FX
;THE INITIAL POINTER TO THEM IS IN AN EXTENDED TRIPLET IN AREA GS
SY.RF1: HRRZ P1,@HT.PTR ;SETUP P1 AGAIN
ADD P1,NAMLOC ;ABSOLUTE
SY.RF2: HLLZ T1,0(P1) ;GET FLAGS AGAIN
TXNN T1,PS.REL ;IF THIS SYMBOL IS RELOCATABLE
TDZA T1,T1 ;NO
ANDX T1,PS.REL ;ALL THOSE DEPENDING ON IT ARE TOO
MOVEM T1,SYMFLG ;STORE INCASE SYMBOL TABLE FIXUPS
SYRF2A: ADDI P1,.L ;POINT TO EXTENDED SYMBOL
MOVE T1,0(P1) ;GET FLAGS
JUMPL T1,CPOPJ ;FINISHED IF PRIMARY SYMBOL
TXNN T1,S.FXP ;THIS TRIPLET A FIXUP REQUEST?
JRST SYRF2A ;NO, TRY NEXT
MOVE T1,P1 ;REMEMBER WHERE WE ARE
SUB T1,NAMLOC
PUSH P,T1 ;SO WE CAN DELETE FIXUP REQUEST WHEN DONE
MOVE P1,2(P1) ;GET POINTER TO FIXUP
SY.RF3: .JDDT LNKLOD,SY.RF3,<<CAMN P1,$FIXUP##>> ;[632]
PUSH P,P1 ;SAVE ADD OF FIXUP BLOCK
ADD P1,FX.LB ;IN CORE
MOVE W1,(P1) ;GET FLAGS AND NEXT POINTER
TXNE W1,FP.POL ;POLISH FIXUP (TYPE 11)?
JRST [PUSHJ P,SY.PF0 ;YES, SEE IF FIXUP CAN BE DONE
POP P,P1 ;RESTORE POINTER
ADD P1,FX.LB ;FIX IN CORE
JRST SY.RF4] ;AND DELETE THIS REQUEST
EXCH W3,2(P1) ;SWAP VALUE WITH REQUEST
PUSHJ P,SY.ADG ;DO THIS FIXUP
POP P,P1 ;RESTORE P1
ADD P1,FX.LB ;INCASE CORE MOVED
MOVE W3,2(P1) ;RESTORE W3
SY.RF4: MOVE T1,P1 ;FINISHED WITH IT NOW
MOVEI T2,.L
PUSHJ P,FX.RET## ;RETURN SPACE
HRRZ P1,W1 ;GET NEXT REL POINTER
JUMPE P1,SY.RF5 ;ZERO MARKS END OF CHAIN
TXNE W1,FP.SYM
JRST SY.RF3 ;DO THIS ONE
E$$ISP::.ERR. (MS,,V%L,L%F,S%F,ISP,<Incorrect symbol pointer>) ;[1174]
SY.RF5: POP P,P1
ADD P1,NAMLOC ;INCASE MOVED
MOVX W1,PS.FXP ;FLAG TO CLEAR
MOVX T1,S.LST ;INCASE STILL EXTENDED
SKIPG -.L(P1) ;ARE WE POINTING AT PRIMARY?
TXOA W1,PT.EXT ;YES, DELETE EXTENDED FLAG ALSO
IORM T1,-.L(P1) ;NO, MARK SECONDARY AS LAST
MOVEI T1,(P1)
MOVEI T2,.L
PUSHJ P,GS.RET## ;GIVE BACK TRIPLET
SKIPL (P1) ;POINTING TO PRIMARY?
JRST [SUBI P1,.L ;NO, BACKUP
JRST .-1] ;TRY AGAIN
ANDCAM W1,0(P1) ;CLEAR FLAGS IN PRIMARY
POPJ P,
;HERE FOR ADDITIVE GLOBAL REQUEST WITH VALUE ALREADY DEFINED
SY.ADG: TXNN W1,FS.FXS ;SYMBOL TABLE FIXUP?
JRST SY.AD0 ;NO
OR W1,SYMFLG ;STORE EXTRA FLAGS (PS.REL)
JRST SY.STF ;YES
;HERE TO FILL IN SINGLE ADDITIVE GLOBAL REQUEST
SY.AD0::
TXNE W1,FS.FXC ;RH CHAINED FIXUP?
JRST SY.ADC ;YES, HANDLE SEPERATELY
IFN FTOVERLAY,<
MOVE T1,0(P1) ;GET INCORE FLAGS
TXNE T1,PS.RBG ;FROM A RELOCATABLE LINK?
PUSHJ P,RT.FX## ;YES, STORE FIXUP FOR RELOCATION
>;END OF IFN FTOVERLAY
HRRZ T2,W3 ;GET REL ADDRESS OF FIXUP
PUSHJ P,SEGCHK ;GET CORE LOCATION
JRST SY.ADP ;OUT ON DSK (PAGED)
TXNE W1,FS.FXL ;LEFT HALF FIXUP?
JRST SY.ADL ;YES
TXNE W1,FS.FXF ;OR FULL WORD?
JRST SY.ADF ;YES
SY.ADR:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,1B1 ;YES, RESET BIT IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2R## ;YES, SET RELOC BIT CORRECTLY
>
HRRZ T1,(T2) ;GET RIGHT HALF VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
HRRM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADL:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,1B0 ;YES, RESET BIT IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2L## ;YES, SET RELOC BIT CORRECTLY
>
HLRZ T1,(T2) ;GET LEFT HALF VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
HRLM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADF:
IFN FTOVERLAY,<
TXNE W1,FS.REL ;RELOCATABLE?
TXO R,3B1 ;YES, RESET BITS IN R
PUSHJ P,SY.ADT ;RELOCATABLE OVERLAY?
JFCL RT.T2F## ;YES, SET RELOC BIT CORRECTLY
>
MOVE T1,(T2) ;GET FULL WORD VALUE
ADD T1,2(P1) ;PLUS DEFINED SYMBOL
MOVEM T1,(T2) ;STORE NEW VALUE
POPJ P,
SY.ADC: MOVE T2,W3 ;RETRIEVE ADDRESS OF CHAIN
MOVE W3,2(P1) ;GET VALUE TO STORE FOR SY.CHR
PJRST SY.CHR ;GO CHASE CHAIN
;SY.CHR WILL DO RIGHT THING FOR
;RELOCATABLE OVERLAYS
;HERE WHEN REQUIRED ADDRESS IS NOT IN CORE
;STORE AS A FIXUP REQUEST FOR ADDITIVES, EITHER RH ,LH, OR FULL
;ENTER WITH R = 1 (LOW), OR R = 2 (HIGH)
;W1 = FIXUP FLAGS
;W3 = ADDITIVE REQUEST
;2(P1) = SYMBOL VALUE
;PUT T2 =W3 AND W3 = 2(P1)
SY.ADP: MOVE T2,W3 ;EXPECTS ADDRESS IN T2
MOVE W3,2(P1) ;TRUE VALUE IN W3
TXNE W1,FS.FXR ;RIGHT HALF FIXUP?
HRLI T2,CPF.AR ;YES
TXNE W1,FS.FXL ;LEFT HALF FIXUP
HRLI T2,CPF.AL ;YES
TXNE W1,FS.FXF ;FULL WORD?
HRLI T2,CPF.AF ;YES
TXNE W1,FS.FXC ;RIGHT HALF CHAINED?
HRLI T2,CPF.CR ;YES
PJRST SY.CHP ;LINK IN
IFN FTOVERLAY,<
SY.ADT: SKIPN RT.LB ;IS IT RELOCATABLE
POPJ P, ;NO
PUSH P,P1 ;SAVE SYMBOL TABLE PTR
MOVSI P1,(Z @) ;TURN ON @ IN STACK
IORM P1,-1(P) ;THERE MUST BE AN EASIER WAY?
SETZ P1, ;SIGNAL NOT A SYMBOL FIXUP
HRRZ T2,W3 ;RESET ADDRESS
PUSHJ P,@-1(P) ;GO TO CORRECT ROUTINE
POP P,P1 ;RESTORE
HRRZ T2,W3 ;RESET ADDRESS
PUSHJ P,SEGCHK ;GET CORE LOCATION
HALT . ;CAN NOT HAPPEN
POPJ P, ;AND RETURN
>
;HERE FOR SYMBOL TABLE FIXUP
;CALLED BY
; MOVE W1,FLAGS
; MOVE W3,SYMBOL TABLE POINTER (LSTSYM TYPE)
; GLOBAL,,LOCAL
; MOVE P1,POINTER TO DEFINING TRIPLET (GS OR FX)
; PUSHJ P,SY.STF
;USES T1 - T4
SY.STF::SPUSH <W3,W2,W1,P1> ;SAVE ALL VALUES NEEDED LATER
SYSTF1: HLRZ T1,W3 ;GET GLOBAL ADDRESS
JUMPE T1,SYSTFL ;NO GLOBAL FIXUP REQUIRED
TXNE W1,FS.MDC ;[1213] ONLY WANT TO COMPARE VALUES?
JRST [MOVE T1,P1 ;[1213] YES, USE DEFINING TRIPLET AS VALUE
JRST SYSTFC] ;[1213] SKIP SEARCH FOR S.PVS TRIPLET
ADD T1,NAMLOC ;RELOCATE
MOVE T3,0(T1) ;GET FLAGS
TXNN T3,PT.OTH ;NOT SYMBOL?
JRST SYSTF3 ;YES IT IS
TXNN T3,PO.IND ;INDIRECT POINTER PERHAPS?
PUSHJ P,E$$ISP ;[1174] NO???
HRL W3,2(T1) ;RESET REAL POINTER
MOVEM W3,-3(P) ;KEEP STACK UP TO DATE
MOVEI T2,.L ;AND GET RID OF THIS DUMMY BLOCK
PUSHJ P,GS.RET##
JRST SYSTF1 ;TRY AGAIN
SYSTF2: TXNE T3,S.LST ;MORE TO COME?
PUSHJ P,E$$ISP ;[1174] NO, NO PVS TRIPLET???
SYSTF3: ADDI T1,.L ;LOOK AT NEXT TRIPLET
SKIPG T3,0(T1) ;PICK UP FLAGS
PUSHJ P,E$$ISP ;[1174] MUSN'T BE PRIMARY
TXNN T3,S.PVS ;FOUND THE PVS TRIPLET?
JRST SYSTF2 ;NO, KEEP LOOKING
;FALL THROUGH TO NEXT PAGE
;HERE WITH ABSOLUTE POINTER TO PVS TRIPLET IN T1. DEFINE GLOBAL SYMBOL.
MOVE T2,W1 ;GET FIXUP FLAGS FOR SY.AST
MOVE W3,2(P1) ;[572] AND FIXUP VALUE
PUSHJ P,SY.AST ;SET 2(T1) TO REAL VALUE
SYSTFC: MOVX T3,PS.UDR ;[1213] ASSUME RH FIXUP
TXNE W1,FS.FXL ;LEFT HALF?
TXC T3,PS.UDF ;YES, MAKE DEFINITION LH TOO
TXNE W1,FS.FXF ;UNLESS FULL WORD
TXO T3,PS.UDF ;IN WHICH CASE WE'RE DEFINING ALL
HLRZ T2,-3(P) ;RESTORE PRIMARY TRIPLET ADDR
ADD T2,NAMLOC ;MAKE ABSOLUTE
MOVE T4,T3 ;[612] COPY OF BITS BEING DEFINED
AND T4,0(T2) ;[612] WHICH OF THOSE ARE NOW UNDEFINED
CAME T3,T4 ;[612] ANYTHING WE'RE DEFINING KNOWN?
JRST SYSTFM ;YES, MULTIPLE DEFINITION
PUSHJ P,SYSTFF ;SET FLAGS AT 0(T2) PROPERLY
TXNE T3,PS.UDF ;STILL UNDEFINED ANYWHERE?
JRST SYSTFL ;YES, GIVE UP FOR NOW
SOSGE USYM ;NO, DECREMENT USYM
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
MOVE W3,2(T1) ;GET NOW-DEFINED VALUE
MOVE P1,T2 ;POINT TO PRIMARY OF NEW SYMBOL
TXNN W1,FS.MDC ;[1213] DON'T ZAP S.PVS IF WE DIDN'T USE IT
PUSHJ P,SY.ZST ;AND ZAP 2NDARY 3RPLET
MOVE W1,0(P1) ;GET FLAGS FOR SY.FXP
PUSHJ P,SY.FXP ;GO DO ALL DEFINITIONS
JRST SYSTFL ;AND CORRECT LS AREA TRIPLET
;HERE IF WE FOUND A MULTIPLE DEFINITION, WITH T1 POINTING TO PRIMARY,
;AND T2 POINTING TO S.PVS TRIPLET. WARN USER AND DISCARD NEW VALUE.
SYSTFM: MOVE P1,T2 ;STORE P.T. ADDR IN P1 FOR SY.MDF
MOVE T4,0(T2) ;GET STILL UNDEF BITS IF ANY
MOVE T2,2(T1) ;NEW SYMBOL VALUE
TXNE T3,PS.UDR ;NOT DEFINING RH?
TXNE T4,PS.UDR ;RH STILL UNKNOWN?
HRR T2,2(P1) ;YES, CAN'T BE MULTIPLE DEFINITION
TXNE T3,PS.UDL ;SAME CASE FOR LH
TXNE T4,PS.UDL ;ONLY GIVE MDS IF CONFLICT
HLL T2,2(P1) ;NOW HAVE ADJUSTED NEW VAL IN T2
CAMN T2,2(P1) ;MULTIPLE DEFINITION?
JRST SYSTFL ;NO (WHAT LUCK!) GO FIX LS AREA
DMOVE W1,0(P1) ;YES, SET NEW TRIPLET FROM OLD
MOVE W3,2(T1) ;BUT WITH DIFFERENT VALUE
PUSHJ P,SY.MDF ;WARN USER OF BUG
SKIPA T4,[PS.MDF] ;FLAG TO SET IN LOCAL TABLE
;SKIP THROUGH TO FIXUP LOCAL TABLE
;HERE TO FIX THINGS UP IN THE LOCAL SYMBOL TABLE
SYSTFL: MOVEI T4,0 ;NORMAL ENTRY, NOT MDS
PUSH P,T4 ;REMEMBER FOR AFTER SYSTF4 RETURNS
MOVE P1,-1(P) ;RESTORE EVERYTHING
MOVE W1,-2(P) ;. .
MOVE W2,-3(P) ;. .
MOVE W3,-4(P) ;. .
PUSHJ P,SYSTF4 ;GO FIXUP LOCAL TABLE
SPOP <T4,P1,W1,W2,W3> ;RESTORE THINGS FOR POSTERITY
HRRZ T2,W3 ;[572] GET RELATIVE LS ADDRESS
JUMPE T2,CPOPJ ;[572] GIVE UP IF NONE
CAML T2,LW.LS ;[572] IS IT STILL IN CORE?
IORM T4,0(T1) ;YES, SET MULTIPLY DEFINED
POPJ P, ;DONE
SYSTF4: HRRZ T2,W3 ;GET ADDRESS IN LOCAL TABLE
JUMPE T2,CPOPJ ;FORGET IT IF NOT IN LOCAL TABLE
CAMGE T2,LW.LS ;STILL IN CORE?
JRST SY.STP ;NO, GO GENERATE FIXUP
ADD T2,LS.LB ;YES, MAKE ABSOLUTE ADDRESS
SUB T2,LW.LS ;IN CASE PAGING
MOVX T3,PS.UDR ;ASSUME RH FIXUP
TXNE W1,FS.FXL ;LEFT HALF?
TXC T3,PS.UDF ;YES, MAKE DEFINITION LH TOO
TXNE W1,FS.FXF ;UNLESS FULL WORD
TXO T3,PS.UDF ;IN WHICH CASE WE'RE DEFINING ALL
PUSHJ P,SYSTFF ;SET FLAGS AT 0(T2) CORRECTLY
MOVE T1,T2 ;T1 POINTS TO LS TRIPLET
MOVE T2,W1 ;T2 CONTAINS FIXUP FLAGS
MOVE W3,2(P1) ;[572] W3 IS ADDITIVE DEFINITION
PJRST SY.AST ;GO FIXUP LS TRIPLET
;HERE TO SET THE FLAGS AT 0(T2) FROM T3 & W1
SYSTFF: ANDCAB T3,0(T2) ;ZAP BITS NOW DEFINED
MOVX T4,PS.REQ ;HOPE WE CAN CLEAR THIS NOW
TXNN T3,PS.UDF ;ONLY IF COMPLETELY DEFINED
ANDCAM T4,0(T2) ;GOT IT!
MOVX T4,PS.REL ;MUST ALSO SET RELOC IF OTHER WAS
TXNE W1,FS.REL ;WAS IT?
IORM T4,0(T2) ;YES, SO NEW SYMBOL IS TOO
POPJ P, ;RETURN WITH T3 SET UP
;HERE FOR POLISH FIXUPS CAUSED BY A BLOCK TYPE 11
;CONTAINING ONE OR MORE UNDEFINED GLOBAL SYMBOLS
;REPLACE THE NOW DEFINED SYMBOL BY ITS VALUE
;IF MORE UNDEFS EXIST GIVE UP
;IF ALL SYMBOLS ARE DEFINED DO FIXUP
SY.PF0: MOVE T4,2(P1) ;GET REL ADDRESS OF POLISH BLOCK
ADD T4,FX.LB ;ADD BASE
HRLI T4,(POINT 18) ;FORM BYTE POINTER
ADDI T4,2 ;BYPASS HEADER AND GLOBAL COUNT
SKIPA T3,T4 ;USE T3 AS CURRENT, T4 AS INITAL
SYPF1: IBP T3 ;BYPASS NEXT HALF WORD
SYPF2: ILDB T1,T3 ;READ HALF WORD
CAIL T1,MXPLOP## ;[712] CHECK FOR VALID OPS
JRST [CAIG T1,-6 ;[712] PSECT INDEX?
JRST SYPF2 ;[712] YES, SKIP IT
POPJ P,] ;[712] NO, IGNORE, ALL GLOBALS NOT YET DEFINED.
CAIL T1,3 ;IF OPERATOR
JRST SYPF2 ;IGNORE IT
JUMPE T1,SYPF1 ;IGNORE NEXT HALF WORD
CAIN T1,1 ;36 BIT VALUE?
AOJA T3,SYPF2 ;YES, GET NEXT HALF WORD AFTER IT
;HERE IF T1=2, GLOBAL SYMBOL REQUEST
ILDB T1,T3 ;GET FIRST PART OF SYMBOL
HRLZ T2,T1 ;STORE LEFT HALF PART OF SYMBOL
ILDB T1,T3 ;GET RIGHT HALF PART
HRR T2,T1 ;FULL SYMBOL IN W2
CAME T2,W2 ;IS THIS THE SYMBOL NOW DEFINED?
JRST SYPF2 ;NO
SUBI T3,2 ;BACKUP BYTE POINTER
IBP T3 ;TO POINT TO 2
MOVEI T1,1 ;CHANGE GLOBAL MARKER INTO 36 BIT VALUE MARKER
IDPB T1,T3
MOVS T1,W3 ;GET VALUE
IDPB T1,T3 ;STORE IT
MOVSS T1
IDPB T1,T3 ;T3 BACK AS IT WAS
SOSE -1(T4) ;ALL UNDEFS NOT DEFINED?
JRST SYPF2 ;NO, GET NEXT HALF WORD
;NOW TO EVALUATE POLISH FIXUP
;USE T.11EV (IN LNKOLD)
;THIS USES W1, W2, W3 FOR NON-SYMBOL USE
SPUSH <W1,W2,W3> ;SAVE SYMBOL ACCS
SUB T4,FX.LB ;UNRELOCATE
MOVEM T4,T11BP ;SETUP BYTE POINTER
MOVE T1,2(P1) ;ADDRESS OF POLISH BLOCK
ADD T1,FX.LB ;MAKE ABSOLUTE
HRLZ T1,0(T1) ;BLOCK LENGTH
HRRI T1,-2(T4) ;START ADDRESS OF BLOCK
MOVEM T1,T11FA
PUSHJ P,T.11EV## ;EVALUATE
SPOP <W3,W2,W1> ;RESTORE ACCS
POPJ P,
;HERE TO GENERATE LOCAL SYMBOL FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS THE SAME AS ALL OTHER PAGED FIXUPS
;WORD 1 BACK PTR,,FORWARD PTR
;WORD 2 INDEX,,SYMPTR
;WORD 3 VALUE
;
;CALLED BY
; MOVE W1,DEFINING SYMBOL FLAGS
; MOVE W3,SYMBOL PTR
; MOVE P1,PTR TO DEFINING SYMBOL
; PUSHJ P,SY.STP
;DESTROYS R
SY.STP: PUSH P,W3 ;SAVE SYMBOL PTRS
HRRZ T2,W3 ;AND REL ADDRESS IN SYMBOL TABLE
MOVE W3,2(P1) ;FIXUP VALUE FROM ORIGINAL SYMBOL DEF
TXNE W1,FS.FXR ;RIGHT HALF FIXUP?
HRLI T2,SPF.AR ;YES
TXNE W1,FS.FXL ;LEFT HALF FIXUP?
HRLI T2,SPF.AL ;YES
TXNE W1,FS.FXF ;FULL WORD FIXUP?
HRLI T2,SPF.AF ;YES
TXNN W1,FS.REL ;DEFINING SYMBOL RELOCATABLE?
JRST SYSTP1 ;NO, FIXUP TYPE IS OK
MOVS T2,T2 ;YES, GET FIXUP TYPE IN RH
ADDI T2,<SPF.RR-SPF.AR> ;MAKE CORRESPONDING
MOVS T2,T2 ; RELOCATABLE FIXUP
SYSTP1: MOVEI R,FS.SS-FX.S0 ;LOAD INDEX
SUB P1,FX.LB ;REMOVE OFFSET INCASE CORE MOVES
PUSHJ P,SY.CHP ;LINK INTO LIST
ADD P1,FX.LB ;...
POP P,W3 ;RESTORE W3
POPJ P,
SUBTTL ADDRESS CHAINS (RH, LH, FULL WORD)
;FIXUP CHAINING OF SYMBOLS
;ENTER WITH
;W3 = VALUE
;T2 = ADDRESS OF CHAIN (REL TO PROG ORIGIN)
;RIGHT HALF
SY.CHR::JUMPE T2,CPOPJ ;DONE IF ZERO LINK
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2R## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [HRLI T2,CPF.CR ;PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
HRL T2,(T2) ;GET NEXT LINK
HRRM W3,(T2) ;FILL IN VALUE
HLRZS T2 ;SETUP FOR NEXT
JRST SY.CHR ;DO IT
;LEFT HALF
SY.CHL::JUMPE T2,CPOPJ ;DONE IF ZERO LINK
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2L## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [HRLI T2,CPF.CL ;PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
HLL T2,(T2) ;GET NEXT LINK
HRLM W3,(T2) ;FILL IN VALUE
HLRZS T2 ;SETUP FOR NEXT
JRST SY.CHL ;DO IT
;FULL WORD
SY.CHF::JUMPE T2,CPOPJ ;DONE IF ZERO LINK
IFN FTOVERLAY,<
SKIPE RT.LB ;RELOCATABLE OVERLAY?
PUSHJ P,RT.T2F## ;YES, SET RELOC BIT CORRECTLY
>
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
JRST [HRLI T2,CPF.CF ;PAGE NOT IN CORE
JRST SY.CHP] ;CHAIN REQUESTS TOGETHER
HRL T2,(T2) ;GET NEXT LINK
MOVEM W3,(T2) ;FILL IN VALUE
HLRZS T2 ;SETUP FOR NEXT
JRST SY.CHF ;DO IT
;FULL WORD REPLACEMENT
RP.CHF::JUMPE T2,CPOPJ ;DONE IF ZERO
PUSHJ P,SEGCHK ;SETUP INCORE ADDRESS
PUSHJ P,E$$ANM ;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
MOVEM W3,(T2) ;REPLACE VALUE
POPJ P,
;HERE IF REQUIRED ADDRESS NOT INCORE
;DO NOT READ PAGE BACK IN, JUST STORE REQUEST IN FX TABLE
;FILL IN LATER WHEN ENOUGH TO JUSTIFY READING PAGE BACK
;FIXUPS ARE STORED IN DOUBLLY LINKED LIST IN ASCENDING ORDER
;POINTER IS PTR TO HIGHEST ADD,,PTR TO LOWEST ADD
;THE NULL LINK IS 0
;DATA BLOCK IS
; BACKWARD PTR,,FORWARD PTR
; FIXUP ADDRESS IN USER CORE
; FIXUP VALUE
;CALLED BY
; MOVEI R,TABLE OFFSET (REL TO FX.S0)
; MOVE T2,REL ADDRESS OF FIXUP
; MOVE W3,VALUE OF FIXUP
; PUSHJ P,SY.CHP
SY.CHP::HRRZ T1,R ;CLEAR RELOCATION BITS
CAILE T1,FS.SS-FX.S0 ;VALIDATE INDEX
PUSHJ P,INVIDX ;INVALID INDEX
PUSH P,T2 ;SAVE ADDRESS
MOVEI T2,3 ;NEED 3 WORD BLOCK
PUSHJ P,FX.GET## ;IN FIXUP AREA
POP P,T2 ;REL ADDRESS (TO SEGMENT) OF REQUEST
MOVEM T2,1(T1) ;STORE IN BLOCK
MOVEM W3,2(T1) ;AND VALUE
SUB T1,FX.LB ;REMOVE SET
.JDDT LNKLOD,SY.CHP,<<CAMN T1,$FIXUP##>> ;[632]
HRRZ T2,T2 ;ADDRESSES ARE ONLY 18 BITS
AOS FXC.S0(R) ;INCREMENT COUNT OF FIXUPS PER SEGMENT
;NOW TO LINK IN CHAIN, HERE WITH
;R = OFFSET TO INITIAL POINTER
;T1 = ADDRESS (REL TO FX.LB) OF THIS BLOCK
;T2 = VALUE (ADDRESS REL TO SEG OF FIXUP)
;USES T3, T4 AS POINTERS
SY.FP0: SKIPE FX.S0(R) ;VIRGIN CHAIN?
JRST SY.FP1 ;NO
HRL T1,T1 ;BOTH ENDS POINT TO SAME LOC
MOVEM T1,FX.S0(R) ;STORE LINK
POPJ P, ;RETURN
INVIDX: POP P,T1 ;GET LOCATION
HRRZS T1 ;CLEAR FLAGS
E$$IVC::.ERR. (MS,.EC,V%L,L%F,S%F,IVC,<Index validation check failed at address >) ;[1212]
.ETC. (OCT,.EP,,,,T1)
;HERE IF CHAIN ALREADY SETUP
SY.FP1: HLRZ T3,FX.S0(R) ;GET PTR TO TOP OF CHAIN
ADD T3,FX.LB ;ADD IN OFFSET
SETZ T4, ;PREV PTR WAS START OF CHAIN
JRST SY.FP4 ;FIRST TIME THROUGH LOOP
SY.FP2: HRLZ T4,T4 ;SAVE LAST IN LEFT HALF
HRR T4,T3 ;SAVE THIS IN RIGHT
HLRZ T3,(T4) ;GET NEXT LOWER
JUMPE T3,SY.FX6 ;END IF ZERO
ADD T3,FX.LB ;ADD IN OFFSET
SY.FP4: HLL T2,1(T3) ;GET INDEX SO COMPARE WILL WORK
CAML T2,1(T3) ;FIND ADDRESS SMALLER THAN WHAT WE HAVE
JRST SY.FP3 ;YES, LINK INTO LIST
JRST SY.FP2 ;NO, TRY AGAIN
SY.FX6: HRLM T1,(T4) ;ADD TO END
HRRM T1,FX.S0(R) ;AND TO INITIAL PTR
SUB T4,FX.LB ;-OFFSET
ADD T1,FX.LB ;+OFFSET
HRRZM T4,(T1) ;FORWARD LINK
POPJ P,
SY.FP3: TRNN T4,-1 ;START OF CHAIN IF 0 ADDRESS
JRST SY.FP5 ;YES, USE PREV POINTERS
HRRM T1,(T3) ;FWD PTR IN NEXT LOWER
HRLM T1,(T4) ;BKW PTR IN NEXT HIGHER
ADD T1,FX.LB ;ADD OFFSET
SUB T4,FX.LB ;REMOVE OFFSET
SUB T3,FX.LB ;FROM ADJACENT BLOCKS
HRRM T4,(T1) ;STORE IN LINK ADDRESS
HRLM T3,(T1)
POPJ P,
;HERE IF NEW ADDRESS IS BIGGEST YET
SY.FP5: HRRM T1,(T3) ;LINK BACK IN CHAIN
HRLM T1,FX.S0(R) ;AND INITIAL PTR
ADD T1,FX.LB ;FIX
SUB T3,FX.LB ;REMOVE OFFSET
HRLZM T3,(T1) ;BACKWARDS PTR
POPJ P,
SUBTTL MULTIPLY DEFINED GLOBAL
;HERE IF MULTIPLY DEFINED GLOBAL SYMBOL
;ENTER WITH W1, W2, W3 CONTAIN NEW SYMBOL
;P1 IS POINTER TO OLD SYMBOL
;USES T1
SY.MDS::PUSHJ P,SY.MDF ;WARN USER AND SET GLOBAL FLAG
TXO W1,PS.MDF ;FLAG MULTIPLE FOR LOCALS
PJRST LS.ADD ;AND GO STICK IN LOCAL TABLE
SY.MDF: MOVE T1,0(P1) ;GET CURRENT FLAGS
TXON T1,PS.MDF ;FLAG IT MULTIPLY DEFINED
AOS MSYM ;AND COUNT ONE MORE IF NEW
MOVEM T1,0(P1)
MOVE T1,2(P1) ;CURRENT VALUE
E$$MDS::.ERR. (MS,.EC,V%L,L%W,S%W,MDS,<Multiply-defined global symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2) ;SYMBOL IN W2
.ETC. (JMP,.EC,,,,.ETIMF##) ;[1174] PRINT OFFENDING MODULE
.ETC. (NLN,.EC) ;[1174]
.ETC. (STR,.EC,,,,,<Defined value = >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T1) ;CURRENT VALUE
.ETC. (STR,.EC,,,,,<, this value = >)
.ETC. (OCT,.EP,,,,W3) ;[1174]
SETZM LSTSYM ;SO WE DON'T DO FIXUPS?
POPJ P,
;HERE TO FILL IN PARTIAL VALUE SYMBOL (SYM1=SYM2)
;PRIMARY VALUE IS USUAL CHAINED REFERENCES
;SECONDARY VALUE IS ADDITIVE VALUE OF PARTIAL DEFINITION
;THERE MAY ALSO BE ADDITIVE GLOBAL FIXUPS REQUIRED
;CALLED BY
; MOVE T1,ADDRESS OF GLOBAL TO FIXUP
; MOVE T2,FLAGS FOR FIXUP TYPE
; MOVE W1,SYMBOL FLAGS
; MOVE W3,FIXUP VALUE
; PUSHJ P,SY.AS0
SY.AS1: TXNE T3,S.LST ;IF LAST TRIPLET
JRST SY.AS4 ;GIVE UP
SY.AS0::ADDI T1,.L ;GET NEXT TRIPLET
MOVE T3,(T1) ;GET FLAGS
JUMPL T3,SY.AS4 ;JUST INCASE
TXNN T3,S.PVS ;IS THIS THE ONE WE WANT
JRST SY.AS1 ;NO, TRY AGAIN
PUSHJ P,SY.AST ;FIXUP VALUE
TXNE W1,PS.UDF ;IF STILL UNDEFINED
JRST SY.AS4 ;GIVE UP
SOSGE USYM ;ONE LESS UNDEFINED THEN
;[1174] Replace @SY.AS0+9L DZN 30-May-79
PUSHJ P,E$$DUZ ;[1174] BUT NOT TOO FAR
MOVX T3,PS.REQ ;IF NOW FULLY DEFINED
ANDCAM T3,0(P1) ;CLEAR GLOBAL REQUEST FLAG IF SET
MOVE W3,2(T1) ;GET FIXUP VALUE (TEMP STORAGE ONLY)
PUSHJ P,SY.ZST ;ZAP PVS TRIPLET (T1 POINTS TO IT)
SY.FXP: EXCH W3,2(P1) ;GET VALUES RIGHT WAY ROUND
;AND FIXUP ALL REQUESTS
MOVE T2,W3 ;GET START OF CHAIN
DMOVE W2,1(P1) ;GET NAME AND VALUE OF SYMBOL
PUSHJ P,SY.CHR ;RIGHT-HALF CHAINED FIXUP
TXNN W1,PS.FXP ;ANY FIXUPS TO BE DONE?
SY.AS4: POPJ P, ;NO
PJRST SY.RF2 ;YES, DO ALL ADDITIVE FIXUPS
;HERE TO GET RID OF A SECONDARY TRIPLET IN THE GS AREA POINTED TO BY T1
SY.ZST: MOVE T3,0(T1) ;GET TRIPLET FLAGS
TXNN T3,S.LST ;LAST BLOCK?
PUSHJ P,SY.ZS1 ;NO, GIVE BACK THE MIDDLE FIRST
MOVEI T2,.L ;GIVE IT BACK
PUSH P,T1 ;SAVE ADDRESS
PUSHJ P,GS.RET##
POP P,T1 ;GET BACK POINTER
MOVE T3,-.L(T1) ;GET FLAGS
JUMPL T3,SY.ZS2 ;REACHED PRIMARY
MOVX T3,S.LST ;SET THIS IS LAST TRIPLET NOW
IORM T3,-.L(T1)
POPJ P, ;DONE
SY.ZS2: MOVX T3,PT.EXT!PS.FXP ;REMOVE EXTENDED FLAG
ANDCAM T3,-.L(T1) ;SINCE WE DON'T HAVE IT NOW
POPJ P, ;DONE
;HERE TO MOVE UP THE SECONDARY TRIPLETS
SY.ZS1: HRLZI T2,.L(T1) ;NEXT TRIPLET
HRRI T2,0(T1) ;THIS TRIPLET
ADDI T1,.L ;POINT TO NEXT
BLT T2,-1(T1) ;MOVE IT UP
SKIPG T2,0(T1) ;GET FLAGS
PUSHJ P,E$$ISP ;[1174]
TXNN T2,S.LST ;GOT THERE YET
JRST SY.ZS1 ;NO, TRY AGAIN
POPJ P,
;HERE TO FIXUP PARTIAL VALUE EITHER RH OR LH
;ENTER WITH
; T1 = PTR TO CURRENT EXTENDED TRIPLET
; T2 = FLAGS (WHICH HALF TO FIXUP)
; W3 = ADDITIVE VALUE
SY.AST::TXNE T2,FS.FXR ;RIGHT HALF?
JRST SY.ASR ;YES
TXNE T2,FS.FXL ;LEFT HALF?
JRST SY.ASL ;YES
SY.ASF: MOVE T3,2(T1) ;GET CURRENT VALUE
ADD T3,W3 ;ADD, IGNORE CARRY
MOVEM T3,2(T1) ;STORE VALUE BACK
POPJ P,
SY.ASR: HRRZ T3,2(T1) ;GET CURRENT VALUE
ADDI T3,(W3) ;IGNORE CARRY
HRRM T3,2(T1) ;STORE VALUE IN RIGHT
POPJ P,
SY.ASL: HLRZ T3,2(T1) ;GET CURRENT VALUE
ADDI T3,(W3) ;IGNORE CARRY
HRLM T3,2(T1) ;STORE BACK
POPJ P,
SUBTTL SYMBOL ROUTINES
;HERE TO MOVE A SYMBOL TO ANOTHER (LARGER) AREA
;GENERALLY TO ADD EXTENDED TRIPLETS
;CALLED BY
; MOVE T1,EXTRA REQUIRED
; MOVE P1,ABS LOC OF PRIMARY
; MOVE P2,REL OFFSET OF PRIMARY
; PUSHJ P,SY.MOV
;RETURNS
;P1 = NEW ABS ADDRESS
;T1 = LAST SYMBOL TRIPLET IN USE
SY.MOV::PUSH P,T1 ;SAVE EXTRA
PUSHJ P,SY.CHK ;SEE HOW MUCH WE ALREADY HAVE
EXCH T2,0(P) ;SWAP SO WE SAVE LENGTH
ADD T2,0(P) ;THIS IS HOW MUCH WE WANT
PUSHJ P,GS.GET## ;GET IT
HRRZ P1,@HT.PTR ;RESET P1(INCASE CORE MOVED)
ADD P1,NAMLOC ;FIX IN CORE
HRLZ T2,P1 ;MOVE FROM
HRR T2,T1 ; TO
MOVE T3,T1 ;UPTO
ADD T3,0(P) ;END
BLT T2,-1(T3)
EXCH P1,T1 ;SWAP
MOVE T2,0(P) ;FINISHED WITH OLD AREA
;UNLESS THERE ARE PARTIAL VALUE FIXUPS
MOVE T3,0(T1) ;GET FLAGS
TXNN T3,PT.EXT ;EXTENDED?
JRST SYMOV2 ;NO DON'T WASTE TIME
MOVE T3,T1 ;YES, MIGHT BE PARTIAL VALUES
SYMOV1: ADDI T3,.L ;ADVANCE TO NEXT SECONDARY
SKIPGE T4,0(T3) ;GET SECONDARY FLAGS
JRST SYMOV2 ;DONE
TXNE T4,S.PVS ;ONLY WANT PARTIAL VALUE
JRST SYMOV3 ;YES, MUST SAVE A POINTER TO NEW BLOCK
TXNN T4,S.LST ;IF LAST TRIPLET WE ARE FINISHED
JRST SYMOV1 ;NO TRY AGAIN
JRST SYMOV2 ;NOTHING WORTH SAVING HERE
;HERE WHEN PVS TRIPLET FOUND
SYMOV3: MOVX T4,PT.SGN!PT.OTH!PO.IND ;SET FLAGS
MOVEM T4,0(T1) ;IN MEMORY
MOVE T4,P1 ;GET NEW POINTER
SUB T4,NAMLOC ;MINUS OFFSET
MOVEM T4,2(T1) ;AS VALUE
ADDI T1,.L ;ADDVANCE
SUBI T2,.L
SYMOV2: PUSHJ P,GS.RET## ;SO GIVE IT BACK
MOVX T1,PT.EXT ;[612] TRIPLET IS NOW EXTENDED
IORM T1,0(P1) ;[612] SO MARK IT SO
MOVE T1,P1 ;ABS ADDRESS
SUB T1,NAMLOC ;MAKE REL
HRRM T1,@HT.PTR ;RESET POINTER
POP P,T2 ;GET LENGTH BACK
MOVE T1,P1
ADD T1,T2 ;POINT TO END
MOVX T3,S.LST ;IS NOT LAST NOW, SO REMOVE FLAG
SKIPL -.L(T1) ;BUT NOT IF PRIMARY
ANDCAM T3,-.L(T1)
POPJ P,
;HERE TO COUNT THE NUNBER OF TRIPLETS IN A SYMBOL
;ENTER WITH P1 = ADDRESS (ABS)
;RETURN T2 = LENGTH
;USES T1
;STOPS ON EITHER LAST TRIPLET (S.LST) OR NEXT PRIMARY (PT.SGN)
SY.CHK::SKIPGE T1,0(P1) ;SEE IF PRIMARY
TXNE T1,PT.EXT ;YES, BUT IS SYMBOL EXTENDED?
JRST SYCHK1 ;MUST COUNT EXTENDED
MOVEI T2,.L ;THE EASY WAY TO GET LENGTH
POPJ P, ;JUST RETURN
SYCHK1: HRRZ T2,P1 ;COPY STARTING ADDRESS
JUMPGE T1,SYCHK2 ;JUMP IF SECONDARY ON ENTRY
ADDI T2,.L ;GET FIRST SECONDARY
SYCHK2: SKIPGE T1,0(T2) ;MAKE SURE NOT PRIMARY
PUSHJ P,E$$ISP ;[1174] SHOULD NEVER HAPPEN
ADDI T2,.L ;ADVANCE PAST
TXNN T1,S.LST ;LAST TRIPLET?
JRST SYCHK2 ;NOT YET
SUBI T2,(P1) ;YES, GET LENGTH
POPJ P,
;HERE TO RETURN OLD SYMBOL AREA BACK TO POOL
;MAY BE ANY LENGTH (MULTIPLE OF .L)
;ENTER WITH P1 = ADDRESS OF SYMBOL IN CORE
;USES T1, T2
SY.RET::PUSHJ P,SY.CHK ;SEE HOW LONG IT IS
HRRZ T1,P1 ;GET START ADDRESS
SETZM @HT.PTR ;DELETE IN SYMBOL TABLE
PJRST GS.RET## ;RETURN IT
;HERE TO SETUP T2 TO POINT TO INCORE ADDRESS
;ENTER WITH T2 = RELATIVE ADDRESS
;SETS UP RHS OF R, LEAVES RELOC BITS IN LHS
;RETURNS
;+1 ADDRESS NOT IN CORE (PAGING ONLY)
; T2 UNAFFECTED, R CHANGED
;+2 ADDRESS IN CORE AND T2 POINTS TO IT
SEGCHK::
PUSH P,T2 ;[1132] SAVE USER VIRTUAL ADDRESS
HRRI R,2 ;ASSUME IN HIGH SEG
SKIPE LL.S2 ;[1132] MUST BE LOW IF ONLY ONE SEGMENT
CAMGE T2,LL.S2 ;[1132] BELOW BOTTOM OF HIGH SEGMENT?
SOJA R,SEGCK2 ;[1132] IN LOW SEGMENT
SUB T2,LL.S2 ;[1132] FORM OFFSET INTO HIGH SEGMENT
CAMGE T2,HL.S2 ;[1132] BEFORE END OF HIGH SEGMENT?
JRST SEGCK4 ;[1132] YES, IN HIGH SEGMENT
MOVE T2,0(P) ;[1132] RESTORE ADDRESS (OFFSET INTO LOW SEG)
HRRI R,1 ;[1132] SET R TO LOW SEGMENT
SEGCK2: ;[1132] HERE IF T2 AND R POINT TO LOW SEG
IFN FTOVERLAY,<
SUB T2,PH.ADD ;[1132] OFFSET INTO LC IF NOT ROOT LINK
> ;END IFN FTOVERLAY
SEGCK4: SKIPN PAG.S0(R) ;[1132] IS THIS AREA PAGING?
JRST SEGCK6 ;[1132] NO, ADDR CAN'T BE ON DISK
CAML T2,LW.S0(R) ;[632] IS ADDRESS IN CORE?
CAMLE T2,UW.S0(R) ;[632] MAYBE, IS IT?
JRST [POP P,T2 ;[1132] NOT IN CORE, RESTORE CALLER'S T2
POPJ P,] ;[1132] RETURN TO CALLER
;HERE IF ADDRESS IS DEFINITELY IN CORE.
SEGCK6: EXCH T2,0(P) ;[1132] GET PHYSICAL ADDRESS FOR .JDDT
.JDDT LNKLOD,SEGCK6,<<CAMN T2,$LOCATION>> ;[1132]
POP P,T2 ;[1132] RESTORE OFFSET INTO SEGMENT
SUB T2,LW.S0(R) ;[632] RELATIVE TO IN-CORE PART OF AREA
HRR R,@SG.TB ;[632] FIND APPROPRIATE RC BLOCK
ADD T2,@RC.LB(R) ;[632] MAKE PHYSICAL LOAD-TIME ADDRESS
JRST CPOPJ1 ;[632] SUCCESS RETURN TO USER
;HERE TO PUT REQUEST IN GLOBAL SYMBOL TABLE
;ENTER WITH
;W1 = SECONDARY TRIPLET FLAGS
;W2 = SYMBOL NAME
;W3 = FIXUP VALUE (NOT USED)
;+0(P) = RETURN ADDRESS
;-1(P) = VALUE OF PRIMARY TRIPLET
;-2(P) = FLAGS FOR PRIMARY TRIPLET
;
;NOTE, REMOVES 3 ITEMS FROM STACK
GS.FX0::MOVEI T2,2*.L ;NEED EXTENDED SYMBOL
PUSHJ P,GS.GET## ;GET SPACE FOR SYMBOL
TXO W1,S.LST ;SIGNAL AS LAST TRIPLET
TMOVEM W1,.L(T1) ;STORE SECONDARY TRIPLET FLAGS, NAME, VALUE
MOVE W1,-2(P) ;GET PRIMARY FLAGS
TXO W1,PS.FXP!PT.EXT ;MARK ADDITIVE REQUESTS IN FIXUP TABLE
MOVE W3,-1(P) ;GET VALUE FROM STACK
TMOVEM W1,0(T1) ;STORE FLAGS, NAME, VALUE
MOVE W3,T1 ;POINT TO INCORE BLOCK
SUB W3,NAMLOC ;INCASE IT MOVES
PUSH P,W3 ;SAVE VALUE INCASE CORE MOVES
PUSHJ P,INSRT ;PUT IN GLOBAL TABLE
POP P,W3 ;GET ADDRESS BACK (RELATIVE TO GX.LB)
POP P,T2 ;GET RETURN ADDRESS
SUB P,[2,,2] ;REMOVE JUNK FROM STACK
JRSTF @T2 ;AND RETURN
;HERE TO LINK FIXUP TRIPLET TO CURRENT GLOBAL TRIPLET
;ENTER WITH FIXUP ADDRESS (RELATIVE TO FX.LB)
;IN W3 (SET BY SY.FX0)
;AND GLOBAL ADDRESS (RELATIVE TO GX.LB)
;IN P2
;NOTE BOTH TABLES MAY MOVE
SY.GX0::HRRZ T1,@HT.PTR ;FIND OUT WHERE GLOBAL TRIPLET
ADD T1,NAMLOC ;IS IN CORE
HRRZM W3,.L+2(T1) ;FIXUP POINTER TO FIXUP LIST
POPJ P,
;HERE TO PUT SYMBOL INTO FIXUP TABLE
;ENTER WITH
;W1 = FLAGS
;W2 = SYMBOL
;W3 = VALUE
;RETURN WITH
;W3 = POINTER TO LOCATION RELATIVE TO FX.LB
SY.FX0::MOVEI T2,.L ;SPACE IN 3 WORD CHUNKS
PUSHJ P,FX.GET## ;SPECIAL SPACE GETTER
TMOVEM W1,0(T1) ;STORE FIXUP REQUEST
MOVE W3,T1 ;PUT ADDRESS IN W3
SUB W3,FX.LB ;MAKE IT RELATIVE TO ORIGIN
.JDDT LNKLOD,SY.FX0,<<CAMN W3,$FIXUP##>> ;[632]
POPJ P, ;RETURN
;HERE TO SEE IF SYMBOL REQUESTED FOR SYMBOL TABLE FIXUP WAS LAST
;SYMBOL DEFINED (NOT FULLY DEFINED OF COURSE)
;CALLED BY
; MOVE W3,SYMBOL
; PUSHJ P,SY.RLS
;RETURNS
;+1 NOT LAST SYMBOL DEFINED
;+2 LAST SYMBOL DEFINED
;T1= ADDRESS OF SYMBOL IN LOCAL TABLE
;T2= ADDRESS OF SYMBOL IN GLOBAL TABLE
SY.RLS::HRRZ T1,LSTSYM ;GET LOCAL ADDRESS
JUMPE T1,.+3 ;LEAVE ZERO ALONE
ADD T1,LS.LB ;RELOCATE
SUB T1,LW.LS ;BUT REMOVE WINDOW BASE
HLRZ T2,LSTSYM ;AND GLOBAL
SKIPE T2
ADD T2,NAMLOC ;RELOCATE
JUMPE T1,[JUMPE T2,SYRLSZ ;[1165] NO LOCALS, TRY GLOBAL
CAME W3,1(T2) ;IF IN GLOBAL TABLE
JRST SYRLSZ ;[1165] NO MATCH
JRST SYRLSM] ;GOT IT HERE
CAME W3,1(T1) ;SAME?
JRST SYRLSZ ;[1165] NO
SYRLSM: MOVE W3,LSTSYM ;YES, SET POINTER IN W3
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
SYRLSZ: SETZM LSTSYM ;[1165] DON'T CONFUSE SYMBOLS DOWN THE PIKE
POPJ P, ;[1165]
SUBTTL COMPILER SPECIFIC ROUTINES
DEFINE X(A,B,C)<
IF1,<BLOCK 1>
IF2,<
IFDEF B'NAM,< ;;[1120] CALL PROCESSOR ROUTINE
PUSHJ P,B'NAM
>
IFNDEF B'NAM,<
JFCL ;;[1120] NOTHING TO DO
>
>
>
XALL
CT.NAM::PROCESSORS
DEFINE X(A,B,C)<
B'BIT
>
CT.BIT::PROCESSORS
SALL
;CALLED BY PUSHJ P,xxxNAM
;
;ENTER WITH
; T1/ INDEX TO CT.TAB
; T2/ PROCSN (CT.BIT)
; W2/ PROGRAM NAME
; -1(P)/ BLANK COMMON
;HERE IF ALGOL MAIN PROGRAM - SETS THIS AS PROGRAM NAME
ALGNAM: SKIPN -1(P) ;SEE IF BLANK COMMON SET
POPJ P, ;[1120] USES COMMON SIZE AS MAIN PROG MARKER.
SETZM -1(P) ;CLEAR COMMON SIZE
MOVEM W2,LODNAM ;SAVE NAME
HRLZM T1,MNTYPE ;AND SAVE ALGOL AS MAIN PROG TYPE
POPJ P, ;[1120] DONE
F40NAM:
IFN FTOVERLAY,<
SKIPE OVERLW ;SEEN /OVERLAY?
JRST E$$FOV ;[1174] YES
>
IFN FMXFOR,<
SKIPE MIXFOR ;WANT TO MIX F40 & F-10?
JRST [HRRZS MIXFOR ;YES
TXNE T2,F40BIT ;[1120] 1ST TIME SEEN F40?
POPJ P, ;[1120] NO, GO TEST CPU'S
MOVX W1,PT.SGN!PT.SYM;[1120] YES,
MOVE W2,['FORSE.'] ;REQUEST FORSE., SO
SETZ W3, ;FORJAK WILL BE LOADED
PUSH P,P1 ;SAVE PERM ACS
PUSHJ P,SY.RQ## ;GENERATE REQUEST
POP P,P1 ;..
POPJ P,] ;[1120] DONE
>
TXNN T2,XFRBIT ;[1203] EXTENDED FORTRAN?
TXNE T2,FORBIT ;[1120] CAN NOT HAVE BOTH
JRST E$$MSR ;[1174] ERROR
POPJ P, ;[1120] DONE
IFN FTOVERLAY,<
E$$FOV::.ERR. (MS,.EC,V%L,L%F,S%F,FOV,<Cannot overlay F40 compiled code>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]>
CBLNAM: JUMPE T2,CPOPJ ;[1120] OK FIRST TIME
TXNE T2,C74BIT ;[1120] TEST FOR OTHER COBOL
JRST E$$CMC ;[1174] NOT ALLOWED
TXNE T2,CBLBIT ;[1120] OR IF COBOL ALREADY SEEN
POPJ P, ;[1120] DONE
E$$CMF::.ERR. (MS,0,V%L,L%F,S%F,CMF,<COBOL module must be loaded first>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
C74NAM: JUMPE T2,CPOPJ ;[1120] OK FIRST TIME
TXNE T2,CBLBIT ;[1120] TEST FOR OTHER COBOL
JRST E$$CMC ;[1174] NOT ALLOWED
TXNN T2,C74BIT ;[1174] OR IF COBOL ALREADY SEEN
JRST E$$CMF ;[1174]
E$$CMC::.ERR. (MS,.EC,V%L,L%F,S%F,CMC,<Cannot mix COBOL-68 and COBOL-74 compiled code>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;FORTRAN
XFRNAM: TXNE T2,FORBIT ;[1203] SEEN OTHER FORTRAN?
JRST E$$CMX ;[1203] YES, ERROR
JRST FOROK ;[1203] NO, PROCEED
FORNAM: TXNE T2,XFRBIT ;[1203] OTHER FORTRAN?
JRST E$$CMX ;[1203] YES, COMPLAIN
FOROK:
IFN FMXFOR,<
SKIPE MIXFOR ;DO WE NEED MIXFOR FEATURE?
JRST FORKLG ;YES
>
TXNN T2,F40BIT ;[1120] F40 SEEN ALREADY?
JRST FORSEG ;[1120] SEE IF WE CARE ABOUT CPU
E$$MSR::.ERR. (MS,0,V%L,L%F,S%F,MSR,</MIXFOR switch required to mix F40 and FORTRAN code>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
IFN FMXFOR,<
FORKLG: HRRZS MIXFOR ;MAKE IT POSITIVE
>
FORSEG: MOVE T1,OTSEG ;[1120] DID USER SPECIFY NON-REENT OTS?
SOJE T1,CPOPJ ;YES, SO LOAD TWO SEG CODE IN TWO SEGMENTS
IFN FTOVERLAY,<
SKIPGE LNKMAX ;ONLY IF WE ARE IN ROOT TEST
>
SKIPN HC.LB ; IF ANY HIGH LOADED
TRNE FL,R.FNS!R.FLS!R.FHS!R.LSO!R.HSO ;ANY REASON TO KEEP SEGMENTS DISTINCT?
POPJ P, ;EITHER USER HAS SPECIFIED WHICH, OR ALREADY LOADED HIGH
;IN EITHER CASE RIGHT THING HAPPENS
TRO FL,R.FLS ;NO, SO FORCE LOW SEGMENT
POPJ P, ;SO FOROTS WILL BE SHAREABLE
E$$CMX::.ERR. (MS,.EC,V%L,L%F,S%C,CMX,<Cannot mix Extended FORTRAN compiled code with FORTRAN compiled code>)
.ETC. (JMP,,,,,.ETIMF##) ;[1203]
AOS .JBERR ;[1207] STOP EXECUTION
JRST FOROK ;[1207] BUT KEEP LOADING
;SITGO
STGNAM:
E$$SNS::.ERR. (MS,.EC,V%L,L%F,S%F,SNS,<SITGO not supported>)
.ETC. (JMP,,,,,.ETIMF##) ;[1203]
SUBTTL MIXFOR FEATURE
IFN FMXFOR,<
.MXFOR::MOVE R2,ENTPTR ;GET AOBJN POINTER TO NAMES
MOVE R3,MIXFOR ;GET POINTER TO ADDRESSES
MXFOR1: HRRZ P4,(R3) ;GET ENTRY ADDRESS
JUMPE P4,MXFOR5 ;IGNORE 0 (F-10 MAIN PROG)
PUSHJ P,ADCKMX ;GET WORD IT POINTS TO
MOVS T1,T1 ;SHOULD BE ONLY LEFT HALF
CAIE T1,(JFCL) ;F-10 MAIN
CAIN T1,015000 ;F40 MAIN (RESET.)
JRST MXFOR5 ;YES, IGNORE
MOVEI R,1 ;ALWAYS STORE IN LOW SEGMENT
MOVE R,@RC.TB ;SINCE JSA CODE IS INPURE
MOVEI P2,4 ;NEED 4 WORDS
PUSHJ P,MXFCOR ;GET CORE FOR FIXUP
MOVSI W1,(CAIA) ;SKIP IF PUSHJ, DON'T IF JSA
CSTORE ;STORE IN CORE
MOVSI W1,(PUSHJ 17,) ;PUSHJ 17,.MXFOR##
ADDI P3,1 ;INCREMENT DEPOSIT POINTER
CSTORE
ADDI P3,1 ;FOR PUSHJ 17,.SAV15##
CSTORE
MOVSI W1,(JRST) ;JUMP TO ENTRY POINT
HRR W1,(R3) ;ADDRESS OF ENTRY
ADDI P3,1
CSTORE
MOVX W1,PT.SGN!PT.SYM!PS.ENT ;SET PS.ENT TO BYPASS TEST AT SY.GS
MOVE W2,(R2) ;SYMBOL
MOVEI W3,-3(P3) ;NEW VALUE OF ENTRY POINT
SUB W3,LC.LB ;MINUS OFFSET
ADD W3,LW.S1 ;PLUS BASE INCASE PAGING LC AREA
PUSHJ P,SY.GS## ;DEFINE ENTRY NOW
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['.MXFOR'] ;NOW FOR REQUEST
ADDI W3,1 ;ADDRESS FOR PUSH P,.MXFOR
PUSHJ P,SY.RQ##
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['.SAV15']
ADDI W3,1
PUSHJ P,SY.RQ##
MOVEI R,1 ;RESTORE R TO LOW SEG
MOVE R,@RC.TB ;SINCE SY.RQ (SEGCHK) DESTROYS IT
HRRZ P4,(R3) ;GET ADDRESS OF UNMODIFIED ENTRY POINT
PUSHJ P,ADCKMX ;ADDRESS CHECK INCASE ON DSK
TLC T1,(JUMP) ;F40 SUBROUTINE HAS ARG OPCODE HERE
JUMPN T1,MXFOR6 ;NO, NON-ZERO IS FORTRAN-10
;HERE FOR F40 CODE
MXFOR2: PUSHJ P,ADCKL1 ;GET NEXT WORD
TLC T1,(JRST) ;SEE IF END OF ARGS
TLNN T1,-1 ;BY JRST 2M
JRST MXFR2A ;YES
TLC T1,035016 ;JRST XOR PUSH 0(16)
TLNE T1,-1 ;LOOK FOR PUSH 0,N(16)
JRST MXFOR2 ;NO
PUSH P,T1 ;SAVE ADDRESS
MOVE T1,RC.CV(R) ;GET NEXT FREE LOC
HRLI T1,(JRST) ;JRST [CODE]
MOVEM T1,(P3) ;STORE
MOVEI P2,3 ;NEED 3 WORDS
PUSHJ P,MXFCOR ;FROM FREE CORE
POP P,W1 ;GET ADDRESS
HRLI W1,(MOVEI 1,@(16)) ;GET ADDRESS IN AC 1
CSTORE
MOVE W1,[PUSH 0,1] ;STACK IT
ADDI P3,1
CSTORE
HRRZI W1,1(P4) ;GET ADDRESS TO RETURN TO
HRLI W1,(JRST)
ADDI P3,1
CSTORE
JRST MXFOR2 ;TRY AGAIN
;HERE AT THE END OF THE ARGS IN THE SUBROUTINE PROLOGUE.
;NOW PUT ALL PATCH CODE IN PATCH AREA, AND HANDLE POSSIBLE MULT RETURN
MXFR2A: HRRZ P4,(R3) ;GET ADDRESS OF UNMODIFIED ENTRY POINT
SUBI P4,1 ;BACKUP 1
PUSHJ P,ADCKMX ;MAKE SURE ITS IN CORE
MOVE P4,(P3) ;SHOULD BE JRST 2M
TLC P4,(JRST) ;MASK LEFT 18 BITS
TLNE P4,-1 ;ALL ZERO
JRST E$$FSF ;[1174] NO, SO GIVE UP
MXFOR3: PUSHJ P,ADCKMX ;GET NEXT DATA WORD
TLC T1,(JRA 16,(16)) ;LOOK FOR RETURN INST
TLNE T1,-1
AOJA P4,MXFOR3 ;NOT YET, INCR AND TRY AGAIN
MOVSI T1,(POPJ 17,) ;CHANGE TO POPJ RETURN
MOVEM T1,(P3)
PUSHJ P,ADCKL1 ;GET NEXT DATA WORD
;INCASE MULTIPLE RETURNS
TLC T1,(ADD 16,) ;COMPILED CODE IS ALWAYS ADD 16,TEMP#
TLNE T1,-1 ;WHERE TEMP# CONTAINS NUMBER OF RETURN
JRST MXFOR5 ;SINGLE RETURN ONLY
PUSHJ P,ADCKL1 ;GET NEXT WORD
TLC T1,(JRA 16,@(16)) ;MULTIPLE RETURN HAS INDIRECT BIT ON
TLNE T1,-1
JRST E$$FSF ;[1174] ERROR
MOVSI T1,(SOJA 16,) ;CHANGE INST TO SOJA 16,.JRA16##
MXFOR4: MOVEM T1,(P3)
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['.JRA16']
MOVE W3,P4 ;LOCATION
PUSHJ P,SY.RQ## ;REQUEST CHAINED FIXUP
MXFOR5: ADDI R3,1 ;GO ON TO NEXT
AOBJN R2,MXFOR1 ;IF THERE IS ONE
MOVE T1,MIXFOR ;ADDRESS OF MIXFOR BLOCK
HLRE T2,ENTPTR ;-LENGTH OF IT
MOVM T2,T2 ;+LENGTH
PUSHJ P,DY.RET## ;RESTORE
SETOM MIXFOR ;RESET MIXFOR CONTROL
PJRST T.5ENT## ;RESTORE AND RETURN
;HERE IF FORTRAN-10, TEST FOR MULTIPLE RETURN
MXFOR6: MOVEI W1,-2(W3) ;[561] SEARCH UNTIL END OF SUBROUTINE
MXFOR7: PUSHJ P,ADCKMX ;GET NEXT DATA WORD
TLC T1,(POP 17,(17)) ;LOOK FOR WHERE MULTIPLE RETURN
TLNN T1,-1 ;CLEARS THE STACK
JRST MXFOR8 ;FOUND IT, WE NEED TO KEEP THIS ON STACK
TLC T1,(POP 17,(17)) ;PUT INST BACK AS IT WAS
TLC T1,(HRRM 1,(17)) ;INCASE NEWER FORM OF RETURM
JUMPE T1,[MOVEI T1,-2 ;YES, SO STORE RETURN
HRRM T1,(P3) ;AT RIGHT PLACE ON STACK
JRST MXFOR5] ;AND TRY NEXT
CAIGE P4,(W1) ;DON'T GO TOO FAR
AOJA P4,MXFOR7 ;BUT LOOK FAR ENOUGH
JRST MXFOR5 ;CANNOT FIND MULTIPLE RETURN
MXFOR8: MOVSI T1,(JFCL) ;REPLACE POP BY NOOP
MOVEM T1,(P3)
MXFOR9: PUSHJ P,ADCKMX ;GET NEXT DATA WORD
TLC T1,(JRST @(16)) ;LOOK FOR MULTIPLE RETURN
TLNN T1,-1
JRST [MOVSI T1,(JRST) ;FOUND IT
JRST MXFOR4] ;REPLACE BY JRST .JRA16##
CAIGE P4,(W1) ;GONE TOO FAR?
AOJA P4,MXFOR9 ;NOT YET
; JRST E$$FSF ;[1174] SHOULD HAVE FOUND IT BY NOW
;HERE IF SUBROUTINE IS NOT STANDARD FORM
E$$FSF::.ERR. (MS,.EC,V%L,L%W,S%W,FSF,<FORTRAN subroutine not in expected format, /MIXFOR fixup not done>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174] RETURNS WHEN MODULE AND FILE PRINTED
JRST MXFOR5 ;TRY NEXT
MXFCOR: MOVE P3,RC.CV(R) ;GET CURRENT RELOC COUNTER
ADDB P2,RC.CV(R) ;NEW RELOC COUNTER
CAMLE P2,HL.S1 ;RESET HIGHEST LOCATION COUNTER
MOVEM P2,HL.S1
CAMLE P2,HC.S1 ;AND HIGHEST DATA LOADED COUNTER
MOVEM P2,HC.S1
SKIPE PAG.S1 ;PAGING?
JRST MXFPAG ;YES, SEE IF IN CORE
ADD P2,LC.LB ;RELOCATE RELATIVE ADDRESS
CAMG P2,LC.AB ;WILL IT FIT IN EXISTING SPACE?
JRST MXFINC ;YES
SUB P2,LC.AB ;GET EXTRA REQUIRED
MOVEI P1,LC.IX ;AREA REQUIRED TO EXPAND
PUSHJ P,LNKCOR## ;TRY TO GET MORE SPACE
JRST MXFPAG ;FAILED, BUT MUST BE ON DSK BY NOW
SUB P3,LW.S1 ;INCASE WE DUMPED CORE FOR FIRST TIME
MXFINC: ADD P3,LC.LB ;FINALLY FIX THIS INCASE CORE MOVED
POPJ P,
MXFPAG: PUSHJ P,PG.LSG ;TEST IF IN CORE
JRST MXFINC ;NOW IN CORE
;HERE TO ADDRESS CHECK FIXUP LOCATION
;ENTER WITH ADDRESS (REL) IN P4
;RETURN WITH ABS ADDRESS IN P3
;CONTENTS OF P3 IN T1
;
ADCKL1: ADDI P4,1 ;GET NEXT LOCATION
ADCKMX: MOVE P2,P4 ;GET UPPER ADDRESS REQUIRED
MOVE P3,P4 ;AND LOWER
SKIPE PAG.S1 ;PAGING?
PUSHJ P,PG.LSG ;YES, MAKE SURE IN CORE
ADD P3,LC.LB ;FIXUP ADDRESS IN CORE
MOVE T1,(P3) ;GET CONTENTS
POPJ P,
>;END IFN FMXFOR
SUBTTL STORE CODE IN FX AREA
T3HOLD::MOVEI T2,.IPS ;STORE CODE IN INTERNAL PAGES
PUSHJ P,DY.GET## ;FIRST BLOCK IN DY, REST IN FX
MOVE T2,[3,,1] ;BLOCK HEADER
MOVEM T2,1(T1) ;FOR RE-READ
MOVEM W1,3(T1) ;STORE HIGH SEG ORIGIN
MOVEI W2,3(T1) ;POINT TO NEXT FREE LOC
HRLI W2,-.IPS+3 ;AOBJN WORD FOR THIS BLOCK
PUSH P,T1 ;SAVE ORIGIN
T3HEDR: PUSHJ P,D.IN1 ;GET NEXT HEADER
HLRZ T1,W1 ;GET TYPE
CAIN T1,5 ;NEED END BLOCK
JRST T5FND ;FOUND IT
PUSHJ P,FXHOLD ;HOLD CODE IN FX AREA
JRST T3HEDR ;AND CONTINUE
;HERE TO STORE BLOCK IN CORE (FX)
;ENTER WITH W1 = FIRST DATA WORD
FXHOLD: HRRZ T1,W1 ;GET WORD COUNT
JUMPE T1,CPOPJ ;IGNORE 0
CAIG T1,^D18 ;ONLY 1 SUB BLOCK
AOJA T1,FXHLD0 ;YES
IDIVI T1,^D18 ;NO, COUNT NO.
IMULI T1,^D19 ;ADD RELOCATION WORD
JUMPE T2,FXHLD0 ;NO REMAINDER
ADDI T1,1(T2) ;ADD REMAINDER + BYTE WORD
FXHLD0: SKIPA W3,T1 ;NO OF WORDS IN THIS BLOCK
FXHLD1: PUSHJ P,D.IN1 ;GET NEXT WORD
AOBJP W2,FXHLD3 ;RAN OUT OF SPACE
FXHLD2: MOVEM W1,(W2) ;STORE IT
SOJGE W3,FXHLD1 ;LOOP FOR ALL OF BLOCK
POPJ P, ;GET NEXT BLOCK
FXHLD3: SUBI W2,.IPS ;BACKUP POINTER TO START OF BLOCK
SKIPE FX.LB ;LIST IN DY IF NOT SETUP
CAMGE W2,FX.LB ;IS LIST IN FX OR DY
TLOA W2,-1 ;IN DY
SUB W2,FX.LB ;IN FX, REMOVE OFFSET
MOVEI T2,.IPS ;GET NEXT BLOCK
PUSHJ P,FX.GET## ;IN FIXUP AREA
TLZN W2,-1 ;WAS IT IN DY
ADD W2,FX.LB ;NO, PUT BACK OFFSET
EXCH T1,W2 ;NEW POINTER IN W2, OLD IN T1
MOVE T2,W2 ;COPY IT
SUB T2,FX.LB ;REMOVE OFFSET
.JDDT LNKLOD,FXHLD3,<<CAMN T2,$FIXUP##>> ;[632]
SUB T2,LW.FX ;INCASE PAGING
MOVEM T2,(T1) ;FIXUP POINTER
HRLI W2,-.IPS ;FORM AOBJN POINTER
AOBJN W2,FXHLD2 ;STORE CURRENT WORD IN NEW BLOCK
;HERE WHEN END BLOCK FOUND
T5FND: MOVEI T1,2 ;ONLY STORE FIRST 3 WORDS
PUSHJ P,FXHLD0
PUSH P,W1 ;SAVE HIGH SEG BREAK
PUSHJ P,FXHLD1 ;FINISH OFF BLOCK
POP P,W1 ;DATA WORD BACK
;NOW GET FIRST BLOCK BACK
POP P,W2
HRLM W1,3(W2) ;NOW WE HAVE A VALID BREAK
T5FND1: PUSH P,DCBUF ;STACK REAL BUFFER HEADER
PUSH P,DCBUF+1
PUSH P,DCBUF+2
MOVEI T1,.IPS-1 ;MAX NO. OF WORDS IN BUFFER
MOVEM T1,DCBUF+2
HRRM W2,DCBUF+1 ;NEW BUFFER HEADER
SETZM DCBUF ;SIGNAL INCORE
JRST LOAD ;AND TRY AGAIN
;HERE TO GET NEXT BUFFER
;MOVE IT FROM FX AREA TO DY AREA (FIXED ADDRESS)
FXRED1: PUSHJ P,FXREAD ;CALLED FROM D.INP
JRST D.IN1 ;SO RETURN THERE
FXRED2: PUSHJ P,FXREAD ;CALLED FROM D.READ
JRST D.RED1 ;SO RETURN TO THE CALLER
FXREAD: PUSHJ P,.PSH4T## ;NEED SOME TEMP ACCS
HRRZ T1,DCBUF+1 ;GET FINAL BYTE POINTER
SUBI T1,.IPS-1 ;BACKUP
HRRM T1,DCBUF+1
MOVEI T2,.IPS-1 ;NO OF WORDS IN BUFFER
MOVEM T2,DCBUF+2
SKIPN T1,(T1) ;GET FIRST WORD (POINTER)
HALT
SKIPE PAG.FX ;PAGING?
HALT
.JDDT LNKLOD,FXREAD,<<CAMN T1,$FIXUP##>> ;[632]
ADD T1,FX.LB ;ADD IN BASE
HRRZ T2,DCBUF+1 ;ADDRESS OF FIXED DY AREA ARRAY
HRLZ T3,T1 ;FROM
HRR T3,T2 ;TO
BLT T3,.IPS-1(T2) ;UNTIL
MOVEI T2,.IPS ;NOW GIVE BACK
PUSHJ P,FX.RET##
PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;AND RETURN
;HERE WHEN ALL DONE
T5FIN:: PUSHJ P,FX.GBC## ;GARBAGE COLLECT FX AREA
HRRZ T1,DCBUF+1 ;WHERE WE ARE NOW
ADD T1,DCBUF+2 ;+ WHATS LEFT
SUBI T1,.IPS-1 ;BACKUP
SKIPE (T1) ;BETTER HAVE FINISHED
HALT
MOVEI T2,.IPS ;GIVE BLOCK BACK
PUSHJ P,DY.RET##
POP P,DCBUF+2
POP P,DCBUF+1
POP P,DCBUF
JRST T.LOAD ;GET NEXT BLOCK
SUBTTL HERE TO TERMINATE LOAD
GO:: PUSHJ P,LIBRARY ;LOAD DEFAULT LIBS
MOVE T1,SYMSEG ;GET /SYMSEG
SKIPN NOSYMS ;NO SYMBOLS AVAILABLE?
CAIN T1,$SSGNONE ;[1201] USER GIVE /SYMSEG:NONE?
JRST [SETZM SYMSEG ;YES, TELL LNKXIT
JRST GOSTRT] ;DEFINE START ADDRESS
JUMPN T1,GOSTRT ;OK IF USER SPECIFIED
IFN TOPS20,<
MOVEI T1,$SSGLOW ;[1201] OTHERWISE, DEFAULT TO LOW
MOVEM T1,SYMSEG ;STORE FOR LNKXIT
> ;END IFN TOPS20
GOSTRT: SKIPN W2,STADDR+1 ;IS START ADDRESS STILL SYMBOLIC?
JRST GOUPTO ;[1175] NO
MOVX W1,PT.SGN!PT.SYM
PUSHJ P,TRYSYM## ;SEE IF DEFINED BY NOW
JRST E$$USA ;[1175] UNDEFINED
JRST E$$USA ;[1175] UNDEFINED
MOVE T1,2(P1) ;GET VALUE
ADDM T1,STADDR ;CALCULATE VALUE
SETZM STADDR+1 ;NOW KNOWN
JRST GOUPTO ;[1175] GO CHECK /UPTO
;HERE WHEN THE START ADDRESS IS UNDEFINED.
E$$USA::.ERR. (MS,.EC,V%L,L%W,S%W,USA,<Undefined start address >) ;[1174]
.ETC. (SBX,.EP,,,,W2) ;[1174]
SETZM STADDR ;[1175] CLEAR ADDRESS
SETZM STADDR+1 ;[1175] ...
;NOW TO CHECK THE /UPTO SYMBOL, IF ANY
GOUPTO: MOVE W2,SYMLIM ;[1175] GET /UPTO VALUE
TXNN W2,77B5 ;[1175] SYMBOLIC?
JRST GOUSYM ;[1175] NO
MOVX W1,PT.SGN!PT.SYM ;[1175] FLAGS
PUSHJ P,TRYSYM## ;[1175] SEE IF DEFINED
JRST E$$UUA ;[1175] NO
JRST E$$UUA ;[1175] NO
MOVE T1,2(P1) ;[1175] YES, FETCH VALUE
MOVEM T1,SYMLIM ;[1175] STORE FOR LNKXIT
JRST GOUSYM ;[1175] GO CHECK UNDEFINED SYMBOLS
;HERE IF THE /UPTO ADDRESS IS UNDEFINED.
E$$UUA::.ERR. (MS,.EC,V%L,L%W,S%W,UUA,<Undefined /UPTO: address >)
.ETC. (SBX,.EP,,,,W2) ;[1175]
SETZM SYMLIM ;[1175] NO LIMIT
; ..
; ..
;HERE TO MAKE A LAST-DITCH TRY AT DEFINING THE LAST UNDEFINED SYMBOL.
GOUSYM: SKIPN USYM ;STILL SOME UNDEFS?
JRST LODXIT ;NO, GIVE UP
MOVX W1,PT.SGN!PT.SYM ;MIGHT BE ALGOL REFERENCE
MOVE W2,['%OWN ']
SETZ W3,
PUSHJ P,TRYSYM## ;SEE IF PENDING REQUEST
CAIA ;NOT IN TABLE
JRST DEFOWN ;YES, NEEDS DEFINING
;HERE TO EXIT
;GO EITHER TO LNKMAP OR LNKXIT
LODXIT: SKIPE USYM ;ANY UNDEFINED SYMBOLS?
PUSHJ P,LODUGS ;[1174] PRINT UNDEFINED GLOBALS MESSAGE
HLRZ P1,INCPTR ;GET GLOBAL INCLUDE POINTER
JUMPN P1,[TLO P1,100 ;SET LH POSITIVE AS ERROR
MOVEI T1,[ASCIZ \?LNKIMM \]
PUSHJ P,MISNG1##
JRST .+1] ;AND REENTER MAIN STREAM
RELEASE DC, ;CLOSE INPUT I/O
MOVEI T1,DC ;FINISHED WITH INPUT BUFFERS NOW
MOVEM T1,IO.CHN
PUSHJ P,DVRET.## ;RETURN TO FREE POOL
SETZM IO.PTR+DC ;FORGET ABOUT IT
PUSHJ P,LODFIX ;DO ALL FIXUPS WE NEED
PUSHJ P,ALGCHK ;SEE IF ALGOL SYMBOL FILE NEEDED
MOVEI T3,1 ;[704] USED FOR LOOP CONTROL IN SRT.RC
PUSHJ P,SRT.RC ;[704] YES, GO SORT THE RELOC TABLES
MOVE T1,MAPSW ;SEE IF WE NEED A MAP
CAME T1,[$MAPEND] ;AT THE END
JRST LNKXIT ;NO
JRST LNKMAP ;YES
LODUGS: 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] START 1 UP FOR SOSGE IN UGSNXT
E01UGS::.ERR. (MS,.EC,V%L,L%F,S%C,UGS) ;[1174]
.ETC. (JMP,,,,,.ETUGS##) ;[1174] PRINT UNDEF'ED GLOBALS AND RETURN
;[704] HERE TO SORT THE PSECT RELOCATION TABLES BY ORDER OF
;[704] THEIR ORIGINS BEFORE DOING THE MAP OR EXIT.
;[704] USES T1,T2,T3,W1 AND R
;[747] ONCE THE SORT IS DONE, UPDATE LOWLOC and then
;[746] jump to check PSECT boundaries for any overlap.
SRT.RC: CAML T3,RC.NO ;[704] FINISHED?
JRST CHKLLC ;[747] YES, UPDATE LOWLOC
MOVE R,RC.NO ;[704] NO, START FROM THE END
SRT.R2: MOVE T1,@RC.TB ;[704] GET TABLE ADDRESS
SUBI R,1 ;[704] NEXT TABLE DOWN
MOVE T2,@RC.TB ;[704] ITS ADDRESS
MOVE W2,T2 ;[704] SAVE IT ALSO IN W2, INCASE OF EXCHANGE
MOVE W1,RC.IV(T1) ;[704] GET ORIGIN OF FIRST ONE
CAMGE W1,RC.IV(T2) ;[704] COMPARE WITH THE ORIGIN OF THE SECOND
JRST [ADDI R,1 ;[704] FIRST ON IS LESS, SO SWAP
EXCH W2,@RC.TB ;[704] THE TABLE ADDRESSES
SUBI R,1 ;[704]
MOVEM W2,@RC.TB ;[704]
JRST .+1] ;[704]
JUMPG R,SRT.R2 ;[704] LOOP BACK IF MORE TABLES
AOJA T3,SRT.RC ;[704] LOOP FOR ANOTHER SORT PASS
;[747] HERE TO UPDATE LOWLOC.
CHKLLC: SKIPN LOWLOC ;[747] IF LOWLOC IS ZERO ALREADY
JRST CHKLL1 ;[760][747] DON'T NEED TO CHECK
SETZ R, ;[747] GET .ABS.
MOVE T1,@RC.TB ;[747]
MOVE W1,RC.HL(T1) ;[1215] USE HIGHEST LOC EVER SEEN
MOVEI R,1 ;[747] GET .LOW.
MOVE T2,@RC.TB ;[747]
MOVE W2,RC.HL(T2) ;[1215] USE HIGHEST LOCATION EVER SEEN
IOR W1,W2 ;[747] ANY THING IN EITHER .ABS. OR .LOW.?
CAILE W1,140 ;[747]
JRST [SETZM LOWLOC ;[747] YES,
JRST CHKLL1] ;[760][747] NOW, GO CHECK PSECT OVERLAP
AOS R ;[747] NOTHING IN .LOW.
CAMLE R,RC.NO ;[1132] NEXT PSECT ORG MUST BE LOWEST
JRST [SETZM LOWLOC ;[1132] NO NEXT, LOWLOC IS ZERO
JRST CHKLL1] ;[1132] DONE
MOVE T1,@RC.TB ;[1132] GET POINTER TO RC BLOCK
MOVE W1,RC.IV(T1) ;[747]
CAMGE W1,LOWLOC ;[747]
MOVEM W1,LOWLOC ;[747] IN THAT CASE, UPDATE
;FALL THROUGH TO NEXT PAGE
;HERE TO UPDATE HL.S1 FROM PSECT INFO, IF NEEDED
CHKLL1: MOVE R,RC.NO ;[1106] POINT TO HIGHEST PSECT
CHKLL2: MOVE T1,@RC.TB ;[1106] GET POINTER TO THIS RC BLOCK
MOVE T2,RC.SG(T1) ;[1106] GET SEGMENT NUMBER
CAIN T2,1 ;[1106] LOW SEG?
JRST CHKLL3 ;[1106] GOT HIGHEST PSECT, GO FIX HL.S1
SOJGE R,CHKLL2 ;[1106] NO, LOOP OVER OTHER RELOC. COUNTERS
JRST CHKLL4 ;[1106] NONE FOUND, DONE
;HERE WHEN WE HAVE FOUND THE HIGHEST RC IN THE LOW SEG (A PSECT)
CHKLL3: SKIPN T2,RC.HL(T1) ;[1106] GET HL IF AVAILABLE
MOVE T2,RC.CV(T1) ;[1106] OR CV IF ITS NOT
CAMLE T2,HL.S1 ;[1106] POINT BEYOND CURRENT HL.S1?
MOVEM T2,HL.S1 ;[1106] YES, UPDATE WITH NEW VALUE
CHKLL4: MOVE R2,RC.NO ;[1106] USED IN CHKBND FOR LOOP CONTROL
; JRST CHKBND ;[760]
;[746] HERE TO CHECK FOR PSECT OVERLAP. IF OVERLAP IS FOUND
;A WARNING IS OUTPUT AND RETURN.
CHKBND: MOVE R,R2 ;[760][746] START FROM THE END
MOVE T1,@RC.TB ;[760][746] GET RELOC TABLE POINTER
MOVE T2,RC.HL(T1) ;[1204] HIGHEST EVER LOADED
MOVE T3,RC.CV(T1) ;[1204] WHERE NEXT WORD GOES
CAMG T2,[1,,0] ;[1204] TOO BIG?
CAMLE T3,[1,,0] ;[1204] MAYBE, IS IT?
PUSHJ P,E$$PTL## ;[1204] YES, DIE
MOVE W1,RC.IV(T1) ;[746] GET THE ORIGIN
CHKBN1: SOJLE R,CHKBN2+1 ;[760] CHECK WITH ALL LOWER PSECTS
MOVE T2,@RC.TB ;[746] GET TABLE PTR TO PSECT BEFORE
MOVE W2,RC.CV(T2) ;[760][746] AND ITS CURRENT VALUE
CAML W1,W2 ;[746] ANY OVERLAP?
JRST CHKBN2 ;[760][746] NO, LOOP
CAMLE W2,RC.CV(T1) ;[760] MIN OF THE TWO RC.CV'S
MOVE W2,RC.CV(T1) ;[760]
CAMGE W1,RC.IV(T2) ;[760] MAX OF THE TWO RC.IV'S
MOVE W1,RC.IV(T2) ;[760]
MOVE T1,RC.NM(T1) ;[746] SET UP TO OUTPUT WARNING
MOVE T2,RC.NM(T2) ;[746] GET THE TWO PSECT NAMES
E$$POV::.ERR. (MS,.EC,V%L,L%W,S%W,POV,<Psects >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,T1) ;[1174]
.ETC. (STR,.EC,,,,,< and >)
.ETC. (SBX,.EC!.EP,,,,T2) ;[1174]
.ETC. (STR,.EC,,,,,< overlap from address >) ;[1212]
.ETC. (OCT,.EC!.EP,,,,W1) ;[1174]
.ETC. (STR,.EC,,,,,< to >)
.ETC. (OCT,.EP,,,,W2) ;[1174]
CHKBN2: JUMPG R,CHKBN1 ;[760] LOOP DOWN IF MORE IN THIS SWEEP
SOJG R2,CHKBND ;[760] NEXT PSECT
POPJ P, ;[760] ALL DONE
LODFIX::SKIPN W1,LINKTB ;ANY BLOCK TYPE 12 LINKS?
JRST B12NOT ;NO
HRLI W1,-LN.12 ;FORM AOBJN WORD
B12LUP: HLRZ T2,(W1) ;GET END ADDRESS
JUMPE T2,B12END ;NONE
HRRZ W3,(W1) ;LAST ADDRESS
PUSHJ P,SEGCHK ;GET IN CORE ADDRESS
JRST [HRLI T2,CPF.RR ;NOT IN CORE
PUSHJ P,SY.CHP ;SO PUT IN FIXUP LIST
JRST B12END] ;AND RETURN FOR NEXT
HRRM W3,(T2) ;STORE IN CORE
B12END: AOBJN W1,B12LUP ;LOOP FOR ALL ITEMS
HRRZ T1,LINKTB ;ADDRESS OF TABLE
MOVEI T2,LN.12 ;LENGTH
PUSHJ P,DY.RET## ;GIVE IT BACK
SETZM LINKTB ;[737] CLEAR POINTER
B12NOT: SKIPN P1,PRGPTR ;ANY BLOCK TYPE 16 TO RETURN?
JRST B16NOT ;NO
B16RET: MOVEI T1,(P1) ;ADDRESS
MOVEI T2,4 ;SIZE
HRRZ P1,(P1) ;NEXT
PUSHJ P,DY.RET## ;RETURN SPACE
JUMPN P1,B16RET ;LOOP
SETZM PRGPTR ;[1103] REMEMBER THAT WE'RE DONE
B16NOT: PJRST COR.FX ;FIXUP ALL CODE CHAINS
;HERE TO SETUP FILE/SYMBOL:ALGOL IF NEEDED, AND STORE THE
;FILESPEC IN THE FIRST ALGOL OWN BLOCK SEEN THIS LOAD
ALGCHK: SKIPN NOSYMS ;/NOSYMS? (AFTER 1044 SEEN)
JRST ALGCH2 ;NO
ALGCH1: MOVEI T1,AC ;POINT TO ALGOL CHANNEL
SKIPE PAG.AS ;AS AREA PAGING?
PUSHJ P,DVDEL.## ;YES, DELETE OVERFLOW FILE
SETZM LW.AS ;ZAP PAGING POINTERS
SETZM UW.AS ;..
MOVEI T1,AS.IX ;NOW DELETE AREA
PJRST XX.ZAP## ;SO LNKXIT WILL HAVE MORE ROOM
;HERE IF NOT /NOSYMBOLS
ALGCH2: SKIPE T1,SYMFRM ;USER SAY /SYMBOL?
CAIN T1,2 ;YES, /SYMBOL:ALGOL?
CAIA ;YES, GIVE IT TO HIM
JRST ALGCH1 ;NO, FORGET WE EVER SAW 1044
JUMPN T1,ALGCH3 ;DON'T DEFAULT IF USER SPECIFIED
MOVX T1,ALGBIT ;GET BIT FOR ALGOL
TDNE T1,MNSEEN ;SEEN AN ALGOL MAIN PROGRAM?
SKIPN AS.LB ;AND SOME ALGOL SYMBOLS?
JRST ALGCH1 ;NO
MOVEI T1,2 ;DEFAULT TO /SYMBOL:ALGOL
MOVEM T1,SYMFRM ;SINCE USER DIDN'T SAY
MOVEI T2,F.LEN ;NEED A TEMP IO DATA BLOCK
PUSHJ P,DY.GET## ;FROM THE DY AREA
MOVE P1,T1 ;SAVE ADDR FOR DV.OUT
MOVE T1,LODNAM ;USE MAIN PROG NAME AS FILE NAME
MOVEM T1,F.NAME(P1) ;SAVE IN BLOCK
MOVSI T1,'SYM' ;EXTENSION '.SYM'
MOVEM T1,F.EXT(P1) ;SAVE FOR LNKFIO
PUSHJ P,DVOUT.## ;MAKE SCAN BLOCK INTO IO BLOCK
%SC,,.IODPR ;SYMBOL CHANNEL, DUMP RECORDS MODE
MOVE T1,P1 ;DONE WITH SCAN BLOCK
MOVEI T2,F.LEN ;SO RETURN IT TO DY AREA
PUSHJ P,DY.RET## ;..
ALGCH3: SKIPN SYMSEG ;USER SPECIFY WHERE SYMBOLS GO?
AOS SYMSEG ;NO, PUT THEM IN LOW SEG (ALGOL 7)
SKIPN P3,ASFILE ;LOW ADDRESS OF DESCRIPTOR
POPJ P, ;NO TYPE 15 SEEN, DON'T FILL IN
MOVEI P2,LN.ABL(P3) ;TOP ADDRESS OF DESCRIPTOR
SKIPE PAG.S1 ;PAGING LOWSEG?
PUSHJ P,PG.LSG ;YES, MAKE SURE BLOCK ADDRESSABLE
ADD P3,LC.LB ;MAKE ABSOLUTE PHYSICAL ADDRESS
HRRZ T1,IO.PTR+%SC ;ADDRESS OF FILE INFO
MOVE T2,I.DEV(T1) ;GET DEVICE OUT OF IO BLOCK
MOVEM T2,0(P3) ;MAKE 1ST WORD OF OTS DESCRIPTOR
MOVE T2,I.NAM(T1) ;SAME FOR FILE NAME
MOVEM T2,1(P3) ;IT BECOMES 2ND WORD
HLLZ T2,I.EXT(T1) ;EXTENSION...
MOVEM T2,2(P3) ;...INTO 3RD WORD
SKIPN T2,I.PPN(T1) ;GET PPN IF SPECIFIED
JRST ALGCH5 ;NOT, USE DEFAULT PATH
TLNE T2,-1 ;POINTER TO PATH?
JRST ALGCH4 ;NO
SKIPN T3,2(T2) ;YES, GET PPN
MOVE T3,PTHDIR ;OR DEFAULT PATH IF NOT SPECIFIED
MOVEM T3,3(P3) ;STORE AS WORD 4 FOR ALGOL
MOVSI T3,3(T2) ;MAKE BLT POINTER FOR SFD'S
HRRI T3,4(P3) ;INTO WORDS 5-9 OF BLOCK
BLT T3,11(P3) ;COPY SFD'S & TRAILING ZERO
POPJ P, ;FINISHED
ALGCH4: MOVEM T2,3(P3) ;STORE PPN IN CORE
SETZM 4(P3) ;INDICATE NO SFD'S
POPJ P, ;DONE
ALGCH5: MOVSI T2,PTHDIR ;WANTS DEFAULT - BLT OUR DEFAULT
HRRI T2,3(P3) ; PATH INTO THE ALGOL OWN BLOCK
BLT T2,11(P3) ;BLLLLLLLLLLIIIIIIIITTTTTTTT
POPJ P, ;DONE AT LAST
LIBRARY::
POP P,T1 ;RESTACK TOP 2 ITEMS
EXCH T1,(P) ;SO WE RETURN TO MAIN CALLER
PUSH P,T1 ;UNTIL ALL LOADED
IFN FTOVERLAY,<
SKIPE OVERLW ;SEEN /OVERLAY?
SKIPL LNKMAX ;AND STILL IN ROOT?
JRST PRGTST ;NO
TDO FL,[L.LIB,,R.LIB] ;FORCE LIBRARY SEARCH MODE
PUSHJ P,QREENT ;WANT REENTRANT VERSION?
CAIA ;NO, LOAD AS IS
TRO FL,R.FLS ;YES, FORCE LOW SEG
MOVEI T2,F.LEN ;GET SPACE
PUSHJ P,DY.GET## ;FOR FILE SPEC
MOVSI T3,'SYS' ;DEFAULT DEVICE
MOVE T4,['OVRLAY'] ;FILE NAME
DSTORE T3,F.DEV(T1),F.NAME(T1)
MOVSI T3,'REL'
SETOM F.NAMM(T1) ;SET MASK
HLLOM T3,F.EXT(T1)
PUSHJ P,LNKPRG ;PUT IN LIST
; JRST PRGTST
>
PRGTST: SKIPG PRGPTR ;ANYTHING TO DO HERE
JRST LIBTST ;NO, SEE IF ANY LIBRARIES
TDZ FL,[L.LIB,,R.LIB] ;INCASE WE WERE IN SEARCH MODE
PUSH P,P1 ;NEED AN ACC
MOVE P1,PRGPTR ;GET START
PRGTS1: SKIPGE (P1) ;WANT THIS ONE?
JRST PRGTS2 ;NO, ALREADY LOADED
MOVEI T2,F.LEN ;GET SPACE FOR DATA BLOCK
PUSHJ P,DY.GET##
MOVE T2,P1 ;GET POINTER TO TYPE 16 BLOCK
PUSHJ P,PRGLIB ;TRANSFORM AND LINK IN
HRROS (P1) ;MARK AS LOADED
PRGTS2: HRRZ P1,(P1) ;GET NEXT ADDRESS
JUMPN P1,PRGTS1 ;NOT DONE YET IF NON-ZERO
HRROS PRGPTR ;MARK WHOLE LIST DONE
POP P,P1
PUSHJ P,NXTLIB ;SETUP RETURN ADDRESS
JRST PRGTST ;SEE IF WE LOADED ANY MORE TYPE 16 BLOCKS
LIBTST: SKIPN LIBPTR ;ANY LIBRARIES
JRST USETST ;NO TRY USER DEFAULT LIBRARY(S)
SKIPN USYM ;YES, BUT ANY NEED FOR THEM
JRST REMLIB ;NO REMOVE THE SPACE THEY OCCUPY
TDO FL,[L.LIB,,R.LIB] ;GET INTO LIBRARY SEARCH MODE
MOVEI T2,F.LEN ;GET SPACE FOR DATA BLOCK
PUSHJ P,DY.GET##
MOVE T2,LIBPTR ;GET POINTER TO TYPE 17 BLOCK
PUSHJ P,PRGLIB ;TRANSFORM AND LINK IN
MOVE T1,LIBPTR ;GET POINTER BACK
MOVE T2,(T1) ;GET NEXT ADDRESS
MOVEM T2,LIBPTR ;AND STORE IT (ZERO IS END)
MOVEI T2,4 ;GIVE BACK BLOCK
PUSHJ P,DY.RET##
SKIPN LIBPTR ;NOT DONE YET IF NON-ZERO
PUSHJ P,NXTLIB
JRST PRGTST ;INCASE WE LOADED ANY MORE TYPE 16 OR 17
;HERE FOR USER DEFINED DEFAULT LIBRARIES
USETST: SKIPE USYM ;ANY UNDEFS LEFT?
SKIPG USEPTR ;ANY LIBRARIES
JRST DEFTST ;NO, TRY SYSTEM DEFAULTS
HRROS USEPTR ;ONLY ONCE THOUGH
PUSH P,P1 ;NEED A SAFE ACC
MOVE P1,USEPTR ;TO HOLD PTR TO LIST
USETS1: MOVX T1,1B0
MOVN T2,1(P1) ;GET LANGUAGE TYPE
JUMPE T2,USETS2 ;ALWAYS WANTED
LSH T1,(T2) ;SHIFT INTO POSSITION
TDNN T1,PROCSN ;HAVE WE LOADED THIS TYPE?
JRST USETS3 ;NO, GIVE IT A MISS
USETS2: MOVEI T2,F.LEN ;SPACE WE NEED
PUSHJ P,DY.GET## ;FOR LOOKUP BLOCK
ADDI T2,-1(T1) ;END OF BLT
MOVEI T3,2(T1) ;BYPASS FIRST 2 WORDS
HRLI T3,2(P1) ;BLT PTR
BLT T3,(T2) ;MOVE TO TEMP BLOCK
PUSHJ P,LNKPRG ;PUT IN LIST
USETS3: HRRZ P1,(P1) ;GET NEXT
JUMPN P1,USETS1 ;DO IT
POP P,P1
TDO FL,[L.LIB,,R.LIB] ;[613] MAKE SURE IN /SEARCH MODE
PUSHJ P,NXTLIB ;[613] LOAD THE USER LIBRARIES
; JRST DEFTST ;NOW FOR SYSTEM DEFAULT LIBS
DEFTST: SKIPN USYM ;ANYTHING TO DO?
JRST DEFXIT ;NO, RETURN TO LNKOV1 OR LNKLOD
TDO FL,[L.LIB,,R.LIB] ;MAKE SURE
PUSHJ P,DEFLOD ;YES, TRY DEFAULT LIBS
PUSHJ P,NXTLIB
SKIPG PRGPTR ;SEE IF WE LOADED ANYMORE 16
SKIPE LIBPTR ;OR 17 BLOCKS
JRST PRGTST ;YES, CYCLE AGAIN
SKIPE LIBPRC ;DID WE LOAD ANYTHING?
JRST DEFTST ;YES, TRY AGAIN
MOVX W1,PT.SGN!PT.SYM ;FLAGS
MOVE W2,['%OWN '] ;SYMBOL
SETZ W3, ;TRY AGAIN FOR %OWN
PUSHJ P,TRYSYM##
CAIA ;NOT IN TABLE
JRST DEFOWN ;UNDEFINED
DEFXIT: SETZM GOTO ;BACK TO NORMAL SCANNING
HRRZS USEPTR ;BACK AS IT WAS
TPOPJ: POP P,T1 ;REMOVE TOP RETURN
POPJ P, ;RETURN TO REAL CALLER
DEFOWN: MOVE W3,%OWN ;GET BASE
PUSHJ P,SY.GS## ;DEFINE
JRST DEFXIT
NXTLIB: POP P,GOTO ;STORE RETURN ADDRESS
JRST LNKWLD ;AND LOAD THIS
PRGLIB: DGET T3,<R.DEV(T2)>,<R.NAM(T2)> ;GET DEV & FILE NAME
DSTORE T3,F.DEV(T1),F.NAME(T1)
SETOM F.NAMM(T1) ;SET MASK
MOVE T3,R.EXT(T2) ;GET USER EXTENSION
HLLOM T3,F.EXT(T1) ;STORE WITH -1 MASK
MOVX T4,FX.DIR ;[672] BIT THAT SAYS DIR SPECIFIED
MOVEM T4,F.MODM(T1) ;[672] SAY TO LOOK AT IT
SKIPE T3,R.PPN(T2) ;[672] GET PPN, IF ANY
MOVEM T4,F.MOD(T1) ;[672] THERE WAS, REMEMBER IT
MOVEM T3,F.DIR(T1)
SETOM F.DIRM(T1) ;MUST MATCH EXACTLY
HRLI T2,-5 ;SET UP TO COPY ANY SFD'S
MOVE T4,T1
PRGSFD: SKIPN T3,R.SFD(T2) ;ANY MORE THERE?
JRST LNKPRG ;NO...WE'RE DONE
MOVEM T3,F.SFD(T4) ;STORE THE SFD
SETOM F.SFDM(T4) ;MUST MATCH EXACTLY
ADDI T4,2 ;SFD'S COME IN BIWORDS FOR SCAN
AOBJN T2,PRGSFD ;LOOP FOR ALL SFD'S
;NOW TO LINK INTO LIST
LNKPRG: SKIPN F.INZR ;FIRST TIME?
JRST FSTPRG ;YES
MOVE T2,F.NXZR ;GET CURRENT
MOVEM T1,(T2) ;STORE FORWARD POINTER
MOVEM T1,F.NXZR ;AND POINT TO IT
POPJ P,
FSTPRG: MOVEM T1,F.INZR ;SET FIRST POINTER
MOVEM T1,F.NXZR ;AND CURRENT
POPJ P,
DEFLOD: MOVE T1,NOLIBS ;GET MASK OF PROCESSORS NOT TO LOOK AT
ANDCAM T1,LIBPRC
SKIPE @GS.LB ;LOAD JOBDAT UNLESS LOADED ORIGINALLY BY DEFAULT
JRST DEFLD2 ; OR IF BEEN THROUGH LOOP ONCE ALREADY
MOVE P1,['JOBDAT']
PUSHJ P,LOAD1 ;LOAD JOBDAT
SETOM @GS.LB ; BUT ONLY ONCE
DEFLD2: HLRZ T1,MNTYPE ;GET COMPILER OF MAIN PROG
JUMPE T1,DEFLD1 ;NO MAIN (MAYBE 2ND TIME ROUND)
MOVE T2,CT.BIT(T1) ;GET CORRESPONDING BIT
ANDCAM T2,LIBPRC ;REMOVE FROM LIST TO LOOK AT
IORM T2,MNSEEN ;[614] A NEW MAIN PROG TYPE SEEN
TDNN T2,NOLIBS ;NOT TO SEARCH THIS LIBRARY?
PUSHJ P,@MNTBL(T1) ;DO WHAT WE HAVE TO FOR IT
DEFLD1: SKIPN T1,LIBPRC ;GET LIST OF OTHER PROCS SEEN
POPJ P, ;ALL DONE
JFFO T1,.+1 ;GET LEADING BIT
MOVE T1,CT.BIT(T2) ;GET BIT
ANDCAM T1,LIBPRC ;CLEAR IT
PUSHJ P,@PRCTBL(T2) ;DO ACTION FOR THIS PROCESSOR
JRST DEFLD1 ;LOOP
;HERE TO SEE IF LIBRARY IS ALREADY REQUESTED
;IF NOT PUT IN LIST OF FILES TO LOAD (IN SEARCH MODE)
;ENTER WITH P1 = SIXBIT \FILE.NAME\
LOAD1: SKIPN T1,F.INZR ;GET BASE OF LIST
JRST LOAD2 ;NO LIST NO REQUESTS YET
CAMN P1,F.NAME(T1) ;ALREADY IN LIST
POPJ P, ;YES JUST RETURN
MOVE T1,F.NXT(T1) ;GET NEXT POINTER
JUMPN T1,.-3 ;TRY IT
LOAD2: MOVEI T2,F.LEN ;GET SPACE
PUSHJ P,DY.GET## ;FOR DATA BLOCK
MOVSI T2,'SYS' ;ALL DEFAULT LIBS LIVE ON SYS (FOR NOW)
MOVEM T2,F.DEV(T1)
MOVEM P1,F.NAME(T1) ;STORE NAME
SETOM F.NAMM(T1) ;SET MASK
MOVSI T2,'REL' ;DEFAULT EXT IS REL
HLLOM T2,F.EXT(T1)
PJRST LNKPRG ;PUT IN LIST AND RETURN
REMLIB: SKIPN T1,LIBPTR ;GET SPACE TO REMOVE
JRST DEFXIT ;ALL DONE
MOVE T2,(T1) ;GET NEXT BLOCK
HRRZM T2,LIBPTR ;RESET POINTER
MOVEI T2,4 ;SIZE OF BLOCK
PUSHJ P,DY.RET## ;GIVE IT BACK
JRST REMLIB ;LOOP
DEFINE X(A,B,C)<
IF1,<
BLOCK 1
>
IF2,<
IFDEF B'.L0,<
EXP B'.L0
>
IFNDEF B'.L0,<
EXP CPOPJ
>>>
;HERE FOR TABLE FOR MAIN COMPILER
XALL
MNTBL: PROCESSORS
;HERE FOR ALL OTHER PROCESSORS SEEN
DEFINE X(A,B,C)<
IF1,<
BLOCK 1
>
IF2,<
IFDEF B'.L1,<
EXP B'.L1
>
IFNDEF B'.L1,<
EXP CPOPJ
>>>
PRCTBL: PROCESSORS
SALL
;HERE TO DO SPECIAL ACTION FOR SOME PROCESSORS
F40.L0: SKIPL FORLIB ;SEE WHICH LIBRARY WE WANT
JRST FORL00 ;NEW FOROTS
IFN FMXFOR,<
MOVE T1,PROCSN ;GET LIST OF PROCESSORS SEEN
TXNN T1,XFRBIT ;[1203] EXTENDED FORTRAN CODE?
TXNE T1,FORBIT ;HAVE WE SEEN ANY FORTRAN-10 CODE?
JRST FOR.L2 ;YES, NEED FOROTS THEN?
>
PUSHJ P,QREENT ;SEE IF WE WANT REENT OTS
JRST F40L11 ;NO
MOVE P1,['IMP40 '] ;LOAD REENT PART
PUSHJ P,LOAD1
F40.L1: SKIPL FORLIB ;WANT FOROTS?
JRST FORL00 ;YES
F40L11: MOVE P1,['LIB40 '] ;AND NON-RENT PART
PJRST LOAD1
FOR.L0: SKIPL FORLIB ;TEST TO SEE IF USER GAVE /FORSE
JRST FORL00 ;NO
IFN FMXFOR,<
FOR.L2:>
IFL .FORLB,<
AOSE FORLIB ;SEE IF SET BY SWITCH OR DEFAULT
JRST FORL02 ;DEFAULT, DON'T PRINT MESSAGE
>
E$$FSI::.ERR. (MS,0,V%L,L%W,S%W,FSI,<FORTRAN requires FOROTS, /FORSE switch ignored>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
FORL02: SETZM FORLIB ;IGNORE STUPID USER REQUEST
FORL00: IFN FMXFOR,<
MOVE T1,PROCSN ;GET PROCESSORS SEEN
SKIPE MIXFOR ;IF WE DON'T WANT MIXFOR FIXUP
TXNN T1,F40BIT ;OR NO F40 CODE LOADED
JRST FORL01 ;DON'T NEED FORJAK
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['FORSE.'] ;GET IT BY REQUESTING FORSE
SETZ W3,
PUSHJ P,SY.RQ## ;GENERATE REQUEST
FORL01:>
PUSHJ P,QREENT ;SEE IF WE WANT REENT OTS
JRST FOR.L1 ;NO
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['FOROT%'] ;SPECIAL SYMBOL
MOVEI W3,400000+.JBHDA ;VALUE
PUSHJ P,SY.GS## ;DEFINE IT
PUSHJ P,FOR.L1 ;[1200] PUT FORLIB IN LIST OF LIBRARIES
; ..
;SINCE WE'RE LOADING REENTRANT FOROTS, LOAD SYS:FORLIB/SEGMENT:LOW.
;THIS IS REQUIRED BY FOROTS VERSION 6 AND LATER.
MOVE P2,F.NXZR ;[1200] LAST LIBRARY PUT ON LIST
CAMN P1,F.NAME(P2) ;[1200] WAS IT FORLIB?
SKIPE F.SWP(P2) ;[1200] WITH NO SWITCHES YET?
POPJ P, ;[1200] NO, RETURN FROM FOR.L0
MOVEI T2,3 ;[1200] YES, ALLOCATE A SWITCH BLOCK
PUSHJ P,DY.GET## ;[1200] IN DY AREA
MOVEM T1,F.SWP(P2) ;[1200] PUT SWITCH IN FILE BLOCK
HRLZM T2,0(T1) ;[1200] STORE BLOCK SIZE
DMOVE T2,[EXP %SEG%,$SSGLOW] ;[1201] SWITCH AND ARGUMENT
DMOVEM T2,1(T1) ;[1200] STORE IN SWITCH BLOCK
POPJ P, ;[1200] DONE
;DEFINE %SEG%. MUST CALL SWTCHS MACRO.
..SEG==0
DEFINE SWMAC(A,B,C,D,E,F,G,H,I)<
IFIDN <B>,<SEGMENT>,<%SEG%==..SEG>
..SEG==..SEG+1>
SWTCHS ;[1200] LOOK FOR /SEGMENT
;HERE WHEN FORTRAN CODE IS SEEN, BUT NO MAIN PROGRAM.
FOR.L1: SKIPL FORLIB ;TEST FOR USER SCREW-UP
JRST FORL10 ;NO
E01FSI::.ERR. (MS,0,V%L,L%W,S%W,FSI) ;[1174]
.ETC. (STR,,,,,.ETIMF##) ;[1174]
SETZM FORLIB
FORL10: MOVE P1,['FORLIB'] ;COMMON LIBRARY
PJRST LOAD1
;HERE WHEN EXTENDED FORTRAN IS SEEN. SAME AS FORTRAN.
XFR.L0==FOR.L0 ;[1203] MAIN PROGRAM ENTRY
XFR.L1==FOR.L1 ;[1203] ANY CODE SEEN ENTRY
CBL.L0:
CBL.L1: MOVE P1,['LIBOL ']
PJRST LOAD1
C74.L0:
C74.L1: MOVE P1,['C74LIB']
PJRST LOAD1
ALG.L0: PUSHJ P,QREENT ;SEE IF WE WANT REENT VERSION
JRST ALG.L2 ;NO
MOVX W1,PT.SGN!PT.SYM
MOVE W2,['%SHARE']
SETZ W3,
PUSHJ P,SY.RQ## ;PUT IN REQUEST
ALG.L1: SKIPE LODNAM ;SEE THE MAIN PROGRAM YET?
JRST ALG.L2 ;YES
E$$AMP::.ERR. (MS,,V%L,L%W,S%W,AMP,<ALGOL main program not loaded>) ;[1174]
ALG.L2: MOVE P1,['ALGLIB']
PJRST LOAD1
NLI.L0:
NLI.L1: MOVX W1,PT.SGN!PT.SYM
MOVE W2,['%NELGO'] ;DEFINE SYMBOL
SETZ W3, ;WITH ZERO VALUE
PUSHJ P,SY.RQ## ;PUT IN REQUEST FOR IT
MOVE P1,['LIBNEL'] ;AND SPECIAL LIBRARY
JRST LOAD1 ;NOW LOAD IT
BCL.L0:
BCP.L1: MOVE P1,['BCPLIB']
PJRST LOAD1
SIM.L1: SKIPE LODNAM ;MAIN PROGRAM SEEN YET?
JRST SIM.L0 ;YES
E$$SMP::.ERR. (MS,,V%L,L%W,S%W,SMP,<SIMULA main program not loaded>) ;[1174]
SIM.L0: MOVE P1,['SIMLIB']
PJRST LOAD1
QREENT: MOVE T1,HL.S1 ;[1131] GET CURRENT END OF LOW SEGMENT
CAIGE T1,400000-50000 ;[1131] SEE IF WITHIN 40 DECIMAL PAGES OF HISEG
JRST QREEN1 ;[1131] YES--GO TRY TO FOR NON-SHARABLE OTS
SKIPN HL.S2 ;[574] NON-SHARABLE OTS. HIGH SEG EXIST?
TDO FL,[L.FLS,,R.FLS] ;[574] NO, DON'T START ONE
POPJ P, ;[574] NON-SKIP RETURN
;HERE IF LOW SEG .LT. 128K. CHECK /OTS AND HI SEG EXISTANCE
QREEN1: SKIPE T1,OTSEG ;[574] HAS USER SPECIFIED /OTS?
SOJE T1,CPOPJ ;[574] YES, /OTS:NONSHARABLE?
SKIPN HL.S2 ;[574] NO, GREAT. HIGH SEG EXIST YET?
AOS 0(P) ;[574] NO, GETSEG OTS AT RUNTIME
POPJ P, ;[574] HIGH SEG EXISTS, MUST LOAD OTS
SUBTTL COMMON I/O ROUTINES
;THESE ROUTINES POP OFF THE RETURN AND GO TO LODNXT ON EOF.
D.IN2:: PUSHJ P,D.IN1 ;GET A WORD
MOVE W2,W1 ;IN W2
D.IN1:: SOSGE DCBUF+2 ;ANYTHING IN BUFFER?
JRST D.INP ;NO DO INPUT
ILDB W1,DCBUF+1 ;GET NEXT WORD
POPJ P,
D.INP:: SKIPN DCBUF ;IF 0 THEN READING FROM CORE
JRST FXRED1 ;GET NEXT BUFFER
PUSHJ P,D.CNT ;[1101] DO IN UUO AND COUNT BLOCK
JRST D.IN1 ;AND RETURN
D.ERR:: STATZ DC,IO.EOF ;EOF?
JRST EOF ;YES
E01EIF::PUSH P,[DC] ;[1174] SAVE CHANNEL FOR LNKLOG
.ERR. (ST,0,V%L,L%F,S%F,EIF) ;[1174]
;THESE ROUTINES ARE LIKE THE CORRESPONDING D.IN? ROUTINES, EXCEPT
;THAT THEY RETURN CPOPJ1 WITH DATA OR CPOPJ ON EOF FROM REL FILE.
D.RED2::PUSHJ P,D.RED1 ;GET A WORD
POPJ P, ;NONE TO GET
MOVE W2,W1 ;SAVE IN W2
D.RED1::SOSGE DCBUF+2 ;ANYTHING IN BUFFER?
JRST D.READ ;NO, GO GET ANOTHER BUFFER
ILDB W1,DCBUF+1 ;YES, GET THE NEXT DATA WORD
JRST CPOPJ1 ;AND RETURN IT
D.READ::SKIPN DCBUF ;READING FROM CORE?
JRST FXRED2 ;YES, GO GET NEXT BUFFER
PUSHJ P,D.CNT ;[1101] DO IN UUO AND COUNT BLOCK #
JRST D.RED1 ;THAT WAS EASY
STATZ DC,IO.EOF ;EOF?
POPJ P, ;YES.
JRST D.ERR ;NO, INPUT ERROR
;THIS ROUTINE DOES AN IN UUO AND KEEPS TRACK OF THE CURRENT BLOCK
;NUMBER. BLOCK NUMBER IS RELATIVE (LIKE USETI) ON DISK, ABSOLUTE
;ON DTA.
;RETURNS +1 IF IN UUO WORKED, +2 IF FAILED (LIKE IN UUO DOES).
;DESTROYS W1 ONLY.
D.CNT: SKIPN DTAFLG ;[1101] READING FROM DECtape?
JRST D.CNT2 ;[1101] NO, JUST AOS THE COUNT FOR DISK
;HERE ON DECtape
SKIPGE LSTBLK ;[1101] IS THIS THE FIRST IN FROM DTA?
JRST D.CNT1 ;[1101] YES, MUST GET THE BLOCK DIFFERENTLY
MOVE W1,DCBUF ;[1101] NORMAL CASE, GET PTR TO NEXT
LDB W1,[POINT 18,1(W1),17] ;[1101] OUT OF OLD BUFFER
MOVEM W1,LSTBLK ;[1101] STORE IN LSTBLK
JRST D.CNT3 ;[1101] SKIP DISK'S AOS, GO DO IN UUO
;HERE ON FIRST IN FROM DECtape. GET FIRST BLOCK NUMBER FROM LOOKUP
D.CNT1: LDB W1,[POINT 10,FEXT,35] ;[1101] ON FIRST IN,
MOVEM W1,LSTBLK ;[1101] GET FROM LOOKUP BLOCK
JRST D.CNT3 ;[1101] GO DO IN UUO
;HERE ON DISK
D.CNT2: AOS LSTBLK ;[1101] ON DISK, JUST AOS LSTBLK
D.CNT3: IN DC, ;[1101] DO THE IN UUO
POPJ P, ;[1101] SUCCESS, RETURN
JRST CPOPJ1 ;[1101] IN UUO SKIPPED, PROPOGATE IT
EOF:: TRZE FL,R.LOD ;ENS BLOCK SEEN?
PUSHJ P,E$$NEB ;[1174] NO GIVE WARNING
POP P,(P) ;POP OFF RETURN
EOF1:: SKIPE XBUF ;USING INDEXED LIBRARY
PUSHJ P,ZXBUF ;YES, GET RID OF IT
JRST LODNXT ;GET NEXT FILE
E$$NEB::.ERR. (MS,.EC,V%L,L%W,S%W,NEB,<No end block seen>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
MOVEI R,1 ;NOW TRY TO FIXUP RELOC TABLES
MOVE R,@RC.TB ;DO LOW SEG FIRST
MOVE T1,RC.HL(R) ;HIGHEST LOC SEEN
CAMLE T1,RC.CV(R) ;GREATER THAN CURRENT?
MOVEM T1,RC.CV(R) ;STORE HIGHEST
MOVEI R,2 ;NO FOR HIGH SEGMENT
SKIPN R,@RC.TB
JRST CPOPJ ;NO HIGH SEG
MOVE T1,RC.HL(R) ;HIGHEST LOC SEEN
CAMLE T1,RC.CV(R) ;GREATER THAN CURRENT?
MOVEM T1,RC.CV(R) ;STORE HIGHEST
SETZM LOD37 ;[1114] DONE WITH COBOL SYMBOLS
SETZM OWNLNG ;[1114] AND ALGOL OWNS
; SETZM VARLNG ;[1114] AND LVARS
POPJ P,
;HERE TO REMOVE XBUF (FAKE BUFFER USED FOR LIBRARY INDEX)
ZXBUF:: HRRZ T1,XBUF ;ADDRESS IN CORE
MOVEI T2,^D128 ;SIZE
SETZM XBUF ;DONE WITH IT NOW
PJRST DY.RET## ;GIVE SPACE BACK AND RETURN
IFN DEBSW,<
$LOCATION:: 0 ;STORE ADDRESS TO BREAK ON
$SYMBOL:: 0 ;STORE 6BIT SYMBOL TO BREAK ON
>
SUBTTL THE END
LITLOD: END LNKLOD