github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 01:19:17 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/link/lnkcor.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2973 lines
98 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/JNG/DZN/PAH/PY/HD/JBS/RJF 5-Feb-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,<
SEARCH MONSYM
> ;[1401] IFN TOPS20
SALL
ENTRY LNKCOR
EXTERN LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2417 ;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.
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
PUSHJ P,TP.OUT ;[2270] WRITE IT
;**; At TP.DMP+8 and TP.DMP+9 Change TP.PT to TPPTR edit 2374
MOVEM T2,TPPTR ;[2374] SAVE THE ARGCHECKING POINTER
AOS TPPTR ;[2374] START ON NEW PAGE
MOVE T1,T2 ;[2270] GET THE SIZE
LSH T1,-2 ;[2270] 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
SUB T2,T1 ;[2270] 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
Reference in New Issue View Git Blame Copy Permalink