Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
lnkcor.mac
There are 50 other files named lnkcor.mac in the archive. Click here to see a list.
TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/JNG/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 LNKCOR
EXTERN LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;DEC EDIT VERSION
SEGMENT
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;40 ADD GENERAL GARBAGE COLLECTOR
;42 TAB.PT NOT REDUCED WHEN CORE GIVEN BACK
;100 FIX BUG IN XX.INI WITH LARGE PROGRAMS
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;204 FIX SFU ERROR
;START OF VERSION 2B
;231 (13869) P1 NOT RESTORED IN TIME IN XX.INI
;234 NUL:/SAVE CAUSES PAGING ON NUL: DEVICE, USE DSK INSTEAD
;246 FIX CORE OVERFLOW CALCULATION
;257 Remove edit 231, restores old P1 too soon
;273 Fix disk overflow of high/low segment.
;301 Cope with case where during DSK overflow, not enough
; room found to replace IO.EMG.
;354 LABEL EDIT 234
;364 Add routine to handle lh fixups in the TITLE block's
; segment data.
;365 Give an error message if about to do a bad fixup.
;371 Define .ERSFU in this module.
;374 Prevent wild transfer of control at LCHCHK.
;415 Respect LS.PP always.
;START OF VERSION 2C
;467 Only allocate the first word of areas that need it in XX.INI
;471 Add code for ALGOL debugging system.
;510 Fixup relocatable symbols in LS area correctly.
;511 Don't do symbol fixups unless entire 3 word block is is core
;516 Handle LS completely full on call to expand LS correctly
; when core is full and some of LS must be paged out.
;517 Add AS.IN routine.
;525 Restore T1 after calling CHKMAX, which uses it.
;530 Define triplet flag bits correctly.
;543 Set PS.MDF correctly on LS fixups.
;544 SOUP in LINK version 3 stuff for TOPS-20.
;556 Check for GS area non-existence at STF.FL (can happen
; if called late in LNKXIT) and skip some stuff if so.
;557 Clean up the listing for release.
;START OF LINK VERSION 3
;451 CHANGE THE RUC MESSAGE
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;566 Do page fault fixup of high seg info in seg block right.
;577 Handle TB fixups to the LS area.
;604 Handle NUL: correctly.
;632 Implement $FIXUP.
;640 Make FR.CNT never return too high an answer.
;647 Add argument to GBCK.L indicating how much memory to clear.
;650 Use VM on TOPS-10 if available.
;670 Don't wipe out DY.LNK in LDCR7Y.
;676 Always do POP loop in memory.
;720 Move core upwards in 2 steps if it's .GE. 400000.
;731 SEARCH MACTEN,UUOSYM
;736 Change overflow file protection to standard protection.
;750 When doing overflow or core compress, leave window size of .IWS.
;755 Set and check TAB.ZE table for zeroing free space.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;771 Fix bug with shuffling large( .GT. 400000) core segment.
;1104 Remove part of edit 750 from LH.DMP to fix address checks.
;1113 Fix memory bugs when writing overlay tree.
;1130 Don't count memory requests for pagable areas toward /MAXCOR.
;1174 Label and clean up all error messages.
;1214 Fix unmatched angle bracket bugs.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
SUBTTL SIMPLE TESTS FIRST
LNKCOR: JUMPE P2,LDCR7Y ;JUST WANT TO SHUFFLE CORE
ADDI P2,.IPM ;MAKE SURE ITS A 128 WORD BLOCK
ANDCMI P2,.IPM
MOVE T1,TAB.UB(P1) ;GET UPPER BOUND
LDCOR0: SUB T1,TAB.AB(P1) ;MINUS ACTUAL BOUND
CAMGE T1,P2 ;BIG ENOUGH?
JRST LDCOR1 ;NO, TRY ONE ABOVE
ADDM P2,TAB.AB(P1) ;FIX ACTUAL BOUND TO REFLECT INCREASE
ADDM P2,TAB.FR(P1) ;AND FREE SPACE COUNTER
IFN TOPS20&FTFORK,<
JRST @CORTBL ;INCASE ANYTHING SPECIAL TO DO
>
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P,
;THAT TEST FAILED BUT MAYBE WE CAN GET SOME FROM NEXT AREA
LDCOR1: CAIL P1,HG.TAB ;NOT IF TOP AREA
JRST LDCOR2 ;SINCE NOTHING ABOVE IT
SKIPE T1,TAB.UB+1(P1) ;ZERO IF NOT IN USE
SKIPE TAB.AB+1(P1) ;ZERO IF SET UP BUT NOT USED
JRST LDCOR2 ;NO EASY TASK
SUB T1,TAB.LB+1(P1) ;SEE HOW MUCH IS REALLY FREE
CAMGE T1,P2 ;BUT IS IT ENOUGH
JRST LDCOR2 ;NO, NEED GENERAL TEST
ADDM P2,TAB.LB+1(P1) ;FIX THE BOUNDARIES
ADDM P2,TAB.UB(P1) ; AS THEY SHOULD BE
JRST LDCOR0 ;RETURN WITH BOUNDS SETUP
SUBTTL MAP FROM INFERIOR FORKS
IFN TOPS20&FTFORK,<
DEFINE XXX (ABC)<
IFNDEF ABC'.COR,<CPOPJ1>
IFDEF ABC'.COR,<ABC'.COR>
>
XALL
CORTBL: AREAS
SALL
LC.COR: TDZA T3,T3 ;LOW SEG OFFSET
HC.COR: MOVEI T3,1 ;HIGH SEG ORIGIN
MOVE T4,P2 ;HOW MUCH WE INCREASED BY
LSH T4,-9 ;IN PAGES
MOVE 1,LC.AB(T3) ;HIGHEST NOW IN USE
SUBI 1,-1(P2) ;HIGHEST NEW ADDRESS
MOVE 2,1
SUB 1,LC.LB(T3) ;REMOVE BASE
ADD 1,LL.S1(T3) ;ADD IN ORIGIN
ADD 1,LW.S1(T3) ;INCASE PAGED IN SUPERIOR FORK
LSH 1,-9 ;IN PAGES
HRL 1,LC.FRK ;SOURCE IS INFERIOR FORK
LSH 2,-9
HRLI 2,(1B0) ;DESTINATION IS CURRENT
SETZ T3, ;NO SPECIAL PRIVS
PMAP
SOJLE T4,CPOPJ ;DONE IF ONLY ONE PAGE
ADDI 1,1 ;INCREMENT PAGE#
AOJA 2,.-3 ;AND CREATE IT
>;END OF IFN TOPS20&FTFORK
SUBTTL TABLE DRIVEN CORE MOVER
;HERE TO SEE IF ENOUGH CORE IN LOW SEGMENT
LDCOR2: PUSHJ P,FR.CNT ;COUNT FREE CORE
MOVE T2,FRECOR ;WE SHOULD KEEP THIS MUCH FREE
ADD T2,P2 ;AFTER GETTING ALL WE NEED
SUBM T1,T2 ;MINUS WHAT WE HAVE
JUMPGE T2,LDCOR4 ;GIVES ENOUGH?
IFN TOPS20,<
JRST LNKOVF ;[650] CORE ALWAYS FULL ON TOPS20
> ;END OF IFN TOPS20
IFE TOPS20,<
SKIPE CORFUL ;NO, IS CORE FULL (CORE UUO FAILED)?
JRST LNKOVF ;YES
MOVN T2,T2 ;GET WHAT WE NEED
ADD T2,.JBREL ;ON TOP OF WHAT WE ALREADY HAVE
IFN FTVM,<
SKIPE USEVM ;[650] VM SYSTEM?
SKIPA T1,[.VCRX] ;[650] YES, GROW FASTER
> ;END OF IFN FTVM
MOVEI T1,.CORX ;[650] MINIMUM NORMAL INCREMENT
ADD T1,.JBREL## ;[650] PLUS CURRENT SIZE
CAMGE T2,T1 ;[650] ASKING FOR LESS THAN MINIMUM?
SKIPA T3,T1 ;[650] YES, ASK FOR AT LEAST MINIMUM
MOVE T3,T2 ;[650] NO, ASK FOR ALL WE NEED
CAMLE T3,MAXCOR ;[650] ASKING FOR TOO MUCH?
JRST LDCOR3 ;[650] YES, OVERFLOW
CORE T3, ;[650] TRY FOR WHAT WE NEED
JRST LDCOR3 ;[650] CAN'T GET IT, OVERFLOW
E$$EXP::.ERR. (MS,.EC,V%L,L%I3,S%I,EXP,<Expanding low segment to >) ;[1174]
.ETC. (COR,.EP,,,,.JBREL)
HRRZ T2,.JBREL ;GET NEW TOP
MOVEI T1,HG.TAB ;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO
SKIPN TAB.LB(T1) ;SO LOOK FOR HIGHEST NON-ZERO
SOJA T1,.-1 ;NOT FOUND YET, BUT WE WILL
MOVEM T2,TAB.UB(T1) ;RESET TOP BOUNDARY
CAIE P1,(T1) ;IF EXPANDING TOP AREA
JRST LDCOR2 ;COUNT AGAIN
> ;END OF IFE TOPS20
LNKCON: JUMPE P2,CPOPJ1 ;P2=0 WAS ONLY SHUFFLING
JRST LNKCOR ;TRY TO GET FROM NEW INCREASE
IFE TOPS20,<
;CORE UUO FAILED
;IF FRECOR=0 INITIALIZE DSK FOR OVERFLOW
;OTHERWISE ZERO FRECOR AND TRY AGAIN
LDCOR3: SKIPN FRECOR ;BEEN HERE BEFORE?
JRST LDCR3A ;YES, OVERFLOW TO DSK NOW
SETZM FRECOR ;CLEAR THIS RESTRICTION
JRST LDCOR2 ;AND TRY AGAIN
;BUT FIRST EXPAND AS MUCH AS WE CAN
;THIS CAN HAPPEN IF A LARGE ARRAY IS SEEN
LDCR3A: SETOM CORFUL ;[650] WE'RE AS BIG AS WE CAN GET
MOVE T3,MAXCOR ;[650] TRY TO GET THIS BIG
LDCR3B: MOVE T1,T3 ;[650] NEXT SMALLER SIZE TO TRY
CAMG T1,.JBREL## ;[650] WOULD IT DO ANY GOOD?
JRST LDCR3D ;[650] NO, GIVE UP
CORE T1, ;[650] TRY FOR IT
CAIA ;[650] FAILED, TRY FOR NEXT SMALLER
JRST LDCR3C ;[650] OK, ADJUST TABLES AND CONTINUE
SUB T3,.PGSIZ ;[650] TRY FOR ONE CORE BLOCK LESS
SOJA T3,LDCR3B ;[650] LOOP TILL WE'RE AS BIG AS CAN BE
;HERE WHEN WE GOT A LITTLE BIGGER. TELL THE USER.
LDCR3C: PUSH P,T2 ;[650] SAVE OVER .ERR.
E01EXP::.ERR. (MS,.EC,V%L,L%I3,S%I,EXP) ;[1174]
.ETC. (COR,.EP,,,,.JBREL)
POP P,T2 ;[650] RESTORE
MOVEI T1,HG.TAB ;START AT TOP OF TABLE
SKIPN TAB.LB(T1) ;FOR SOMEONE SETUP
SOJA T1,.-1 ;NOT SETUP, SCAN DOWN
MOVE T3,.JBREL
MOVEM T3,TAB.UB(T1) ;ALLOCATE FREE SPACE
LDCR3D: CAMG T2,.JBREL## ;[650] NEED TO OVERFLOW YET?
JRST LNKCON ;[650] NO, DO IT NEXT TIME (CORFUL SET)
JRST LNKOVF ;NOW EXPAND TO DSK
> ;END IFE TOPS20
E$$MEF::.ERR. (MS,0,V%L,L%F,S%F,MEF,<Memory expansion failed>) ;[1174]
;WE HAVE ENOUGH CORE SOMEWHERE BUT IS IT ABOVE WHERE WE ARE?
LDCOR4: MOVE T1,[TAB.NB,,TAB.NB+1]
SETZM TAB.NB ;USUAL BLT TO CLEAR TABLE
BLT T1,TAB.NB+HG.TAB
MOVEI T1,ARTAB(P1) ;GET ADDRESS OF ASCII NAME OF AREA
E$$MOV::.ERR. (MS,.EC,V%L,L%I,S%I,MOV,<Moving low segment to expand area >) ;[1174]
.ETC. (STR,.EP,,,,T1)
MOVSI T2,-LN.TAB(P1) ;FORM AOBJN WORD FOR THIS AREA
HRRI T2,(P1) ;AND ABOVE
PUSHJ P,FRECNT ;COUNT SPACE ABOVE
CAMGE T1,P2 ;ENOUGH?
JRST LDCOR7 ;NO, MUST MOVE DOWN
;WE HAVE ENOUGH ABOVE SO JUST MOVE UP
SUB T1,P2 ;GET FREE SPACE
PUSH P,T1 ;SAVE IT
;NOW TO FILL IN TAB.NB WITH ITEMS NOT TO MOVE
MOVNI T2,1(P1) ;FORM AOBJN WORD
HRLZ T2,T2 ;FOR FIRST PART OF TABLE
MOVE T1,TAB.LB(T2) ;CURRENT LOWER BOUND
MOVEM T1,TAB.NB(T2) ;WHERE IT WILL GO TO
AOBJN T2,.-2 ;LOOP
MOVSI T2,-HG.TAB(P1) ;FORM AOBJN POINTER
HRRI T2,(P1) ;FOR REST OF AREAS
MOVE T1,TAB.AB(T2) ;GET ACTUAL IN USE
ADDI T1,.IPM(P2) ;PLUS WHAT WE NEED
ANDCMI T1,.IPM ;MUST BE ON BLOCK BOUND
JRST LDCR4B ;SEE IF ANY MORE TO DO
LDCR4A: ;HERE FOR REST OF TABLE
ADD T1,TAB.AB(T2) ;ADD IN LENGTH OF THIS
SUB T1,TAB.LB(T2) ;..
ADDI T1,.IPM ;ENSURE ON BLOCK BOUND
ANDCMI T1,.IPM
LDCR4B: SKIPE TAB.LB+1(T2) ;LEAVE 0 AS 0
MOVEM T1,TAB.NB+1(T2) ;TO GET START OF NEXT
AOBJN T2,LDCR4A ;LOOP
;WE NOW HAVE A TABLE OF ADDRESS OF START OF DATA AFTER MOVE
;PLUS SOME LEFT OVER
;WE NEED A GOOD ALGORITHM TO DISTRIBUTE THIS TO
;MINIMIZE THE NUMBER OF WORDS TO BLT
;THIS SIMPLE ONE WILL DO FOR NOW
POP P,T1 ;GET FREE SPACE BACK
LSH T1,-.IPS2W ;[650] IN .IPS-SIZED CHUNKS
HRREI T2,HG.TAB(P1)
MOVM T2,T2 ;GET NUMBER ARE AREAS TO ALLOCATE
MOVSI T2,-LN.TAB(P1) ;FORM AOBJN POINTER
HRRI T2,(P1) ;FOR REST OF AREAS INCLUDING THIS ONE
SETZ T3, ;START AT ZERO
LDCR4C: SKIPE TAB.LB(T2) ;IGNORE ZERO AREAS
CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;BUT IGNORE BOUND GLOBALS
CAIA
ADDI T3,1 ;COUNT SETUP ONES
AOBJN T2,LDCR4C ;SO WE KNOW WHO TO GIVE SPARE TO
IDIVI T1,(T3) ;ALLOCATE EVENLY
SKIPE T2 ;NO REMAINDER
ADDI T1,1 ;COUNT ONE EXTRA UNTIL REMAINDER GONE
LSH T1,.IPS2W ;[650] BACK TO WORDS
MOVE T3,T2 ;PREFER TO USE T2 FOR INDEX
MOVSI T2,-LN.TAB(P1) ;AOBJN WORD AGAIN
HRRI T2,(P1) ;EXCLUDING THIS AREA
;HERE TO FIXUP TAB.NB TO REFLECT DESIRED POSITIONS
;ENTER WITH :-
;T1 = CORE TO ADD WORDS (PLUS 128 IF REMAINDER NON-ZERO)
;T2 = AOBJN WORD FOR AREA TO COVER
;T3 = COUNT OF REMAINDER (WHEN 0 T1=T1-128)
;T4 = USED FOR COUNT
LDCR5Z: SETZ T4, ;USED TO KEEP CURRENT INCREMENT
LDCOR5: AOBJP T2,LDCOR6 ;ALL SET NOW GO MOVE IT
SKIPN TAB.LB(T2) ;LEAVE ZERO ALONE
JRST LDCOR5
CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS
JRST LDCR5M ;SINCE NO FREE SPACE
ADD T4,T1 ;INCREMENT THE INCREMENT
SOSN T3 ;REMAINDER JUST EXPIRED?
SUBI T1,.IPS ;YES, NOT SO MUCH TO GIVE AWAY NOW
LDCR5M: ADDM T4,TAB.NB(T2) ;ADD IN EXTRA
JRST LDCOR5 ;LOOP
;HERE TO MOVE CORE AREAS, EITHER UP OR DOWN
LDCOR6:
IFN FTVM,<
MOVSI T3,-LN.PAG ;[650] AOBJN PTR TO PAGBLK BUFFER
> ;END OF IFN FTVM
MOVE T1,TAB.NB+GS.IX ;[650] DESTINATION OF GLOBALS
SUB T1,TAB.LB+GS.IX ;ORIGIN
JUMPE T1,LDCR6A ;NOTHING TO CHANGE IF NOT MOVED
ADDM T1,HT.PTR ;FIXUP POINTER TO HASH TABLE
LDCR6A: SETZ T2, ;INITIALIZE COUNTER
LDCR6B: PUSHJ P,MOVTST ;SEE WHATS TO BE MOVED
JRST ADJFRE ;NOTHING
CAML T1,TAB.LB(T2) ;SEE WHICH WAY TO GO
JRST MOVUP ;UP IN CORE
MOVDWN: CAMG T1,TAB.AB-1(T2) ;ARE WE CLEAR OF AREA LOWER STILL?
JRST LDCR6B ;NO, TRY NEXT
MOVBLT:
IFN FTVM,<
SKIPE USEVM ;[650] CAN WE MOVE WITH PAGE UUO'S?
JRST LDCR6V ;[650] YES, DO SO (MUCH FASTER)
> ;END OF IFN FTVM
MOVE T3,TAB.AB(T2) ;TOP OF WHAT WE HAVE
SUB T3,TAB.LB(T2) ;GIVES LENGTH TO GO
HRL T1,TAB.LB(T2) ;FORM XWD FOR BLT
ADD T3,TAB.NB(T2) ;LAST ADDRESS TO BE MOVED TO
BLT T1,(T3) ;AND MOVE
PUSHJ P,ADJTBL ;[650] ADJUST THE TABLES
JRST LDCR6B ;[650] AND TRY AGAIN
IFN FTVM,<
;HERE TO MOVE VIA PAGE. UUO, THEN CONTINUE AT LDCR6A
LDCR6V: PUSHJ P,MOVPAG ;[650] MOVE VIA PAGE. UUO
JRST LDCR6A ;[650] TRY AGAIN
> ;END OF IFN FTVM
;HERE TO ADJUST THE VARIOUS TABLES
;THIS IS DONE AFTER EACH BLT
;ENTER WITH T2 = AOBJN POINTER
ADJTBL: SKIPN T1,TAB.NB(T2) ;GET NEW ORIGIN
POPJ P, ;IF O JUST IGNORE
SETOM TAB.ZE(T2) ;[755] NEED TO CLEAR FREE SPACE LATER.
SUB T1,TAB.LB(T2) ;FIND DIFFERENCE
ADDM T1,TAB.LB(T2) ;ADJUST ALL TABLES
ADDM T1,TAB.AB(T2)
ADDM T1,TAB.PT(T2)
POPJ P, ;[650] RETURN
;HERE IF NOT ENOUGH CORE ABOVE WHERE WE ARE
;SEE IF ENOUGH JUST BELOW
LDCOR7: JUMPE P1,LDCR7X ;NOTHING BELOW IF AREA=0?
MOVEI T1,-1(P1) ;GET NEXT LOWER POINTER
SKIPN T2,TAB.UB(T1) ;GET BOUND IF NOT ZERO
SOJGE T1,.-1 ;AREA 0 ALWAYS SET UP
SUB T2,TAB.AB(T1) ;GET FREE SPACE
SUB T2,P2 ;MINUS WHAT WE WANT
JUMPL T2,LDCR7X ;NO SUCH LUCK
LSH T2,-.IPS2W ;[650] FORM 128 WORD BLOCKS
IDIVI T2,2 ;[650] HALF IT
ADD T2,T3 ;[650] GIVE REMAINDER TO EXPANDING AREA
LSH T2,.IPS2W ;[650] BACK TO WORDS
ADD T2,P2 ;ALSO ADD IN WHAT WE WANTED
;NOW ADJUST TABLES AND MOVE CODE
MOVN T2,T2
CAIN P1,GS.IX ;GLOBAL SYMBOL AREA MOVED DOWN?
ADDM T2,HT.PTR ;YES, ADJUST HASH TABLE POINTER
ADDM T2,TAB.UB(T1) ;PREVIOUS UPPER BOUND OF LOWER AREA
IFN FTVM,<
SKIPE USEVM ;[650] VM AVAILABLE?
JRST LDCR7V ;[650] YES, USE FAST WAY
> ;END OF IFN FTVM
ADDM T2,TAB.AB(P1) ;NEW ACTUAL BOUND
ADDM T2,TAB.PT(P1) ;ADJUST POINTER
HRLZ T3,TAB.LB(P1) ;GET FROM ...
ADDB T2,TAB.LB(P1) ;ADJUST LOWER
HLL T2,T3 ;FROM ...TO
BLT T2,@TAB.AB(P1) ;BLT OF AREA
MOVE T3,TAB.AB(P1) ;GET LAST WORD IN USE
SETZM 1(T3) ;CLEAR FIRST FREE WORD
HRLI T3,1(T3) ;FORM BLT POINTER
HRRI T3,2(T3) ;TO ZERO FREE AREA
BLT T3,@TAB.UB(P1)
JRST LNKCON ;TRY AGAIN
IFN FTVM,<
;HERE TO MOVE P1'S AREA DOWN BY T2 ON A VM SYSTEM VIA MOVPAG
LDCR7V: ADD T2,TAB.LB(P1) ;[650] NEW LOWER BOUND
MOVEM T2,TAB.NB(P1) ;[650] SETUP FOR MOVPAG
MOVE T2,P1 ;[650] AREA TO MOVE IN T2 FOR MOVPAG
MOVSI T3,-LN.PAG ;[650] DOPAGE'S AC
PUSHJ P,MOVPAG ;[650] MOVE AREA DOWN
PUSHJ P,FRCPAG ;[650] DO LAST PAGE. UUO
SETZM TAB.NB(P1) ;[650] RESTORE TAB.NB TO GOODNESS
JRST LNKCON ;[650] CONTINUE
> ;END OF IFN FTVM
LDCR7X: CAIG P1,1 ;TRIED 0 & 1 ALREADY
JRST LDCR7Y
MOVN T2,P1 ;GET AREA
HRLZ T2,T2 ;AOBJN POINTER FOR ALL BELOW
PUSHJ P,FRECNT ;COUNT FREE SPACE
SUB T1,P2 ;MINUS WHAT WE WANT
JUMPL T1,LDCR7Y ;NOT ENOUGH
;SEE HOW MANY AREAS ARE SETUP (NON-ZERO)
MOVN T3,P1 ;GET AREA
HRLZ T3,T3 ;AOBJN POINTER FOR ALL BELOW
MOVEI T4,1 ;CURRENT ONE IS
LDCR7U: SKIPE TAB.LB(T3)
CAMN T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS
CAIA
ADDI T4,1 ;ONE MORE
AOBJN T3,LDCR7U
LSH T1,-.IPS2W ;[650] INTO 128 WORD BLOCKS
IDIVI T1,(T4) ;DISTRIBUTE EVENLY
SKIPE T2 ;ANY REMAINDER?
ADDI T1,1 ;YES
LSH T1,.IPS2W ;[650] BACK TO WORDS
;HERE TO SETUP LOWER PART OF TABLE TAB.NB
MOVN T3,P1
HRLZ T3,T3 ;AOBJN WORD
SKIPN T4,TAB.LB(T3) ;LOAD UP BASE
AOBJN T3,.-1 ;NEVER FAILS BUT JUST INCASE
MOVEM T4,TAB.NB(T3) ;LOWEST NON-ZERO BOUND DOES NOT MOVE
LDCR7L: SKIPN TAB.LB(T3) ;IGNORE ZERO'S
JRST LDCR7M
ADD T4,TAB.AB(T3)
SUB T4,TAB.LB(T3) ;WHAT WE NEED
CAME T2,[-LN.TAB+BG.IX,,BG.IX] ;IGNORE BOUND GLOBALS
ADD T4,T1 ;PLUS HANDOUT
ADDI T4,.IPM ;MAKE SURE ON A BLOCK BOUND
ANDCMI T4,.IPM
SKIPN TAB.LB+1(T3) ;SEE IF NEXT IS SETUP
AOBJN T3,.-1 ;WILL ALWAYS FIND A TOP
MOVEM T4,TAB.NB+1(T3) ;IS NEW BOUND
SOSN T2 ;COUNT DOWN REMAINDER
SUBI T1,.IPS ;AND REMOVE EXTRA
LDCR7M: AOBJN T3,LDCR7L ;LOOP
;NOW FOR REST OF TABLE, UNCHANGED
MOVSI T3,-LN.TAB(P1)
HRRI T3,(P1) ;AOBJN POINTER
AOBJP T3,LDCR7N ;ACCOUNT FOR AREA WE ARE TRYING TO EXPAND
SKIPE T1,TAB.LB(T3)
MOVEM T1,TAB.NB(T3) ;MOVE BOUND
AOBJN T3,.-2 ;LOOP
LDCR7N: JRST LDCOR6 ;START TO MOVE
;MOST GENERAL MOVER
;HERE WHEN NOT ENOUGH BELOW AND NOT ENOUGH ABOVE
;BUT ENOUGH IN BOTH PLACES COMBINED
;SETUP TAB.NB TO MOVE ALL OF CORE IN EITHER DIRECTION
LDCR7Y: MOVSI T2,-HG.TAB ;SET UP TAB.NB
MOVE T1,TAB.LB ;FIRST ITEM NEVER MOVES
MOVEM T1,TAB.NB ;SINCE IT IS AGAINST FIXED AREA
MOVEI T3,1 ;[650] INIT COUNT OF USED AREAS TO 1
LDCR7A: ADD T1,TAB.AB(T2) ;ADD IN ACTUAL SPACE USED
SUB T1,TAB.LB(T2)
ADDI T1,.IPM ;MUST BE ON BLOCK BOUND
ANDCMI T1,.IPM
CAIN P1,(T2) ;IS THIS THE AREA TO GIVE IT TO?
ADD T1,P2 ;YES, ADJUST START OF NEXT ABOVE
SKIPN TAB.LB+1(T2) ;[650] LEAVE 0 ALONE
JRST LDCR7Z ;[670] GO LOOP
MOVEM T1,TAB.NB+1(T2) ;[650] STORE DESTINATION ADDRESS
ADDI T3,1 ;[650] COUNT ANOTHER ACTIVE AREA
LDCR7Z: AOBJN T2,LDCR7A ;[670] LOOP
PUSH P,T3 ;[650] SAVE COUNT OF AREAS OVER FR.CNT
PUSHJ P,FR.CNT ;[650] COUNT ALL OF SPACE AGAIN
SUB T1,P2 ;[650] REMOVE WHAT WE WANTED
LSH T1,-.IPS2W ;[650] SAME CODE AS ABOVE
POP P,T3 ;[650] RESTORE COUNT OF AREAS
IDIV T1,T3 ;[650] SHARE EXTRA OVER ACTIVE AREAS
SKIPE T3,T2 ;[650]
ADDI T1,1 ;[650]
LSH T1,.IPS2W ;[650]
MOVSI T2,-LN.TAB ;SCAN ALL TABLES
JRST LDCR5Z ;AND ADD TO ALL ITEMS IN TABLE
;HERE FOR REVERSE BLT TO MOVE CORE UPWARDS
CHUNK1==200000 ;[720] IF NEED TO BE MOVED IN 2 STEPS
MOVUP: ADD T1,TAB.AB(T2) ;FIND ADDRESS OF END
SUB T1,TAB.LB(T2)
SKIPA T4,T2 ;GET COPY TO PLAY WITH
SKIPN TAB.LB(T4) ;OK IF NOT ZERO
AOBJN T4,.-1 ;LOOP UNTIL WE GET SOMETHING USEFUL
TLNN T4,-1 ;DID WE FIND A NON-ZERO HIGHER AREA?
JRST MOVUP1 ;NO, SKIP TEST FOR NEXT SINCE IT DOESN'T EXIST
CAML T1,TAB.LB(T4) ;IS START OF NEXT IN WAY?
JRST LDCR6B ;YES, TRY NEXT
;NOTE WE CAN NOT USE A BLT HERE SINCE WE ARE GOING UP IN CORE
;THEREFORE USE POP LOOP.
MOVUP1:
IFN FTVM,<
SKIPE USEVM ;[650] CAN WE USE PAGE. UUO TO MOVE?
JRST LDCR6V ;[650] YES, MUCH BETTER THAN POP LOOP
> ;END OF IFE FTVM
PUSH P,T2 ;[771] SAVE WHO WE ARE
MOVE T4,TAB.AB(T2) ;TOP
SUB T4,TAB.LB(T2) ;MINUS BOTTOM GIVES LENGTH
;NOW FOR ITERATIVE LOOP
;T4: 400000+LENGTH,,TOP OF OLD DATA
HRL T4,T4 ;IN BOTH HALF
JUMPL T4,[PUSH P,[CHUNK1,,0] ;[1214] SIZE .GE. 400000
SUB T4,[CHUNK1,,0] ;[720] FIRST DO LENTH LESS A CHUNK
JRST .+1] ;[720] THEN MOVE CHUNK
ADD T4,TAB.LB(T2) ;TOP OF DATA
TLO T4,(1B0) ;PREVENT PDL UNDERFLOW
MOVE T1,TAB.NB(T2) ;DESTINATION
SUB T1,TAB.LB(T2) ;-START TO GET OFFSET
TXO T1,<(T4)> ;[720] ADD INDEX FIELD
MOVEM T1,POPOFS ;[720] STORE FOR LOOP BELOW
POPLP: POP T4,@POPOFS ;[720] MOVE A WORD
JUMPL T4,POPLP ;[720] LOOP IF MORE WORDS
POP P,T2 ;[771] RESTORE STACK
CAMN T2,[CHUNK1,,0] ;[720] DOING 2 STEPS?
JRST [HRLI T4,CHUNK1-1 ;[720] YES, MOVE ONE MORE CHUNK
TLO T4,(1B0) ;[720] PREVENT PDL OVRFLO
JRST POPLP] ;[720] ONE MORE TIME
PUSHJ P,ADJTBL ;FIXUP TABLE
JRST LDCR6A ;[650] TRY AGAIN
;HERE TO MOVE AN AREA UP OR DOWN ON A VM SYSTEM BASED ON TAB.NB
;USES EXCHANGE RATHER THAN MOVE SO WON'T HAVE TO DESTROY DESTINATION
;ENTER WITH T2 POINTING TO AREA TO MOVE
IFN FTVM,<
MOVPAG: SPUSH <P1,P2,P3> ;[650] NEED LOTS OF ACS
MOVE P1,TAB.NB(T2) ;[650] CALCULATE SIGNED OFFSET
SUB P1,TAB.LB(T2) ;[650] FROM OLD PLACE TO NEW
MOVE P2,TAB.AB(T2) ;[650] SET P2 = TOTAL SIZE OF AREA TO MOVE
SUB P2,TAB.LB(T2) ;[650] BY OLD LAST WORD - OLD FIRST WORD
ADDI P2,1 ;[650] +1 SINCE AB IS 1 LESS
JUMPL P1,MOVPG1 ;[650] MOVING UP?
MOVNI T1,1 ;[650] YES, WILL SWEEP AREA DOWNWARDS
MOVE P3,TAB.AB(T2) ;[650] AND SET FIRST WORD TO MOVE TO END
JRST MOVPG2 ;[650] REJOIN MAIN CODE
MOVPG1: MOVEI T1,1 ;[650] GOING DOWN, WILL SCAN UP AREA
MOVE P3,TAB.LB(T2) ;[650] STARTING AT BOTTOM WORD
MOVPG2: ASH P1,-9 ;[650] CONVERT WORDS TO PAGES
LSH P2,-9 ;[650] ..
LSH P3,-9 ;[650] ..
;BACK HERE TO PUT EACH NEW PAGE. UUO ARG INTO THE PAGBLK AREA
MOVPG3: MOVE T4,P3 ;[650] RETRIEVE SOURCE PAGE
ADD T4,P1 ;[650] + OFFSET = DESTINATION PAGE
HRL T4,P3 ;[650] SOURCE,,DESTINATION
TXO T4,1B0 ;[650] NOTE EXCHANGE, NOT MOVE
PUSHJ P,DOPAGE ;[650] EXCH THE PAGE
ADD P3,T1 ;[650] POINT TO NEXT PAGE TO MOVE
SOJG P2,MOVPG3 ;[650] AND GO MOVE IT
;HERE WHEN THROUGH WITH THIS AREA
SPOP <P3,P2,P1> ;[650] RESTORE ACS USED
JRST ADJTBL ;[650] GO FIXUP OTHER TAB.XX WORDS
> ;END OF IFN FTVM
SUBTTL HERE TO CLEAN UP BEFORE RETURNING TO CALLER
ADJFRE:
IFN FTVM,<
SKIPE USEVM ;[650] BEEN DOING PAGE. UUOS?
PUSHJ P,FRCPAG ;[650] YES, FINISH UP
> ;END OF IFN FTVM
MOVSI T2,-LN.TAB+1 ;USUAL AOBJN POINTER +1
ADJFR1: MOVE T3,T2 ;GET COPY OF POINTER
SKIPN T1,TAB.LB+1(T3) ;START OF NEXT
AOBJN T3,.-1 ;IGNORE 0'S
SUBI T1,1 ;END IS ONE LESS
SKIPN TAB.AB(T2) ;[755] LEAVE ZERO IF NOT SET
JRST ADJFR2 ;[755]
CAME T1,TAB.UB(T2) ;[755] ANY CHANGE IN UB?
SETOM TAB.ZE(T2) ;[755] YES, NEEDS CLEARING LATER
MOVEM T1,TAB.UB(T2) ;FREE SPACE POINTER
ADJFR2: AOBJN T2,ADJFR1 ;[755] LOOP FOR NEXT AREA IF NOT FINISHED
MOVE T2,.JBREL ;TOP OF LOW SEG
MOVEI T1,HG.TAB ;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO
SKIPN TAB.LB(T1) ;SO LOOK FOR HIGHEST NON-ZERO
SOJA T1,.-1 ;NOT FOUND YET, BUT WE WILL
MOVEM T2,TAB.UB(T1) ;RESET TOP BOUNDARY
; ..
; ..
;HERE TO ZERO ALL XXX.UB SPACE IN CORE IF NOT VIRTUAL
;IF VIRTUAL, IT'S ALREADY ZERO (WE EXCHANGED WITH ZERO PAGES)
SETOM COREFL ;[650] SIGNAL CORE SHUFFLED FOR LNKF40
IFN FTVM,<
SKIPE USEVM ;[650] BLT'S OR PAGE UUOS?
JRST LNKCON ;[650] PAGE, UUO'S, NO ZEROING NEEDED
> ;END OF IFN FTVM
MOVSI T2,-LN.TAB+1
BLTUBT: HRRZ T1,TAB.AB(T2) ;GET START OF FREE AREA
JUMPE T1,BLTUB1 ;NOT IF ZERO THERE
SKIPN TAB.ZE(T2) ;[755] NEEDS TO BE CLEARED?
JRST BLTUB1 ;[755] NO,
SETZM TAB.ZE(T2) ;[755] YES, INITIALIZE FLAG
ADDI T1,1 ;GET FIRST FREE (PERHAPS)
HRLI T1,(T1) ;BLT POINTER
ADDI T1,1 ;IT IS NOW
SKIPN T3,TAB.LB+1(T2) ;ADDRESS OF NEXT LOW BLOUD
AOBJN T2,.-1 ;SKIP THE ZERO
JUMPE T3,BLTUB1 ;SHOULD HAVE SOMETHING THOUG
CAIG T3,(T1) ;SEE IF ANY REAL SPACE
JRST BLTUB1 ;NO, TAB.AB=TAB.UB
SETZM -1(T1) ;GET THE FIRST ZERO THERE
BLT T1,-1(T3) ;FOR END ADDRESS
BLTUB1: AOBJN T2,BLTUBT ;GET NEXT
MOVEI T1,HG.TAB ;LAST IS SPECIAL
SKIPN TAB.LB(T1) ;INCASE GS.LB IS ZERO
SOJA T1,.-1 ;WE WILL FIND TRUE TOP
HRRZ T1,TAB.AB(T1)
ADDI T1,1
HRL T1,T1
ADDI T1,1
HRRZ T3,.JBREL
CAIG T3,(T1)
JRST LNKCON ;NOW REALLY DO THE ALLOCATION
SETZM -1(T1)
BLT T1,-1(T3)
JRST LNKCON ;TRY AGAIN
;HERE TO STORE A PAGE. UUO ARG FROM T4 INTO THE PAGBLK AREA.
;WILL DO A PAGE. UUO AND SKIP RETURN WHENEVER PAGBLK AREA FILLS UP
;T3 CONTAINS AN AOBJN POINTER TO PAGBLK.
;PAGE. UUO FUNCTION TO DO IS IN PAGFUN
IFN FTVM,<
DOPAGE: MOVEM T4,PAGBLK(T3) ;[650] STORE THE ARGUMENT
AOBJN T3,CPOPJ ;[650] RETURN UNLESS LIST IS FULL
JRST FRCPG1 ;[650] ELSE GO DO A PAGE. UUO
;ENTER HERE TO FORCE A PAGE. UUO ON THE CURRENT CONTENTS OF PAGBLK.
FRCPAG: CAMN T3,[-LN.PAG,,0] ;[650] PAGE. UUO BLOCK EMPTY?
POPJ P, ;[650] YES, DON'T BOTHER WITH A PAGE. UUO
FRCPG1: HLRE T3,T3 ;[650] GET NEG. COUNT OF EMPTY WORDS
ADDI T3,LN.PAG ;[650] + SIZE OF BLOCK = # WORDS USED
MOVEM T3,PAGCNT ;[650] STORE FOR UUO
MOVS T3,PAGFUN ;[650] PICK UP FUNCTION CODE
HRRI T3,PAGCNT ;[650] POINT AT FIRST WORD OF ARGUMENT BLOCK
PAGE. T3, ;[650] DO THE PAGE. UUO
PUSHJ P,E$$PUF ;[1174] DIDN'T MAKE IT
MOVSI T3,-LN.PAG ;[650] RESTORE AOBJN POINTER TO GOODNESS
POPJ P, ;[650] RETURN
;HERE ON A PAGE. UUO FAILURE
E$$PUF::.ERR. (MS,.EC,V%L,L%F,S%F,PUF,<PAGE. UUO failed, error code was >) ;[1174]
.ETC. (OCT,.EP,,,,T3)
> ;END OF IFN FTVM
;HERE TO COUNT FREE CORE IN BOUND AREAS
;ENTER WITH T2 CONTAINING AOBJN WORD TO AREAS TO COUNT
;RETURNS COUNT IN T1
FR.CNT::MOVSI T2,-LN.TAB ;ENTER HERE TO COUNT ALL OF CORE
FRECNT: SETZ T1, ;INITIALIZE COUNT
ADD T1,TAB.UB(T2) ;ADD UPPER BOUND
SUB T1,TAB.AB(T2) ; SUBTRACT ACTUAL BOUNDS
AOBJN T2,.-2 ;FOR ALL AREAS
ANDCMI T1,.IPM ;[640] MAKE MULTIPLE OF .IPS
POPJ P,
;HERE TO SEE IF ANYTHING LEFT TO MOVE
;SKIP RETURN IF YES
;NON-SKIP IF ALL DONE
MOVTST: AOBJN T2,.+2 ;GET NEXT UNLESS AT END OR START
MOVSI T2,-LN.TAB ;RESET AOBJN COUNTER
MOVE T1,TAB.NB(T2) ;GET DESTINATION
CAME T1,TAB.LB(T2) ;SAME AS ORIGIN
AOSA (P) ;NO, EXIT WITH T2 SET UP
AOBJN T2,.-3 ;LOOP
POPJ P, ;UNLESS DONE
;AREA NAMES FOR INFO MESSAGES
DEFINE XXX (A) <
ASCIZ \A\
>
XALL
ARTAB: AREAS
SALL
SUBTTL XX.GET - SUBROUTINES TO GET SPACE IN SPECIFIC AREA
DEFINE XXX(AREA) <
AREA'.GET::PUSH P,P1 ;SAVE P1
MOVEI P1,AREA'.IX ;INDEX TO AREA
IFIDN <AREA><FX>,<
SKIPN AREA'.LB ;ALREADY SETUP?
PUSHJ P,AREA'.INI ;NO, DO SO NOW>
.GETBK: PUSHJ P,.GETSP ;GENERAL SIMPLE CORE EXPANDER
POP P,P1 ;RESTORE
POPJ P,
DEFINE XXX(%AREA) <
%AREA'.GET::PUSH P,P1 ;SAVE P1
MOVEI P1,%AREA'.IX ;INDEX TO %AREA
IFIDN <%AREA><FX>,<
SKIPN %AREA'.LB ;ALREADY SETUP?
PUSHJ P,%AREA'.INI ;NO, DO SO NOW>
PJRST .GETBK ;COMMON RETURN
>>
XALL
AREAS
SALL
;SUBROUTINE TO GET SPACE FROM LINKED LIST OF SPACE
;
;CALLED BY
; PUSH P,P1 ;USUALLY
; MOVEI T2,SIZE ;WHAT WE WANT
; MOVEI P1,XXX.IX ;AREA TO GET SPACE FROM
; PUSHJ P,GETSPC ;
;ADDRESS OF RETURNED SPACE IN T1
;T2 IS UNCHANGED
;USED T3 AND T4
;HERE TO GET SOME WORDS FROM FREE CORE FOR ANY AREA
;LINKED GARBAGE LIST IS OF FORM <SIZE-OF-THIS ,, POINTER TO NEXT>
;NOTE ALL POINTERS ARE RELATIVE TO BASE OF THAT AREA
;INITIAL POINTER IS TB.LNK(P1)
;TOTAL FREE SPACE IS IN TB.FSP(P1)
;GARBAGE AREAS ARE IN ASCENDING ORDER OF SIZE
;NUMBER OF WORDS REQUIRED IS IN T2
;RETURN ADDRESS OF WORDS IN T1
;ALSO USES T3 AS BACK LINK
.GETSP::
JUMPG T2,GETWDS ;DEFENSIVE CHECK INCASE 0 WORDS
E$$AZW::.ERR. (MS,,V%L,L%F,S%F,AZW,<Allocating zero words>) ;[1174]
GETWDS: CAMLE T2,TB.FSP(P1) ;SEE IF ENOUGH TOTAL FREE SPACE
JRST GETWDM ;NO, SO DON'T WASTE TIME
MOVSI T3,TB.LNK(P1) ;GET INITIAL POINTER
GETWD1: MOVS T1,T1 ;SAVE OLD POINTER
HLR T1,T3 ;SAVE THIS
TRNN T1,-1 ;IF POINTER IS ZERO
JRST GETWDM ;NOT ENOUGH IN ONE CHUNK
MOVE T3,(T1) ;GET NEXT
TRNE T3,-1 ;LEAVE ZERO ALONE
ADD T3,TAB.LB(P1) ;ADD IN BASE
MOVS T3,T3 ;PUT SIZE IN RIGHT
CAILE T2,(T3) ;SEE IF THIS HOLE IS BIG ENOUGH
JRST GETWD1 ;NO, TRY NEXT
;FALL THROUGH TO NEXT PAGE
;FOUND A SPACE REMOVE FROM LIST
.GETSR: ;ENTRY TO REMOVE THIS AREA
GETWD4: MOVS T1,T1 ;PUT IT WAY ROUND WE EXPECT IT
HLRZ T4,T3 ;GET LINK ADDRESS
SKIPE T4 ;LEAVE ZERO ALONE
SUB T4,TAB.LB(P1) ;REMOVE OFFSET
HRRM T4,(T1) ;REMOVE LINK FROM CHAIN
HRR T1,T3 ;SIZE WE GOT IN THIS CHUNK
HRRZ T3,TB.FSP(P1) ;GET TOTAL FREE WORDS
SUBI T3,(T1) ;MINUS THOSE JUST TAKEN
MOVEM T3,TB.FSP(P1) ;AS NEW TOTAL
CAIN T2,(T1) ;EXACTLY THE RIGHT SIZE
JRST GETWD3 ;YES, NOTHING TO PUT BACK
PUSH P,T2 ;SAVE SIZE REALLY REQUIRED
PUSH P,T1 ;AND ADDRESS
HRRZ T3,T1 ;SIZE OF THIS BLOCK
HLRZ T1,T1 ;ADDRESS
ADDI T1,(T2) ;START OF LEFT OVER SPACE
SUBM T3,T2 ;AND ITS SIZE
PUSHJ P,.RETSP ;PUT IT IN CHAIN
POP P,T1 ;RESTORE
POP P,T2
GETWD3: HLRZ T1,T1 ;SET POINTER
;NOW ZERO ALL OF BLOCK BEFORE GIVING IT TO THE USER
SETZM (T1) ;CLEAR FIRST WORD
HRLZ T3,T1 ;FORM BLT POINTER
HRRI T3,1(T1)
MOVE T4,T1 ;FORM END OF BLT
ADDI T4,-1(T2)
CAIE T2,1 ;BUT NOT IF ONLY ONE WORD
BLT T3,(T4) ;ZAP
POPJ P,
;HERE TO ACTUALLY GET THE WORDS FROM UNUSED MEMORY MAY CAUSE OVERFLOWS
GETWDM: MOVE T1,TAB.FR(P1) ;NUMBER OF FREE WORD
SUBI T1,(T2) ;SEE IF ENOUGH
JUMPL T1,GETWD2 ;NO, MUST EXPAND SOME THING
MOVEM T1,TAB.FR(P1) ;YES, STORE NEW COUNT
MOVE T1,TAB.PT(P1) ;GET ACTUAL ADDRESS OF NEXT FREE WORD
ADD T1,T2 ;ALLOCATE THIS BLOCK
EXCH T1,TAB.PT(P1) ;T1 POINTS TO ALLOCATED BLOCK
POPJ P,
;HERE IF WE HAVE TO EXPAND TO GET SOME ROOM
GETWD2: PUSH P,T2 ;SAVE NUMBER OF WORDS REQUIRED
PUSH P,P2 ;DESTROYS P2
MOVE P2,T2 ;NUMBER OF WORDS WE NEED
SUB P2,TAB.FR(P1) ;MINUS WHAT WE HAVE NOW
PUSHJ P,LNKCOR ;GENERAL CORE EXPANDER
JRST E$$MEF ;[1174] FAILED
POP P,P2 ;RESTORE P2
POP P,T2 ;RESTORE T2
JRST GETWDM ;TRY AGAIN
;HERE TO CREATE A NEW AREA (USUALLY FX)
;CALLED BY
; MOVE T2,SIZE REQUIRED
; MOVE P1,AREA
; PUSHJ P,FX.INI
;RETURNS WITH AREA SETUP
;SAVES T2
;USES T1, AND T3
FX.INI: PUSH P,T2 ;SAVE T2
PUSHJ P,XX.INI ;GENERAL
POP P,T2
POPJ P, ;RETURN
XX.INI::MOVEI T1,(P1) ;GET AREA NUMBER
SKIPN TAB.LB(T1) ;FIND NEXT LOWEST SETUP
SOJG T1,.-1 ;DY IS ALWAYS SETUP
MOVE T2,TAB.UB(T1) ;SEE IF ANY FREE
SUB T2,TAB.AB(T1)
CAIL T2,.IPS ;MUST HAVE AT LEAST THIS
JRST SY.FX1 ;WE HAVE
PUSH P,[EXP XX.INI] ;RETURN ADDRESS
PUSHJ P,.SAVE2## ;SAVE P1 AND P2
MOVEI P2,.IPS
MOVEI P1,(T1)
PUSHJ P,LNKCOR
PUSHJ P,E$$MEF ;[1174]
MOVNI T1,.IPS ;WE MUST HAVE GOT THE SPACE
ADDM T1,TAB.AB(P1) ;SO TAKE IT BACK
ADDM T1,TAB.FR(P1) ;ALSO FROM FREE SPACE IN TAB.AB
SKIPN TAB.PG(P1) ;IS THIS AREA PAGING?
POPJ P, ;NO, JUST RETURN TO XX.INI
JRST .+1(P1) ;YES, SORT OUT WINDOWS
DEFINE XXX (ABC) <
IFNDEF CNA.'ABC,<
HALT
>
IFDEF CNA.'ABC,<
JRST CNA.'ABC
>>
AREAS
;HERE IF LOW OR HIGH CODE PAGED
;JUST REDUCE THE INCORE WINDOW
CNA.LC:
CNA.HC: ADDM T1,TAB.UW(P1) ;REDUCE THE WINDOW
JRST CNABLT ;AND CLEAR BLOCK
;HERE IF LOCAL SYMBOLS ARE PAGED
;IF GOING IN FORWARDS DIRECTION (UW.LS=-1) AREA IS 0
;IF NOT CLEAR AREA
CNA.LS: SKIPGE UW.LS ;TEST FOR -1
POPJ P, ;JUST RETURN
ADDM T1,UW.LS ;BACKUP UPPER POINTER
CNABLT: MOVE T1,TAB.AB(P1) ;TOP OF WHAT WE KEEP
ADDI T1,2
HRLI T1,-1(T1) ;FORM BLT PTR.
SETZM -1(T1) ;CLEAR FIRST WORD
MOVEI T2,.IPS-2(T1) ;DESTINATION OF BLT
BLT T1,(T2) ;CLEAR ALL OF BLOCK
POPJ P,
SY.FX1: MOVE T2,TAB.UB(T1)
MOVEM T2,TAB.UB(P1)
MOVEM T2,TAB.AB(P1)
MOVNI T2,.IPS
ADDB T2,TAB.UB(T1)
ADDI T2,1
MOVEM T2,TAB.LB(P1)
SETZM (T2) ;CLEAR
MOVEM T2,TAB.PT(P1) ;POINT BEYOND IT
MOVEI T1,.IPS ;BUT REST IS FREE
MOVEM T1,TAB.FR(P1) ;MARK IT SO
CAIE P1,FX.IX ;IS 1ST WORD USEFUL IN THIS AREA?
POPJ P, ;YES
;THIS AREA MUST NOT START THE SYMBOL CHAINS AT RELATIVE 0
;OTHERWISE WE CANNOT TELL END OF CHAIN FROM ONE AT 0
;FIX IS TO ALLOCATE FIRST WORD
;CURRENTLY NOT USED FOR ANYTHING
AOS TAB.PT(P1) ;FIRST WORD IN USE
SOS TAB.FR(P1) ;SO ONE LESS FREE
POPJ P,
SUBTTL XX.RET - SUBROUTINES TO RETURN SPACE IN SPECIFIC AREA
DEFINE XXX(AREA) <
AREA'.RET::PUSH P,P1 ;SAVE P1
MOVEI P1,AREA'.IX ;INDEX TO AREA
.RETBK: PUSHJ P,.RETSP ;RETURN SPACE
POP P,P1 ;RESTORE
POPJ P, ;RETURN
DEFINE XXX(%AREA) <
%AREA'.RET::PUSH P,P1 ;SAVE P1
MOVEI P1,%AREA'.IX ;INDEX TO %AREA
PJRST .RETBK ;COMMON RETURN
>>
XALL
AREAS
SALL
;SUBROUTINE TO RETURN SPACE TO LINKED LIST
;
;CALLING SEQUENCE IS
; PUSH P,P1 ;SAVE P1 (USUALLY REQUIRED
; T1 = ADDRESS OF SPACE
; T2 = SIZE OF SPACE
; MOVEI P1,XXX.IX ;AREA
; PUSHJ P,.RETSP
;
;USES T3 AND T4
;HERE TO ADD SOME WORDS TO FREE CORE LIST
;ADDRESS OF BLOCK IN T1
;SIZE OF IT IN T2
;ALSO USES T3,T4
;IF SPACE IS ADJACENT TO TOP OF AREA MOVE DOWN THE XX.AB POINTER
; THIS FREES UP THE SPACE FOR THE GENERAL CORE EXPANDER
.RETSP::JUMPE T2,CPOPJ ;CAN NOT GIVE BACK 0
CAML T1,TAB.LB(P1) ;MAKE SURE ITS IN BOUNDS
CAMLE T1,TAB.AB(P1)
PUSHJ P,E$$RUM ;[1174] IT'S NOT, GIVE ERROR
CAIGE T2,.IPS ;IF MORE THAN 1 BLOCK
JRST ADDWDS ;NO, JUST LINK IN
MOVE T3,T1 ;GET COPY
ADDI T3,(T2) ;END OF AREA
CAME T3,TAB.AB(P1) ;ADJACENT TO UPPER USED BOUND?
JRST ADDWDS ;NO
MOVE T3,T1 ;GET COPY
IORI T3,.IPM ;MAKE INTO BOUND
MOVE T4,T3 ;GET A COPY
EXCH T4,TAB.AB(P1) ;AND EXCHANGE WITH PREVIOUS COPY
;HOWEVER WE HAVE TO ZERO THE AREA
HRL T3,T3 ;SO BUILD BLT POINTER
SETZM (T3) ;CLEAR FIRST WORD
ADDI T3,1 ;FINISH BLT POINTER
BLT T3,(T4) ;CLEAR ALL OF AREA
MOVE T3,T2 ;GET COPY OF NEW ADDRESS
ANDCMI T3,.IPM ;COUNT NO. OF BLOCKS
MOVN T3,T3 ;NEGATE SO WE CAN ADD
ADDM T3,TAB.PT(P1) ; TO FREE SPACE POINTER TO KEEP IN BOUNDS
ANDI T2,.IPM ;LESS TO GIVE BACK NOW
JUMPE T2,CPOPJ ;FINISHED IF NONE
ADDWDS: HRLZM T2,(T1) ;STORE SIZE AND CLEAR ADDRESS
ADDM T2,TB.FSP(P1) ;ADD IN THIS BLOCK
SKIPE TB.LNK(P1) ;ANYTHING THERE?
JRST ADDWD1 ;YES, LINK IN CHAIN
SUB T1,TAB.LB(P1) ;REMOVE OFFSET
HRRZM T1,TB.LNK(P1) ;ADDRESS IN RIGHT HALF
POPJ P, ;RETURN
E$$RUM::.ERR. (MS,,V%L,L%F,S%F,RUM,<Returning unavailable memory>) ;[1174]
ADDWD1: MOVEI T4,TB.LNK(P1) ;START OF CHAIN
JRST ADDWD3 ;SKIP FIRST TIME
ADDWD2: HRL T4,T4 ;SAVE PREVIOUS IN LEFT HALF
HLR T4,T3 ;SAVE LAST POINTER WITH ADDRESS IN RIGHT
ADDWD3: MOVE T3,(T4) ;GET NEXT POINTER
TRNE T3,-1 ;LEAVE ZERO ALONE
ADD T3,TAB.LB(P1) ;ADD OFFSET
MOVS T3,T3 ;GET SIZE IN RIGHT HALF, ADDRESS IN LEFT
CAIG T2,(T3) ;FIND CURRENT HOLE AT LEAST AS BIG
JRST ADDWD4 ;YES, LINK INTO LIST
TLNE T3,-1 ;FINISHED LIST IF ADDRESS IS 0
JRST ADDWD2 ;NO, TRY AGAIN
SUB T1,TAB.LB(P1) ;REMOVE OFFSET
HRRM T1,(T4) ;YES, LINK ONTO END
POPJ P,
ADDWD4: TRNE T4,-1 ;END OF CHAIN IF 0 ADDRESS
JRST ADDWD5 ;YES, USE PREV POINTERS
SUB T4,TAB.LB(P1) ;REMOVE OFFSET
HRRM T4,(T1) ;STORE IN LINK ADDRESS
SUB T1,TAB.LB(P1) ;REMOVE OFFSET
ADD T4,TAB.LB(P1) ;ADD OFFSET
HRRM T1,(T4)
POPJ P,
ADDWD5: SUB T4,TAB.LB(P1) ;REMOVE OFFSET
MOVS T4,T4 ;PREVIOUS,,CURRENT
SUB T1,TAB.LB(P1)
HRRM T1,(T4) ;LINK BACK IN CHAIN
ADD T1,TAB.LB(P1)
HLRM T4,(T1) ;ANDFORWARDS
POPJ P,
SUBTTL XX.GBC - SUBROUTINES TO GARBAGE COLLECT SPECIFIC AREA
DEFINE XXX(AREA) <
AREA'.GBC::PUSHJ P,.SAVE1## ;SAVE P1
MOVEI P1,AREA'.IX ;INDEX TO AREA
PJRST .GBCSP ;GARBAGE COLLECT
>
XALL
AREAS
SALL
;SUBROUTINE TO GARBAGE COLLECT SPECIFIC AREA
;
;CALLING SEQUENCE
; PUSH P,P1 ;SAVE P1
; MOVEI P1,XXX.IX ;AREA
; PUSHJ P,.GBCSP
;
;USES T1, T2, T3, T4
;
;THE FREE SPACE IS IN A LIST ANCHORED TO TB.LNK
;STORED IN ASCENDING ORDER OF SIZE
;FIRST RELINK LIST IN ASCENDING ORDER OF ADDRESS ANCHORED TO TAB.NB
;THEN COLLECT ADJACENT AREAS, GIVE BACK TOP IF ALL FREE
;THEN PUT NEW LIST BACK IN TB.LNK
;NOTE, TEMP LIST CONTAINS ACTUAL ADDRESSES SINCE CORE CANNOT MOVE
.GBCSP::SKIPN TB.FSP(P1) ;ANYTHING TO DO?
POPJ P, ;NO
SETZM TB.FSP(P1) ;WE ARE ABOUT TO TAKE IT ALL
MOVE T1,TB.LNK(P1) ;FIRST TIME JUST STORE
ADD T1,TAB.LB(P1) ;ADD IN BASE
MOVE T2,(T1) ;GET NEXT POINTER
HRRZM T2,TB.LNK(P1) ;SAVE FOR 2ND
HLLZS (T1) ;CLEAR LINK
HRRZM T1,TAB.NB(P1) ;USED TO HOLD TEMP LIST
GBCSP1: SKIPN T1,TB.LNK(P1) ;GET ADDRESS OF BLOCK
JRST GBCSP5 ;ALL DONE, NOW COLLECT
ADD T1,TAB.LB(P1) ;ADD IN BASE
HRRZ T2,(T1) ;GET NEXT POINTER
HRRZM T2,TB.LNK(P1) ;STORE NEXT BLOCK POINTER
HLLZS (T1) ;CLEAR FORWARD POINTER
MOVE T3,TAB.NB(P1) ;START OF TEMP CHAIN
SETZ T4, ;FIRST TIME
GBCSP2: CAIG T1,(T3) ;FIND CURRENT HOLE AT HIGHER ADDRESS
JRST GBCSP3 ;YES, LINK INTO LIST
MOVE T4,T3 ;CURRENT GETS FUTURE
HRRZ T3,(T4) ;GET NEXT POINTER
JUMPN T3,GBCSP2 ;NOT FINISHED YET
HRRM T1,(T4) ;YES, LINK ONTO END
JRST GBCSP1 ;SEE IF MORE TO DO
;HERE WHEN CURRENT ADDRESS IS NOT HIGHEST
GBCSP3: JUMPN T4,GBCSP4 ;0 IF LOWEST ADDRESS
HRRM T3,(T1) ;STORE IN LINK ADDRESS
HRRZM T1,TAB.NB(P1) ;STORE BACK AS LOWEST
JRST GBCSP1 ;SEE IF MORE TO DO
;HERE IF ADDRESS IS IN MIDDLE OF LIST
GBCSP4: HRRM T3,(T1) ;LINK FORWARDS
HRRM T1,(T4) ;LINK BACK IN CHAIN
JRST GBCSP1 ;SEE IF MORE TO DO
;NOW TO COLLECT ADJACENT SPACES
GBCSP5: SKIPA T4,TAB.NB(P1) ;GET START OF LIST
GBCSP6: HRRZ T4,T1 ;NEXT NON-CONTIGUOUS AREA
JUMPE T4,GBCSP8 ;END OF LIST IF 0
GBCSP7: MOVE T1,(T4) ;GET SIZE,, NEXT POINTER
HLRZ T2,T1 ;SIZE OF THIS BLOCK
ADDI T2,(T4) ;END OF THIS +1
HRRZ T3,T4 ;SAVE T4 INCASE END IN SIGHT
CAIE T2,(T1) ;ADJACENT?
JRST GBCSP6 ;NO
HLLZS (T4) ;CLEAR CURRENT POINTER IN FIRST BLOCK
MOVE T2,(T1) ;GET FUTURE POINTER AND CURRENT SIZE
ADDM T2,(T4) ;ADD NEW SIZE AND POINTER
SETZM (T1) ;CLEAR OLD POINTER IN 2ND BLOCK
JRST GBCSP7 ;GET NEXT ADJACENT
;HERE TO GIVE BACK TOP PIECE IF POSSIBLE
GBCSP8: MOVS T1,T1 ;PUT SIZE IN RIGHT
ADD T1,TAB.FR(P1) ;ADD IN UNALLOCATED SPACE IN LAST BLOCK
CAMN T2,TAB.PT(P1) ;COMPARE WITH UNALLOCATED POINTER
CAIGE T1,.IPS ;MUST BE 1 OR MORE BLOCKS
JRST GBCSP9 ;NOT ENOUGH
MOVE T2,T3 ;GET COPY OF LOWEST FREE ADDRESS IN LAST BLOCK
IORI T2,.IPM ;ROUND UP
MOVE T4,TAB.PT(P1) ;SAVE TOP OF CURRENTLY ZEROED CORE
MOVEM T2,TAB.AB(P1) ;MAKE NEW TOP OF USED CORE
MOVEM T3,TAB.PT(P1) ;SAVE NEW UNALLOCATED POINTER
ANDI T1,.IPM ;NO. OF WORDS FREE IN LAST BLOCK
MOVEM T1,TAB.FR(P1) ;AS UNALLOCATED IN LAST BLOCK
MOVEI T1,TAB.NB(P1) ;NOW WE MUST CLEAR LAST FORWARD POINTER
CAIA
MOVE T1,T2 ;CURRENT GETS PREV FUTURE
HRRZ T2,(T1) ;SET NEW FUTURE
CAIE T2,(T3) ;FOUND IT?
JRST .-3 ;NO
HLLZS (T1) ;YES, CLEAR FORWARD LINK
HRL T3,T3 ;FORM BLT PTR TO CLEAR CORE
ADDI T3,1 ;FROM NEW TAB.PT
SETZM -1(T3) ; UP TO
BLT T3,(T4) ; OLD TAB.PT
;HERE TO RE-LINK IN ORDER OF SIZE
GBCSP9: SKIPN T1,TAB.NB(P1) ;GET NEXT POINTER
POPJ P, ;ALL DONE
MOVE T2,(T1) ;GET SIZE,,NEXT POINTER
HRRZM T2,TAB.NB(P1) ;STORE NEXT
HLRZ T2,T2 ;SIZE ONLY
PUSHJ P,.RETSP ;RETURN THIS BLOCK
JRST GBCSP9 ;LOOP
SUBTTL XX.TST - SUBROUTINES TO SEE IF SPECIFIED ADDRESS IS FREE (TO EXPAND CURRENT BLOCK)
;CALLING SEQUENCE IS
; PUSHJ P,XX.TST
; WITH T1 = REQUIRED ADDRESS
; RETURN 0 FAILED
; RETURN 1 T2 = SIZE OF BLOCK AVAILABLE
DEFINE XXX(AREA) <
AREA'.TST::PUSH P,P1 ;SAVE P1
MOVEI P1,AREA'.IX ;INDEX TO AREA
.TSTBK: PUSHJ P,.TSTSP ;GENERAL SIMPLE CORE TESTER
CAIA ;NON-SKIP RETURN
AOS -1(P) ;SKIP RETURN
POP P,P1 ;RESTORE
POPJ P,
DEFINE XXX(%AREA) <
%AREA'.TST::PUSH P,P1 ;SAVE P1
MOVEI P1,%AREA'.IX ;INDEX TO %AREA
PJRST .TSTBK ;COMMON RETURN
>>
XALL
AREAS
SALL
;SUBROUTINE TO TEST IF ADDRESS IS FREE
.TSTSP: ENTRY .TSTSP
SKIPN T2,TB.LNK(P1) ;GET START OF CHAIN
POPJ P, ;NO START
HRL T1,T2 ;STORE BACK ADDRESS
JRST .TSTS2 ;FIRST TIME
.TSTS1: HRL T1,T2 ;STORE BACK ADDRESS
HRRZ T2,(T2) ;GET NEXT ADDRESS
JUMPE T2,CPOPJ ;ZERO IS END
ADD T2,TAB.LB(P1) ;RELOCATE IT
.TSTS2: CAIE T2,(T1) ;WHAT WE WANT?
JRST .TSTS1 ;NO, TRY NEXT
HLRZ T2,(T2) ;GET SIZE
JRST CPOPJ1 ;AND SKIP RETURN
SUBTTL XX.REM - SUBROUTINES TO REMOVE SPECIFIED BLOCK (TO ADD TO CURRENT IN USE)
;CALLING SEQUENCE IS
; PUSHJ P,XX.REM
; WITH T1 =BACK ADDRESS,, REQUIRED ADDRESS
; T2 = SIZE REQUIRED
DEFINE XXX(AREA) <
AREA'.REM::PUSH P,P1 ;SAVE P1
MOVEI P1,AREA'.IX ;INDEX TO AREA
.REMBK: PUSHJ P,.TSTSP ;GENERAL SIMPLE CORE REMOVER
POP P,P1 ;RESTORE
POPJ P,
DEFINE XXX(%AREA) <
%AREA'.REM::PUSH P,P1 ;SAVE P1
MOVEI P1,%AREA'.IX ;INDEX TO %AREA
PJRST .REMBK ;COMMON RETURN
>>
XALL
AREAS
SALL
;SUBROUTINE TO REMOVE DESIRED CHUNK
.REMSP: ENTRY .REMSP
PJRST .GETSR ;USE GENERAL PURPOSE ROUTINE
SUBTTL XX.ZAP ROUTINE TO REMOVE ALL OF ONE AREA
;CALLING SEQUENCE
; MOVEI T1, AREA TO BE REMOVED
; PUSHJ P,XX.ZAP
;ALSO USES T2
XX.ZAP::SKIPN T2,TAB.LB(T1) ;GET LOWER BOUND
JRST ZAP0 ;JUST CLEAR POINTERS
HRL T2,T2 ;FORM BLT POINTER
ADDI T2,1 ;WELL ALMOST
SETZM -1(T2) ;CLEAR FIRST WORD
BLT T2,@TAB.AB(T1) ;AND REST
MOVE T2,TAB.UB(T1) ;GET UPPER BOUND
PUSH P,T1 ;SAVE T1
SKIPN TAB.LB-1(T1) ;SEE WHO TO GIVE IT TO
SOJA T1,.-1 ;WILL GET DY EVENTUALLY
MOVEM T2,TAB.UB-1(T1) ;GIVE IT TO NEXT LOWER AREA SETUP
POP P,T1 ;RESTORE ORIGINAL AREA
ZAP0: SETZM TAB.LB(T1) ;CLEAR ALL POINTERS
SETZM TAB.AB(T1)
SETZM TAB.UB(T1)
SETZM TAB.PT(T1)
SETZM TAB.FR(T1)
SETZM TB.LNK(T1)
SETZM TB.FSP(T1)
POPJ P, ;RETURN
SUBTTL GIVE BACK BLOCKS OF CORE
;CALLING SEQUENCE
; HRRI T1,UPPER ADDRESS TO RETURN
; HRLI T1,UPPER ADDRESS TO CLEAR
; PUSHJ P,GBCK.L
;ALSO USES T2
GBCK.L::
HLRZ T2,T1 ;[647] GET UPPER ADDRESS TO CLEAR
JUMPE T2,[PUSH P,T1 ;[647] UPPER ADDRESS TO CLEAR SAME AS RETURN
JRST GBCKL1]
HRRZS T1,T1 ;[647] CLEAR LH
CAMLE T2,T1 ;[647] CLEARING MORE THAN GIVING BACK?
MOVE T2,T1 ;[647] YES, DON'T CLEAR TOO FAR
PUSH P,T2 ;[647] SAVE HIGHEST TO CLEAR TO
GBCKL1:
IFN DEBSW,<
HRRZ T2,T1
ANDI T2,.IPM ;ADDRESS MUST END IN .IPM
CAIE T2,.IPM
HALT
>
MOVEI T2,HG.TAB ;START AT TOP
SKIPE TAB.LB(T2) ;IGNORE IF NOT SETUP
CAMGE T1,TAB.LB(T2) ;FOUND RIGHT BLOCK YET?
SOJA T2,.-2 ;NO, BUT WE WILL
HRRZ T3,TAB.LB(T2) ;GET 1ST ADDRESS
SETZM (T3) ;ZERO IT
HRL T3,T3
ADDI T3,1 ;FORM BLT PTR
MOVEM T1,TAB.LB(T2) ;[647] UPDATE NEW LOWER BOUND
POP P,T1 ;[647] GET UPPER ADDRESS TO CLEAR
BLT T3,@T1 ;CLEAR ALL OF CORE
MOVE T1,TAB.LB(T2) ;[647] GET NEW LOWER BOUND
AOSA TAB.LB(T2) ;AS NEXT HIGHER ADDRESS
SKIPN TAB.LB(T2) ;LOOK FOR NEXT LOWER AREA SETUP
SOJA T2,.-1 ;WILL FIND ONE EVENTUALLY
MOVEM T1,TAB.UB(T2) ;GIVE FREE SPACE TO IT
POPJ P,
SUBTTL DSK OVERFLOW ROUTINES
;USE STANDARD OPEN BLOCK, EASIER TO DEBUG AND DUMP DATA BASE
LNKOVF: SKIPN AS.LB ;IS THERE AN AS AREA?
JRST LSCOVF ;NO, CHECK LS AREA
SKIPE PAG.AS ;AS AREA ALREADY PAGED OUT?
JRST ASREDU ;YES, TRY TO REDUCE IT FURTHER
PUSHJ P,AS.DMP ;NO, PUT IT OUT
JRST LSCOVF ;[650] DIDN'T WIN ANYTHING
JRST LNKCON ;AND TRY AGAIN
LSCOVF: SKIPN LS.PP ;ALLOWED TO THINK ABOUT LS AREA?
SKIPN LS.LB ;DO WE STIL HAVE SYMBOLS?
JRST LHCOVF ;NO, TRY CORE
SKIPE PAG.LS ;ALL LOCAL SYMBOLS STILL IN CORE?
JRST LSREDU ;NO
PUSHJ P,LS.DMP ;YES, GET RID OF THEM
JRST LHCOVF ;[650] DIDN'T GET ANYWHERE
JRST LNKCON ;AND TRY AGAIN
;HERE TO SEE IF THE AS AREA IS BIGGER THAN ONE PAGE, AND REDUCE
;IT UNMERCIFULLY IF SO. THERE IS NO PERCENTAGE IN KEEPING IT IN.
ASREDU: MOVE T1,AS.PT ;GET ABS POINTER TO FIRST FREE
SUB T1,AS.LB ;SUBTRACT FIRST USED
ANDCMI T1,.IPM ;FIND HOW MANY WORDS WE CAN OUTPUT
JUMPE T1,LSCOVF ;IF NONE, TRY LS AREA
ADD T1,LW.AS ;CONVERT TO NEW LW.AS
PUSH P,T1 ;SAVE THE NEW LOW VIRTUAL ADDRESS
SUBI T1,1 ;FIND HIGHEST ADDR TO OUTPUT
HRL T1,LW.AS ;MAKE 1ST,,LAST TO OUTPUT
PUSHJ P,AS.OUT ;DUMP THE CORE
POP P,LW.AS ;RESTORE NEW LOWEST ADDR IN CORE
MOVE T1,AS.PT ;GET POINTER TO 1ST PAGE STILL IN
ANDCMI T1,.IPM ;FIND FIRST ADDR TO KEEP
SUBI T1,1 ;MAKE LAST LOC TO RETURN
PUSHJ P,GBCK.L ;GIVE BACK THE CORE
MOVE T1,LW.AS ;GET LOWEST ADDR IN CORE
ADD T1,AS.AB ;CALCULATE HIGHEST VIRT ADDR
SUB T1,AS.LB ;AS LW+AB-LB
MOVEM T1,UW.AS ;STORE FOR THE WORLD
JRST LNKCON ;TRY THE ALLOCATION AGAIN
;HERE TO SEE IF IT IS WORTHWHILE TO OUTPUT MORE OF THE SYMBOL TABLE
LSREDU: MOVE T1,LS.AB ;[650] SEE IF ITS WORTH IT
SUB T1,LS.LB
ANDCMI T1,.IPM ;BUT NOT INCLUDING LAST BLOCK
JUMPE T1,LHCOVF ;[650] NOTHING TO DO, TRY CORE OVERFLOW
MOVE T1,LSYM ;HIGHEST
ANDCMI T1,.IPM ;EXCEPT FOR LAST BLOCK
PUSH P,T1 ;SAVE AS IT WILL BE LOWEST AFTER OUTPUT
SUBI T1,1 ;HIGHEST IS ONE LESS
HRL T1,LW.LS ;LOWEST NOW
PUSHJ P,LS.OUT ;OUTPUT WINDOW
POP P,LW.LS ;RESET LOWER WINDOW
MOVE T1,LS.PT ;POINTER INTO PAGE STAYING IN
ANDCMI T1,.IPM ;GET ADDRESS OF START OF PAGE
SUBI T1,1 ;LAST GOING OUT IS 1 LESS
PUSHJ P,GBCK.L ;GIVE IT AWAY
JRST LNKCON ;TRY AGAIN
;HERE TO CHECK FOR EITHER LC OR HC TO BE PAGED
;THE ALGORITHM IS
;IF ONLY A LOW SEGMENT REDUCE ITS SIZE
;IF TWO SEGMENTS THEN
; IF NEITHER HAS YET BEEN OUTPUT, OUTPUT THE LARGER
; IF BOTH HAVE BEEN OUTPUT, THEN OUTPUT SOME OF CURRENT LARGER
; IF ONLY ONE HAS BEEN OUTPUT, THEN OUTPUT SOME OF CURRENT LARGER
LHCOVF: SKIPN HC.LB ;IF NO HIGH SEGMENT
JRST LCOVF ;NO CHOICE BUT TO PAGE LOW SEG
;SEE IF WE ARE PAGING BOTH ALREADY
DGET T1,LC.AB,HC.AB ;GET UPPER BOUNDS
SUB T1,LC.LB
SUB T2,HC.LB ;FIND LENGTHS
CAIN T1,.IPM ;[650] BOTH SEGMENTS MINIMUM SIZE?
CAIE T2,.IPM ;[650] MAYBE, ARE THEY?
JRST LHCOV1 ;[650] NO
PUSHJ P,CHKMAX ;[650] YES, SEE IF MAXCOR REASONABLE
JRST LNKCON ;[650] MORE ROOM! EXPAND CORE...
DGET T1,LC.AB,HC.AB ;[650] RECALCULATE WHAT CHKMAX WIPED OUT
SUB T1,LC.LB ;[650]
SUB T2,HC.LB ;[650]
LHCOV1: SKIPE PAG.S1
SKIPN PAG.S2
JRST LCHCHK ;NO
;HERE IF BOTH AREAS ARE PAGED
CAMG T2,T1 ;LOW .GT. HIGH
JRST LCREDU ;YES, IF EQUAL TAKE FROM LOW
JRST HCREDU ;NO TRY HIGH
;HERE TO DECIDE WHETHER TO REDUCE THE SIZE OF SEGMENT ALREADY
;PAGED, OR TO START PAGING ONE
;WE NEED SOME GOOD WAY TO DECIDE WHICH
;TO OUTPUT FIRST
;FOR NOW JUST OUTPUT BIGGER
;PERHAPS SHOULD OUTPUT ONE WITH MOST BLANK DATA
;CHECK THAT PAGING THE LARGER WILL
;BE ENOUGH -- IF NOT JUST PAGE
;REQUIRED ONE
LCHCHK: MOVEI T3,LC.IX ;ASSUME LOW IS BIGGEST
CAMGE T1,T2 ;WHICH SEGMENT IS BIGGER?
MOVEI T3,HC.IX ;HIGH IS, USE IT
CAMGE P2,T1-LC.IX(T3) ;IS IT BIG ENOUGH?
PJRST @[EXP LCREDW,HCREDW]-LC.IX(T3) ;YES, DO BIGEST
CAIE P1,LC.IX ;CAN ONLY PAGE REQUESTED IF
CAIN P1,HC.IX ;LC OR HC, OTHERWISE USE T3
PJRST @[EXP LCREDW,HCREDW]-LC.IX(P1) ;NO, DO REQUESTED
PJRST @[EXP LCREDW,HCREDW]-LC.IX(T3) ;JUST USE BIGGEST
LCOVF: SKIPN LC.LB ;[1113] LAST CHANCE--IS THERE AN LC AREA?
JRST E$$MEF ;[1174] NO--JUST RAN OUT OF LUCK
MOVE T1,LC.AB ;[650] FIND SIZE
SUB T1,LC.LB ;[650]
CAIE T1,.IPM ;[650] ONLY ONE PAGE?
JRST LCOVF1 ;[650] NO, CONTINUE
PUSHJ P,CHKMAX ;[650] YES, MAXCOR REASONABLE?
JRST LNKCON ;[650] WASN'T, TRY AGAIN
LCOVF1: SKIPN PAG.S1 ;ALREADY PAGING?
JRST LC.DMP ;NO DO SO
JRST LCREDU ;YES, REDUCE SIZE OF WINDOW
;HERE TO TEST /MAXCORE TO MAKE SURE SIZE IS REASONABLE
;IF NOT INCREASE MAXCOR BUT WARN USER
CHKMAX: SKIPN MAXCOR ;MAXCOR SET?
JRST CPOPJ1 ;NO, SKIP RETURN
MOVE T1,DY.AB ;SEE HOW MUCH WE ABSOLUTELY NEED
ADD T1,GS.AB
SUB T1,GS.LB ;+GLOBAL AREA
ADD T1,FX.AB
SUB T1,FX.LB ;+FIXUPS
IFN FTOVERLAY,<
ADD T1,RT.AB ;[650]
SUB T1,RT.LB ;[650] +RELOCATION TABLES
ADD T1,BG.AB ;[650]
SUB T1,BG.LB ;[650] +BOUND GLOBALS
> ;END OF IFN FTOVERLAY
ADDI T1,2*.IPS ;SYMBOLS + LOW CODE
SKIPE HC.LB
ADDI T1,.IPS ;+ HIGH CODE
SKIPE AS.LB ;[650] ALGOL SYMBOLS?
ADDI T1,.IPS ;[650] YES, ONE BIGGER
CAIE P1,LC.IX ;[1130] COUNT THIS REQUEST TOO
CAIN P1,HC.IX ;[1130] UNLESS THE REQUEST IS FOR
JRST CHKMX1 ;[1130] A PAGABLE AREA, I.E.,
CAIE P1,LS.IX ;[1130] LC, HC, LS OR AS
CAIN P1,AS.IX ;[1130] ..
JRST CHKMX1 ;[1130] ..
ADD T1,P2 ;[1130] NOT PAGABLE--COUNT THIS REQUEST TOO
CHKMX1: IOR. T1,.PGSIZ ;[1130] GET PAGE BOUND
CAMG T1,MAXCOR ;TROUBLE IF MAXCOR TOO SMALL
JRST CPOPJ1 ;OK, ITS NOT
MOVE T2,HIORGN ;[650] GET BOTTOM OF HIGH SEG
SUBI T2,1001 ;[650] MAX MAXCORE, WITH 1P FOR HELPER
CAMLE T1,T2 ;[650] NEED LESS THAN MAX??
JRST CPOPJ1 ;[650] NO, DON'T INCREASE ANY MORE
MOVEM T1,MAXCOR ;SAVE NEW MINIMUM
E$$MSS::.ERR. (MS,.EC,V%L,L%W,S%W,MSS,</MAXCOR: set too small, expanding to >) ;[1174]
.ETC. (COR,.EP,,,,T1)
SETZM CORFUL ;[650] LET LDCOR2 TRY AGAIN
POPJ P,
;HERE FOR LOW SEGMENT
LCREDW: SKIPN PAG.S1 ;ALREADY SETUP?
JRST LC.DMP ;NO, FIRST TIME
LCREDU: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX FOR LOW
JRST CREDU ;REDUCE SIZE
;HERE FOR HIGH SEGMENT
HCREDW: SKIPN PAG.S2 ;ALREADY SETUP
JRST HC.DMP ;NO, FIRST TIME
HCREDU: PUSH P,R ;SAVE R
MOVEI R,HC.IX ;INDEX FOR HIGH
;FALL INTO CREDU
;HERE TO REDUCE LOW/HIGH SEGMENT WINDOW TO HALF SIZE AND TRY AGAIN
;IF THIS IS NOT ENOUGH, LNKCOR WILL LOOP UNTIL
;EITHER ALL WINDOWS ARE DOWN TO 200 WORDS OR IT GETS ENOUGH SPACE
CREDU: MOVE T1,TAB.AB(R) ;TOP
SUB T1,TAB.LB(R) ;-BOTTOM
ADDI T1,1 ;LENGTH
LSH T1,-1 ;CUT IN HALF
ANDCMI T1,.IWM ;[750] AT LEASET RESERVE WINDOW SIZE
JUMPE T1,RPOPJ ;NOTHING TO DO
PUSH P,T1 ;SAVE LENGTH TO REMOVE
ADD T1,LW.S0(R) ;NEW BOTTOM
SUBI T1,1 ;THEREFORE TOP TO OUTPUT
HRL T1,LW.S0(R) ;FROM HERE UP
PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R)
POP P,T1 ;GET BACK LENGTH
ADDM T1,LW.S0(R) ;SHORTEN WINDOW
ADD T1,TAB.LB(R) ;FIX IN CORE
SUBI T1,1 ;HIGHEST ADDRESS TO GIVE AWAY
PUSHJ P,GBCK.L ;TO NEXT LOWER AREA IN USE
POP P,R ;RESTORE R
JRST LNKCON ;TRY AGAIN, MAY RETURN
RPOPJ: POP P,R ;RESTORE R
POPJ P,
SUBTTL OUTPUT CORE WINDOW
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO OUTPUT]
; PUSHJ P,LC.OUT/HC.OUT/LS.OUT
;USES T1, T2, T3
DEFINE PAGOUT (%AREA,CHAN,WD)<
%AREA'.OUT::HRRZ T2,T1 ;GET UPPER ADDRESS
CAMLE T2,HB.'WD ;BIGGEST SO FAR?
MOVEM T2,HB.'WD ;YES
HLRZ T2,T1 ;GET FIRST ADDRESS
LSH T2,-.DBS2W ;[650] INTO 128 WORD BLOCKS
USETO CHAN,1(T2) ;SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
HLRZ T3,T1 ;FROM
SUBI T3,1(T1) ;-TO = -LENGTH
HLRZ T2,T1 ;FROM
SUB T2,LW.'WD ;MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,%AREA'.LB ;FIX IN CORE
SUBI T2,1 ;IOWD IS ONE LESS
HRL T2,T3 ;LEFT HALF IS -COUNT
SETZ T3, ;TERMINATE LIST
OUT CHAN,T2 ;DUMP BLOCK
POPJ P, ;OK
E$$O'%AREA::PUSH P,[CHAN] ;[1174] STACK ERROR CHAN
.ERR. (ST,0,V%L,L%F,S%F,O'%AREA,<Error outputting area %AREA>)
>
XALL
;LOW SEGMENT
PAGOUT (LC,LC,S1)
;HIGH SEGMENT
PAGOUT (HC,HC,S2)
;SYMBOL TABLE
PAGOUT (LS,SC,LS)
;ALGOL SYMBOLS
PAGOUT (AS,AC,AS)
SALL
SUBTTL INPUT CORE WINDOW
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO INPUT]
; PUSHJ P,LC.IN/HC.IN/LS.IN
;USES T1, T2, T3
DEFINE PAGIN (%AREA,CHAN,WD,FIXUP,%OK)<
%AREA'.IN:: HRRZ T2,T1 ;GET LAST ADDRESS WE NEED
CAMG T2,HB.'WD ;BIGGER THAN WHAT WE HAVE?
JRST %OK ;NO
MOVEM T2,HB.'WD ;YES, RESET HIGHEST
LSH T2,-.DBS2W ;[650] MUST DO USETO TO ZERO FILE
;SO WE WILL INPUT ZERO DATA
USETO CHAN,2(T2) ;YES, GET THIS MUCH
%OK:! HLRZ T2,T1 ;[1174] GET FIRST ADDRESS
LSH T2,-.DBS2W ;[650] INTO 128 WORD BLOCKS
USETI CHAN,1(T2) ;SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
HLRZ T3,T1 ;FROM
SUBI T3,1(T1) ;-TO = -LENGTH
HLRZ T2,T1 ;FROM
SUB T2,LW.'WD ;MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,%AREA'.LB ;FIX IN CORE
SUBI T2,1 ;IOWD IS ONE LESS
HRL T2,T3 ;LEFT HALF IS -COUNT
SETZ T3, ;TERMINATE LIST
IN CHAN,T2 ;DUMP BLOCK
IFB <FIXUP>,<
POPJ P, ;OK
>
IFNB <FIXUP>,<
PJRST %AREA'.FXR ;DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::PUSH P,[CHAN] ;[1174] SAVE ERROR CHAN
.ERR. (ST,0,V%L,L%F,S%F,I'%AREA,<Error inputting area %AREA>)
>
XALL
;LOW SEGMENT
PAGIN (LC,LC,S1,)
;HIGH SEGMENT
PAGIN (HC,HC,S2,)
;SYMBOL FILE
PAGIN (LS,SC,LS,LS.FXR)
;ALGOL SYMBOLS
PAGIN (AS,AC,AS,)
SALL
;TABLES OF XX.IN AND XX.OUT, INDEXED BY XX.IX
DEFINE XXX(%AREA)<
IFDEF %AREA'.IN,<
EXP %AREA'.IN
>
IFNDEF %AREA'.IN,<
EXP [HALT]
>>
XALL
TB.IN:: AREAS
DEFINE XXX(%AREA)<
IFDEF %AREA'.OUT,<
EXP %AREA'.OUT
>
IFNDEF %AREA'.OUT,<
EXP [HALT]
>>
TB.OUT::AREAS
SALL
SUBTTL DUMP LOCAL SYMBOLS WHEN CORE IS FULL
LS.DMP:: MOVE T1,LS.AB ;[650] SIZE OF LS AREA
SUB T1,LS.LB ;[650]
ANDCMI T1,.IPM ;[650] BUT NOT LAST PAGE
JUMPE T1,CPOPJ ;[650] IF 1P, DON'T BOTHER
E$$PLS::.ERR. (MS,0,V%L,L%I,S%I,PLS,<Area LS overflowing to disk>) ;[1174]
SKIPLE T1,SYMFRM ;[604] USER REQUESTING A SYMBOL FILE?
CAIE T1,1 ;[604] NEW STYLE?
JRST LSDMP0 ;[604] NO, JUST OVERFLOW TO DSK:
MOVEI T1,%SC ;[604] YES, SEE IF THERE'S AN OLD ONE
MOVEM T1,IO.CHN ;[604] SO WE CAN PUT THE NEW ONE ON
PUSHJ P,DVSUP.## ;[604] THE SAME STR TO SUPERCEDE
JRST LSDMP0 ;[604] /SYFILE DEVICE USELESS - USE DSK:
MOVE T3,IO.PTR+%SC ;[604] DVSUP. SAID TO USE %SC DEVICE
SKIPA T3,I.DEV(T3) ;[604] SO PICK IT UP FROM I/O DATA BLK
LSDMP0: MOVSI T3,'DSK' ;[604] /SYFILE DEVICE USELESS - USE DSK:
MOVE T1,IO.EMG ;GET SPACE
MOVEM T1,IO.PTR+SC ;SAVE IT
SETZM IO.EMG ;NOT FREE NOW (RESET LATER)
MOVEI T2,.IODPR ;USE MODE 16
MOVEM T2,I.MOD(T1)
MOVEM T3,I.DEV(T1) ;[604] USE CHOSEN DEVICE
MOVEI T2,LN.RIB-1 ;SIZE OF EXTENDED ENTER BLOCK
MOVEM T2,I.RIB(T1)
MOVE T2,JOBNUM ;GET SIXBIT JOB NUMBER
HRRI T2,'LLS' ;FILL IN RIGHT HALF
MOVEM T2,I.NAM(T1) ;TO FORM TEMP NAME
MOVSI T2,'TMP'
MOVEM T2,I.EXT(T1)
SETZ T2, ;[736] STANDARD PROTECTION
MOVEM T2,I.PRV(T1)
MOVE T2,LS.AB ;GET LENGTH OF INCORE TABLE
SUB T2,LS.LB
LSH T2,-<.DBS2W-1> ;[650] ASSUME THIS IS HALF OF IT
MOVEM T2,I.EST(T1) ;AS GOOD A GUESS AS ANY OTHER
LS.SET: MOVEI T1,SC ;PUT CHAN IN T1
PUSHJ P,DVUPD.## ;GET UPDATE MODE FILE
PUSHJ P,E$$ELS ;[1174] ERROR
;NOW FOR OUTPUT, SETUP IOWD FOR ALL SYMBOLS NOT IN CURRENT PROG
PUSH P,P1 ;SAVE AN AC
MOVE P1,LS.AB ;[650] SIZE OF LS AREA
SUB P1,LS.LB ;[650] ALMOST ANYWAY
SUBI P1,.IPS ;[650] HIGHEST TO OUTPUT
MOVE T1,P1
PUSHJ P,LS.OUT ;GENERAL OUTPUT ROUTINE
MOVE T1,P1 ;HIGHEST REL ADDRESS TO GIVE AWAY
ADD T1,LS.LB ;ADD IN OFFSET
ADDI P1,1 ;LOWEST TO KEEP
MOVEM P1,LW.LS ;WILL BECOME WINDOW LOWER LIMIT
SETOM UW.LS ;SIGNAL PAGING BUT NO UPPER LIMIT
MOVE T2,P1 ;TEMP STORE
POP P,P1 ;RESTORE
PUSHJ P,GBCK.L ;GIVE IT AWAY
PUSHJ P,GETIOM ;[650] USE SOME OF NEW AREA FOR IO.EMG
JRST CPOPJ1 ;[650] INDICATE SUCCESS
E$$ELS::PUSH P,[SC] ;[1174]
.ERR. (LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[1174]
POPJ P,
SUBTTL DUMP ALGOL SYMBOLS IF CORE FILLING
AS.DMP:: MOVE T1,AS.AB ;[650] SIZE OF AS AREA
SUB T1,AS.LB ;[650]
ANDCMI T1,.IPM ;[650] EXCEPT LAST PAGE
JUMPE T1,CPOPJ ;[650] DON'T BOTHER IF ONLY 1P
E$$PAS::.ERR. (MS,0,V%L,L%I,S%I,PAS,<Area AS overflowing to disk>) ;[1174]
SKIPLE T1,SYMFRM ;[604] USER WANT ALGOL SYFILE?
CAIE T1,2 ;[604] MAYBE, DOES HE?
JRST ASDMP0 ;[604] NO, PUT OVERFLOW FILE ON DSK:
MOVEI T1,%SC ;[604] OK, LETS CHECK SYFILE DEVICE
MOVEM T1,IO.CHN ;[604] AND PUT OVERFLOW FILE THERE TOO
PUSHJ P,DVSUP.## ;[604] PUT ON SAME STR AS OLD FILE
JRST ASDMP0 ;[604] /SYFILE DEVICE USELESS
MOVE T3,IO.PTR+%SC ;[604] OK, PICKUP /SYFILE DEVICE
SKIPA T3,I.DEV(T3) ;[604] FORM I/O DATA BLOCK
ASDMP0: MOVSI T3,'DSK' ;[604] USE DSK IF NOTHING BETTER
MOVE T1,IO.EMG ;GET EMERGENCY FILE BLOCK
MOVEM T1,IO.PTR+AC ;USE FOR AS OVERFLOW FILE
SETZM IO.EMG ;GET BACK WHEN MORE ROOM IN CORE
MOVEI T2,.IODPR ;USE DUMP ACROSS RECORDS MODE
MOVEM T2,I.MOD(T1) ;STORE FOR LNKFIO
MOVEM T3,I.DEV(T1) ;[604] STORE DEVICE CHOSEN ABOVE
MOVEI T2,LN.RIB-1 ;SETUP .RBLEN
MOVEM T2,I.RIB(T1) ;WITH EXTENDED ENTER LENGTH
MOVE T2,JOBNUM ;JOB NUMBER IN SIXBIT
HRRI T2,'LAS' ;MAKE NAME OF OVERFLOW FILE
MOVEM T2,I.NAM(T1) ;STORE IN FILE BLOCK
MOVSI T2,'TMP' ;EXTENSION .TMP FOR LOGOUT
MOVEM T2,I.EXT(T1) ;IN FILE BLOCK
SETZ T2, ;[736]STANDARD PROTECTION
MOVEM T2,I.PRV(T1) ;SO ALGOL SYMBOLS ARE SECURE
MOVE T2,AS.AB ;LENGTH OF AREA IN CORE
SUB T2,AS.LB ;SO CAN PUT IN FILE ESTIMATE
LSH T2,-<.DBS2W-1> ;[650] ASSUME FILE WILL BE 2*CURRENT
MOVEM T2,I.EST(T1) ;BETTER THAN 4* FOR MOST CASES
MOVEI T1,AC ;POINT TO THE AS CHANNEL
PUSHJ P,DVUPD.## ;GET FILE IN UPDATE MODE
PUSHJ P,E$$EAS ;[1174] ERROR CREATING AS AREA FILE
MOVE T1,AS.PT ;FIGURE SIZE OF AS AREA
SUB T1,AS.LB ;NOT COUNTING THAT ABOVE PT
ANDCMI T1,.IPM ;FIND EXTRANEOUS BLOCKS
PUSH P,T1 ;SAVE OVER AS.OUT
SUBI T1,1 ;GET ADDR OF LAST TO OUTPUT
PUSHJ P,AS.OUT ;WRITE OUT THE DATA
POP P,LW.AS ;RESTORE LOWEST VIRT ADDRESS
MOVE T1,AS.PT ;GET FIRST PHYS PAGE TO KEEP
ANDCMI T1,.IPM ;POINT TO 1ST WORD IN PAGE
SUBI T1,1 ;WORD BEFORE IS HIGHEST TO RETURN
PUSHJ P,GBCK.L ;GIVE BACK FREED UP CORE
SETOM UW.AS ;[650] INDICATE AS AREA STILL GROWING
PUSHJ P,GETIOM ;[650] USE SOME OF EXTRA TO SETUP IO.EMG
JRST CPOPJ1 ;[650] INDICATE SUCCESS TO CALLER
E$$EAS::PUSH P,[AC] ;[1174] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[1174]
POPJ P, ;NEVER GET HERE
SUBTTL DUMP LOW/HIGH SEG DATA WHEN CORE IS FULL
;HERE FOR LOW SEG
LC.DMP:: ;[1174]
E$$PLC::.ERR. (MS,0,V%L,L%I,S%I,PLC,<Area LC overflowing to disk>) ;[1174]
PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX FOR LOW
JRST LH.DMP ;GO DUMP IT
;HERE FOR HIGH SEG
HC.DMP:: ;[1174]
E$$PHC::.ERR. (MS,0,V%L,L%I,S%I,PHC,<Area HC overflowing to disk>) ;[1174]
PUSH P,R
MOVEI R,HC.IX
;FALL INTO LH.DMP
;HERE TO DUMP EITHER LOW OR HIGH
;ENTER WITH R=LC.IX OR HC.IX
LH.DMP: SKIPN @[EXP IO.PTR+%XC,IO.PTR+%VC]-1(R) ;[604]
JRST LHDMP0 ;[604] /XPN OR /SAVE NOT SPECIFIED
MOVE T1,[EXP %XC,%VC]-1(R) ;[604] ONE WAS, GET CHANNEL #
MOVEM T1,IO.CHN ;[604] SAVE IT FOR LNKFIO
PUSHJ P,DVSUP.## ;[604] SEE IF CAN OVERFLOW TO SAME STR
JRST LHDMP0 ;[604] CAN'T, JUST USE DSK:
MOVE T3,@[EXP IO.PTR+%XC,IO.PTR+%VC]-1(R) ;[604]
SKIPA T3,I.DEV(T3) ;[604] GET STR OLD SAVE/XPN FILE IS ON
LHDMP0: MOVSI T3,'DSK' ;[604] NONE EXISTS, USE DSK:
MOVE T1,IO.EMG ;[604] GET TEMP SPACE
MOVEM T1,IO.PTR+LC-1(R) ;SAVE IT
SETZM IO.EMG ;NOT FREE NOW (RESET LATER)
MOVEM T3,I.DEV(T1) ;[604] SET UP DEVICE CORRECTLY
MOVEI T2,.IODPR ;USE MODE 16
MOVEM T2,I.MOD(T1)
MOVEI T2,LN.RIB-1 ;SIZE OF EXTENDED ENTER BLOCK
MOVEM T2,I.RIB(T1)
MOVE T2,JOBNUM ;GET SIXBIT JOB NUMBER
HRR T2,[EXP <'LLC'>,<'LHC'>]-1(R)
MOVEM T2,I.NAM(T1) ;TO FORM TEMP NAME
MOVSI T2,'TMP'
MOVEM T2,I.EXT(T1)
SETZ T2, ;[736] STANDARD PROTECTION
MOVEM T2,I.PRV(T1)
MOVE T2,HL.S0(R) ;GET HIGHEST LOC LOADED
LSH T2,-<.DBS2W-1> ;[650] 2* NUMBER OF 128 WORDS
MOVEM T2,I.EST(T1) ;GOOD GUESS?
LH.SET: MOVEI T1,LC-1(R) ;CHAN#
PUSHJ P,DVUPD.## ;UPDATE MODE
PUSHJ P,@[EXP E$$ELC,E$$EHC]-1(R) ;[1174]
;NOW FOR OUTPUT, SETUP IOWD FOR DATA TO BE OUTPUT
;AND GET RID OF AREA
MOVE T1,TAB.AB(R) ;SEE HOW LONG A BUFFER WE USED
SUB T1,TAB.LB(R) ;THIS IS LENGTH
MOVEM T1,UW.S0(R) ;THIS IS THE UPPER WINDOW BOUND
MOVEI T2,1(T1) ;MAKE INTO 128 WORDS &
LSH T2,-<1+.IPS2W> ;[650] CUT IN HALF
LSH T2,.IPS2W ;[650] BUT KEEP IN 128 WORD CHUNKS
CAIGE T2,.IPS ;[1104] IN CASE 1/2 IS .LT. 1 PAGE,
MOVEI T2,.IPS ;[1104] DUMP ONE PAGE TO MARK PAGING
SUBI T1,-1(T2) ;GET NEW BOTTOM WINDOW BOUND
PUSH P,T1 ;SAVE IT
SKIPN T1 ;IF SEG IS ONLY 1 BLOCK
TROA T1,.IPM ;OUTPUT IT TO MARK PAGING
HRRZI T1,-1(T1) ;UPPER WINDOW OF WHATS OUTPUT
PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R)
POP P,T1 ;RECOVER LOWEST ADDRESS NOT OUTPUT
JUMPE T1,LHSET0 ;SPECIAL IF BASE STILL 0
MOVEM T1,LW.S0(R) ;SET IT
ADD T1,TAB.LB(R) ;BOTTOM IN REAL CORE
SUBI T1,1 ;[650] SET FOR GBCK.L
PUSHJ P,GBCK.L ;RETURN FREE SPACE
LHSET0: PUSHJ P,GETIOM ;RESET IO.EMG
PUSHJ P,LNKCON ;TRY AGAIN, IN CASE ORIG CALL WAS FOR
CAIA ;THIS AREA (NEED TO UPDATE UW CORRECTLY)
AOS -1(P) ;PRESERVE LNKCOR RETURN
MOVE T1,TAB.AB(R) ;ACTUAL TOP
SUB T1,TAB.LB(R) ;LENGTH -1
ADD T1,LW.S0(R) ;NEW TOP
MOVEM T1,UW.S0(R)
POP P,R ;RESTORE
POPJ P, ;RETURN TO LNKCOR CALLER
E$$ELC::PUSH P,[LC] ;[1174]
.ERR. (LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>) ;[1174]
POPJ P,
E$$EHC::PUSH P,[HC] ;[1174]
.ERR. (LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>) ;[1174]
POPJ P,
SUBTTL FIXUPS
;HERE TO SEE IF ANY SYMBOL FIXUP HAVE TO BE DONE FOR THIS WINDOW
;CHECK CURRENT LW.LS-UW.LS AGAINST ENTRIES IN FXP.LS
;FORMAT OF FXP.LS IS
; PTR TO LAST,,PTR TO FIRST
;USES T1, T2, T3
LS.FXR::SKIPN FS.SS ;ANY FIXUPS TO DO?
POPJ P, ;NO, JUST RETURN
PUSH P,R ;MUST SAVE R INCASE FROM LNKXIT
PUSH P,[0] ;ADDRESS TO OUTPUT IF WE DO ANY FIXUPS
PUSHJ P,SYMCHN ;SEE IF ANY FIXUPS FOR THIS AREA
POP P,T1 ;GET BACK POINTER WORD
POP P,R ;SAFE TO RESTORE R NOW
JUMPE T1,CPOPJ ;NO FIXUPS DONE
TLZ T1,.IPM ;MAKE INTO TRUE OUTPUT PTR
IORI T1,.IPM
PJRST LS.OUT ;OUTPUT AND RET
;GETIOM - GET SPACE FOR IO.EMG AND RESERVE IT
;CALLED BY
; PUSHJ P,GETIOM
;USES T1, T2
GETIOM: MOVEI T2,LN.IO ;SPACE WE NEED
PUSHJ P,DY.GET ;GET IT
MOVEM T1,IO.EMG
POPJ P,
;CHKSYM - SEE IF ANY FIXUPS EXIST FOR THE NEW SYMBOL WINDOW
;IF SO LINK THEM INTO FXT.S0
;AND DO THEM
;USES T1-T4
SYMCHN: SETZM FXT.S0 ;CLEAR TEMP PTR
HRRZ T1,FS.SS ;GET PTR TO LOWEST
ADD T1,FX.LB ;+OFFSET
HRRZ T2,1(T1) ;GET ADDRESS
ADDI T2,.L-1 ;MAKE SURE LAST WORD IN CORE
HLRZ T1,FS.SS ;PTR TO HIGHEST
ADD T1,FX.LB ;+OFFSET
HRRZ T3,1(T1) ;ADDRESS
CAMG T2,UW.LS ;IS LOWEST ADDRESS TOO HIGH?
CAMGE T3,LW.LS ;OR HIGHEST TOO LOW?
POPJ P, ;YES, JUST GIVE UP
;MAKE QUICK TEST INCASE ALL IN CORE
;IN WHICH CASE WE NEED NOT CHASE CHAIN
SUBI T2,.L-1 ;ACCOUNT FOR ALL 3 WORDS
ADDI T3,.L-1 ;IN ALL CHECKS
CAML T2,LW.LS ;IS LOWEST ADDRESS .GT. LOW WINDOW?
CAMLE T3,UW.LS ;AND HIGHEST ADDRESS .LE. HIGH WINDOW
JRST .+5 ;NO, DO THE SLOW WAY
MOVE T1,FS.SS ;GET POINTER WORD
MOVEM T1,FXT.S0 ;MOVE IT ALL OVER
SETZM FS.SS ;REMOVE FROM LIST TO CONSIDER
JRST FXSLP0 ;AND DO IT
MOVEI T1,FS.SS ;GET INITIAL PTR
;START AT BACK SINCE MOST USUAL CASE
;IS TO READ FILE BACKWARDS
CHKSYL: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,CPOPJ ;NOTHING TO DO
ADD T1,FX.LB ;OFFSET
HRRZ T2,1(T1) ;GET ADDRESS
ADDI T2,.L-1 ;ALL 3 WORDS MUST BE INCORE
CAMLE T2,UW.LS ;INCORE?
JRST CHKSYL ;NO, LOOP
HRRZ T3,(T1) ;GET FORWARD LINK
JUMPE T3,[MOVEI T3,FS.SS ;IF TERO THIS IS TOP OF CHAIN
JRST CHKSYM] ;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
CHKSYM: SUB T1,FX.LB ;-OFFSET
MOVSM T1,FXT.S0 ;TEMP PTR TO HIGHEST TO DO
ADD T1,FX.LB ;+OFFSET
CHKSYH: HLRZ T1,(T1) ;GET NEXT
JUMPE T1,[MOVEI T1,FS.SS ;GET FIRST IF
JRST SYMFIN] ;REACHED END OF CHAIN
ADD T1,FX.LB ;+OFFSET
HRRZ T2,1(T1) ;ADDRESS
CAML T2,LW.LS ;STILL IN COREE?
JRST CHKSYH ;YES
MOVE T2,T1 ;GET ABS ADDRESS
SUB T2,FX.LB ;REMOVE OFFSET
HRL T1,T2 ;STORE LINK IN LEFT HALF FOR LATER
SYMFIN: 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
FXSLP0: HRRZ T1,FXT.S0 ;GET FIRST ADDRESS
ADD T1,FX.LB ;IN CORE
HRRZ T1,1(T1) ;GET SYMBOL ADDRESS (REL TO ORIGIN)
HRLM T1,-1(P) ;PUT ON STACK INPLACE OF [0]
HLRZ T1,FXT.S0 ;SAME FOR UPPER ADDRESS
ADD T1,FX.LB
HRRZ T1,1(T1)
ADDI T1,.L-1 ;FIXED UP ALL 3 WORDS
HRRM T1,-1(P)
FXSLUP: HRRZ T1,FXT.S0 ;GET NEXT PTR
JUMPE T1,CPOPJ ;ALL DONE FOR THIS LIST
.JDDT LNKCOR,FXSLUP,<<CAMN T1,$FIXUP>> ;[632]
ADD T1,FX.LB ;+OFFSET
HRRZ T2,(T1) ;NEXT PTR
HRRM T2,FXT.S0 ;STORED
HRRZ T2,1(T1) ;GET ADDRESS
HLRZ T3,1(T1) ;AND INDEX
MOVE T4,2(T1) ;VALUE
ADD T2,LS.LB ;ADD IN BASE
SUB T2,LW.LS ;MINUS WINDOW BASE
PUSHJ P,@SYMTAB(T3) ;GO TO RIGHT ROUTINE
MOVEI T2,3 ;SIZE OF BLOCK
PUSHJ P,FX.RET ;RESTORE NOW (INCASE REQUIRED AGAIN)
JRST FXSLUP ;AND CONTINUE
IFN DEBSW,<
;SET THE FOLLOWING LOCATION TO THE OFFSET FROM THE BEGINNING OF THE FX
;AREA OF THE FIRST WORD OF A FIXUP BLOCK THAT IS INTERESTING FOR
;DEBUGGING PURPOSES. LINK WILL HIT A BREAKPOINT WHEN THE FIXUP BLOCK
;IS PROCESSED, OR WHEN A NEW FIXUP IS STORED IN THAT BLOCK.
$FIXUP::BLOCK 1 ;[632] PLACE FOR FX OFFSET FOR .JDDT
> ;END IFN DEBSW
DEFINE X (A)<
EXP STF.'A
>
XALL
SYMTAB: SFIXUPS
SALL
;ENTER WITH :-
;T1 = ADDRESS OF FIXUP IN FX (FROM)
;T2 = ADDRESS OF FIXUP RECIPIENT IN LS (TO)
;T3 = INDEX (SCRATCH)
;T4 = VALUE OF FIXUP
;RELOCATABLE
STF.RR:! STF.RL:! STF.RF: ;ALL DISPATCH HERE
PUSH P,T1 ;SAVE A SCRATCH AC
MOVX T1,PS.REL ;GET 'I AM RELOCATABLE' BIT
IORM T1,0(T2) ;MAKE SURE SET IN FLAG WORD
POP P,T1 ;RESTORE SCRATCH AC
SUBI T3,<SPF.RR-SPF.AR> ;CONVERT TO CORRESPONDING
PJRST @SYMTAB(T3) ; ADDITIVE TYPE AND DISPATCH
;RIGHT HALF
STF.AR: HRRZ T3,2(T2) ;GET CURRENT VALUE
ADD T3,T4 ;ADD IN FIXUP
HRRM T3,2(T2) ;PUT NEW VALUE BACK
MOVX T3,PS.UDR ;WE CAN NOW TURN THIS FLAG OFF
JRST STF.FL ;JOIN COMMON CODE
;LEFT HALF
STF.AL: HLRZ T3,2(T2) ;GET CURRENT VALUE
ADD T3,T4 ;ADD IN FIXUP
HRLM T3,2(T2) ;PUT BACK NEW
MOVX T3,PS.UDL ;LEFT HALF NOW DEFINED
JRST STF.FL
;FULL WORD
STF.AF: ADDM T4,2(T2) ;ADD IN FIXUP
MOVX T3,PS.UDF ;FULLY DEFINED NOW
; JRST STF.FL ;FALL INTO COMMON CODE
;FALL THROUGH TO NEXT PAGE
;HERE WITH T3 CONTAINING THE BITS WE'RE DEFINING. CLEAR IN LS AREA
;AND CHECK FOR POSSIBLE MULTIPLE DEFINITION IF GLOBAL.
STF.FL: MOVX T4,PS.GLB ;CHECK GLOBAL DEFINITION, SINCE
TDNN T4,0(T2) ;LOCALS CAN'T BE MULT. DEFINED
JRST STF.LC ;LOCAL SYMBOL, NO PROBLEM
;**** TEMP CROCK TO AVOID HALT IF DOING FIXUPS WHILE SORTING SYMBOL
;**** TABLE LATE IN LNKXIT, AFTER LNKXIT HAS DELETED GS AREA. THE REAL
;**** SOLUTION IS TO HAVE LNKXIT KEEP THE GS AREA AROUND LONGER, BUT
;**** THAT SOLUTION IS FAR TOO COMPLEX TO IMPLEMENT AT THE PRESENT TIME,
;**** DUE TO LNKXIT'S HORRIBLE HABIT OF DOING CORE UUO'S AND REFERENCING
;**** .JBREL DIRECTLY (THE GS ARE WOULD BE OVERWRITTEN BY THE FX OR LS
;**** AREAS EVEN IF IT WASN'T DELETED). THIS SHOULD BE FIXED!!!!
SKIPN GS.LB ;GS AREA EXIST?
JRST STF.LC ;NO (**CROCK**) SKIP THIS CHECK
;**** END OF TEMP CROCK
SPUSH <W1,W2,W3,P1,P2,T1,T2,T3> ;SAVE THE WORLD
TMOVE W1,0(T2) ;PICK UP THE SYMBOL WE NEED
PUSHJ P,TRYSYM## ;GET THE REAL VALUE
HALT . ;THEN WHY IS IT IN THE LS AREA?
JFCL ;DOESN'T MATTER IF UNDEFINED
SPOP <T3,T2> ;RESTORE DEFINING BITS AND LS PTR
MOVE W1,0(P1) ;PICKUP REAL FLAGS FROM GLOBALS
TXNN W1,PS.UDF!PS.REQ ;SYMBOL COMPLETELY DEFINED?
JRST STF.PV ;YES, P2 POINTS TO REAL VALUE
TXNN W1,PT.EXT ;NO, MUST GET PART VALUE FROM PVS
JRST STF.GU ;NO PVS, GIVE UP
STF.NX: ADDI P1,.L ;ADVANCE TO NEXT TRIPLET
SKIPG P2,0(P1) ;PICK UP SECONDARY FLAGS
JRST STF.GU ;PRIMARY HERE?? GIVE UP!
TXNE P2,S.PVS ;IS THIS THE ONE WE'RE LOOKING FOR
JRST STF.PV ;YES, GO COMPARE VALUES
TXNN P2,S.LST ;NO, BUT ARE THERE MORE TRIPLETS?
JRST STF.NX ;YES, GO EXAMINE THEM
JRST STF.GU ;NO, NOT MULTIPLY DEFINED AT ALL
;HERE WITH THE ABS ADDR OF THE PVS TRIPLET ON THE GLOBAL SYMBOL IN
;P2. THIS SYMBOL MUST BE MULTIPLY DEFINED IF FULLY DEFINED AND A PVS
;TRIPLET STILL EXISTS, BUT CHECK VALUES ANYWAY IN CASE NOT FULLY DEFINED
;(/MAP:NOW OR AN UNDEFINED GLOBAL) SO MAP WILL BE CORRECT.
STF.PV: MOVE T4,2(T2) ;GET THE NEW VALUE WE JUST FOUND
TXNE T3,PS.UDR ;NOT DEFINING RH?
TXNE W1,PS.UDR ;OR IS RH UNKNOWN?
HRR T4,2(P1) ;YES, CAN'T POSSIBLY BE CONFICTING
TXNE T3,PS.UDL ;SAME LOGIC FOR LH
TXNE W1,PS.UDL ;..
HLL T4,2(P1) ;T4 NOW DIFFERENT IF MULT. DEF.
CAMN T4,2(P1) ;IS IT?
TDZA T4,T4 ;NO, CLEAR T4
MOVX T4,PS.MDF ;YES, FLAG AS MULTIPLY DEFINED
IORM T4,0(T2) ;SET PS.MDF IF NEEDED
STF.GU: SPOP <T1,P2,P1,W3,W2,W1> ;RESTORE THE WORLD
STF.LC: ANDCAB T3,0(T2) ;CLEAR ALL UNDEF BITS JUST DEFINED
TXNE T3,PS.UDF ;IF SYMBOL IS NOW FULLY DEFINED
POPJ P, ;NO, WAIT SOME MORE
MOVX T3,PS.REQ ;WE CAN TURN OFF THE REQUEST BIT
ANDCAM T3,0(T2)
POPJ P,
;HERE TO FIXUP NAME STUFF IN TITLE BLOCK
STF.TL: MOVE T3,0(T2) ;GET FLAGS
TXNN T3,PT.TTL ;BETTER BE A TITLE
JRST BADSTF ;IT'S NOT, REPORT ERROR
HRRM T4,2(2) ;[577] STORE POINTER BACK TO RH
POPJ P,
;HERE TO FIXUP LOCAL BLOCK NAME CHAIN IN TITLE BLOCK
STF.TB: MOVE T3,0(T2) ;[577] GET FLAGS
TXNN T3,PT.TTL ;[577] BETTER BE A TITLE
JRST BADSTF ;[577] ITS NOT, REPORT ERROR
HRLM T4,2(T2) ;[577] OK, STORE VALUE
POPJ P, ;[577] RETURN
;HERE TO FIXUP SEG STUFF IN TITLE BLOCK
STF.SG: SKIPL T3,0(T2) ;GET FLAGS
TXNN T3,S.SEG ;LOOK FOR SEGMENT STUFF
JRST BADSTF ;REPORT ERROR
HRRM T4,1(T2) ;STORE BACK LOW
TLNN T4,-1 ;[566] DID USER PROGRAM HAVE A HIGH SEG?
SETZB T4,2(T2) ;[566] NO, CLEAR HI SEG LENGTH WORD
SKIPE 2(T2) ;ANY HIGH?
HLRM T4,2(T2) ;YES, STORE BACK
POPJ P,
;HERE TO FIXUP SEGMENT ORIGINS IN TITLE BLOCK (LEFT HALVES)
STF.SL: SKIPL T3,(T2) ;CHECK SECONDARY TRIPLET
TXNN T3,S.SEG ;THAT DESCRIBES SEGMENT DATA
JRST BADSTF ;REPORT THE ERROR
HRRE T3,T4 ;GET SIGNED LOW SEG VALUE
AOSE T3 ;-1 MEANS DO NOT CHANGE
HRLM T4,1(T2) ;OTHERWISE, STORE NEW VALUE
HLRE T3,T4 ;NOW LOOK AT HI SEG VALUE
AOSE T3 ;DON'T STORE IF -1
HLLM T4,2(T2) ;PUT NEW VALUE IN PLACE
POPJ P, ;DONE
;HERE ON A BAD TRIPLET
BADSTF: PUSH P,T1 ;NEED T1 FOR CONTINUE ATTEMPT
E$$SFU::.ERR. (MS,0,V%L,L%W,S%W,SFU,<Symbol table fouled up>) ;[1174] OUCH!
POP P,T1 ;RECOVER FIXUP POINTER
POPJ P, ;TRY TO CONTINUE
SUBTTL THE END
CORLIT: END