Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
sources/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/PAH/PY/HD 6-Jan-83
;COPYRIGHT (C) 1974, 1983 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,<
SEARCH MONSYM
OPDEF SMAP[JSYS 767]
> ;[1401] IFN TOPS20
SALL
ENTRY LNKCOR
EXTERN LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==5 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2026 ;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).
;START OF VERSION 4B
;1230 Make overflow files, and hence symbol and .EXE files, end up on right path.
;START OF VERSION 5
;1221-1477 Maintenance edits
;1401 Native mode handling of overflow files
;1412 Overflow into nonzero sections if loading them.
;1426 FTFRK2 program fork code.
;1442 Make LH.DMP call CRTFRK if a nonzero section is being dumped to.
; Also don't dump to nonexistent section 0 in the program fork.
;1450 Correct typo in call to CRTFRK, save register 16 properly, use
; PRGFRK symbol for fork handling.
;START OF VERSION 5A
;1520 Use GBCK.L to fix pointers in LSREDU.
;1525 Adjust TAB.PT when high or low segment overflows to disk.
;1532 Map 2nd half of overflow window, not 1st half, at CREDU.
;1536 Fix paging of multisection LS areas on the -20.
;1771 Add 1 to t2 before call to DY.RET near NEWSC0
;2023 Try expunging directory for quota exceeded failures with PMAPs.
;2024 Fix edit 2023 and fix typo at OVFOU2+5.
;2026 Update copyright and delete edit banners.
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
IFN TOPS20,<
SKIPN T2,@TB.JFD(P1) ;[1401] IS THIS AREA PAGED?
JRST LCR1.5 ;[1401] NO, NOTHING SPECIAL
PUSH P,TAB.AB(P1) ;[1401] REMEMBER ACTUAL BOUND
ADDM P2,TAB.AB(P1) ;[1401] FIX ACTUAL BOUND TO REFLECT INCREASE
ADDM P2,TAB.FR(P1) ;[1401] AND FREE SPACE COUNTER
MOVE T3,P2 ;[1401] TAKE THE BLOCK
LSH T3,-9 ;[1401] MAKE IT PAGES
SKIPE T3 ;[1401] IF NONZERO
IOR T3,[PM%CNT] ;[1401] MARK IT AS A COUNT
IOR T3,[PM%RD!PM%WR!PM%PLD];[1401] READ/WRITE ACCESS
MOVE T1,TAB.UW(P1) ;[1401] UPPER WINDOW INTO FILE
SKIPG T1 ;[1401] IF TAB.UW IS -1
JRST [ MOVE T1,0(P) ;[1401] OLD TAB.AB
SUB T1,TAB.LB(P1) ;[1401]
ADD T1,TAB.LW(P1) ;[1401]
JRST .+1
] ;[1401] CALCULATE CORRECT UW
AOS T1 ;[1401] START AT PAGE AFTER CURRENT UW
LSH T1,-9 ;[1401] AS PAGES
HRL T1,T2 ;[1401] T1: JFN,,FILEPAGE
;[1450] SKIPGE T1 ;[1412] REALLY A JFN?
;[1450] ADD T1,NONZER ;[1412] NO, ADD IN SECTION NUMBER
POP P,T2 ;[1401] T2: PROCESSPAGE
AOS T2 ;[1401]
LSH T2,-9 ;[1401] ...
HRLI T2,.FHSLF ;[1401] ...
PMAP ;[1401]
ERJMP E$$MEF ;[1401] ERROR
SKIPL TAB.UW(P1) ;[1401]
ADDM P2,TAB.UW(P1) ;[1401] UPDATE WINDOW BOUNDS
JRST CPOPJ1 ;[1401] AND RETURN
LCR1.5:
> ;[1401] END IFN TOPS20
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%I,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
IFN TOPS20,<
SKIPN TAB.PG(T2) ;[1401] IS THIS AREA PAGING?
JRST LDCR6D ;[1401] NO, DO ORDINARY BLTS
LDCR6C: PUSH P,T2 ;[1401] SET ASIDE INDEX -- WE WILL USE T2
MOVE T3,TAB.AB(T2) ;[1401] TOP OF AREA
SUB T3,TAB.LB(T2) ;[1401] -BOTTOM OF AREA = LENGTH
LSH T3,-9 ;[1401] LENGTH IN PAGES
SKIPE T3 ;[1401] ZERO?
AOS T3 ;[1401] NO, INCLUDE ALL PAGES
SKIPE T3 ;[1401] ZERO?
IOR T3,[PM%CNT] ;[1401] NO, MARK IT A COUNT
IOR T3,[PM%WR!PM%RD];[1401] READABLE AND WRITEABLE
MOVE T1,TAB.LB(T2) ;[1401] ADDRESS TO MAP AWAY
LSH T1,-9 ;[1401] IN PAGES, PLEASE
HRLI T1,.FHSLF ;[1401] SELF,,PROCESSPAGE
MOVE T2,T1 ;[1401] T2 GETS IT
SETOM T1 ;[1401] T1 GETS -1 -- UNMAP, PLEASE
PMAP ;[1401] OUT THEY GO!
ERJMP [ POP P,(P) ;[1401] ERROR -- CLEAR STACK
JRST E$$MEF ] ;[1401] AND RETIRE
POP P,T2 ;[1401] GET INDEX BACK
PUSH P,T3 ;[1401] SET ASIDE BITS AND COUNT
SKIPN T3,@TB.JFD(T2) ;[1401] PICK UP THE JFN
JRST [ POP P,(P) ;[1401] ERROR -- CLEAR STACK
POP P,(P)
JRST E$$MEF ] ;[1401] AND RETIRE
MOVE T1,TAB.LW(T2) ;[1401] NOTE ADDRESS IN OVF FILE
LSH T1,-9 ;[1401] MAKE IT PAGES
HRL T1,T3 ;[1401] JFN,,FILEPAGE
SKIPGE T1 ;[1412] REALLY A JFN?
ADD T1,NONZER ;[1412] NO, ADD IN SECTION NUMBER
POP P,T3 ;[1401] PUT COUNT BACK
PUSH P,T2 ;[1401] SAVE INDEX ONCE MORE
MOVE T2,TAB.NB(T2) ;[1401] FETCH DESTINATION
LSH T2,-9 ;[1401] IN PAGES, PLEASE
HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF
PMAP
ERJMP [ POP P,(P) ;[1401] ERROR -- CLEAR STACK
JRST E$$MEF ] ;[1401] AND RETIRE
POP P,T2 ;[1401] PUT THE INDEX BACK
PUSHJ P,ADJTBL ;[1401] ADJUST THE TABLES
JRST LDCR6B ;[1401] AND TRY AGAIN
; [1401] DISPATCH TABLE GIVING JFNS FOR OVERFLOW FILES
TB.JFD::
DEFINE XXX (ABC)<
IFDEF ABC'.JF,< ABC'.JF >
IFNDEF ABC'.JF,< [ 0 ] >
>
AREAS
LDCR6D: > ;[1401] IFN TOPS20
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
IFN TOPS20,<
SKIPN TAB.PG(T2) ;[1401] FREE SPACE WAS ZEROED BY UNMAP
> ;[1401] IFN TOPS20
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
IFN TOPS20,<
SKIPN TAB.PG(P1) ;[1401] IS THIS AREA PAGING?
JRST LDCR7B ;[1401] NO, DO ORDINARY BLTS
PUSH P,T2 ;[1401] SET ASIDE COUNT -- WE WILL USE T2
MOVE T2,TAB.LB(P1) ;[1401] WHERE TO START
LSH T2,-9 ;[1401] IN PAGES
HRLI T2,.FHSLF ;[1401] PROCESS IS SELF
MOVE T3,TAB.AB(P1) ;[1401] TOP OF AREA
SUB T3,TAB.LB(P1) ;[1401] -BOTTOM OF AREA = LENGTH
AOS T3 ;[1401] WELL, ALMOST
LSH T3,-9 ;[1401] LENGTH IN PAGES
SKIPE T3 ;[1401] ZERO?
IOR T3,[PM%CNT] ;[1401] NO, MARK IT A COUNT
IOR T3,[PM%WR!PM%RD];[1401] READABLE AND WRITEABLE
SETOM T1 ;[1401] T1 GETS -1 -- UNMAP, PLEASE
PMAP ;[1401] OUT THEY GO!
ERJMP [ POP P,(P) ;[1401] ERROR -- CLEAR STACK
JRST E$$MEF ] ;[1401] AND RETIRE
MOVE T1,TAB.LW(P1) ;[1401] NOW GET THEM BACK
LSH T1,-9 ;[1401] FILEPAGE
HRL T1,@TB.JFD(P1) ;[1401] FILEJFN
SKIPGE T1 ;[1412] REALLY A JFN?
ADD T1,NONZER ;[1412] NO, ADD SECTION NUMBER
MOVE T2,(P) ;[1401] GET COUNT BACK, BUT KEEP IT
ADDM T2,TAB.AB(P1) ;[1401] FIXUP BOUNDS
ADDM T2,TAB.PT(P1) ;[1401] AND POINTERS
ADDB T2,TAB.LB(P1) ;[1401] FETCH DESTINATION
LSH T2,-9 ;[1401] IN PAGES, PLEASE
HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF
PMAP
ERJMP [ POP P,(P) ;[1401] ERROR -- CLEAR STACK
JRST E$$MEF ] ;[1401] AND RETIRE
POP P,T2 ;[1401] PUT THE COUNT BACK
JRST LNKCON ;[1401] TRY AGAIN
LDCR7B: > ;[1401] IFN TOPS20
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
IFN TOPS20,<
SKIPE TAB.PG(T2) ;[1401] IS THIS AREA PAGING?
JRST LDCR6C ;[1401] YES, DO PMAPS
> ;[1401] END OF IFN TOPS20
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
IFE TOPS20,<
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
> ;[1426] IFE TOPS20
IFN TOPS20,<
LSH T1,-9 ;GET PAGE
TLO T1,.FHSLF
MOVE T2,T1
SETOM T1
SETZM T3
PMAP ;UNMAP THIS FROM THE WINDOW
ERJMP E$$MEF
> ;[1426] IFN TOPS20
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:
REPEAT 0,<
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,
> ; [1401] REPEAT 0
;
;[1401] The following modification converts free space management to a
; first-fit algorithm and randomizes the free space chain.
; Credit to Knuth ( who describes it and notes its virtues )
; and to DZN ( who told me to check it out ).
;
MOVE T4,TB.LNK(P1) ;[1401] PICK UP 1ST LINK
HRRM T4,(T1) ;[1401] CHAIN IN RETURNED BLOCK
HRRZ T4,T1 ;[1401] GET PTR TO RETURNED BLOCK
SUB T4,TAB.LB(P1) ;[1401] RELATIVIZE IT
MOVEM T4,TB.LNK(P1) ;[1401] AND STORE AS HEAD OF CHAIN
POPJ P, ;[1401] DONE
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
IFE TOPS20,<
HRL T2,T2 ;FORM BLT POINTER
ADDI T2,1 ;WELL ALMOST
SETZM -1(T2) ;CLEAR FIRST WORD
BLT T2,@TAB.AB(T1) ;AND REST
> ;[1401] IFE TOPS20
IFN TOPS20,<
ADDI T2,1
MOVE T3,TAB.AB(T1) ;[1401] PICK UP LAST ADDR
SUB T3,T2 ;[1401] LENGTH
LSH T3,-9 ;[1401] IN PAGES
SKIPE T3 ;[1401] ZERO?
AOS T3 ;[1401] NO, INCLUDE ALL PAGES
SKIPE T3 ;[1401] ZERO?
IOR T3,[PM%CNT] ;[1401] MARK IT A COUNT
PUSH P,T1 ;[1401] SAVE INDEX
LSH T2,-9 ;[1401] IN PAGES
HRLI T2,.FHSLF
SETOM T1
PMAP
POP P,T1 ;[1401] RESTORE INDEX
> ;[1401] IFN TOPS20
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
GBCKL2: JUMPL T2,CPOPJ ;[1755] STOP WHEN THROUGH
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
IFE TOPS20,<
PUSHJ P,GBCK.L ;GIVE BACK THE CORE
> ;[1401] IFE TOPS20
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
IFE TOPS20,<
ADD T1,LW.S0(R) ;NEW BOTTOM
SUBI T1,1 ;THEREFORE TOP TO OUTPUT
HRL T1,LW.S0(R) ;FROM HERE UP
> ;[1401] IFE TOPS20
IFN TOPS20,<
HRL T1,LW.S0(R) ;SEND THE WHOLE AREA AWAY
HRR T1,UW.S0(R)
> ;[1401] IFN TOPS20
PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R)
POP P,T1 ;GET BACK LENGTH
IFE TOPS20,<
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
> ;[1401] IFE TOPS20
IFN TOPS20,<
MOVE T2,TAB.LW(R) ;[1532] SHORTEN WINDOW
ADD T2,T1 ;[1532] NEW WINDOW STARTS
MOVEM T2,TAB.LW(R) ;[1532] MIDWAY THRU CURRENT WINDOW
ADDB T1,TAB.LB(R) ;[1401] SUBTRACT FROM THIS AREA
PUSH P,R ;[1401] SAVE THE INDEX
SOSA T1 ;[1401] NEW TOP OF NEXT LOWER AREA
SKIPN TAB.LB(R) ;[1401] FIND THE NEXT LOWER AREA
SOJN R,.-1 ;[1401] KEEP GOING TILL WE DO
MOVEM T1,TAB.UB(R) ;[1401] HAVING DONE SO, RESET IT'S UPPER BOUND
POP P,R ;[1401] RESTORE THE INDEX
HRL T1,LW.S0(R) ;[1401] GET HALF AREA BACK
HRR T1,UW.S0(R) ;[1401]
PUSHJ P,@[EXP LC.IN,HC.IN]-1(R)
> ;[1401] IFN TOPS20
POP P,R ;RESTORE R
JRST LNKCON ;TRY AGAIN, MAY RETURN
RPOPJ: POP P,R ;RESTORE R
POPJ P,
SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS10
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO OUTPUT]
; PUSHJ P,LC.OUT/HC.OUT/LS.OUT
;USES T1, T2, T3
IFE TOPS20,<
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>)
>
> ;[1401] END IFE TOP20
SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS20
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO OUTPUT]
; PUSHJ P,LC.OUT/HC.OUT/LS.OUT
;USES T1, T2, T3
IFN TOPS20,<
DEFINE PAGOUT (%AREA,CHAN,WD)<
%AREA'.OUT::
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
HLR T2,LW.LS ;[1536] PICK UP SECTION NUMBER
LSH T2,9 ;[1536] MAKE IT PAGE NUMBER
PUSH P,NONZER ;[1536] SAVE NONZER IF IN USE
MOVEM T2,NONZER ;[1536] SET IT FOR LS.OUT
> ;[1536] END IFN FTFRK2
> ;[1536] END IFIDN
MOVEI T2,%AREA'.IX ;[1426] CHANNEL INFO
PUSHJ P,OVF.OU ;[1426] DO THE I/O
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
POP P,NONZER ;[1536]
> ;[1536] END IFN FTFRK2
> ;[1536] END IFIDN
POPJ P,
E$$O'%AREA::
MOVEI T2,%AREA'.IX ;[1426] AREA NAME
PUSHJ P,OVFER1 ;[1426] SET UP .TEMP
.ERR. (MS,.EC,V%L,L%F,S%F,O'%AREA,<Error writing area %AREA>)
.ETC. (STR,.EC,,,,,< to file >)
.ETC. (STR,,,,,.TEMP)
POPJ P,
> ;[1426] END PAGOUT
OVF.OU:
OVFOU0: PUSH P,P1 ;[1426] SAVE REGISTER
PUSH P,T2 ;[1426] -1(P): AREA
PUSH P,T1 ;[1401] 0(P): FIRST,,LAST
MOVE P1,TB.CHN(T2) ;[1426] P1:CHANNEL
HRL P1,T2 ;[1426] P1:AREA,,CHANNEL
SKIPN T1,CHAN.JF(P1) ;[1401] JFN?
JRST [POP P,0(P)
POP P,T2 ;[1426] AREA
POP P,P1 ;[1426] RESTORE REGISTER
JRST @TB.OER(T2) ] ;[1426] GIVE THE ERROR
HRRZ T2,0(P) ;[1401] GET UPPER ADDRESS
HLRZ T3,0(P) ;[1412]
CAMG T2,T3 ;[1412]
TLO T2,1 ;[1412] SECTION BOUND CROSSING
MOVE T3,NONZER ;[1412]
LSH T3,9 ;[1412] MAKE IT AN ADDRESS
ADD T2,T3 ;[1412] AND ADD IT IN
MOVSS P1 ;[1426] P1: CHANNEL,,WD
CAMG T2,TAB.HB(P1) ;[1426] BIGGER THAN WHAT WE HAVE?
JRST OVFOU1 ;[1401] NO, CONTINUE.
EXCH T2,TAB.HB(P1) ;[1442] SWAP OLD BOUND FOR NEW
IFN FTFRK2,<
SKIPN T2 ;[1442] IF WE'RE STARTING UP A NON-0 SECTION
SKIPE EXTFLG ;[1442] DON'T WRITE NONEXISTENT SECT-0 PAGES
JRST OVFOU1 ;[1401] NO, UNMAP THE PAGES
;[1401] OTHERWISE WRITE THE PAGES
HLRZ T2,0(P) ;[1401] T2: FIRST ADDR OF DEST
LSH T2,-9 ;[1401] T2: FIRST PAGE OF DEST
HRRZ T3,0(P) ;[1401] T3: LAST ADDR
LSH T3,-9 ;[1401] T3: LAST PAGE
SUB T3,T2 ;[1401] T3: PAGE COUNT
SKIPE T3 ;[1401] ZERO?
AOS T3 ;[1401] NO, INCLUDE ALL PAGES
SKIPE T3 ;[1401] IF NONZERO
IOR T3,[PM%CNT] ;[1401] SET COUNT FLAG
IOR T3,[PM%RWX] ;[1401] SET READ/WRITE/EXEC
HRL T2,T1 ;[1401] T2: JFN,,FIRST PAGE
SKIPGE T2 ;[1412] REALLY A JFN?
ADD T2,NONZER ;[1412] NO, ADD SECTION NUMBER
SKIPE T1,NONZER ;[1426] REMEMBER BASE SECTION
LSH T1,9 ;[1426] CONVERT TO ADDRESS
HLR T1,0(P) ;[1426] LOWER BOUND OF BLOCK
SUB T1,TAB.LW(P1) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T1,TAB.LB(P1) ;[1401] FIX IN CORE
LSH T1,-9 ;[1401] RELOCATE TO REAL PAGE
HRLI T1,.FHSLF ;[1401] T1: SELF,,SOURCE PAGE
SETZM T4 ;[2023] ZERO T4 - USE TO INDICATE FIRST TRY
PMAP ;[1401] OUT THEY GO
ERCAL PMAPER ;[2023] TRY EXPUNGE IF QUOTA EXCEEDED
> ;[1426] IFN FTFRK2
OVFOU1:
HLRZ T2,0(P) ;[1401] T2: FIRST ADDR OF DEST
LSH T2,-9 ;[1401] T2: FIRST PAGE OF DEST
HRRZ T3,0(P) ;[1401] T3: LAST ADDR
LSH T3,-9 ;[1401] T3: LAST PAGE
SUB T3,T2 ;[1401] T3: PAGE COUNT
SKIPGE T3 ;[1426] LAST .LT. FIRST?
ADDI T3,1000 ;[1536] ABSOLUTE DIFFERENCE
JUMPE T3,OVFOU2 ;[1426]
AOS T3 ;[1426] INCLUDE ALL PAGES
IOR T3,[PM%CNT] ;[1426] IN COUNT
OVFOU2: IOR T3,[PM%RD!PM%WR];[1401] SET READ/WRITE
HLR T2,0(P) ;[1450] T2: FIRST ADDR OF SOURCE
SKIPE T1,NONZER ;[1536] REMEMBER BASE SECTION
LSH T1,9 ;[1536] CONVERT TO ADDRESS
HLL T2,T1 ;[1536] AND ADD IN SECTION
SUB T2,TAB.LW(P1) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,TAB.LB(P1) ;[1401] FIX IN CORE
LSH T2,-9 ;[1401] RELOCATE TO REAL PAGE
HRLI T2,.FHSLF ;[1401] T1: SELF,,SOURCE PAGE
SETOM T1 ;[1401] UNMAP
PMAP ;[1401] OUT THEY GO
ERJMP [POP P,0(P)
POP P,T2 ;[1426] AREA
POP P,P1 ;[1426] RESTORE REGISTER
JRST @TB.OER(T2) ] ;[1426] GIVE THE ERROR
POP P,T1 ;[1426] BOUNDS
POP P,T2 ;[1426] AREA
POP P,P1 ;[1426] RESTORE REGISTER
POPJ P, ;[1401] NORMAL RETURN
;This routine expunges the directory if a PMAP fails with a Quota Exceeded
;violation
PMAPER: DMOVEM T1,CRTMP1 ;[2024] Save AC's form PMAP%
MOVEM T3,CRTMP3 ;[2024] in CRTMP1-3
MOVEI T1,.FHSLF ;[2024] This process
GETER% ;[2024] Get last error
ERJMP ERMAP ;[2024]
HRRZS T2 ;[2024] Just the error number
CAIE T2,IOX11 ;[2024] Is it Quota Exceeded error?
JRST ERMAP ;[2024] No - just give error
PUSHJ P,EXPNG ;[2024] Yes - Try expunging the directory
POPJ P, ;[2024] Return to PMAPER caller
ERMAP: POP P,0(P) ;[2024] Throw away ERCAL address
POP P,0(P) ;[2024] Toss arg to OVF.OU
POP P,T2 ;[2024] Area number
POP P,P1 ;[2024] Restore P1
JRST @TB.OER(T2)
EXPNG:: PUSH P,T4
HLRZ T2,CRTMP2 ;[2024] Get the JFN
SETZB T1,T3 ;[2024] No flags - no directory groups
RCDIR% ;[2024] Just get the directory number
ERJMP BADRET
MOVE T2,T3 ;[2024] Directory number to T2
DELDF% ;[2024] Expunge the directory
ERJMP BADRET
SETZ T3, ;[2024] Zero T3
MOVE T1,CRTMP2 ;[2024] Destination to T1
HRRZ T4,CRTMP3 ;[2024] Number of pages attempted
MAPPAG: HRRZ T2,CRTMP2 ;[2024] Starting page of destination
ADD T2,T3 ;[2024] Calculate page to check for
HRR T1,T2 ;[2024] That page to T1
RPACS% ;[2024] Get access bits for that page
ERJMP BADRET ;[2024]
TXNN T2,PA%PEX ;[2024] Does that page exist?
JRST NOPAGE ;[2024] No
AOS T3 ;[2024] Yes - increment count
SOJG T4,MAPPAG ;[2024] Check the next page
JRST BADRET
NOPAGE: DMOVE T1,CRTMP1 ;[2024] Restore PMAP% source and destination
ADD T1,T3 ;[2024] Page number of source to start from
ADD T2,T3 ;[2024] Page number of destination to start at
MOVE T3,CRTMP3 ;[2024] Flag bits for PMAP%
HRR T3,T4 ;[2024] Count of pages left to map
PMAP% ;[2024] Try again
ERJMP BADRET ;[2024] Failed again give up and go home
POP P,T4
POPJ P, ;[2024] Success - pop,pop home and go on
BADRET: POP P,T4
AOS (P) ;[2024] Skip return for failures
POPJ P,
DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS
IFDEF %AREA'.DMP,<
EXP E$$O'%AREA ;[1230] ERROR WITH %AREA FILE
>
IFNDEF %AREA'.DMP,<
EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE
>
>
XALL ;[1230]
TB.OER: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS
SALL ;[1230]
> ;[1401] END IFN TOP20
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 DISK OVERFLOW ROUTINES -- INPUT -- TOPS10
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO INPUT]
; PUSHJ P,LC.IN/HC.IN/LS.IN
;USES T1, T2, T3
IFE TOPS20,<
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>)
>
> ;[1401] END IFE TOPS20
SUBTTL DISK OVERFLOW -- INPUT -- TOPS20
;CALLED BY
; MOVE T1,[FIRST,,LAST ADDRESS TO INPUT]
; PUSHJ P,LC.IN/HC.IN/LS.IN
;USES T1, T2, T3
IFN TOPS20,<
DEFINE PAGIN (%AREA,CHAN,WD,FIXUP)<
%AREA'.IN::
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
HLR T2,LW.LS ;[1536] PICK UP SECTION NUMBER
LSH T2,9 ;[1536] MAKE IT PAGE NUMBER
PUSH P,NONZER ;[1536] SAVE NONZER IF IN USE
MOVEM T2,NONZER ;[1536] SET IT FOR LS.OUT
> ;[1536] IFN FTFRK2
> ;[1536] END IFIDN
MOVEI T2,%AREA'.IX ;[1426] CHANNEL INFO
PUSHJ P,OVF.IN ;[1426] DO THE I/O
IFIDN <%AREA>,<LS>,<
POP P,NONZER ;[1536]
> ;[1536] END IFIDN
IFB <FIXUP>,<
POPJ P, ;[1401] OK
>
IFNB <FIXUP>,<
PJRST %AREA'.FXR ;[1401] DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::
MOVEI T2,%AREA'.IX ;[1426] AREA NAME
PUSHJ P,OVFER1 ;[1426] SET UP .TEMP
.ERR. (MS,.EC,V%L,L%F,S%F,I'%AREA,<Error reading area %AREA>)
.ETC. (STR,.EC,,,,,< from file >)
.ETC. (STR,,,,,.TEMP)
POPJ P,
> ;[1426] END PAGIN
OVF.IN:
OVFIN0: PUSH P,P1 ;[1426] SAVE REGISTER
PUSH P,T2 ;[1426] -1(P): AREA
PUSH P,T1 ;[1401] 0(P): FIRST,,LAST
MOVE P1,TB.CHN(T2) ;[1426] P1:CHANNEL
HRL P1,T2 ;[1426] P1:AREA,,CHANNEL
SKIPN T1,CHAN.JF(P1) ;[1401] JFN?
JRST [POP P,0(P)
POP P,T2 ;[1426] AREA
POP P,P1 ;[1426] RESTORE REGISTER
JRST @TB.IER(T2) ] ;[1426] GIVE THE ERROR
HRRZ T2,0(P) ;[1401] GET LAST ADDRESS
HLRZ T3,0(P) ;[1412]
CAMG T2,T3 ;[1412]
TLO T2,1 ;[1412] SECTION BOUND CROSSING
MOVE T3,NONZER ;[1412]
LSH T3,9 ;[1412] MAKE IT AN ADDRESS
ADD T2,T3 ;[1412] AND ADD IT IN
MOVSS P1 ;[1426] P1: CHANNEL,,WD
CAMLE T2,TAB.HB(P1) ;[1426] BIGGER THAN WHAT WE HAVE?
MOVEM T2,TAB.HB(P1) ;[1426] YES, RESET HIGHEST
IFN FTFRK2,<
PUSHJ P,NEWSCT ;[1450] YES, GET THE NEXT ONE
> ;[1450] IFN FTFRK2
HRLS T1 ;[1401] JFN IN RH
HLRZ T2,0(P) ;[1401] T2: FIRST ADDRESS
LSH T2,-9 ;[1401] IN PAGES, PLEASE
HRR T1,T2 ;[1401] JFN,,FILE PAGE
SKIPGE T1 ;[1412] REALLY A JFN?
ADD T1,NONZER ;[1412] NO, ADD SECTION NUMBER
HRRZ T3,0(P) ;[1401] T3:LAST ADDRESS
AOS T3
LSH T3,-9 ;[1401] IN PAGES
SUB T3,T2 ;[1401] T3:LAST-FIRST
SKIPGE T3 ;[1426] IF LAST .LE. FIRST
ADDI T3,1000 ;[1536] SECTION BOUND WAS CROSSED
SKIPE T3 ;[1401] IF NONZERO,
IOR T3,[PM%CNT] ;[1401] SET COUNT BIT
IOR T3,[PM%RD!PM%WR];[1401] SET ACCESS
SKIPE T2,NONZER ;[1426] REMEMBER BASE SECTION
LSH T2,9 ;[1426] CONVERT TO ADDRESS
HLR T2,0(P) ;[1426] LOWER BOUND OF BOCK
SUB T2,TAB.LW(P1) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,TAB.LB(P1) ;[1401] FIX IN CORE
LSH T2,-9 ;[1401] IN PAGES
HRLI T2,.FHSLF ;[1401] PROCESS IS SELF
PMAP ;[1401] MAP THESE PAGES
ERJMP [POP P,0(P)
POP P,T2 ;[1426] AREA
POP P,P1 ;[1426] RESTORE REGISTER
JRST @TB.IER(T2) ] ;[1426] GIVE THE ERROR
POP P,T1 ;[1401] CLEAN UP STACK
POP P,T2
POP P,P1
POPJ P, ;[1426] AND RETURN
IFN FTFRK2,<
NEWSCT:
SKIPE TAB.HB(P1) ;[1450] DON'T DO ANYTHING FIRST TIME
SKIPN EXTFLG ;[1450] ANY NONZERO SECTIONS SEEN?
POPJ P, ;[1450] NO, DO NOTHING
PUSH P,T1 ;[1450] SAVE THE TEMPS
PUSH P,T2
PUSH P,T3
PUSH P,P1 ;[1450] AND OTHER REGISTERS
MOVE T2,NONZER ;[1450] PICK UP SECTION
LSH T2,-9 ;[1450] AS SECT NUMBER
MOVNS T2 ;[1450]
HRLZI T1,400000 ;[1450] SET B0
LSH T1,1(T2) ;[1450] B(N)=SECT(N-1)
MOVE T3,FXSPTR ;[1450]
TDNE T1,(T3) ;[1450] THIS BIT SET IN ARRAY MAP WORD?
JRST NEWSC1 ;[1450] YES, THE SECTION'S THERE ALREADY
IORM T1,(T3) ;[1450] NO, SAY IT'S THERE
HLRZ T1,FXSPTR ;[1450] IS IT BEYOND THE CURRENT ALLOCATON?
MOVNS T2 ;[1450] POSITIVE AGAIN
CAMG T2,T1 ;[1450]
JRST NEWSC0 ;[1450] NO, NO NEED TO REALLOCATE ARRAY
MOVEI T2,1(T2) ;[1450] YES, ASK FOR ANOTHER BLOCK
PUSHJ P,DY.GET ;[1450]
; ON GETTING HERE, COPY THE OLD BLOCK TO THE NEW ONE, UPDATE FXSPTR, AND
; FREE UP THE OLD BLOCK.
MOVE T3,FXSPTR ;[1450] SAVE OLD BLOCK PTR
HRRM T1,FXSPTR ;[1450] UPDATE BLOCK PTR
SUBI T2,1 ;[1450] COUNT IS ONE LESS THAN ARRAYSIZE
HRLM T2,FXSPTR ;[1450]
HRL T1,T3 ;[1450] CONSTRUCT BLT PTR
HLRZ T2,T3 ;[1450] GET OLD COUNT
ADDI T2,(T1) ;[1771] AND END POINT
BLT T1,(T2) ;[1450] COPY OLD TO NEW
HRRZ T1,T3 ;[1450] FREE OLD BLOCK
HLRZ T2,T3 ;[1450]
AOS T2 ;[1771] MAKE COUNT CORRECT FOR CALL
PUSHJ P,DY.RET ;[1450]
NEWSC0: MOVE P1,NONZER ;[1450] PICK UP SECTION
LSH P1,-9 ;[1450] AS SECT NUMBER
PUSHJ P,E$$CRS ;[1450] SAY WE'RE CREATING THE SECTION
SETZM T1 ;[1450] CREATE THE SECTION
HRRZ T2,P1 ;[1450] SPECIFY WHICH
TLO T2,PRGFRK ;[1450] AND WHERE
MOVE T3,[PM%CNT!PM%RWX!PM%IND!1]
SMAP
ERJMP E$$MEF
NEWSC1:
POP P,P1 ;[1450] RESTORE REGS
POP P,T3
POP P,T2
POP P,T1
POPJ P, ;[1450] AND RETURN
> ;[1450] IFN FTFRK2
OVFER1:
MOVE T2,TB.CHN(T2) ;[1426] FETCH CHANNEL FOR AREA
MOVE T2,CHAN.JF(T2) ;[1401] AND PICK UP JFN
HRROI T1,.TEMP ;[1401] PUT THE STRING IN .TEMP
SETZM T3 ;[1401] NOTHING FANCY
SETZM T4
JFNS
POPJ P, ;[1426] NAME IN .TEMP
> ;[1401]END IFN TOPS20
DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS
IFDEF %AREA'.DMP,<
EXP E$$I'%AREA ;[1230] ERROR WITH %AREA FILE
>
IFNDEF %AREA'.DMP,<
EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE
>
>
XALL ;[1230]
TB.IER: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS
SALL ;[1230]
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 TABLES USED BY ??.DMP, INDEXED BY ??.IX
DEFINE XXX(%AREA)< ;;[1230] DEFINE TEMP FILE NAMES
IFDEF %AREA'.DMP,<
EXP 'L'%AREA'' ;[1230] FOR nnn'%AREA'.TMP
>
IFNDEF %AREA'.DMP,<
EXP 0 ;[1230] %AREA AREA DOES NOT PAGE
>
>
XALL ;[1230]
TB.NAM: AREAS ;[1230] GENERATE TEMP FILE NAMES
SALL ;[1230]
TB.CHN: EXP 0 ;[1230] DY AREA DOES NOT PAGE
XWD 0,LC ;[1230] LC AREA CHANNELS
XWD 0,HC ;[1230] HC AREA CHANNELS
XWD %SC,AC ;[1230] AS AREA CHANNELS
EXP 0 ;[1230] RT AREA DOES NOT PAGE
XWD %SC,SC ;[1230] LS AREA CHANNELS
EXP 0 ;[1230] FX AREA DOES NOT PAGE
EXP 0 ;[1230] BG AREA DOES NOT PAGE
EXP 0 ;[1230] GS AREA DOES NOT PAGE
DEFINE XXX(%AREA)< ;;[1230] DEFINE PAGING MESSAGE ADDRS
IFDEF %AREA'.DMP,<
EXP E$$P'%AREA ;[1230] PAGING AREA %AREA
>
IFNDEF %AREA'.DMP,<
EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE
>
>
XALL ;[1230]
TB.PAG: AREAS ;[1230] GENERATE PAGING MESSAGE ADDRS
SALL ;[1230]
E$$PLC::.ERR. (MS,0,V%L,L%I,S%I,PLC,<Area LC overflowing to disk>) ;[1230]
POPJ P, ;[1230] RETURN
E$$PHC::.ERR. (MS,0,V%L,L%I,S%I,PHC,<Area HC overflowing to disk>) ;[1230]
POPJ P, ;[1230] RETURN
E$$PLS::.ERR. (MS,0,V%L,L%I,S%I,PLS,<Area LS overflowing to disk>) ;[1230]
POPJ P, ;[1230] RETURN
E$$PAS::.ERR. (MS,0,V%L,L%I,S%I,PAS,<Area AS overflowing to disk>) ;[1230]
POPJ P, ;[1230] RETURN
IFN FTFRK2,<
E$$CRS::
.ERR. (MS,.EC,V%L,L%I,S%I,CRS,<Creating section >) ;[1450]
.ETC. (OCT,.EP,,,,P1) ;[1450]
POPJ P, ;[1450] RETURN
> ;[1450] IFN FTFRK2
DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS
IFDEF %AREA'.DMP,<
EXP E$$E'%AREA ;[1230] ERROR WITH %AREA FILE
>
IFNDEF %AREA'.DMP,<
EXP [HALT] ;[1230] %AREA AREA DOES NOT PAGE
>
>
XALL ;[1230]
TB.ERR: AREAS ;[1230] GENERATE ERROR MESSAGE ADDRS
SALL ;[1230]
E$$ELC::
IFE TOPS20,<
PUSH P,[LC] ;[1230] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
; MOVE T2,LC.JF ;[1401] PICK UP LC JFN
; HRROI T1,.TEMP ;[1401] PUT THE STRING IN .TEMP
; SETZM T3 ;[1401] NOTHING FANCY
; SETZM T4
; JFNS
MOVE T2,LC.IX ;[1511] PUT INDEX IN IO.CHN
MOVEM T2,IO.CHN## ;[1511] TO HAVE DVTXT1 FETCH FILENAME
MOVEI T1,.TEMP ;[1511] INTO .TEMP
PUSHJ P,DVTXT1 ;[1511]
.ERR. (MS,.EC,V%L,L%F,S%F,ELC,<Error creating area LC overflow file >)
.ETC. (STR,,,,,.TEMP)
> ;[1401] IFN TOPS20
POPJ P,
E$$EHC::
IFE TOPS20,<
PUSH P,[HC] ;[1230] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
; MOVE T2,HC.JF ;[1401] PICK UP HC JFN
; HRROI T1,.TEMP ;[1401] PUT THE STRING IN .TEMP
; SETZM T3 ;[1401] NOTHING FANCY
; SETZM T4
; JFNS
MOVE T2,HC.IX ;[1511] PUT INDEX IN IO.CHN
MOVEM T2,IO.CHN## ;[1511]
MOVEI T1,.TEMP ;[1511] SO DVTXT1 CAN RETURN A FILENAME
PUSHJ P,DVTXT1 ;[1511]
.ERR. (MS,.EC,V%L,L%F,S%F,EHC,<Error creating area HC overflow file >)
.ETC. (STR,,,,,.TEMP)
> ;[1401] IFN TOPS20
POPJ P,
E$$ELS::
IFE TOPS20,<
PUSH P,[SC] ;[1230] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
; MOVE T2,SC.JF ;[1401] PICK UP LS JFN
; HRROI T1,.TEMP ;[1401] PUT THE STRING IN .TEMP
; SETZM T3 ;[1401] NOTHING FANCY
; SETZM T4
; JFNS
MOVE T2,LS.IX ;[1511]
MOVEM T2,IO.CHN## ;[1511]
MOVEI T1,.TEMP ;[1511]
PUSHJ P,DVTXT1## ;[1511]
.ERR. (MS,.EC,V%L,L%F,S%F,ELS,<Error creating area LS overflow file >)
.ETC. (STR,,,,,.TEMP)
> ;[1401] IFN TOPS20
POPJ P,
E$$EAS::
IFE TOPS20,<
PUSH P,[AC] ;[1230] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[1230]
> ;[1401] IFE TOPS20
IFN TOPS20,<
MOVE T2,AS.IX ;[1511] PUT INDEX IN IO.CHN
MOVEM T2,IO.CHN## ;[1511]
MOVEI T1,.TEMP ;[1511] PUT THE FILENAME IN .TEMP
PUSHJ P,DVTXT1## ;[1511]
.ERR. (MS,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>)
.ETC. (STR,,,,,.TEMP)
> ;[1511] IFN TOPS20
POPJ P, ;[1511] RETURN
SUBTTL DUMP LOCAL SYMBOL AREAS (LS AND AS) WHEN MEMORY IS FULL
LS.DMP::SPUSH <R,P1> ;[1230] SAVE SOME ACS
MOVX R,LS.IX ;[1230] SET UP LS AREA INDEX
PUSHJ P,LA.DMP ;[1230] COMMON CODE TO SET UP FILE
JRST LARET ;[1230] DIDN'T NEED TO OVERFLOW--RETURN
MOVE P1,TAB.AB(R) ;[1230] SIZE OF LS AREA
SUB P1,TAB.LB(R) ;[1230] ALMOST ANYWAY
IFE TOPS20,<
SUBI P1,.IPS ;[1230] HIGHEST TO OUTPUT
> ;[1401]
MOVE T1,P1 ;[1230]
PUSHJ P,@TB.OUT(R) ;[1230] GENERAL OUTPUT ROUTINE
MOVE T1,P1 ;[1230] HIGHEST REL ADDRESS TO GIVE AWAY
IFN TOPS20,<
SUBI P1,.IPS ;[1401] KEEP ONE PAGE
ADDI P1,1 ;[1401] LOWEST TO KEEP
MOVEM P1,LW.S0(R) ;[1401] WILL BECOME WINDOW LOWER LIMIT
HRL T1,P1 ;[1401] BRING IT BACK
PUSHJ P,@TB.IN(R) ;[1401] ...
MOVE T1,TAB.AB(R) ;[1401] RESET ALLOCATION POINTER
SUBM T1,TAB.PT(R) ;[1401] ...
MOVE T1,TAB.LB(R) ;[1401] PICK UP LOWERBOUND
ADDI T1,.IPS-1 ;[1401] RESET TAB.AB(R) TO NEW LIMITS
MOVEM T1,TAB.AB(R)
SUBM T1,TAB.PT(R) ;[1401] RESET LS.PT
MOVE T1,P1 ;[1401]
> ;[1401] IFN TOPS20
ADD T1,TAB.LB(R) ;[1230] ADD IN OFFSET
IFE TOPS20,<
ADDI P1,1 ;[1230] LOWEST TO KEEP FOR GBCK.L
> ;[1401] IFE TOPS20
JRST LARET1 ;[1230] GIVE BACK FREED MEM AND RETURN
AS.DMP::SPUSH <R,P1> ;[1230] SAVE SOME ACS
MOVX R,AS.IX ;[1230] SET UP AS AREA INDEX
PUSHJ P,LA.DMP ;[1230] COMMON CODE TO SET UP FILE
JRST LARET ;[1230] DIDN'T NEED TO OVERFLOW--RETURN
MOVE P1,TAB.PT(R) ;[1230] FIGURE SIZE OF AS AREA
SUB P1,TAB.LB(R) ;[1230] NOT COUNTING THAT ABOVE PT
ANDCMI P1,.IPM ;[1230] FIND EXTRANEOUS BLOCKS
MOVE T1,P1 ;[1230] COPY
SUBI T1,1 ;[1230] GET ADDR OF LAST TO OUTPUT
PUSHJ P,@TB.OUT(R) ;[1230] WRITE OUT THE DATA
MOVE T1,TAB.PT(R) ;[1230] GET FIRST PHYS PAGE TO KEEP
ANDCMI T1,.IPM ;[1230] POINT TO 1ST WORD IN PAGE
SUBI T1,1 ;[1230] WORD BEFORE IS HIGHEST TO RETURN
; JRST LARET1 ;[1230] FALL INTO IT
LARET1:
SETOM TAB.UW(R) ;[1230] SIGNAL PAGING BUT NO UPPER LIMIT
IFE TOPS20,<
MOVEM P1,TAB.LW(R) ;[1230] FIX WINDOW LOWER LIMIT
PUSHJ P,GBCK.L ;[1230] GIVE IT AWAY
> ;[1401]
PUSHJ P,GETIOM ;[1230] USE SOME OF NEW AREA FOR IO.EMG
AOS -2(P) ;[1230] INDICATE SKIP RETURN
LARET: SPOP <P1,R> ;[1230] COMMON RETURN--RESTORE ACS
POPJ P, ;[1230] DONE
LA.DMP::MOVE T1,TAB.AB(R) ;[1230] COMPUTE SIZE OF LS AREA
SUB T1,TAB.LB(R) ;[1230] ..
ANDCMI T1,.IPM ;[1230] BUT NOT LAST PAGE
JUMPE T1,CPOPJ ;[1230] IF 1P, DON'T BOTHER
PUSHJ P,@TB.PAG(R) ;[1230] GIVE OVERFLOW MESSAGE
MOVE T1,IO.EMG ;[1230] ALLOCATE EMERG. AREA
HRRZ T2,TB.CHN(R) ;[1230] FOR PROPER CHANNEL
MOVEM T1,IO.PTR(T2) ;[1230] ..
SETZM IO.EMG ;[1230] NOT FREE NOW (RESET LATER)
MOVEI T2,.IODPR ;[1230] USE DUMP RECORDS MODE
MOVEM T2,I.MOD(T1) ;[1230] ..
MOVEI T2,LN.RIB-1 ;[1230] SIZE OF EXTENDED ENTER BLOCK
MOVEM T2,I.RIB(T1) ;[1230] ..
MOVE T2,JOBNUM ;[1230] BUILD nnnL?? FILE NAME
HRR T2,TB.NAM(R) ;[1230] ..
MOVEM T2,I.NAM(T1) ;[1230] ..
MOVSI T2,'TMP' ;[1230] BUILD EXTENSION TOO
MOVEM T2,I.EXT(T1) ;[1230] ..
SETZM I.PRV(T1) ;[1230] STANDARD PROTECTION
MOVE T2,TAB.AB(R) ;[1230] GET LENGTH OF AREA
SUB T2,TAB.LB(R) ;[1230] ..
LSH T2,-<.DBS2W-1> ;[1230] ASSUME THIS IS HALF OF IT
MOVEM T2,I.EST(T1) ;[1230] AS GOOD A GUESS AS ANY OTHER
SKIPLE T2,SYMFRM ;[1230] USER REQUESTING A SYMBOL FILE?
CAME T2,[EXP $SYMALGOL,0,$SYMTRIPLET]-AS.IX(R) ;[1230] ..
JRST LADMP1 ;[1230] NO--JUST OVERFLOW TO DSK:[-]
HLRZ T1,TB.CHN(R) ;[1230] WRITING A SYMBOL FILE--TRY TO
HRRZ T2,TB.CHN(R) ;[1230] WRITE OVERFLOW FILE THERE
PUSHJ P,DVSUP.## ;[1230] ..
PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE
JRST CPOPJ1 ;[1230] DONE
LADMP1: MOVX T2,'DSK ' ;[1230] WRITE OVERFLOW FILE TO DSK:[-]
MOVEM T2,I.DEV(T1) ;[1230] ..
SETZM I.RIB+.RBPPN(T1) ;[1230] ..
HRRZ T1,TB.CHN(R) ;[1230] OVERFLOW AREA ON PROPER CHANNEL
PUSHJ P,DVUPD.## ;[1230] ..
PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE
JRST CPOPJ1 ;[1230] DONE
SUBTTL DUMP LOW/HIGH SEG DATA WHEN CORE IS FULL
;HERE FOR LOW SEG
LC.DMP::PUSH P,R ;[1230] SAVE R
MOVEI R,LC.IX ;INDEX FOR LOW
JRST LH.DMP ;GO DUMP IT
;HERE FOR HIGH SEG
HC.DMP::PUSH P,R ;[1230] SET UP INDEX FOR HC AREA
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:
IFE FTFRK2,<
PUSHJ P,@TB.PAG(R) ;[1230] PRINT OVERFLOW MESSAGE
> ;[1450] IFE FTFRK2
IFN TOPS20&FTFRK2,<
SKIPN EXTFLG ;[1442] DOING A NONZERO SECTION?
JRST LHDMP1 ;[1412] NO, OVERFLOW TO DISK
PUSH P,P1 ;[1450] SAVE A REGISTER
MOVE P1,NONZER ;[1450] PASS SECTION INFO
LSH P1,-9 ;[1450] AS A SECT NUMBER
PUSHJ P,E$$CRS ;[1450]
POP P,P1 ;[1450] RESTORE REGISTER
SETZM T1 ;[1412] CREATE THE SECTION
MOVE T2,NONZER ;[1412] PICK UP SECTION NUMBER
LSH T2,-9 ;[1412] REMOVE PAGE INFO
TLO T2,PRGFRK ;[1450]
MOVE T3,[PM%CNT!PM%RWX!PM%IND!1]
;[1412] CREATE ONE SECTION...
SMAP ;[1412]
ERJMP E$$MEF ;[1412] NOGOOD
HLRZM T2,@TB.JFD(R) ;[1412] FAKE UP JFN
MOVEI T2,4 ;[1442] GET AN ARG BLOCK
PUSHJ P,DY.GET ;[1442]
PUSH P,AP ;[1450] DON'T LOSE CURRENT CONTENTS
MOVE AP,T1 ;[1442] SET ARG PTR
MOVEI T2,LC.IX ;[1442] LOWSEG
CAME T2,R ;[1442] IT IS LOWSEG, RIGHT?
JRST E$$NHN## ;[1442] NO HIGHSEG IN NONZERO SECTIONS
MOVEI T2,LC.JF ;[1442]
MOVEM T2,WNAM(AP) ;[1442] LC AREA
MOVE T1,NONZER ;[1442] SECT,,0
;[1450] LSH T1,-9 ;[1442] AS PAGES
MOVEM T1,WSRC(AP) ;[1442] PAGE IN PROGRAM FORK
MOVE T1,TAB.LB(R) ;[1442] PAGE IN LINK
MOVE T2,TAB.AB(R) ;[1442] CALC SIZE OF AREA
SUB T2,T1 ;[1442]
AOS T2 ;[1442]
LSH T2,-9 ;[1442] IN PAGES, PLEASE
MOVEM T2,WSIZ(AP) ;[1442]
LSH T1,-9 ;[1442] AS A PAGE
MOVEM T1,WDST(AP) ;[1442]
PUSHJ P,CRTFRK ;[1442] SETUP
JRST E$$MEF ;[1442] COULDN'T DO IT
MOVE T1,NONZER ;[1450] CALC SECT NUMBER
LSH T1,-9 ;[1450]
HRLM T1,FXSPTR ;[1450] SIZE OF SECT FIXUP ARRAY
MOVEI T2,1(T1) ;[1450] ASK FOR STORAGE
PUSHJ P,DY.GET ;[1450]
HRRM T1,FXSPTR ;[1450] SET POINTER TO ARRAY
MOVNI T2,-1(T2) ;[1450] PICK UP SECTION
HRLZI T1,400000 ;[1450] SET B0
LSH T1,1(T2) ;[1450] B(N)=SECT(N-1)
MOVE T2,FXSPTR ;[1450]
MOVEM T1,(T2) ;[1450] SET THIS BIT
POP P,AP ;[1450]
POP P,R ;[1442] FIX STACK, RESTORE R
POPJ P, ;[1442] AND EXIT
> ;[1442]IFN TOPS20&FTFRK2
LHDMP1:
IFN FTFRK2,<
PUSHJ P,@TB.PAG(R) ;[1230] PRINT OVERFLOW MESSAGE
> ;[1450] IFN FTFRK2
MOVE T1,IO.EMG ;[604] GET TEMP SPACE
HRRZ T2,TB.CHN(R) ;[1230] FOR PROPER CHANNEL
MOVEM T1,IO.PTR(T2) ;[1230] ..
SETZM IO.EMG ;NOT FREE NOW (RESET LATER)
MOVSI T2,'DSK' ;[1230] PUT OVERFLOW FILE ON DSK:[-]
MOVEM T2,I.DEV(T1) ;[1230] ..
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,TB.NAM(R) ;[1230] ..
MOVEM T2,I.NAM(T1) ;TO FORM TEMP NAME
MOVSI T2,'TMP'
MOVEM T2,I.EXT(T1)
SETZM I.PRV(T1) ;[1230] STANDARD PROTECTION
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?
HRRZ T1,TB.CHN(R) ;[1230] GET CHANNEL FOR OVERFLOW FILE
PUSHJ P,DVUPD.## ;UPDATE MODE
PUSHJ P,@TB.ERR(R) ;[1230] CAN'T--GO PRINT ERROR AND DIE
;NOW FOR OUTPUT, SETUP IOWD FOR DATA TO BE OUTPUT
;AND GET RID OF AREA
LHDMP2:
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
IFN TOPS20,<
SKIPE T1 ;IF SEG IS ONLY 1 BLOCK
JRST LHSET0
TROA T1,.IPM ;OUTPUT IT TO MARK PAGING
HRRZI T1,-1(T1) ;UPPER WINDOW OF WHATS OUTPUT
SKIPA ;[1401]
LHSET0: MOVE T1,UW.S0(R) ;[1401] OUTPUT ALL OF IT
PUSHJ P,@[EXP LC.OUT,HC.OUT]-1(R)
POP P,T1 ;[1401] RECOVER LOWEST ADDRESS NOT OUTPUT
SKIPN T1 ;[1401] IF BASE STILL 0
MOVEI T1,.IPS-1 ;[1401] SEGMENT IS 1 PAGE LONG
MOVEM T1,LW.S0(R) ;[1401] SET IT
MOVNS T1 ;[1525] ADJUST THE POINTER
ADDM T1,TAB.PT(R) ;[1525] BY THE NEW OFFSET
MOVE T1,UW.S0(R) ;[1401] CALC LENGTH OF WINDOW
SUB T1,LW.S0(R) ;[1401] ...
ADD T1,TAB.LB(R) ;[1401] BOTTOM IN REAL CORE
MOVEM T1,TAB.AB(R) ;[1401] TOP IN REAL CORE
HRL T1,LW.S0(R) ;[1401] GET PART OF IT BACK
HRR T1,UW.S0(R) ;[1401] ...
PUSHJ P,@[EXP LC.IN,HC.IN]-1(R)
> ;[1755] IFN TOPS20
IFE TOPS20,<
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,LHSET1 ;[1751] 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
> ;[1755] IFE TOPS20
LHSET1: 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
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::
MOVE T1,LW.LS ;[1536] MORE THAN A SECTION?
TLNN T1,-1 ;[1536] DON'T DO FIXUPS, WON'T HELP
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
IFE TOPS20,<
JUMPE T1,CPOPJ ;NO FIXUPS DONE
TLZ T1,.IPM ;MAKE INTO TRUE OUTPUT PTR
IORI T1,.IPM
PJRST LS.OUT ;OUTPUT AND RET
> ;[1401] IFE TOPS20
IFN TOPS20,<
POPJ P, ;[1401] RETURN
> ;[1401] IFN TOPS20
;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 SPECIAL FORK STUFF
IFN FTFRK2,<
CRTFRK::
; Routine CRTFRK.
; Expects an argument block address in register 16
; having the format
; virtual page in area
; real page in LINK's lowseg
; size of area in pages
; where to put the new fork handle
;
; ** Should we ever want a multifork loader, here is where the
; CFORK goes...***
MOVEI T1,PRGFRK ;[1450]
MOVEM T1,@WNAM(AP) ; tell the forkname
HRLS T1 ; set up mapping
HRR T1,WSRC(AP) ; T1: source page
DMOVE T2,WDST(AP) ; T2: destination page
HRLI T2,.FHSLF ; T3: area size
TXO T3,PM%CNT!PM%RWX
PMAP ; set up mapping
ERJMP CRTFR0 ; error, noskip return
MOVE T1,WNAM(AP) ; What area is being set up?
SETZM T2
CAME T1,TB.JFD(T2) ; find out whose jfn
AOJA T2,.-1 ; try again
HRRZS T3 ; Get a page count
LSH T3,9 ; Make a word count
SOS T3
HRRZ T1,WSRC(AP) ;[1450] Add to base
LSH T1,9
ADD T3,T1
MOVEM T3,TAB.UW(T2) ; Window bound set up
AOS (P) ; skip return, all ok
CRTFR0: POPJ P,
> ;[1426] IFN FTFRK2
SUBTTL THE END
CORLIT: END