Trailing-Edge
-
PDP-10 Archives
-
BB-BT99U-BB_1990
-
10,7/link/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/JBS/RJF 7-SEP-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,<
SEARCH MONSYM
> ;[1401] IFN TOPS20
SALL
ENTRY LNKCOR
EXTERN LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2422 ;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.
;1275 Fix core management bug when expanding a zero length area with PAGE.
;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.
;1542 Do not add section number to addresses twice at LDCR6C, LDCOR7.
;1543 Avoid using EXTFLG when calling LS.OUT or NEWSCT.
;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.
;2044 Always removed mapped area in XX.INI under TOPS-20
;2051 Don't ask for SPR if DSK: can't be written to for .TMP files
;Start of Version 6
;2200 Use 30 bit addresses for symbol table fixups.
;2202 Use T1 and T2 as arguments for xx.IN and xx.OUT, fix some PMAPs.
;2213 Fix off by one when testing/setting FXSBIT.
;2214 Add 30 bit symbol fixups.
;2215 Performance improvements for GBCK.L, fix wrong AC bug in 2202.
;2235 Give error if overlay in non-zero section.
;2242 Make NEWSCT global so it can be called from LNKLOD.
;2247 Load program in an inferior fork.
;2254 Remove fail block fixup, update title and seg fixups for 30 bits.
;2255 Remove code which prevents fixups to nonzero LS sections.
;2264 Add module name to LNKCCS, add JSYS errors to LNKIxx and LNKOxx.
;2270 Add pagable TP area for argument typechecking.
;2300 Remove FTFORK code.
;2301 Fix up native TOPS-20 error messages.
;2302 Fix off-by-one in LC.IN/LC.OUT.
;2321 Use halfword LL.S2, left half is non-zero if /SEG:LOW or /REDIRECT.
;2330 Add TOPS-10 versions of xx.IN and xx.OUT.
;2365 Preserve t4 across call to NEWSCT
;2366 Implement sparse paging on TOPS-10.
;2374 Change TP.PT to new global TPPTR.
;2403 New coprorate Copywrite statement
;2417 Update Copywrite statement to 1988.
;2422 TP.DMP never could work correctly. Make it do so.
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 TAB.PG(P1) ;[2202] IS THIS AREA PAGED?
JRST LCR1.5 ;[1401] NO, NOTHING SPECIAL
MOVE T1,TAB.AB(P1) ;[2202] GET THE CURRENT BOUND
SUB T1,TAB.LB(P1) ;[2202] CURRENT SIZE
ADD T1,TAB.LW(P1) ;[2202] GET THE UPPER BOUND
ADDM P2,TAB.AB(P1) ;[2202] FIX ACTUAL BOUND TO REFLECT INCREASE
ADDM P2,TAB.FR(P1) ;[2202] AND FREE SPACE COUNTER
SKIPL TAB.UW(P1) ;[2202] ACTUAL UPPER WINDOW BOUND?
ADDM P2,TAB.UW(P1) ;[2202] YES, UPDATE IT TOO
MOVE T2,T1 ;[2202] GET THE UPPER BOUND
ADDI T1,1 ;[2202] GET THE LOWER BOUND OF THE INCREASE
ADD T2,P2 ;[2202] NEW UPPER BOUND
PUSHJ P,@TB.IN(P1) ;[2202] MAP IN THE PAGES
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
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 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
AOJE T3,LDCR6E ;[2202] INCLUDE ALL PAGES (DON'T WRITE IF NONE)
TXO T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
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!
ERCAL [POP P,T2 ;[2202] ERROR -- GET THE INDEX
JRST @TB.OER(T2)] ;[2202] TELL THE USER WHAT FAILED
LDCR6E: HRRZ T2,0(P) ;[1401] GET INDEX BACK
PUSH P,T3 ;[1401] SET ASIDE BITS AND COUNT
SKIPN T3,@TB.JFD(T2) ;[1401] PICK UP THE JFN
PUSHJ P,E$$MMF ;[2270] NO JFN - GIVE UP
MOVE T1,TAB.LW(T2) ;[1401] NOTE ADDRESS IN OVF FILE
CAIE T2,HC.IX ;[2321] HIGH SEGMENT?
JRST LDCR6L ;[2321] NO, LOW SEGMENT
ADD T1,LL.S2 ;[2247] YES, ADD OFFSET INTO FILE
HRRZS T1 ;[2321] ALWAYS IN SECTION ZERO
LDCR6L: LSH T1,-9 ;[2321] MAKE IT PAGES
HRL T1,T3 ;[1401] JFN,,FILEPAGE
POP P,T3 ;[1401] PUT COUNT BACK
JUMPE T3,LDCR6F ;[2202] DON'T READ IF AREA EMPTY
MOVE T2,TAB.NB(T2) ;[1401] FETCH DESTINATION
LSH T2,-9 ;[1401] IN PAGES, PLEASE
HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF
PMAP%
ERCAL [POP P,T2 ;[2202] ERROR -- GET THE INDEX
JRST @TB.IER(T2)] ;[2202] TELL THE USER WHAT FAILED
LDCR6F: POP P,T2 ;[2247] PUT THE INDEX BACK
PUSHJ P,ADJTBL ;[2247] 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
AOJE T3,LDCR7C ;[2202] WELL, ALMOST (DON'T DO IT IF NO AREA)
LSH T3,-9 ;[1401] LENGTH IN PAGES
TXO T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
SETOM T1 ;[1401] T1 GETS -1 -- UNMAP, PLEASE
PMAP% ;[1401] OUT THEY GO!
ERCAL @TB.OER(P1) ;[2202] ERROR -- RETIRE
LDCR7C: MOVE T1,TAB.LW(P1) ;[1401] NOW GET THEM BACK
CAIE P1,HC.IX ;[2321] HIGH SEGMENT?
JRST LDCR7S ;[2321] NO, LOW SEGMENT
HRRZ T2,LL.S2 ;[2321] YES, GET OFFSET INTO FILE
ADD T1,T2 ;[2321] ADD IT
LDCR7S: LSH T1,-9 ;[2321] FILEPAGE
HRL T1,@TB.JFD(P1) ;[1401] FILEJFN
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
JUMPE T3,LDCR7D ;[2202] DON'T READ IF NO AREA
LSH T2,-9 ;[1401] IN PAGES, PLEASE
HRLI T2,.FHSLF ;[1401] PROCESS IS OURSELF
PMAP%
ERCAL @TB.IER(P1) ;[2202] ERROR -- RETIRE
LDCR7D: 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
JUMPE P2,MOVPG4 ;[1275] DON'T MOVE IF AREA CONTAINS NO PAGES
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
MOVPG4: SPOP <P3,P2,P1> ;[1275] 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>
IFIDN <AREA><TP>,< ;[2270]
SKIPN AREA'.LB ;[2270] ALREADY SETUP?
PUSHJ P,AREA'.INI ;[2270] 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>
IFIDN <%AREA><TP>,< ;[2270]
SKIPN %AREA'.LB ;[2270] ALREADY SETUP?
PUSHJ P,%AREA'.INI ;[2270] 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
SKIPE TAB.UW(P1) ;[2270] AREA PAGING?
POPJ P, ;[2270] YES, JUST LEAVE (TYPECHECKING)
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
TP.INI: PUSH P,T2 ;[2270] SAVE T2
PUSHJ P,XX.INI ;[2270] GENERAL ROUTINE
POP P,T2 ;[2270] RESTORE T2
POPJ P, ;[2270] 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: ;[2044]
IFE TOPS20,< ;[2044]
SKIPGE UW.LS ;TEST FOR -1
POPJ P, ;JUST RETURN
>;[2044] END IFE TOPS20
IFN TOPS20,< ;[2044]
SKIPL UW.LS ;[2044] Test for -1
>;[2044] END IFN TOPS20
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,<
ADDI T1,1 ;[2044] Need page above top of area
LSH T1,-9 ;GET PAGE
TLO T1,.FHSLF
MOVE T2,T1
SETOM T1
SETZM T3
PMAP% ;UNMAP THIS FROM THE WINDOW
ERCAL E$$OLS ;[2202] ERROR -- RETIRE
> ;[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?
CAIN P1,TP.IX ;[2270]
CAIA ;[2270] NO, DON'T ALLOCATE IT
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
AOJE T3,XXZAP1 ;[2202] NO, INCLUDE ALL PAGES
TXO T3,<PM%CNT> ;[2202] 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
XXZAP1: ;[2202]
> ;[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
MOVEM T1,TAB.LB(T2) ;[2215] UPDATE NEW LOWER BOUND
POP P,T1 ;[2215] GET UPPER ADDRESS TO CLEAR
IFN TOPS20,< ;[2215] ALWAYS BLT ON TOPS-10
CAIG T1,T3 ;[2215] ANYTHING TO CLEAR?
JRST GBCKL3 ;[2215] NO
> ;[2215] IFN TOPS20
SETZM (T3) ;ZERO FIRST ADDRESS
HRL T3,T3
ADDI T3,1 ;FORM BLT PTR
BLT T3,@T1 ;CLEAR ALL OF CORE
GBCKL3: 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 T2,AS.PT ;[2202] GET ABS POINTER TO FIRST FREE
SUB T2,AS.LB ;[2202] SUBTRACT FIRST USED
ANDCMI T2,.IPM ;[2202] FIND HOW MANY WORDS WE CAN OUTPUT
JUMPE T2,LSCOVF ;[2202] IF NONE, TRY LS AREA
ADD T2,LW.AS ;[2202] CONVERT TO NEW LW.AS
PUSH P,T2 ;[2202] SAVE THE NEW LOW VIRTUAL ADDRESS
SUBI T2,1 ;[2202] FIND HIGHEST ADDR TO OUTPUT
MOVE T1,LW.AS ;[2202] 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
IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA
HRLI T1,1 ;[2215] SINCE AS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
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 T2,LS.AB ;[2202] SEE IF ITS WORTH IT
SUB T2,LS.LB ;[2202] GET THE SIZE
ANDCMI T2,.IPM ;[2202] BUT NOT INCLUDING LAST BLOCK
JUMPE T2,LHCOVF ;[2202] NOTHING TO DO, TRY CORE OVERFLOW
MOVE T2,LSYM ;[2202] HIGHEST
ANDCMI T2,.IPM ;[2202] EXCEPT FOR LAST BLOCK
PUSH P,T2 ;[2202] SAVE AS IT WILL BE LOWEST AFTER OUTPUT
SUBI T2,1 ;[2202] HIGHEST IS ONE LESS
MOVE T1,LW.LS ;[2202] 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
IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA
HRLI T1,1 ;[2215] SINCE LS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
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
IFE TOPS20,< ;[2247]
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
>;[2247] END IFE TOPS20
;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
IFE TOPS20,< ;[2247]
;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
>;[2247] IFE TOPS20
LCOVF: SKIPN LC.LB ;[1113] LAST CHANCE--IS THERE AN LC AREA?
JRST E$$MEF ;[1174] NO--JUST RAN OUT OF LUCK
IFN TOPS20,< ;[2247]
JRST LCREDU ;[2247] REDUCE LOW SEGMENT
>;[2247] IFN TOPS20
IFE TOPS20,< ;[2247]
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
>;[2247] IFE TOPS20
LCREDU: PUSH P,R ;SAVE R
MOVEI R,LC.IX ;INDEX FOR LOW
JRST CREDU ;REDUCE SIZE
;HERE FOR HIGH SEGMENT
IFE TOPS20,< ;[2247]
HCREDW: SKIPN PAG.S2 ;ALREADY SETUP
JRST HC.DMP ;NO, FIRST TIME
>;[2247] IFE TOPS20
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 T2,TAB.AB(R) ;[2202] TOP
SUB T2,TAB.LB(R) ;[2202] -BOTTOM
ADDI T2,1 ;[2202] LENGTH
LSH T2,-1 ;[2202] CUT IN HALF
ANDCMI T2,.IWM ;[2202] AT LEASET RESERVE WINDOW SIZE
JUMPE T2,TPOVF ;[2270] TRY THE TYPECHECKING AREA
PUSH P,T2 ;[2202] SAVE LENGTH TO REMOVE
IFE TOPS20,<
ADD T2,LW.S0(R) ;[2202] NEW BOTTOM
SUBI T2,1 ;[2202] THEREFORE TOP TO OUTPUT
MOVE T1,LW.S0(R) ;[2202] FROM HERE UP
> ;[1401] IFE TOPS20
IFN TOPS20,<
MOVE T1,LW.S0(R) ;[2202] SEND THE WHOLE AREA AWAY
MOVE T2,UW.S0(R) ;[2202]
> ;[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
MOVE T1,LW.S0(R) ;[2202] GET HALF AREA BACK
MOVE T2,UW.S0(R) ;[2202]
PUSHJ P,@[EXP LC.IN,HC.IN]-1(R)
> ;[1401] IFN TOPS20
POP P,R ;RESTORE R
JRST LNKCON ;TRY AGAIN, MAY RETURN
TPOVF: POP P,R ;[2270] RESTORE R
SKIPE TP.AB ;[2270] HAVE A TYPECHECKING AREA?
SKIPE TP.PP ;[2270] AND ALOWED TO PAGE IT?
POPJ P, ;[2270] NO, RETURN NON-SKIP
SKIPE PAG.TP ;[2270] ALREADY OVERFLOWED?
JRST TPREDU ;[2270] NO
PUSHJ P,TP.DMP ;[2270] YES, GET RID OF THEM
POPJ P, ;[2270] DIDN'T GET ANYWHERE
JRST LNKCON ;[2270] AND TRY AGAIN
TPREDU: MOVE T1,UW.TP ;[2270] GET THE UPPER BOUND
SUB T1,LW.TP ;[2270] GET THE SIZE
CAIGE T1,2*.IPS ;[2270] MORE THAN TWO PAGES LEFT?
POPJ P, ;[2270] NO, NOTHING TO DO
LSH T1,-1 ;[2270] GET HALF THE SIZE
TRO T1,.IPM ;[2270] SET ON A PAGE BOUNDARY
ADD T1,LW.TP ;[2270] PLUS BOTTOM IS HIGHEST TO KEEP
MOVE T2,UW.TP ;[2270] GET THE OLD UPPER WINDOW
MOVEM T1,UW.TP ;[2270] SET IT AS THE NEW UPPER WINDOW
ADDI T1,1 ;[2270] FIRST WORD TO REMOVE
PUSHJ P,TP.OUT ;[2270] REMOVE IT
MOVE T1,UW.TP ;[2270] GET THE UPPER BOUND
SUB T1,LW.TP ;[2270] GET THE NEW SIZE
ADD T1,TP.LB ;[2270] GET NEW HIGH ADDRESS
MOVEM T1,TP.AB ;[2270] SAVE IT
JRST LNKCON ;[2270] TRY AGAIN
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::
CAMLE T2,HB.'WD ;BIGGEST SO FAR?
MOVEM T2,HB.'WD ;YES
IFIDN <%AREA><LC>,< ;[2366] Special if LC area
;[2366] Build byte pointer to the map. Point at the first page
;[2366] to write.
SPUSH <P1,P2,P3,P4> ;[2366] Need lots of acs
LSH T1,-.DBS2W ;[2366] From address into 128 word blocks
LSH T2,-.DBS2W ;[2366] To address into 128 word blocks
MOVE T3,T1 ;[2366] Get the from address
LSH T3,-.LMS2D ;[2366] Make index into map
ADJBP T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry
;[2366] Get the next disk block
LCOUTL: LDB T4,T3 ;[2366] Get the window base block
JUMPN T4,LCOUTN ;[2366] Check for non-zero
;[2366] Found a zero entry. Fill in as many zero entries as necessary
PUSH P,T3 ;[2366] Save the pointer
PUSH P,T1 ;[2366] And the from block
MOVE P1,LC.UM ;[2366] Get the new block number
LCOUTZ: ADDI P1,1 ;[2366] Actually one higher
DPB P1,T3 ;[2366] Store the block number
ADDI P1,.LMS-1 ;[2366] Point to next block group
MOVEM P1,LC.UM ;[2366] Adjust upper bound
ADDI T1,.LMS ;[2366] Address for next group
CAML T1,T2 ;[2366] Last index for this write?
JRST LCOUTA ;[2366] Yes, go pop acs and continue
ILDB T4,T3 ;[2366] No, get the next index
JUMPE T4,LCOUTZ ;[2366] Get an index if it is zero
LCOUTA: POP P,T1 ;[2366] Get the from block
POP P,T3 ;[2366] And the pointer
JRST LCOUTL ;[2366] Go output these blocks
;[2366] Found an index. Add the offset and do USETO
LCOUTN: MOVE P1,T1 ;[2366] Get the from block
ANDI P1,.LMM ;[2366] Get the offset part
MOVE P2,T4 ;[2366] Get the index base
ADD T4,P1 ;[2366] Get the actual disk block
USETO CHAN,(T4) ;[2366] Set on block
MOVE P4,T4 ;[2366] Remember the starting block
;[2366] Loop looking for contiguous blocks. Stop when there is
;[2366] either no contiguous block, or when the last block needed
;[2366] is seen.
;[2366] P1 Contains the number of blocks to write
;[2366] P2 Contains the index base for the current block
;[2366] P3 contains the block number to write
SUBI P1,.LMS ;[2366] Get the number of blocks
MOVN P1,P1 ;[2366] As a positive quantity
MOVE P3,T1 ;[2366] Get a copy of the from block
TRZ P3,.LMM ;[2366] Get beginning block for this index
LCOUTM: ADDI P3,.LMS ;[2366] Beginning of next index
CAML P3,T2 ;[2366] Need next index?
JRST LCOUTE ;[2366] No
ILDB T4,T3 ;[2366] Get the next block index
ADDI P2,.LMS ;[2366] Increment the previous index
CAMN P2,T4 ;[2366] Are they the same?
CAIL P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit?
JRST LCOUTF ;[2366] No, write what we have
ADDI P1,.LMS ;[2366] Got a contiguous chunk, add more blocks
JRST LCOUTM ;[2366] Do the next chunk
;[2366] Found the last chunk. Set P1 to reflect the correct
;[2366] number of blocks.
LCOUTE: MOVEI P1,1(T2) ;[2366] Highest block to write
SUB P1,T1 ;[2366] Minus lowest (for this time)
;[2366] Write the blocks.
LCOUTF: MOVE T4,P1 ;[2366] Get the number of blocks
IMULI T4,-.DBS ;[2366] Make it negative words
MOVE P2,T1 ;[2366] Get back the start
LSH P2,.DBS2W ;[2366] In words
SUB P2,LW.LC ;[2366] Minus window start (may not be origin)
ADD P2,LC.LB ;[2366] Fix in core
SUBI P2,1 ;[2366] IOWD is one less
HRL P2,T4 ;[2366] Left half is -count
SETZ P3, ;[2366] Terminate list
OUT CHAN,P2 ;[2366] Dump block
CAIA ;[2366] It worked
JRST E$$OLC ;[2366] It failed
ADDI P4,-1(P1) ;[2366] Get last block written
CAMLE P4,LC.UP ;[2366] Largest physical block written?
MOVEM P4,LC.UP ;[2366] Yes, remember it
ADD T1,P1 ;[2366] Account for blocks written
CAMG T1,T2 ;[2366] All done?
JRST LCOUTL ;[2366] No, do some more
SPOP <P4,P3,P2,P1> ;[2366] Restore the acs
>;[2366] IFIDN LC
IFDIF <%AREA><LC>,< ;[2366] FOR NON-LC AREA
MOVE T3,T1 ;[2330] GET FIRST ADDRESS
LSH T3,-.DBS2W ;[2330] INTO 128 WORD BLOCKS
USETO CHAN,1(T3) ;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
MOVE T3,T1 ;FROM
SUB T3,T2 ;[2330] -TO = -LENGTH
SUBI T3,1 ;[2330] CORRECT COUNT
MOVE 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
>;[2366] IFDIF LC
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
;[2202] CALLED BY
;[2202] MOVE T1,<FIRST ADDRESS TO OUTPUT>
;[2202] MOVE T2,<LAST ADDRESS TO OUTPUT>
;[2202] PUSHJ P,LC.OUT/HC.OUT/LS.OUT
;[2202] USES T1, T2, T3, T4
IFN TOPS20,<
DEFINE PAGOUT (%AREA,CHAN,WD)<
%AREA'.OUT::
MOVEI T4,%AREA'.IX ;[2202] CHANNEL INFO
PUSHJ P,OVF.OU ;[1426] DO THE I/O
POPJ P,
E$$O'%AREA::
PUSHJ P,JSERR## ;[2264] SET UP THE JSYS ERROR
..FORK==0 ;[2247] ASSUME NOT TO FORK
IFIDN <%AREA>,<LC>,<..FORK==1> ;[2247] FORK IF LC AREA
IFIDN <%AREA>,<HC>,<..FORK==1> ;[2247] FORK IF HC AREA
.ERR. (MS,.EC,V%L,L%F,S%F,O'%AREA,<Error writing area %AREA>)
IFE ..FORK,< ;[2264]
.ETC. (STR,.EC,,,,,< to file >)
.ETC. (FSP,.EC,,,,'CHAN) ;[2301]
>;[2247] IFE ..FORK
.ETC. (NLN,.EC) ;[2264] NEW LINE FOR ERROR TEXT
.ETC. (STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT
> ;[1426] END PAGOUT
OVF.OU:
OVFOU0: CAML T1,T2 ;[2247] UPPER LESS THAN LOWER?
POPJ P, ;[2247] YES, DON'T DO ANYTHING
PUSH P,T2 ;[2202] -1(P): LAST
PUSH P,T1 ;[2202] 0(P): FIRST
MOVE T1,TB.CHN(T4) ;[2202] T1: CHANNEL
SKIPN T1,CHAN.JF(T1) ;[2202] JFN?
JRST @TB.OER(T4) ;[2202] GIVE THE ERROR
CAMG T2,TAB.HB(T4) ;[2202] BIGGER THAN WHAT WE HAVE?
JRST OVFOU1 ;[1401] NO, CONTINUE.
EXCH T2,TAB.HB(T4) ;[2202] SWAP OLD BOUND FOR NEW
JUMPN T2,OVFOU1 ;[2202] IF WE'RE STARTING UP A NON-0 SECTION
MOVE T2,0(P) ;[2202] T2: FIRST ADDR OF DEST
LSH T2,-9 ;[1401] T2: FIRST PAGE OF DEST
MOVE T3,-1(P) ;[2202] T3: LAST ADDR
LSH T3,-9 ;[1401] T3: LAST PAGE
SUBI T3,-1(T2) ;[2202] T3: PAGE COUNT. NOTE THAT
;[2202] (FIRST-LAST)+1 = FIRST-(LAST-1)
TXO T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
HRL T2,T1 ;[1401] T2: JFN,,FIRST PAGE
MOVE T1,0(P) ;[2202] LOWER BOUND OF BLOCK
SUB T1,TAB.LW(T4) ;[2202] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T1,TAB.LB(T4) ;[2202] FIX IN CORE
LSH T1,-9 ;[1401] RELOCATE TO REAL PAGE
HRLI T1,.FHSLF ;[1401] T1: SELF,,SOURCE PAGE
PMAP% ;[1401] OUT THEY GO
ERCAL PMAPER ;[2023] TRY EXPUNGE IF QUOTA EXCEEDED
OVFOU1: MOVE T2,0(P) ;[2202] T2: First addr of dest
MOVE T3,-1(P) ;[2202] T3: Last addr
SUB T3,T2 ;[2202] T3: Number of words
LSH T3,-9 ;[2202] T3: Number of pages
ADDI T3,1 ;[2302] T3: Size of area
TXO T3,PM%CNT ;[2302] SET COUNT
SUB T2,TAB.LW(T4) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,TAB.LB(T4) ;[1401] FIX IN CORE
LSH T2,-9 ;[1401] RELOCATE TO REAL PAGE
HRLI T2,.FHSLF ;[1401] T2: SELF,,SOURCE PAGE
SETOM T1 ;[1401] UNMAP
PMAP% ;[1401] OUT THEY GO
ERCAL @TB.OER(T4) ;[1426] GIVE THE ERROR
POP P,T1 ;[2202] LOWER BOUND
POP P,T2 ;[2202] UPPER BOUND
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 from PMAP%
MOVEM T3,CRTMP3 ;[2024] in CRTMP1-3
MOVEI T1,.FHSLF ;[2024] This process
GETER% ;[2024] Get last error
ERJMP @TB.OER(T4) ;[2202]
HRRZS T2 ;[2024] Just the error number
CAIE T2,IOX11 ;[2024] Is it Quota Exceeded error?
JRST @TB.OER(T4) ;[2215] No - just give error
PUSHJ P,EXPNG ;[2024] Yes - Try expunging the directory
POPJ P, ;[2024] Return to PMAPER caller
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'.OUT,< ;;[2264] IF OVERFLOW ROUTINE EXISTS
EXP E$$O'%AREA ;[1230] ERROR WITH %AREA FILE
>
IFNDEF %AREA'.OUT,< ;;[2264] IF NO OVERFLOW ROUTINE EXISTS
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)
;ARGUMENT TYPECHECKING [2270]
PAGOUT (TP,PC,TP) ;[2270]
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::
IFIDN <%AREA><LC>,< ;[2366] Special if LC area
CAMLE T2,HB.LC ;[2366] Bigger than what we have?
MOVEM T2,HB.LC ;[2366] Yes, reset highest
;[2366] Build byte pointer to the map. Point at the first page
;[2366] to read.
SPUSH <P1,P2,P3,P4> ;[2366] Need lots of acs
LSH T1,-.DBS2W ;[2366] From address into 128 word blocks
LSH T2,-.DBS2W ;[2366] To address into 128 word blocks
MOVE T3,T1 ;[2366] Get the from address
LSH T3,-.LMS2D ;[2366] Make index into map
ADJBP T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry
;[2366] Get the next disk block
LCINL: LDB T4,T3 ;[2366] Get the window base block
JUMPN T4,LCINN ;[2366] Check for non-zero
;[2366] Found a zero entry. Zero memory as necessary, disk space will
;[2366] be allocated when the pages are written. The disk pages are
;[2366] not allocated here because the .EXE file writer sometimes tries
;[2366] to read in much more than it needs.
MOVE P1,T1 ;[2366] Get the from block
LSH P1,.DBS2W ;[2366] In words
SUB P1,LW.LC ;[2366] Minus window start (may not be origin)
ADD P1,LC.LB ;[2366] Fix in core
TRO T1,.LMM ;[2366] End of this area
MOVE P2,T1 ;[2366] Get the from block
CAML P2,T2 ;[2366] Beyond what's wanted?
MOVE P2,T2 ;[2366] Yes, use top wanted
LSH P2,.DBS2W ;[2366] In words
TRO P2,.DBM ;[2366] At top of page
SUB P2,LW.LC ;[2366] Minus window start (may not be origin)
ADD P2,LC.LB ;[2366] Fix in core
SETZM (P1) ;[2366] Zero the first word
HRLS P1 ;[2366] Build BLT word
ADDI P1,1 ;[2366] As from,,to
BLT P1,(P2) ;[2366] Zero memory
IBP T3 ;[2366] Go to the next block
AOJA T1,LCINZ ;[2366] Do next area
;[2366] Found an index. Add the offset.
LCINN: MOVE P1,T1 ;[2366] Get the from block
ANDI P1,.LMM ;[2366] Get the offset part
MOVE P2,T4 ;[2366] Get the index base
ADD T4,P1 ;[2366] Get the actual disk block
MOVE P4,T4 ;[2366] Remember initial block
;[2366] Loop looking for contiguous blocks. Stop when there is
;[2366] either no contiguous block, or when the last block needed
;[2366] is seen.
;[2366] P1 Contains the number of blocks to read
;[2366] P2 Contains the index base for the current block
;[2366] P3 Contains the block number to read
SUBI P1,.LMS ;[2366] Get the number of blocks
MOVN P1,P1 ;[2366] As a positive quantity
MOVE P3,T1 ;[2366] Get a copy of the from block
TRZ P3,.LMM ;[2366] Get beginning block for this index
LCINM: ADDI P3,.LMS ;[2366] Beginning of next index
CAML P3,T2 ;[2366] Need next index?
JRST LCINE ;[2366] No
ILDB T4,T3 ;[2366] Get the next block index
ADDI P2,.LMS ;[2366] Increment the previous index
CAMN P2,T4 ;[2366] Are they the same?
CAIL P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit?
JRST LCINF ;[2366] No, write what we have
ADDI P1,.LMS ;[2366] Got a contiguous chunk, add more blocks
JRST LCINM ;[2366] Do the next chunk
;[2366] Found the last chunk. Set P1 to reflect the correct
;[2366] number of blocks.
LCINE: MOVEI P1,1(T2) ;[2366] Highest block to write
SUB P1,T1 ;[2366] Minus lowest (for this time)
;[2366] Make sure the blocks exist in the overflow file
;
LCINF: MOVE T4,P4 ;[2366] Get the first block to read
ADDI T4,-1(P1) ;[2366] Get the highest block to be read
CAMG T4,LC.UP ;[2366] Higher than exists in file?
JRST LCINR ;[2366] No, read the file
USETO CHAN,1(T4) ;[2366] Create new blocks to read
MOVEM T4,LC.UP ;[2366] Remember new highest block
;[2366] Read the blocks.
LCINR: USETI CHAN,(P4) ;[2366] Set on block
MOVE T4,P1 ;[2366] Get the number of blocks
IMULI T4,-.DBS ;[2366] Make it negative words
MOVE P2,T1 ;[2366] Get back the start
LSH P2,.DBS2W ;[2366] In words
SUB P2,LW.LC ;[2366] Minus window start (may not be origin)
ADD P2,LC.LB ;[2366] Fix in core
SUBI P2,1 ;[2366] Iowd is one less
HRL P2,T4 ;[2366] Left half is -count
SETZ P3, ;[2366] Terminate list
IN CHAN,P2 ;[2366] Read block
CAIA ;[2366] It worked
JRST E$$ILC ;[2366] It failed
ADD T1,P1 ;[2366] Account for blocks written
LCINZ: CAMG T1,T2 ;[2366] All done?
JRST LCINL ;[2366] No, do some more
SPOP <P4,P3,P2,P1> ;[2366] Restore the acs
>;[2366] IFIDN LC
IFDIF <%AREA><LC>,< ;[2366] FOR NON-LC AREA
MOVE T3,T2 ;[2330] 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 T3,-.DBS2W ;[2330] MUST DO USETO TO ZERO FILE
;SO WE WILL INPUT ZERO DATA
USETO CHAN,2(T3) ;[2330] YES, GET THIS MUCH
%OK:! MOVE T3,T1 ;[2330] GET FIRST ADDRESS
LSH T3,-.DBS2W ;[2330] INTO 128 WORD BLOCKS
USETI CHAN,1(T3) ;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
MOVE T3,T1 ;[2330] FROM
SUB T3,T2 ;[2330] -TO = -LENGTH
SUBI T3,1 ;[2330] CORRECT LENGTH
MOVE T2,T1 ;[2330] 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
>;[2366] IFDIF LC
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
;[2202] CALLED BY
;[2202] MOVE T1,<FIRST ADDRESS TO INPUT>
;[2202] MOVE T2,<LAST ADDRESS TO INPUT>
;[2202] PUSHJ P,LC.IN/HC.IN/LS.IN
;[2202] USES T1, T2, T3, T4
IFN TOPS20,<
DEFINE PAGIN (%AREA,CHAN,WD,FIXUP)<
%AREA'.IN::
MOVEI T4,%AREA'.IX ;[2202] CHANNEL INFO
PUSHJ P,OVF.IN ;[1426] DO THE I/O
IFB <FIXUP>,<
POPJ P, ;[1401] OK
>
IFNB <FIXUP>,<
PJRST %AREA'.FXR ;[1401] DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::
PUSHJ P,JSERR## ;[2264] SET UP THE JSYS ERROR
..FORK==0 ;[2247] ASSUME NOT TO FORK
IFIDN <%AREA>,<LC>,<..FORK==1> ;[2247] FORK IF LC AREA
IFIDN <%AREA>,<HC>,<..FORK==1> ;[2247] FORK IF HC AREA
.ERR. (MS,.EC,V%L,L%F,S%F,I'%AREA,<Error reading area %AREA>)
IFE ..FORK,< ;[2264]
.ETC. (STR,.EC,,,,,< from file >)
.ETC. (FSP,.EC,,,,'CHAN) ;[2301]
>;[2247] IFE ..FORK
.ETC. (NLN,.EC) ;[2264] NEW LINE FOR ERROR TEXT
.ETC. (STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT
POPJ P,
> ;[1426] END PAGIN
OVF.IN:
PUSH P,P1 ;[1426] SAVE REGISTER
PUSH P,T2 ;[2202] -1(P): LAST
PUSH P,T1 ;[2202] 0(P): FIRST
CAIE T4,LC.IX ;[2202] LOW SEGMENT?
CAIN T4,HC.IX ;[2247] OR HIGH SEGMENT?
CAIA ;[2247] YES, MUST CHECK SECTIONS
JRST OVFIN1 ;[2202] NO
MOVE P1,T1 ;[2247] GET THE LOWER BOUND
PUSHJ P,NEWSCT ;[2202] MAKE SURE IT EXISTS
MOVE P1,-1(P) ;[2247] GET THE UPPER BOUND
PUSHJ P,NEWSCT ;[2202] MAKE SURE IT EXISTS
OVFIN1: MOVE T1,TB.CHN(T4) ;[2202] GET THE CHANNEL
SKIPN T1,CHAN.JF(T1) ;[2202] JFN?
JRST @TB.IER(T4) ;[2202] GIVE THE ERROR
HRLS T1 ;[1401] JFN IN RH
MOVE T2,0(P) ;[2202] T2: FIRST ADDRESS
CAIE T4,HC.IX ;[2321] HIGH SEGMENT?
JRST OVFIN2 ;[2321] NO, LOW SEGMENT
HRRZ T3,LL.S2 ;[2321] YES, GET OFFSET INTO FILE
ADD T2,T3 ;[2321] ADD IT
OVFIN2: LSH T2,-9 ;[2321] IN PAGES, PLEASE
HRR T1,T2 ;[1401] JFN,,FILE PAGE
MOVE T3,-1(P) ;[2202] GET LAST ADDRESS
CAMLE T3,TAB.HB(T4) ;[2202] BIGGER THAN WHAT WE HAVE?
MOVEM T3,TAB.HB(T4) ;[2202] YES, RESET HIGHEST
SUB T3,0(P) ;[2247] T3:LAST-FIRST
LSH T3,-9 ;[1401] IN PAGES
ADDI T3,1 ;[2302] NUMBER OF PAGES TO MAP
TXO T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
MOVE T2,0(P) ;[2202] LOWER BOUND OF BLOCK
SUB T2,TAB.LW(T4) ;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
ADD T2,TAB.LB(T4) ;[1401] FIX IN CORE
LSH T2,-9 ;[1401] IN PAGES
HRLI T2,.FHSLF ;[1401] PROCESS IS SELF
PMAP% ;[1401] MAP THESE PAGES
ERCAL @TB.IER(T4) ;[2202] GIVE THE ERROR
POP P,T1 ;[1401] CLEAN UP STACK
POP P,T2
POP P,P1
POPJ P, ;[1426] AND RETURN
NEWSCT:: ;[2242]
PUSH P,T4 ;[2365] SAVE T4
HRRZ T2,LL.S0(T4) ;[2321] GET THE SEGMENT OFFSET
ADD P1,T2 ;[2321] ADD IT
HLRZS P1 ;[2247] GET THE SECTION NUMBER
MOVN T2,P1 ;[2202] GET THE NEGATED SECTION NUMBER
SKIPE OVERLW ;[2235] DOING OVERLAYS?
JUMPN P1,E$$CBO ;[2235] YES, MUST BE DOING SECTION ZERO
CAIN T4,HC.IX ;[2247] HIGH SEGMENT?
JUMPN P1,E$$NHN## ;[2247] YES, MUST BE DOING SECTION ZERO
HRLZI T1,400000 ;[1450] SET B0
LSH T1,(T2) ;[2213] B(N)=SECT(N)
TDNE T1,FXSBIT ;[2200] THIS BIT SET IN ARRAY MAP WORD?
JRST NEWSC1 ;[2365] YES, THE SECTION'S THERE ALREADY
IORM T1,FXSBIT ;[1450] NO, SAY IT'S THERE
PUSHJ P,E$$CRS ;[1450] SAY WE'RE CREATING THE SECTION
JUMPE P1,NEWSC1 ;[2365] DON'T REALLY CREATE SECTION ZERO
SETZM T1 ;[1450] CREATE THE SECTION
HRRZ T2,P1 ;[1450] SPECIFY WHICH
HRL T2,LC.JF ;[2247] AND WHERE
MOVE T3,[SM%RD!SM%WR!SM%EX!1] ;[2202] CREATE ONE SECTION
SMAP%
ERCAL E$$CCS
NEWSC1: POP P,T4 ;[2365] RESTORE T4
POPJ P, ;[1450] AND RETURN
E$$CCS::.ERR. (MS,.EC,V%L,L%F,S%F,CCS,<Cannot create section >) ;[2202]
.ETC. (OCT,.EP!.EC,,,,P1) ;[2264]
.ETC. (JMP,,,,,.ETIMF##) ;[2264] Type the filename
> ;[2301] END IFN TOPS20
E$$CBO::.ERR. (MS,,V%L,L%F,S%F,CBO,<Cannot build overlays outside section zero>) ;[2235]
DEFINE XXX(%AREA)< ;;[1230] DEFINE ERROR MESSAGE ADDRS
IFDEF %AREA'.IN,< ;;[2264] IF OVERFLOW ROUTINE EXISTS
EXP E$$I'%AREA ;[1230] ERROR WITH %AREA FILE
>
IFNDEF %AREA'.IN,< ;;[2264] IF NO OVERFLOW ROUTINE EXISTS
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,)
;ARGUMENT TYPECHECKING [2270]
PAGIN (TP,PC,TP,) ;[2270]
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
XWD 0,PC ;[2270] TP AREA CHANNELS
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]
IFE TOPS20,< ;[2247]
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
>;[2247] IFE TOPS20
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
E$$PTP::.ERR. (MS,0,V%L,L%I,S%I,PTP,<Area TP overflowing to disk>) ;[2270]
POPJ P, ;[2270] RETURN
IFN TOPS20,< ;[2202]
E$$CRS::
.ERR. (MS,.EC,V%L,L%I,S%I,CRS,<Creating section >) ;[1450]
.ETC. (OCT,.EP,,,,P1) ;[1450]
POPJ P, ;[1450] RETURN
> ;[2202] IFN TOPS20
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]
IFE TOPS20,< ;[2270]
E$$ELC::PUSH P,[LC] ;[2051] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>)
E$$EHC::PUSH P,[HC] ;[2051] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>)
E$$ELS::PUSH P,[SC] ;[2051] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>)
E$$EAS::PUSH P,[AC] ;[2051] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>)
E$$ETP::PUSH P,[PC] ;[2270] INDICATE WHICH CHANNEL
.ERR. (LRE,0,V%L,L%F,S%F,ETP,<Error creating area TP overflow file>) ;[2270]
>;[2301] IFE TOPS20
IFN TOPS20,< ;[2301]
E$$ELS::PUSH P,[SC] ;[2301] INDICATE WHICH CHANNEL
.ERR. (LRE,.EC,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[2301]
.ETC. (NLN,.EC) ;[2301] CRLF
.ETC. (STR,,,,,ERRJSY) ;[2301] Type error text
E$$EAS::PUSH P,[AC] ;[2301] INDICATE WHICH CHANNEL
.ERR. (LRE,.EC,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[2301]
.ETC. (NLN,.EC) ;[2301] CRLF
.ETC. (STR,,,,,ERRJSY) ;[2301] Type error text
E$$ETP::PUSH P,[PC] ;[2301] INDICATE WHICH CHANNEL
.ERR. (LRE,.EC,V%L,L%F,S%F,ETP,<Error creating area TP overflow file>) ;[2301]
.ETC. (NLN,.EC) ;[2301] CRLF
.ETC. (STR,,,,,ERRJSY) ;[2301] Type error text
>;[2301] IFN TOPS20
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]
SETZ T1, ;[2202] START AT ZERO
MOVE T2,P1 ;[2202] GIVE BACK THIS MUCH
PUSHJ P,@TB.OUT(R) ;[1230] GENERAL OUTPUT ROUTINE
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
MOVE T1,P1 ;[2202] 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
> ;[2202] IFN TOPS20
MOVE T1,P1 ;[1401]
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
TP.DMP::SPUSH <R,P1> ;[2270] SAVE SOME ACS
MOVX R,TP.IX ;[2270] SET UP LS AREA INDEX
PUSHJ P,LA.DMP ;[2270] COMMON CODE TO SET UP FILE
JRST LARET ;[2270] DIDN'T NEED TO OVERFLOW--RETURN
MOVE T2,TP.AB ;[2270] GET THE TOP
SUB T2,TP.LB ;[2270] MINUS BOTTOM IS SIZE
SETZ T1, ;[2270] START FROM THE BEGINNING
MOVEM T2,TPPTR ;[2422] SAVE SIZE
PUSHJ P,TP.OUT ;[2270] WRITE IT
MOVE T2,TPPTR ;[2422] SIZE OF TP AREA WE JUST WROTE
AOS TPPTR ;[2422] +1=POINTER TO NEXT FREE
MOVE T1,T2 ;[2270] GET THE SIZE
LSH T1,-1 ;[2270][2422] GET HALF OF THE AREA
TRZ T1,.IPM ;[2270] AS BEGINNING OF A PAGE
MOVEM T1,LW.TP ;[2270] STORE AS LOWER WINDOW
MOVEM T2,UW.TP ;[2270] AND UPPER WINDOW
PUSHJ P,TP.IN ;[2270] READ IT
MOVE T2,UW.TP ;[2422] UPPER WINDOW
SUB T2,LW.TP ;[2422] -LOWER WINDOW = SIZE OF AREA
ADD T2,TP.LB ;[2270] HIGHEST LOC IN AREA
MOVEM T2,TP.AB ;[2270] STORE IT
JRST LARET2 ;[2270] DONE
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
SETZ T1, ;[2202] STARTING AT ZERO
MOVE T2,P1 ;[2202] COPY
SUBI T2,1 ;[2202] 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]
LARET2: PUSHJ P,GETIOM ;[2270] 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
IFE TOPS20,< ;[2247]
;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:
PUSHJ P,@TB.PAG(R) ;[1230] PRINT OVERFLOW MESSAGE
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
SKIPN T1 ;IF SEG IS ONLY 1 BLOCK
MOVEI T1,.IPS ;[2366] OUTPUT IT TO MARK PAGING
HRRZI T2,-1(T1) ;[2202] UPPER WINDOW (ALWAYS UNDER ONE SECTION)
SETZ T1, ;[2202] START AT ZERO
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
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
> ;[1755] IFE TOPS20
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] ;[2200] LOWER ADDRESS TO OUTPUT
PUSH P,[0] ;[2200] UPPER ADDRESS TO OUTPUT
PUSHJ P,SYMCHN ;SEE IF ANY FIXUPS FOR THIS AREA
POP P,T2 ;[2200] GET BACK UPPER
POP P,T1 ;[2200] GET BACK LOWER
POP P,R ;SAFE TO RESTORE R NOW
IFE TOPS20,<
JUMPE T1,CPOPJ ;NO FIXUPS DONE
TRZ T1,.IPM ;[2202] MAKE INTO TRUE OUTPUT PTR
IORI T2,.IPM ;[2202] POINT TO END OF BLOCK
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
LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
ADDI T2,.L-1 ;MAKE SURE LAST WORD IN CORE
HLRZ T1,FS.SS ;PTR TO HIGHEST
ADD T1,FX.LB ;+OFFSET
LDB T3,[ADDRESS 1(T1)] ;[2200] 30 BIT 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
LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT 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 ZERO 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
LDB T2,[ADDRESS 1(T1)] ;[2200] ADDRESS
CAML T2,LW.LS ;STILL IN CORE?
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
LDB T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS (REL TO ORIGIN)
MOVEM T1,-2(P) ;[2200] PUT LOW ADDRESS ON STACK INPLACE OF [0]
HLRZ T1,FXT.S0 ;SAME FOR UPPER ADDRESS
ADD T1,FX.LB
LDB T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS
ADDI T1,.L-1 ;FIXED UP ALL 3 WORDS
MOVEM T1,-1(P) ;[2200] SAVE UPPER ADDRESS ON STACK
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
LDB T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
LDB T3,[HIGH6 1(T1)] ;[2200] AND INDEX FROM HIGH SIX BITS
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:! ;[2214] ALL RELOCATABLE DISPATCH HERE
STF.RL:! ;[2214]
STF.RE:! ;[2214]
STF.RF: PUSH P,T1 ;[2214] 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>_<-^D30>> ;[2200] 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 ;[2214] FALL INTO COMMON CODE
;[2214] Thirty bit
STF.AE: LDB T3,[ADDRESS 2(T2)] ;[2214] Get current value
ADD T3,T4 ;[2214] Add in fixup
DPB T3,[ADDRESS 2(T2)] ;[2214] Put back new value
MOVX T3,PS.UDF ;[2214] Fully defined now
; JRST STF.FL ;[2214] 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
MOVEM T4,2(2) ;[2254] STORE POINTER BACK
POPJ P,
;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
SKIPN T4 ;[2254] DID USER PROGRAM HAVE THIS SEG?
SETZB T4,1(T2) ;[2254] NO, CLEAR LENGTH WORD
MOVEM T4,2(T2) ;[2254] YES, STORE BACK
POPJ P,
;HERE TO FIXUP SEGMENT ORIGINS IN TITLE BLOCK
STF.SL: SKIPL T3,(T2) ;CHECK SECONDARY TRIPLET
TXNN T3,S.SEG ;THAT DESCRIBES SEGMENT DATA
JRST BADSTF ;REPORT THE ERROR
MOVEM T4,1(T2) ;[2254] OTHERWISE, STORE NEW VALUE
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
E$$MMF::.ERR. (MS,0,V%L,L%F,S%F,MMF,<Memory manager error>) ;[2202]
CORLIT: END