Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99U-BB_1990 - 10,7/link/lnkcor.mac
There are 50 other files named lnkcor.mac in the archive. Click here to see a list.
TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JBC/JNG/DZN/PAH/PY/HD/JBS/RJF 7-SEP-88



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC

IFN TOPS20,<

SEARCH MONSYM
> ;[1401] IFN TOPS20

SALL

ENTRY	LNKCOR
EXTERN	LNKLOG


CUSTVR==0		;CUSTOMER VERSION
DECVER==6		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==2422		;DEC EDIT VERSION


SEGMENT
SUBTTL	REVISION HISTORY


;START OF VERSION 1A
;40	ADD GENERAL GARBAGE COLLECTOR
;42	TAB.PT NOT REDUCED WHEN CORE GIVEN BACK
;100	FIX BUG IN XX.INI WITH LARGE PROGRAMS

;START OF VERSION 2
;135	ADD OVERLAY FACILITY
;204	FIX SFU ERROR

;START OF VERSION 2B
;231	(13869) P1 NOT RESTORED IN TIME IN XX.INI
;234	NUL:/SAVE CAUSES PAGING ON NUL: DEVICE, USE DSK INSTEAD
;246	FIX CORE OVERFLOW CALCULATION
;257	Remove edit 231, restores old P1 too soon
;273	Fix disk overflow of high/low segment.
;301	Cope with case where during DSK overflow, not enough
;	room found to replace IO.EMG.
;354	LABEL EDIT 234
;364	Add routine to handle lh fixups in the TITLE block's
;	segment data.
;365	Give an error message if about to do a bad fixup.
;371	Define .ERSFU in this module.
;374	Prevent wild transfer of control at LCHCHK.
;415	Respect LS.PP always.

;START OF VERSION 2C
;467	Only allocate the first word of areas that need it in XX.INI
;471	Add code for ALGOL debugging system.
;510	Fixup relocatable symbols in LS area correctly.
;511	Don't do symbol fixups unless entire 3 word block is is core
;516	Handle LS completely full on call to expand LS correctly
;	when core is full and some of LS must be paged out.
;517	Add AS.IN routine.
;525	Restore T1 after calling CHKMAX, which uses it.
;530	Define triplet flag bits correctly.
;543	Set PS.MDF correctly on LS fixups.
;544	SOUP in LINK version 3 stuff for TOPS-20.
;556	Check for GS area non-existence at STF.FL (can happen
;	if called late in LNKXIT) and skip some stuff if so.
;557	Clean up the listing for release.

;START OF LINK VERSION 3
;451 CHANGE THE RUC MESSAGE

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;566	Do page fault fixup of high seg info in seg block right.
;577	Handle TB fixups to the LS area.
;604	Handle NUL: correctly.
;632	Implement $FIXUP.
;640	Make FR.CNT never return too high an answer.
;647	Add argument to GBCK.L indicating how much memory to clear.
;650	Use VM on TOPS-10 if available.
;670	Don't wipe out DY.LNK in LDCR7Y.
;676	Always do POP loop in memory.
;720	Move core upwards in 2 steps if it's .GE. 400000.
;731	SEARCH MACTEN,UUOSYM
;736	Change overflow file protection to standard protection.
;750	When doing overflow or core compress, leave window size of .IWS.
;755	Set and check TAB.ZE table for zeroing free space.
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;771	Fix bug with shuffling large( .GT. 400000) core segment.
;1104	Remove part of edit 750 from LH.DMP to fix address checks.
;1113	Fix memory bugs when writing overlay tree.
;1130	Don't count memory requests for pagable areas toward /MAXCOR.
;1174	Label and clean up all error messages.
;1214	Fix unmatched angle bracket bugs.
;1217	Clean up the listings for release.
;1220	Release on both TOPS-10 and TOPS-20 as version 4A(1220).

;START OF VERSION 4B
;1230	Make overflow files, and hence symbol and .EXE files, end up on right path.
;1275	Fix core management bug when expanding a zero length area with PAGE.
;START OF VERSION 5
;1221-1477	Maintenance edits
;1401	Native mode handling of overflow files
;1412	Overflow into nonzero sections if loading them.
;1426	FTFRK2 program fork code.
;1442	Make LH.DMP call CRTFRK if a nonzero section is being dumped to.
;	Also don't dump to nonexistent section 0 in the program fork.
;1450	Correct typo in call to CRTFRK, save register 16 properly, use
;	PRGFRK symbol for fork handling.

;START OF VERSION 5A
;1520	Use GBCK.L to fix pointers in LSREDU.
;1525	Adjust TAB.PT when high or low segment overflows to disk.
;1532	Map 2nd half of overflow window, not 1st half, at CREDU.
;1536	Fix paging of multisection LS areas on the -20.
;1542	Do not add section number to addresses twice at LDCR6C, LDCOR7.
;1543	Avoid using EXTFLG when calling LS.OUT or NEWSCT.
;1771	Add 1 to t2 before call to DY.RET near NEWSC0
;2023	Try expunging directory for quota exceeded failures with PMAPs.
;2024	Fix edit 2023 and fix typo at OVFOU2+5.
;2026	Update copyright and delete edit banners.
;2044	Always removed mapped area in XX.INI under TOPS-20
;2051	Don't ask for SPR if DSK: can't be written to for .TMP files

;Start of Version 6
;2200	Use 30 bit addresses for symbol table fixups.
;2202	Use T1 and T2 as arguments for xx.IN and xx.OUT, fix some PMAPs.
;2213	Fix off by one when testing/setting FXSBIT.
;2214	Add 30 bit symbol fixups.
;2215	Performance improvements for GBCK.L, fix wrong AC bug in 2202.
;2235	Give error if overlay in non-zero section.
;2242	Make NEWSCT global so it can be called from LNKLOD.
;2247	Load program in an inferior fork.
;2254	Remove fail block fixup, update title and seg fixups for 30 bits.
;2255	Remove code which prevents fixups to nonzero LS sections.
;2264	Add module name to LNKCCS, add JSYS errors to LNKIxx and LNKOxx.
;2270	Add pagable TP area for argument typechecking.
;2300	Remove FTFORK code.
;2301	Fix up native TOPS-20 error messages.
;2302	Fix off-by-one in LC.IN/LC.OUT.
;2321	Use halfword LL.S2, left half is non-zero if /SEG:LOW or /REDIRECT.
;2330	Add TOPS-10 versions of xx.IN and xx.OUT.
;2365	Preserve t4 across call to NEWSCT 
;2366	Implement sparse paging on TOPS-10.
;2374	Change TP.PT to new global TPPTR.
;2403	New coprorate Copywrite statement
;2417	Update Copywrite statement to 1988.
;2422	TP.DMP never could work correctly.  Make it do so.

SUBTTL SIMPLE TESTS FIRST


LNKCOR:	JUMPE	P2,LDCR7Y	;JUST WANT TO SHUFFLE CORE
	ADDI	P2,.IPM		;MAKE SURE ITS A 128 WORD BLOCK
	ANDCMI	P2,.IPM
	MOVE	T1,TAB.UB(P1)	;GET UPPER BOUND
LDCOR0:	SUB	T1,TAB.AB(P1)	;MINUS ACTUAL BOUND
	CAMGE	T1,P2		;BIG ENOUGH?
	JRST	LDCOR1		;NO, TRY ONE ABOVE
IFN TOPS20,<
	SKIPN	TAB.PG(P1)	;[2202] IS THIS AREA PAGED?
	JRST	LCR1.5		;[1401] NO, NOTHING SPECIAL
	MOVE	T1,TAB.AB(P1)	;[2202] GET THE CURRENT BOUND
	SUB	T1,TAB.LB(P1)	;[2202] CURRENT SIZE
	ADD	T1,TAB.LW(P1)	;[2202] GET THE UPPER BOUND
	ADDM	P2,TAB.AB(P1)	;[2202] FIX ACTUAL BOUND TO REFLECT INCREASE
	ADDM	P2,TAB.FR(P1)	;[2202] AND FREE SPACE COUNTER
	SKIPL	TAB.UW(P1)	;[2202] ACTUAL UPPER WINDOW BOUND?
	 ADDM	P2,TAB.UW(P1)	;[2202] YES, UPDATE IT TOO
	MOVE	T2,T1		;[2202] GET THE UPPER BOUND
	ADDI	T1,1		;[2202] GET THE LOWER BOUND OF THE INCREASE
	ADD	T2,P2		;[2202] NEW UPPER BOUND
	PUSHJ	P,@TB.IN(P1)	;[2202] MAP IN THE PAGES
	JRST	CPOPJ1		;[1401]  AND RETURN
LCR1.5:
>	;[1401] END IFN TOPS20

	ADDM	P2,TAB.AB(P1)	;FIX ACTUAL BOUND TO REFLECT INCREASE
	ADDM	P2,TAB.FR(P1)	;AND FREE SPACE COUNTER
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,

;THAT TEST FAILED BUT MAYBE WE CAN GET SOME FROM NEXT  AREA

LDCOR1:	CAIL	P1,HG.TAB	;NOT IF TOP AREA
	JRST	LDCOR2		;SINCE NOTHING ABOVE IT
	SKIPE	T1,TAB.UB+1(P1)	;ZERO IF NOT IN USE
	SKIPE	TAB.AB+1(P1)	;ZERO IF SET UP BUT NOT USED
	JRST	LDCOR2		;NO EASY TASK
	SUB	T1,TAB.LB+1(P1)	;SEE HOW MUCH IS REALLY FREE
	CAMGE	T1,P2		;BUT IS IT ENOUGH
	JRST	LDCOR2		;NO, NEED GENERAL TEST
	ADDM	P2,TAB.LB+1(P1)	;FIX THE BOUNDARIES
	ADDM	P2,TAB.UB(P1)	; AS THEY SHOULD BE
	JRST	LDCOR0		;RETURN WITH BOUNDS SETUP
SUBTTL	TABLE DRIVEN CORE MOVER


;HERE TO SEE IF ENOUGH CORE IN LOW SEGMENT

LDCOR2:	PUSHJ	P,FR.CNT	;COUNT FREE CORE
	MOVE	T2,FRECOR	;WE SHOULD KEEP THIS MUCH FREE
	ADD	T2,P2		;AFTER GETTING ALL WE NEED
	SUBM	T1,T2		;MINUS WHAT WE HAVE
	JUMPGE	T2,LDCOR4	;GIVES ENOUGH?
IFN TOPS20,<
	JRST	LNKOVF		;[650] CORE ALWAYS FULL ON TOPS20
> ;END OF IFN TOPS20
IFE TOPS20,<
	SKIPE	CORFUL		;NO, IS CORE FULL (CORE UUO FAILED)?
	JRST	LNKOVF		;YES
	MOVN	T2,T2		;GET WHAT WE NEED
	ADD	T2,.JBREL	;ON TOP OF WHAT WE ALREADY HAVE
IFN FTVM,<
	SKIPE	USEVM		;[650] VM SYSTEM?
	SKIPA	T1,[.VCRX]	;[650] YES, GROW FASTER
> ;END OF IFN FTVM
	MOVEI	T1,.CORX	;[650] MINIMUM NORMAL INCREMENT
	ADD	T1,.JBREL##	;[650] PLUS CURRENT SIZE
	CAMGE	T2,T1		;[650] ASKING FOR LESS THAN MINIMUM?
	SKIPA	T3,T1		;[650] YES, ASK FOR AT LEAST MINIMUM
	MOVE	T3,T2		;[650] NO, ASK FOR ALL WE NEED
	CAMLE	T3,MAXCOR	;[650] ASKING FOR TOO MUCH?
	JRST	LDCOR3		;[650] YES, OVERFLOW
	CORE	T3,		;[650] TRY FOR WHAT WE NEED
	  JRST	LDCOR3		;[650] CAN'T GET IT, OVERFLOW
E$$EXP::.ERR.	(MS,.EC,V%L,L%I,S%I,EXP,<Expanding low segment to >) ;[1174]
	.ETC.	(COR,.EP,,,,.JBREL)
	HRRZ	T2,.JBREL	;GET NEW TOP
	MOVEI	T1,HG.TAB	;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO
	SKIPN	TAB.LB(T1)	;SO LOOK FOR HIGHEST NON-ZERO
	SOJA	T1,.-1		;NOT FOUND YET, BUT WE WILL
	MOVEM	T2,TAB.UB(T1)	;RESET TOP BOUNDARY
	CAIE	P1,(T1)		;IF EXPANDING TOP AREA
	JRST	LDCOR2		;COUNT AGAIN
> ;END OF IFE TOPS20

LNKCON:	JUMPE	P2,CPOPJ1	;P2=0 WAS ONLY SHUFFLING
	JRST	LNKCOR		;TRY TO GET FROM NEW INCREASE
IFE TOPS20,<

;CORE UUO FAILED
;IF FRECOR=0 INITIALIZE DSK FOR OVERFLOW
;OTHERWISE ZERO FRECOR AND TRY AGAIN

LDCOR3:	SKIPN	FRECOR		;BEEN HERE BEFORE?
	JRST	LDCR3A		;YES, OVERFLOW TO DSK NOW
	SETZM	FRECOR		;CLEAR THIS RESTRICTION
	JRST	LDCOR2		;AND TRY AGAIN

;BUT FIRST EXPAND AS MUCH AS WE CAN
;THIS CAN HAPPEN IF A LARGE ARRAY IS SEEN

LDCR3A:	SETOM	CORFUL		;[650] WE'RE AS BIG AS WE CAN GET
	MOVE	T3,MAXCOR	;[650] TRY TO GET THIS BIG
LDCR3B:	MOVE	T1,T3		;[650] NEXT SMALLER SIZE TO TRY
	CAMG	T1,.JBREL##	;[650] WOULD IT DO ANY GOOD?
	JRST	LDCR3D		;[650] NO, GIVE UP
	CORE	T1,		;[650] TRY FOR IT
	  CAIA			;[650] FAILED, TRY FOR NEXT SMALLER
	JRST	LDCR3C		;[650] OK, ADJUST TABLES AND CONTINUE
	SUB	T3,.PGSIZ	;[650] TRY FOR ONE CORE BLOCK LESS
	SOJA	T3,LDCR3B	;[650] LOOP TILL WE'RE AS BIG AS CAN BE

;HERE WHEN WE GOT A LITTLE BIGGER. TELL THE USER.
LDCR3C:	PUSH	P,T2		;[650] SAVE OVER .ERR.
E01EXP::.ERR.	(MS,.EC,V%L,L%I3,S%I,EXP) ;[1174]
	.ETC.	(COR,.EP,,,,.JBREL)
	POP	P,T2		;[650] RESTORE
	MOVEI	T1,HG.TAB	;START AT TOP OF TABLE
	SKIPN	TAB.LB(T1)	;FOR SOMEONE SETUP
	SOJA	T1,.-1		;NOT SETUP, SCAN DOWN
	MOVE	T3,.JBREL
	MOVEM	T3,TAB.UB(T1)	;ALLOCATE FREE SPACE
LDCR3D:	CAMG	T2,.JBREL##	;[650] NEED TO OVERFLOW YET?
	JRST	LNKCON		;[650] NO, DO IT NEXT TIME (CORFUL SET)
	JRST	LNKOVF		;NOW EXPAND TO DSK

> ;END IFE TOPS20


E$$MEF::.ERR.	(MS,0,V%L,L%F,S%F,MEF,<Memory expansion failed>) ;[1174]
;WE HAVE ENOUGH CORE SOMEWHERE BUT IS IT ABOVE WHERE WE ARE?
LDCOR4:	MOVE	T1,[TAB.NB,,TAB.NB+1]
	SETZM	TAB.NB		;USUAL BLT TO CLEAR TABLE
	BLT	T1,TAB.NB+HG.TAB
	MOVEI	T1,ARTAB(P1)		;GET ADDRESS OF ASCII NAME OF AREA
E$$MOV::.ERR.	(MS,.EC,V%L,L%I,S%I,MOV,<Moving low segment to expand area >) ;[1174]
	.ETC.	(STR,.EP,,,,T1)
	MOVSI	T2,-LN.TAB(P1)	;FORM AOBJN WORD FOR THIS AREA
	HRRI	T2,(P1)		;AND ABOVE
	PUSHJ	P,FRECNT	;COUNT SPACE ABOVE
	CAMGE	T1,P2		;ENOUGH?
	JRST	LDCOR7		;NO, MUST MOVE DOWN

;WE HAVE ENOUGH ABOVE SO JUST MOVE UP
	SUB	T1,P2		;GET FREE SPACE
	PUSH	P,T1		;SAVE IT
;NOW TO FILL IN TAB.NB WITH ITEMS NOT TO MOVE
	MOVNI	T2,1(P1)	;FORM AOBJN WORD
	HRLZ	T2,T2		;FOR FIRST PART OF TABLE
	MOVE	T1,TAB.LB(T2)	;CURRENT LOWER BOUND
	MOVEM	T1,TAB.NB(T2)	;WHERE IT WILL GO TO
	AOBJN	T2,.-2		;LOOP
	MOVSI	T2,-HG.TAB(P1)	;FORM AOBJN POINTER
	HRRI	T2,(P1)		;FOR REST OF AREAS
	MOVE	T1,TAB.AB(T2)	;GET ACTUAL IN USE
	ADDI	T1,.IPM(P2)	;PLUS WHAT WE NEED
	ANDCMI	T1,.IPM		;MUST BE ON BLOCK BOUND
	JRST	LDCR4B		;SEE IF ANY MORE TO DO

LDCR4A:				;HERE FOR REST OF TABLE
	ADD	T1,TAB.AB(T2)	;ADD IN LENGTH OF THIS
	SUB	T1,TAB.LB(T2)	;..
	ADDI	T1,.IPM		;ENSURE ON BLOCK BOUND
	ANDCMI	T1,.IPM
LDCR4B:	SKIPE	TAB.LB+1(T2)	;LEAVE 0 AS 0
	MOVEM	T1,TAB.NB+1(T2)	;TO GET START OF NEXT
	AOBJN	T2,LDCR4A	;LOOP
;WE NOW HAVE A TABLE OF ADDRESS OF START OF DATA AFTER MOVE
;PLUS SOME LEFT OVER
;WE NEED A GOOD ALGORITHM TO DISTRIBUTE THIS TO
;MINIMIZE THE NUMBER OF WORDS TO BLT
;THIS SIMPLE ONE WILL DO FOR NOW

	POP	P,T1		;GET FREE SPACE BACK
	LSH	T1,-.IPS2W	;[650] IN .IPS-SIZED CHUNKS
	HRREI	T2,HG.TAB(P1)
	MOVM	T2,T2		;GET NUMBER ARE AREAS TO ALLOCATE
	MOVSI	T2,-LN.TAB(P1)	;FORM AOBJN POINTER
	HRRI	T2,(P1)		;FOR REST OF AREAS INCLUDING THIS ONE
	SETZ	T3,		;START AT ZERO
LDCR4C:	SKIPE	TAB.LB(T2)	;IGNORE ZERO AREAS
	CAMN	T2,[-LN.TAB+BG.IX,,BG.IX]	;BUT IGNORE BOUND GLOBALS
	CAIA
	ADDI	T3,1		;COUNT SETUP ONES
	AOBJN	T2,LDCR4C		;SO WE KNOW WHO TO GIVE SPARE TO
	IDIVI	T1,(T3)		;ALLOCATE EVENLY
	SKIPE	T2		;NO REMAINDER
	ADDI	T1,1		;COUNT ONE EXTRA UNTIL REMAINDER GONE
	LSH	T1,.IPS2W	;[650] BACK TO WORDS
	MOVE	T3,T2		;PREFER TO USE T2 FOR INDEX
	MOVSI	T2,-LN.TAB(P1)	;AOBJN WORD AGAIN
	HRRI	T2,(P1)		;EXCLUDING THIS AREA


;HERE TO FIXUP TAB.NB TO REFLECT DESIRED POSITIONS
;ENTER WITH :-
;T1 = CORE TO ADD WORDS (PLUS 128  IF REMAINDER NON-ZERO)
;T2 = AOBJN WORD FOR AREA TO COVER
;T3 = COUNT OF REMAINDER (WHEN 0 T1=T1-128)
;T4 = USED FOR COUNT
LDCR5Z:	SETZ	T4,		;USED TO KEEP CURRENT INCREMENT
LDCOR5:	AOBJP	T2,LDCOR6	;ALL SET NOW GO MOVE IT
	SKIPN	TAB.LB(T2)	;LEAVE ZERO ALONE
	JRST	LDCOR5
	CAMN	T2,[-LN.TAB+BG.IX,,BG.IX]	;IGNORE BOUND GLOBALS
	JRST	LDCR5M		;SINCE NO FREE SPACE
	ADD	T4,T1		;INCREMENT THE INCREMENT
	SOSN	T3		;REMAINDER JUST EXPIRED?
	SUBI	T1,.IPS		;YES, NOT SO MUCH TO GIVE AWAY NOW
LDCR5M:	ADDM	T4,TAB.NB(T2)	;ADD IN EXTRA
	JRST	LDCOR5		;LOOP
;HERE TO MOVE CORE AREAS, EITHER UP OR DOWN
LDCOR6:
IFN FTVM,<
	MOVSI	T3,-LN.PAG	;[650] AOBJN PTR TO PAGBLK BUFFER
> ;END OF IFN FTVM
	MOVE	T1,TAB.NB+GS.IX	;[650] DESTINATION OF GLOBALS
	SUB	T1,TAB.LB+GS.IX	;ORIGIN
	JUMPE	T1,LDCR6A	;NOTHING TO CHANGE IF NOT MOVED
	ADDM	T1,HT.PTR	;FIXUP POINTER TO HASH TABLE
LDCR6A:	SETZ	T2,		;INITIALIZE COUNTER
LDCR6B:	PUSHJ	P,MOVTST	;SEE WHATS TO BE MOVED
	  JRST	ADJFRE		;NOTHING
	CAML	T1,TAB.LB(T2)	;SEE WHICH WAY TO GO
	JRST	MOVUP		;UP IN CORE
MOVDWN:	CAMG	T1,TAB.AB-1(T2)	;ARE WE CLEAR OF AREA LOWER STILL?
	JRST	LDCR6B		;NO, TRY NEXT
MOVBLT:
IFN FTVM,<
	SKIPE	USEVM		;[650] CAN WE MOVE WITH PAGE UUO'S?
	JRST	LDCR6V		;[650] YES, DO SO (MUCH FASTER)
> ;END OF IFN FTVM

IFN TOPS20,<
	SKIPN	TAB.PG(T2)	;[1401] IS THIS AREA PAGING?
	JRST	LDCR6D		;[1401] NO, DO ORDINARY BLTS
LDCR6C:	PUSH	P,T2		;[1401] SET ASIDE INDEX -- WE WILL USE T2
	MOVE	T3,TAB.AB(T2)	;[1401] TOP OF AREA
	SUB	T3,TAB.LB(T2)	;[1401] -BOTTOM OF AREA = LENGTH
	LSH	T3,-9		;[1401] LENGTH IN PAGES
	AOJE	T3,LDCR6E	;[2202] INCLUDE ALL PAGES (DON'T WRITE IF NONE)
	TXO	T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
	MOVE	T1,TAB.LB(T2)	;[1401] ADDRESS TO MAP AWAY
	LSH	T1,-9		;[1401] IN PAGES, PLEASE
	HRLI	T1,.FHSLF	;[1401] SELF,,PROCESSPAGE
	MOVE	T2,T1		;[1401] T2 GETS IT
	SETOM	T1		;[1401] T1 GETS -1 -- UNMAP, PLEASE
	PMAP%			;[1401] OUT THEY GO!
	  ERCAL	[POP P,T2	;[2202] ERROR -- GET THE INDEX
		 JRST @TB.OER(T2)] ;[2202] TELL THE USER WHAT FAILED 
LDCR6E:	HRRZ	T2,0(P)		;[1401] GET INDEX BACK
	PUSH	P,T3		;[1401] SET ASIDE BITS AND COUNT
	SKIPN	T3,@TB.JFD(T2)	;[1401] PICK UP THE JFN
	 PUSHJ	P,E$$MMF	;[2270] NO JFN - GIVE UP
	MOVE	T1,TAB.LW(T2)	;[1401] NOTE ADDRESS IN OVF FILE
	CAIE	T2,HC.IX	;[2321] HIGH SEGMENT?
	 JRST	LDCR6L		;[2321] NO, LOW SEGMENT
	ADD	T1,LL.S2	;[2247] YES, ADD OFFSET INTO FILE
	HRRZS	T1		;[2321] ALWAYS IN SECTION ZERO
LDCR6L:	LSH	T1,-9		;[2321] MAKE IT PAGES
	HRL	T1,T3		;[1401] JFN,,FILEPAGE
	POP	P,T3		;[1401] PUT COUNT BACK
	JUMPE	T3,LDCR6F	;[2202] DON'T READ IF AREA EMPTY
	MOVE	T2,TAB.NB(T2)	;[1401] FETCH DESTINATION
	LSH	T2,-9		;[1401] IN PAGES, PLEASE
	HRLI	T2,.FHSLF	;[1401] PROCESS IS OURSELF
	PMAP%
	  ERCAL	[POP P,T2	;[2202] ERROR -- GET THE INDEX
		 JRST @TB.IER(T2)] ;[2202] TELL THE USER WHAT FAILED 
LDCR6F:	POP	P,T2		;[2247] PUT THE INDEX BACK
	PUSHJ	P,ADJTBL	;[2247] ADJUST THE TABLES
	JRST	LDCR6B		;[1401] AND TRY AGAIN

; [1401] DISPATCH TABLE GIVING JFNS FOR OVERFLOW FILES

TB.JFD::
DEFINE XXX (ABC)<
IFDEF ABC'.JF,< ABC'.JF >
IFNDEF ABC'.JF,< [ 0 ] >
>
AREAS

LDCR6D:	>			;[1401] IFN TOPS20

	MOVE	T3,TAB.AB(T2)	;TOP OF WHAT WE HAVE
	SUB	T3,TAB.LB(T2)	;GIVES LENGTH TO GO
	HRL	T1,TAB.LB(T2)	;FORM XWD FOR BLT
	ADD	T3,TAB.NB(T2)	;LAST ADDRESS TO BE MOVED TO
	BLT	T1,(T3)		;AND MOVE 
	PUSHJ	P,ADJTBL	;[650] ADJUST THE TABLES
	JRST	LDCR6B		;[650] AND TRY AGAIN

IFN FTVM,<
;HERE TO MOVE VIA PAGE. UUO, THEN CONTINUE AT LDCR6A
LDCR6V:	PUSHJ	P,MOVPAG	;[650] MOVE VIA PAGE. UUO
	JRST	LDCR6A		;[650] TRY AGAIN
> ;END OF IFN FTVM

;HERE TO ADJUST THE VARIOUS TABLES
;THIS IS DONE AFTER EACH BLT
;ENTER WITH T2 = AOBJN POINTER

ADJTBL:	SKIPN	T1,TAB.NB(T2)	;GET NEW ORIGIN
	POPJ	P,		;IF O JUST IGNORE
IFN TOPS20,<
	SKIPN	TAB.PG(T2)	;[1401] FREE SPACE WAS ZEROED BY UNMAP
> ;[1401] IFN TOPS20
	SETOM	TAB.ZE(T2)	;[755] NEED TO CLEAR FREE SPACE LATER.
	SUB	T1,TAB.LB(T2)	;FIND DIFFERENCE
	ADDM	T1,TAB.LB(T2)	;ADJUST ALL TABLES
	ADDM	T1,TAB.AB(T2)
	ADDM	T1,TAB.PT(T2)
	POPJ	P,		;[650] RETURN
;HERE IF NOT ENOUGH CORE ABOVE WHERE WE ARE
;SEE IF ENOUGH JUST BELOW
LDCOR7:	JUMPE	P1,LDCR7X	;NOTHING BELOW IF AREA=0?
	MOVEI	T1,-1(P1)	;GET NEXT LOWER POINTER
	SKIPN	T2,TAB.UB(T1)	;GET BOUND IF NOT ZERO
	SOJGE	T1,.-1		;AREA 0 ALWAYS SET UP
	SUB	T2,TAB.AB(T1)	;GET FREE SPACE
	SUB	T2,P2		;MINUS WHAT WE WANT
	JUMPL	T2,LDCR7X	;NO SUCH LUCK
	LSH	T2,-.IPS2W	;[650] FORM 128 WORD BLOCKS
	IDIVI	T2,2		;[650] HALF IT
	ADD	T2,T3		;[650] GIVE REMAINDER TO EXPANDING AREA
	LSH	T2,.IPS2W	;[650] BACK TO WORDS
	ADD	T2,P2		;ALSO ADD IN WHAT WE WANTED
;NOW ADJUST TABLES AND MOVE  CODE
	MOVN	T2,T2
	CAIN	P1,GS.IX	;GLOBAL SYMBOL AREA MOVED DOWN?
	ADDM	T2,HT.PTR	;YES, ADJUST HASH TABLE POINTER
	ADDM	T2,TAB.UB(T1)	;PREVIOUS UPPER BOUND OF LOWER AREA
IFN FTVM,<
	SKIPE	USEVM		;[650] VM AVAILABLE?
	JRST	LDCR7V		;[650] YES, USE FAST WAY
> ;END OF IFN FTVM
IFN TOPS20,<
	SKIPN	TAB.PG(P1)	;[1401] IS THIS AREA PAGING?
	JRST	LDCR7B		;[1401] NO, DO ORDINARY BLTS
	PUSH	P,T2		;[1401] SET ASIDE COUNT -- WE WILL USE T2
	MOVE	T2,TAB.LB(P1)	;[1401] WHERE TO START
	LSH	T2,-9		;[1401] IN PAGES
	HRLI	T2,.FHSLF	;[1401] PROCESS IS SELF
	MOVE	T3,TAB.AB(P1)	;[1401] TOP OF AREA
	SUB	T3,TAB.LB(P1)	;[1401] -BOTTOM OF AREA = LENGTH
	AOJE	T3,LDCR7C	;[2202] WELL, ALMOST (DON'T DO IT IF NO AREA)
	LSH	T3,-9		;[1401] LENGTH IN PAGES
	TXO	T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
	SETOM	T1		;[1401] T1 GETS -1 -- UNMAP, PLEASE
	PMAP%			;[1401] OUT THEY GO!
	  ERCAL	@TB.OER(P1)	;[2202] ERROR -- RETIRE
LDCR7C:	MOVE	T1,TAB.LW(P1)	;[1401] NOW GET THEM BACK
	CAIE	P1,HC.IX	;[2321] HIGH SEGMENT?
	 JRST	LDCR7S		;[2321] NO, LOW SEGMENT
	HRRZ	T2,LL.S2	;[2321] YES, GET OFFSET INTO FILE
	ADD	T1,T2		;[2321] ADD IT
LDCR7S:	LSH	T1,-9		;[2321] FILEPAGE
	HRL	T1,@TB.JFD(P1)	;[1401] FILEJFN
	MOVE	T2,(P)		;[1401] GET COUNT BACK, BUT KEEP IT
	ADDM	T2,TAB.AB(P1)	;[1401] FIXUP BOUNDS
	ADDM	T2,TAB.PT(P1)	;[1401] AND POINTERS
	ADDB	T2,TAB.LB(P1)	;[1401] FETCH DESTINATION
	JUMPE	T3,LDCR7D	;[2202] DON'T READ IF NO AREA
	LSH	T2,-9		;[1401] IN PAGES, PLEASE
	HRLI	T2,.FHSLF	;[1401] PROCESS IS OURSELF
	PMAP%
	  ERCAL	@TB.IER(P1)	;[2202] ERROR -- RETIRE
LDCR7D:	POP	P,T2		;[1401] PUT THE COUNT BACK
	JRST	LNKCON		;[1401] TRY AGAIN
LDCR7B:	>			;[1401] IFN TOPS20
	ADDM	T2,TAB.AB(P1)	;NEW ACTUAL BOUND
	ADDM	T2,TAB.PT(P1)	;ADJUST POINTER
	HRLZ	T3,TAB.LB(P1)	;GET FROM ...
	ADDB	T2,TAB.LB(P1)	;ADJUST LOWER
	HLL	T2,T3		;FROM ...TO
	BLT	T2,@TAB.AB(P1)	;BLT OF AREA
	MOVE	T3,TAB.AB(P1)	;GET LAST WORD IN USE
	SETZM	1(T3)		;CLEAR FIRST FREE WORD
	HRLI	T3,1(T3)	;FORM BLT POINTER
	HRRI	T3,2(T3)	;TO ZERO FREE AREA
	BLT	T3,@TAB.UB(P1)
	JRST	LNKCON		;TRY AGAIN


IFN FTVM,<
;HERE TO MOVE P1'S AREA DOWN BY T2 ON A VM SYSTEM VIA MOVPAG
LDCR7V:	ADD	T2,TAB.LB(P1)	;[650] NEW LOWER BOUND
	MOVEM	T2,TAB.NB(P1)	;[650] SETUP FOR MOVPAG
	MOVE	T2,P1		;[650] AREA TO MOVE IN T2 FOR MOVPAG
	MOVSI	T3,-LN.PAG	;[650] DOPAGE'S AC
	PUSHJ	P,MOVPAG	;[650] MOVE AREA DOWN
	PUSHJ	P,FRCPAG	;[650] DO LAST PAGE. UUO
	SETZM	TAB.NB(P1)	;[650] RESTORE TAB.NB TO GOODNESS
	JRST	LNKCON		;[650] CONTINUE
> ;END OF IFN FTVM
LDCR7X:	CAIG	P1,1		;TRIED 0 & 1 ALREADY
	JRST	LDCR7Y
	MOVN	T2,P1		;GET AREA
	HRLZ	T2,T2		;AOBJN POINTER FOR ALL BELOW
	PUSHJ	P,FRECNT	;COUNT FREE SPACE
	SUB	T1,P2		;MINUS WHAT WE WANT
	JUMPL	T1,LDCR7Y	;NOT ENOUGH
;SEE HOW MANY AREAS ARE SETUP (NON-ZERO)
	MOVN	T3,P1		;GET AREA
	HRLZ	T3,T3		;AOBJN POINTER FOR ALL BELOW
	MOVEI	T4,1		;CURRENT ONE IS
LDCR7U:	SKIPE	TAB.LB(T3)
	CAMN	T2,[-LN.TAB+BG.IX,,BG.IX]	;IGNORE BOUND GLOBALS
	CAIA
	ADDI	T4,1		;ONE MORE
	AOBJN	T3,LDCR7U
	LSH	T1,-.IPS2W	;[650] INTO 128 WORD BLOCKS
	IDIVI	T1,(T4)		;DISTRIBUTE EVENLY
	SKIPE	T2		;ANY REMAINDER?
	ADDI	T1,1		;YES
	LSH	T1,.IPS2W	;[650] BACK TO WORDS
;HERE TO SETUP LOWER PART OF TABLE TAB.NB
	MOVN	T3,P1
	HRLZ	T3,T3		;AOBJN WORD
	SKIPN	T4,TAB.LB(T3)	;LOAD UP BASE
	AOBJN	T3,.-1		;NEVER FAILS BUT JUST INCASE
	MOVEM	T4,TAB.NB(T3)	;LOWEST NON-ZERO BOUND DOES NOT MOVE

LDCR7L:	SKIPN	TAB.LB(T3)	;IGNORE ZERO'S
	JRST	LDCR7M
	ADD	T4,TAB.AB(T3)
	SUB	T4,TAB.LB(T3)	;WHAT WE NEED
	CAME	T2,[-LN.TAB+BG.IX,,BG.IX]	;IGNORE BOUND GLOBALS
	ADD	T4,T1		;PLUS HANDOUT
	ADDI	T4,.IPM		;MAKE SURE ON A BLOCK BOUND
	ANDCMI	T4,.IPM
	SKIPN	TAB.LB+1(T3)	;SEE IF NEXT IS SETUP
	AOBJN	T3,.-1		;WILL ALWAYS FIND A TOP
	MOVEM	T4,TAB.NB+1(T3)	;IS NEW BOUND
	SOSN	T2		;COUNT DOWN REMAINDER
	SUBI	T1,.IPS		;AND REMOVE EXTRA
LDCR7M:	AOBJN	T3,LDCR7L	;LOOP
;NOW FOR REST OF TABLE, UNCHANGED
	MOVSI	T3,-LN.TAB(P1)
	HRRI	T3,(P1)		;AOBJN POINTER
	AOBJP	T3,LDCR7N	;ACCOUNT FOR AREA WE ARE TRYING TO EXPAND
	SKIPE	T1,TAB.LB(T3)
	MOVEM	T1,TAB.NB(T3)	;MOVE BOUND
	AOBJN	T3,.-2		;LOOP
LDCR7N:	JRST	LDCOR6		;START TO MOVE
;MOST GENERAL MOVER
;HERE WHEN NOT ENOUGH BELOW AND NOT ENOUGH ABOVE
;BUT ENOUGH IN BOTH PLACES COMBINED
;SETUP TAB.NB TO MOVE ALL OF CORE IN EITHER DIRECTION

LDCR7Y:	MOVSI	T2,-HG.TAB	;SET UP TAB.NB
	MOVE	T1,TAB.LB	;FIRST ITEM NEVER MOVES
	MOVEM	T1,TAB.NB	;SINCE IT IS AGAINST FIXED AREA
	MOVEI	T3,1		;[650] INIT COUNT OF USED AREAS TO 1
LDCR7A:	ADD	T1,TAB.AB(T2)	;ADD IN ACTUAL SPACE USED
	SUB	T1,TAB.LB(T2)
	ADDI	T1,.IPM		;MUST BE ON BLOCK BOUND
	ANDCMI	T1,.IPM
	CAIN	P1,(T2)		;IS THIS THE AREA TO GIVE IT TO?
	ADD	T1,P2		;YES, ADJUST START OF NEXT ABOVE
	SKIPN	TAB.LB+1(T2)	;[650] LEAVE 0 ALONE
	JRST	LDCR7Z		;[670] GO LOOP
	MOVEM	T1,TAB.NB+1(T2)	;[650] STORE DESTINATION ADDRESS
	ADDI	T3,1		;[650] COUNT ANOTHER ACTIVE AREA
LDCR7Z:	AOBJN	T2,LDCR7A	;[670] LOOP

	PUSH	P,T3		;[650] SAVE COUNT OF AREAS OVER FR.CNT
	PUSHJ	P,FR.CNT	;[650] COUNT ALL OF SPACE AGAIN
	SUB	T1,P2		;[650] REMOVE WHAT WE WANTED
	LSH	T1,-.IPS2W	;[650] SAME CODE AS ABOVE
	POP	P,T3		;[650] RESTORE COUNT OF AREAS
	IDIV	T1,T3		;[650] SHARE EXTRA OVER ACTIVE AREAS
	SKIPE	T3,T2		;[650]
	ADDI	T1,1		;[650]
	LSH	T1,.IPS2W	;[650]
	MOVSI	T2,-LN.TAB	;SCAN ALL TABLES
	JRST	LDCR5Z		;AND ADD TO ALL ITEMS IN TABLE
;HERE FOR REVERSE BLT TO MOVE CORE UPWARDS

CHUNK1==200000			;[720] IF NEED TO BE MOVED IN 2 STEPS

MOVUP:	ADD	T1,TAB.AB(T2)	;FIND ADDRESS OF END
	SUB	T1,TAB.LB(T2)
	SKIPA	T4,T2		;GET COPY TO PLAY WITH
	SKIPN	TAB.LB(T4)	;OK IF NOT ZERO
	AOBJN	T4,.-1		;LOOP UNTIL WE GET SOMETHING USEFUL
	TLNN	T4,-1		;DID WE FIND A NON-ZERO HIGHER AREA?
	JRST	MOVUP1		;NO, SKIP TEST FOR NEXT  SINCE IT DOESN'T EXIST
	CAML	T1,TAB.LB(T4)	;IS START OF NEXT IN WAY?
	JRST	LDCR6B		;YES, TRY NEXT
;NOTE WE CAN NOT USE A BLT HERE SINCE WE ARE GOING UP IN CORE
;THEREFORE USE POP LOOP.
MOVUP1:
IFN FTVM,<
	SKIPE	USEVM		;[650] CAN WE USE PAGE. UUO TO MOVE?
	JRST	LDCR6V		;[650] YES, MUCH BETTER THAN POP LOOP
> ;END OF IFE FTVM
IFN TOPS20,<
	SKIPE	TAB.PG(T2)	;[1401] IS THIS AREA PAGING?
	JRST	LDCR6C		;[1401] YES, DO PMAPS
> ;[1401] END OF IFN TOPS20
	PUSH	P,T2		;[771] SAVE WHO WE ARE
	MOVE	T4,TAB.AB(T2)	;TOP
	SUB	T4,TAB.LB(T2)	;MINUS BOTTOM GIVES LENGTH
;NOW FOR ITERATIVE LOOP
;T4:	400000+LENGTH,,TOP OF OLD DATA
	HRL	T4,T4		;IN BOTH HALF
	JUMPL	T4,[PUSH P,[CHUNK1,,0]	;[1214] SIZE .GE. 400000
		SUB	T4,[CHUNK1,,0]	;[720] FIRST DO LENTH LESS A CHUNK
		JRST .+1]		;[720] THEN MOVE CHUNK
	ADD	T4,TAB.LB(T2)	;TOP OF DATA
	TLO	T4,(1B0)	;PREVENT PDL UNDERFLOW
	MOVE	T1,TAB.NB(T2)	;DESTINATION
	SUB	T1,TAB.LB(T2)	;-START TO GET OFFSET
	TXO	T1,<(T4)>	;[720] ADD INDEX FIELD
	MOVEM	T1,POPOFS	;[720] STORE FOR LOOP BELOW
POPLP:	POP	T4,@POPOFS	;[720] MOVE A WORD
	JUMPL	T4,POPLP	;[720] LOOP IF MORE WORDS
	POP	P,T2		;[771] RESTORE STACK
	CAMN	T2,[CHUNK1,,0]	;[720] DOING 2 STEPS?
	JRST	[HRLI	T4,CHUNK1-1	;[720] YES, MOVE ONE MORE CHUNK
		TLO	T4,(1B0)	;[720] PREVENT PDL OVRFLO
		JRST	POPLP]	;[720] ONE MORE TIME
	PUSHJ	P,ADJTBL	;FIXUP TABLE
	JRST	LDCR6A		;[650] TRY AGAIN
;HERE TO MOVE AN AREA UP OR DOWN ON A VM SYSTEM BASED ON TAB.NB
;USES EXCHANGE RATHER THAN MOVE SO WON'T HAVE TO DESTROY DESTINATION
;ENTER WITH T2 POINTING TO AREA TO MOVE


IFN FTVM,<
MOVPAG:	SPUSH	<P1,P2,P3>	;[650] NEED LOTS OF ACS
	MOVE	P1,TAB.NB(T2)	;[650] CALCULATE SIGNED OFFSET
	SUB	P1,TAB.LB(T2)	;[650]   FROM OLD PLACE TO NEW
	MOVE	P2,TAB.AB(T2)	;[650] SET P2 = TOTAL SIZE OF AREA TO MOVE
	SUB	P2,TAB.LB(T2)	;[650] BY OLD LAST WORD - OLD FIRST WORD
	ADDI	P2,1		;[650] +1 SINCE AB IS 1 LESS
	JUMPE	P2,MOVPG4	;[1275] DON'T MOVE IF AREA CONTAINS NO PAGES
	JUMPL	P1,MOVPG1	;[650] MOVING UP?
	MOVNI	T1,1		;[650] YES, WILL SWEEP AREA DOWNWARDS
	MOVE	P3,TAB.AB(T2)	;[650] AND SET FIRST WORD TO MOVE TO END
	JRST	MOVPG2		;[650] REJOIN MAIN CODE
MOVPG1:	MOVEI	T1,1		;[650] GOING DOWN, WILL SCAN UP AREA
	MOVE	P3,TAB.LB(T2)	;[650] STARTING AT BOTTOM WORD
MOVPG2:	ASH	P1,-9		;[650] CONVERT WORDS TO PAGES
	LSH	P2,-9		;[650]  ..
	LSH	P3,-9		;[650]  ..

;BACK HERE TO PUT EACH NEW PAGE. UUO ARG INTO THE PAGBLK AREA
MOVPG3:	MOVE	T4,P3		;[650] RETRIEVE SOURCE PAGE
	ADD	T4,P1		;[650] + OFFSET = DESTINATION PAGE
	HRL	T4,P3		;[650] SOURCE,,DESTINATION
	TXO	T4,1B0		;[650] NOTE EXCHANGE, NOT MOVE
	PUSHJ	P,DOPAGE	;[650] EXCH THE PAGE
	ADD	P3,T1		;[650] POINT TO NEXT PAGE TO MOVE
	SOJG	P2,MOVPG3	;[650] AND GO MOVE IT

;HERE WHEN THROUGH WITH THIS AREA
MOVPG4:	SPOP	<P3,P2,P1>	;[1275] RESTORE ACS USED
	JRST	ADJTBL		;[650] GO FIXUP OTHER TAB.XX WORDS

> ;END OF IFN FTVM
SUBTTL	HERE TO CLEAN UP BEFORE RETURNING TO CALLER


ADJFRE:
IFN FTVM,<
	SKIPE	USEVM		;[650] BEEN DOING PAGE. UUOS?
	PUSHJ	P,FRCPAG	;[650] YES, FINISH UP
> ;END OF IFN FTVM
	MOVSI	T2,-LN.TAB+1	;USUAL AOBJN POINTER +1
ADJFR1:	MOVE	T3,T2		;GET COPY OF POINTER
	SKIPN	T1,TAB.LB+1(T3)	;START OF NEXT
	AOBJN	T3,.-1		;IGNORE 0'S
	SUBI	T1,1		;END IS ONE LESS
	SKIPN	TAB.AB(T2)	;[755] LEAVE ZERO IF NOT SET
	JRST	ADJFR2		;[755] 
	CAME	T1,TAB.UB(T2)	;[755] ANY CHANGE IN UB?
	SETOM	TAB.ZE(T2)	;[755] YES, NEEDS CLEARING LATER
	MOVEM	T1,TAB.UB(T2)	;FREE SPACE POINTER
ADJFR2:	AOBJN	T2,ADJFR1	;[755] LOOP FOR NEXT AREA IF NOT FINISHED
	MOVE	T2,.JBREL	;TOP OF LOW SEG
	MOVEI	T1,HG.TAB	;HOWEVER TOP ITEMS IN TABLE MAY BE ZERO
	SKIPN	TAB.LB(T1)	;SO LOOK FOR HIGHEST NON-ZERO
	SOJA	T1,.-1		;NOT FOUND YET, BUT WE WILL
	MOVEM	T2,TAB.UB(T1)	;RESET TOP BOUNDARY

;  ..
;  ..

;HERE TO ZERO ALL XXX.UB SPACE IN CORE IF NOT VIRTUAL
;IF VIRTUAL, IT'S ALREADY ZERO (WE EXCHANGED WITH ZERO PAGES)
	SETOM	COREFL		;[650] SIGNAL CORE SHUFFLED FOR LNKF40
IFN FTVM,<
	SKIPE	USEVM		;[650] BLT'S OR PAGE UUOS?
	JRST	LNKCON		;[650] PAGE, UUO'S, NO ZEROING NEEDED
> ;END OF IFN FTVM
	MOVSI	T2,-LN.TAB+1
BLTUBT:	HRRZ	T1,TAB.AB(T2)	;GET START OF FREE AREA
	JUMPE	T1,BLTUB1	;NOT IF ZERO THERE
	SKIPN	TAB.ZE(T2)	;[755] NEEDS TO BE CLEARED?
	JRST	BLTUB1		;[755] NO,
	SETZM	TAB.ZE(T2)	;[755] YES, INITIALIZE FLAG
	ADDI	T1,1		;GET FIRST FREE (PERHAPS)
	HRLI	T1,(T1)		;BLT POINTER
	ADDI	T1,1		;IT IS NOW
	SKIPN	T3,TAB.LB+1(T2)	;ADDRESS OF NEXT LOW BLOUD
	AOBJN	T2,.-1		;SKIP THE ZERO
	JUMPE	T3,BLTUB1	;SHOULD HAVE SOMETHING THOUG
	CAIG	T3,(T1)		;SEE IF ANY REAL SPACE
	JRST	BLTUB1		;NO, TAB.AB=TAB.UB
	SETZM	-1(T1)		;GET THE FIRST ZERO THERE
	BLT	T1,-1(T3)	;FOR END ADDRESS
BLTUB1:	AOBJN	T2,BLTUBT	;GET NEXT
	MOVEI	T1,HG.TAB	;LAST IS SPECIAL
	SKIPN	TAB.LB(T1)	;INCASE GS.LB IS ZERO
	SOJA	T1,.-1		;WE WILL FIND TRUE TOP
	HRRZ	T1,TAB.AB(T1)
	ADDI	T1,1
	HRL	T1,T1
	ADDI	T1,1
	HRRZ	T3,.JBREL
	CAIG	T3,(T1)
	JRST	LNKCON		;NOW REALLY DO THE ALLOCATION
	SETZM	-1(T1)
	BLT	T1,-1(T3)
	JRST	LNKCON		;TRY AGAIN
;HERE TO STORE A PAGE. UUO ARG FROM T4 INTO THE PAGBLK AREA.
;WILL DO A PAGE. UUO AND SKIP RETURN WHENEVER PAGBLK AREA FILLS UP
;T3 CONTAINS AN AOBJN POINTER TO PAGBLK.
;PAGE. UUO FUNCTION TO DO IS IN PAGFUN


IFN FTVM,<
DOPAGE:	MOVEM	T4,PAGBLK(T3)	;[650] STORE THE ARGUMENT
	AOBJN	T3,CPOPJ	;[650] RETURN UNLESS LIST IS FULL
	JRST	FRCPG1		;[650] ELSE GO DO A PAGE. UUO

;ENTER HERE TO FORCE A PAGE. UUO ON THE CURRENT CONTENTS OF PAGBLK.
FRCPAG:	CAMN	T3,[-LN.PAG,,0]	;[650] PAGE. UUO BLOCK EMPTY?
	POPJ	P,		;[650] YES, DON'T BOTHER WITH A PAGE. UUO
FRCPG1:	HLRE	T3,T3		;[650] GET NEG. COUNT OF EMPTY WORDS
	ADDI	T3,LN.PAG	;[650] + SIZE OF BLOCK = # WORDS USED
	MOVEM	T3,PAGCNT	;[650] STORE FOR UUO
	MOVS	T3,PAGFUN	;[650] PICK UP FUNCTION CODE
	HRRI	T3,PAGCNT	;[650] POINT AT FIRST WORD OF ARGUMENT BLOCK
	PAGE.	T3,		;[650] DO THE PAGE. UUO
	  PUSHJ P,E$$PUF	;[1174] DIDN'T MAKE IT
	MOVSI	T3,-LN.PAG	;[650] RESTORE AOBJN POINTER TO GOODNESS
	POPJ	P,		;[650] RETURN


;HERE ON A PAGE. UUO FAILURE
E$$PUF::.ERR.	(MS,.EC,V%L,L%F,S%F,PUF,<PAGE. UUO failed, error code was >) ;[1174]
	.ETC.	(OCT,.EP,,,,T3)

> ;END OF IFN FTVM
;HERE TO COUNT FREE CORE IN BOUND AREAS
;ENTER WITH T2 CONTAINING AOBJN WORD TO AREAS TO COUNT
;RETURNS COUNT IN T1

FR.CNT::MOVSI	T2,-LN.TAB	;ENTER HERE TO COUNT ALL OF CORE
FRECNT:	SETZ	T1,		;INITIALIZE COUNT
	ADD	T1,TAB.UB(T2)	;ADD UPPER BOUND
	SUB	T1,TAB.AB(T2)	; SUBTRACT ACTUAL BOUNDS
	AOBJN	T2,.-2		;FOR ALL AREAS
	ANDCMI	T1,.IPM		;[640] MAKE MULTIPLE OF .IPS
	POPJ	P,
;HERE TO SEE IF ANYTHING LEFT TO MOVE
;SKIP RETURN IF YES
;NON-SKIP IF ALL DONE

MOVTST:	AOBJN	T2,.+2		;GET NEXT UNLESS AT END OR START
	MOVSI	T2,-LN.TAB	;RESET AOBJN COUNTER
	MOVE	T1,TAB.NB(T2)		;GET DESTINATION
	CAME	T1,TAB.LB(T2)		;SAME AS ORIGIN
	AOSA	(P)			;NO, EXIT WITH T2 SET UP
	AOBJN	T2,.-3			;LOOP
	POPJ	P,			;UNLESS DONE

;AREA NAMES FOR INFO MESSAGES
DEFINE XXX (A) <
 	ASCIZ	\A\
>

	XALL
ARTAB:	AREAS
	SALL
SUBTTL	XX.GET - SUBROUTINES TO GET SPACE IN SPECIFIC AREA


DEFINE XXX(AREA) <
AREA'.GET::PUSH	P,P1		;SAVE P1
	MOVEI	P1,AREA'.IX	;INDEX TO AREA
	IFIDN <AREA><FX>,<
	SKIPN	AREA'.LB	;ALREADY SETUP?
	PUSHJ	P,AREA'.INI	;NO, DO SO NOW>
	IFIDN <AREA><TP>,<	;[2270]
	SKIPN	AREA'.LB	;[2270] ALREADY SETUP?
	PUSHJ	P,AREA'.INI	;[2270] NO, DO SO NOW>
.GETBK:	PUSHJ	P,.GETSP	;GENERAL SIMPLE CORE EXPANDER
	POP	P,P1		;RESTORE
	POPJ	P,
 DEFINE XXX(%AREA) <
%AREA'.GET::PUSH	P,P1		;SAVE P1
	MOVEI	P1,%AREA'.IX	;INDEX TO %AREA
	IFIDN <%AREA><FX>,<
	SKIPN	%AREA'.LB	;ALREADY SETUP?
	PUSHJ	P,%AREA'.INI	;NO, DO SO NOW>
	IFIDN <%AREA><TP>,<	;[2270]
	SKIPN	%AREA'.LB	;[2270] ALREADY SETUP?
	PUSHJ	P,%AREA'.INI	;[2270] NO, DO SO NOW>
	PJRST	.GETBK		;COMMON RETURN
>>

	XALL
	AREAS
	SALL
;SUBROUTINE TO GET SPACE FROM LINKED LIST OF SPACE
;
;CALLED BY 
;	PUSH	P,P1		;USUALLY
;	MOVEI	T2,SIZE		;WHAT WE WANT
;	MOVEI	P1,XXX.IX	;AREA TO GET SPACE FROM
;	PUSHJ	P,GETSPC	;
;ADDRESS OF RETURNED SPACE IN T1
;T2 IS UNCHANGED
;USED T3 AND T4

;HERE TO GET SOME WORDS FROM FREE CORE FOR ANY AREA
;LINKED GARBAGE LIST IS OF FORM <SIZE-OF-THIS ,, POINTER TO NEXT>
;NOTE ALL POINTERS ARE RELATIVE TO BASE OF THAT AREA
;INITIAL POINTER IS TB.LNK(P1)
;TOTAL FREE SPACE IS IN TB.FSP(P1)
;GARBAGE AREAS ARE IN ASCENDING ORDER OF SIZE
;NUMBER OF WORDS REQUIRED IS IN T2
;RETURN ADDRESS OF WORDS IN T1
;ALSO USES T3 AS BACK LINK

.GETSP::
	JUMPG	T2,GETWDS	;DEFENSIVE CHECK INCASE 0 WORDS
E$$AZW::.ERR.	(MS,,V%L,L%F,S%F,AZW,<Allocating zero words>) ;[1174]
GETWDS:	CAMLE	T2,TB.FSP(P1)	;SEE IF ENOUGH TOTAL FREE SPACE
	JRST	GETWDM		;NO, SO DON'T WASTE TIME
	MOVSI	T3,TB.LNK(P1)	;GET INITIAL POINTER
GETWD1:	MOVS	T1,T1		;SAVE OLD POINTER
	HLR	T1,T3		;SAVE THIS
	TRNN	T1,-1		;IF POINTER IS ZERO
	JRST	GETWDM		;NOT ENOUGH IN ONE CHUNK
	MOVE	T3,(T1)		;GET NEXT
	TRNE	T3,-1		;LEAVE ZERO ALONE
	ADD	T3,TAB.LB(P1)	;ADD IN BASE
	MOVS	T3,T3		;PUT SIZE IN RIGHT
	CAILE	T2,(T3)		;SEE IF THIS HOLE IS BIG ENOUGH
	JRST	GETWD1		;NO, TRY NEXT

;FALL THROUGH TO NEXT PAGE
;FOUND A SPACE REMOVE FROM  LIST
.GETSR:			;ENTRY TO REMOVE THIS AREA
GETWD4:	MOVS	T1,T1		;PUT IT WAY ROUND WE EXPECT IT
	HLRZ	T4,T3		;GET LINK ADDRESS
	SKIPE	T4		;LEAVE ZERO ALONE
	SUB	T4,TAB.LB(P1)	;REMOVE OFFSET
	HRRM	T4,(T1)		;REMOVE LINK FROM CHAIN
	HRR	T1,T3		;SIZE WE GOT IN THIS CHUNK
	HRRZ	T3,TB.FSP(P1)	;GET TOTAL FREE WORDS
	SUBI	T3,(T1)		;MINUS THOSE JUST TAKEN
	MOVEM	T3,TB.FSP(P1)	;AS NEW TOTAL
	CAIN	T2,(T1)		;EXACTLY THE RIGHT SIZE
	JRST	GETWD3		;YES, NOTHING TO PUT BACK
	PUSH	P,T2		;SAVE SIZE REALLY REQUIRED
	PUSH	P,T1		;AND ADDRESS
	HRRZ	T3,T1		;SIZE OF THIS BLOCK
	HLRZ	T1,T1		;ADDRESS
	ADDI	T1,(T2)		;START OF LEFT OVER SPACE
	SUBM	T3,T2		;AND ITS SIZE
	PUSHJ	P,.RETSP	;PUT IT IN CHAIN
	POP	P,T1		;RESTORE
	POP	P,T2
GETWD3:	HLRZ	T1,T1		;SET POINTER
;NOW ZERO ALL OF BLOCK BEFORE GIVING IT TO THE USER
	SETZM	(T1)		;CLEAR FIRST WORD
	HRLZ	T3,T1		;FORM BLT POINTER
	HRRI	T3,1(T1)
	MOVE	T4,T1		;FORM END OF BLT
	ADDI	T4,-1(T2)
	CAIE	T2,1		;BUT NOT IF ONLY ONE WORD
	BLT	T3,(T4)		;ZAP
	POPJ	P,
;HERE TO ACTUALLY GET THE WORDS FROM UNUSED MEMORY MAY CAUSE OVERFLOWS

GETWDM:	MOVE	T1,TAB.FR(P1)	;NUMBER OF FREE WORD
	SUBI	T1,(T2)		;SEE IF ENOUGH
	JUMPL	T1,GETWD2	;NO, MUST EXPAND SOME THING
	MOVEM	T1,TAB.FR(P1)	;YES, STORE NEW COUNT
	MOVE	T1,TAB.PT(P1)	;GET ACTUAL ADDRESS OF NEXT FREE WORD
	ADD	T1,T2		;ALLOCATE THIS BLOCK
	EXCH	T1,TAB.PT(P1)	;T1 POINTS TO ALLOCATED BLOCK
	POPJ	P,

;HERE IF WE HAVE TO EXPAND TO GET SOME ROOM
GETWD2:	PUSH	P,T2		;SAVE NUMBER OF WORDS REQUIRED
	PUSH	P,P2		;DESTROYS P2
	MOVE	P2,T2		;NUMBER OF WORDS WE NEED
	SUB	P2,TAB.FR(P1)	;MINUS WHAT WE HAVE NOW
	PUSHJ	P,LNKCOR	;GENERAL CORE EXPANDER
	  JRST	E$$MEF		;[1174] FAILED
	POP	P,P2		;RESTORE P2
	POP	P,T2		;RESTORE T2
	SKIPE	TAB.UW(P1)	;[2270] AREA PAGING?
	 POPJ	P,		;[2270] YES, JUST LEAVE (TYPECHECKING)
	JRST	GETWDM		;TRY AGAIN

;HERE TO CREATE A NEW AREA (USUALLY FX)
;CALLED BY 
;	MOVE	T2,SIZE REQUIRED
;	MOVE	P1,AREA
;	PUSHJ	P,FX.INI
;RETURNS WITH AREA SETUP
;SAVES T2
;USES T1, AND T3

FX.INI:	PUSH	P,T2		;SAVE T2
	PUSHJ	P,XX.INI	;GENERAL 
	POP	P,T2
	POPJ	P,		;RETURN

TP.INI:	PUSH	P,T2		;[2270] SAVE T2
	PUSHJ	P,XX.INI	;[2270] GENERAL ROUTINE
	POP	P,T2		;[2270] RESTORE T2
	POPJ	P,		;[2270] RETURN

XX.INI::MOVEI	T1,(P1)		;GET AREA NUMBER
	SKIPN	TAB.LB(T1)	;FIND NEXT LOWEST SETUP
	SOJG	T1,.-1		;DY IS ALWAYS SETUP
	MOVE	T2,TAB.UB(T1)	;SEE IF ANY FREE
	SUB	T2,TAB.AB(T1)
	CAIL	T2,.IPS		;MUST HAVE AT LEAST THIS
	JRST	SY.FX1		;WE HAVE
	PUSH	P,[EXP XX.INI]	;RETURN ADDRESS
	PUSHJ	P,.SAVE2##	;SAVE P1 AND P2
	MOVEI	P2,.IPS
	MOVEI	P1,(T1)
	PUSHJ	P,LNKCOR
	  PUSHJ	P,E$$MEF	;[1174]
	MOVNI	T1,.IPS		;WE MUST HAVE GOT THE SPACE
	ADDM	T1,TAB.AB(P1)	;SO TAKE IT BACK
	ADDM	T1,TAB.FR(P1)	;ALSO FROM FREE SPACE IN TAB.AB
	SKIPN	TAB.PG(P1)	;IS THIS AREA PAGING?
	POPJ	P,		;NO, JUST RETURN TO XX.INI
	JRST	.+1(P1)		;YES, SORT OUT WINDOWS


DEFINE XXX (ABC) <
 IFNDEF CNA.'ABC,<
	HALT
>
 IFDEF CNA.'ABC,<
	JRST	CNA.'ABC
>>
	AREAS
;HERE IF LOW OR HIGH CODE PAGED
;JUST REDUCE THE INCORE WINDOW
CNA.LC:
CNA.HC:	ADDM	T1,TAB.UW(P1)	;REDUCE THE WINDOW
	JRST	CNABLT		;AND CLEAR  BLOCK

;HERE IF LOCAL SYMBOLS ARE PAGED
;IF GOING IN FORWARDS DIRECTION (UW.LS=-1) AREA IS 0 
;IF NOT CLEAR AREA
CNA.LS:				;[2044]
IFE TOPS20,<			;[2044]
	SKIPGE	UW.LS		;TEST FOR -1
	POPJ	P,		;JUST RETURN
>;[2044] END IFE TOPS20
IFN TOPS20,<			;[2044]
	SKIPL	UW.LS		;[2044] Test for -1
>;[2044] END IFN TOPS20
	ADDM	T1,UW.LS	;BACKUP UPPER POINTER
CNABLT:	MOVE	T1,TAB.AB(P1)	;TOP OF WHAT WE KEEP
IFE TOPS20,<
	ADDI	T1,2
	HRLI	T1,-1(T1)	;FORM BLT PTR.
	SETZM	-1(T1)		;CLEAR FIRST WORD
	MOVEI	T2,.IPS-2(T1)	;DESTINATION OF BLT
	BLT	T1,(T2)		;CLEAR ALL OF BLOCK
> ;[1426] IFE TOPS20
IFN TOPS20,<
	ADDI	T1,1		;[2044] Need page above top of area
	LSH	T1,-9		;GET PAGE
	TLO	T1,.FHSLF
	MOVE	T2,T1
	SETOM	T1
	SETZM	T3
	PMAP%			;UNMAP THIS FROM THE WINDOW
	  ERCAL E$$OLS		;[2202] ERROR -- RETIRE
> ;[1426] IFN TOPS20
	POPJ	P,

SY.FX1:	MOVE	T2,TAB.UB(T1)
	MOVEM	T2,TAB.UB(P1)
	MOVEM	T2,TAB.AB(P1)
	MOVNI	T2,.IPS
	ADDB	T2,TAB.UB(T1)
	ADDI	T2,1
	MOVEM	T2,TAB.LB(P1)
	SETZM	(T2)		;CLEAR
	MOVEM	T2,TAB.PT(P1)	;POINT BEYOND IT
	MOVEI	T1,.IPS		;BUT REST IS FREE
	MOVEM	T1,TAB.FR(P1)	;MARK IT SO
	CAIE	P1,FX.IX	;IS 1ST WORD USEFUL IN THIS AREA?
	CAIN	P1,TP.IX	;[2270]
	CAIA			;[2270] NO, DON'T ALLOCATE IT
	  POPJ	P,		;YES
;THIS AREA MUST NOT START THE SYMBOL CHAINS AT RELATIVE 0
;OTHERWISE WE CANNOT TELL END OF CHAIN FROM ONE AT 0
;FIX IS TO ALLOCATE FIRST WORD
;CURRENTLY NOT USED FOR ANYTHING
	AOS	TAB.PT(P1)	;FIRST WORD IN USE
	SOS	TAB.FR(P1)	;SO ONE LESS FREE
	POPJ	P,
SUBTTL	XX.RET - SUBROUTINES TO RETURN SPACE IN SPECIFIC AREA


DEFINE XXX(AREA) <
AREA'.RET::PUSH	P,P1		;SAVE P1
	MOVEI	P1,AREA'.IX	;INDEX TO AREA
.RETBK:	PUSHJ	P,.RETSP	;RETURN SPACE
	POP	P,P1		;RESTORE
	POPJ	P,		;RETURN
DEFINE XXX(%AREA) <
%AREA'.RET::PUSH	P,P1		;SAVE P1
	MOVEI	P1,%AREA'.IX	;INDEX TO %AREA
	PJRST	.RETBK		;COMMON RETURN
>>

	XALL
	AREAS
	SALL
;SUBROUTINE TO RETURN SPACE TO LINKED LIST
;
;CALLING SEQUENCE IS
;	PUSH P,P1		;SAVE P1 (USUALLY REQUIRED
;	T1 = ADDRESS OF SPACE
;	T2 = SIZE OF SPACE
;	MOVEI	P1,XXX.IX	;AREA
;	PUSHJ	P,.RETSP
;
;USES T3 AND T4

;HERE TO ADD SOME WORDS TO FREE CORE LIST
;ADDRESS OF BLOCK IN T1
;SIZE OF IT IN T2
;ALSO USES T3,T4
;IF SPACE IS ADJACENT TO TOP OF AREA MOVE DOWN THE XX.AB POINTER
; THIS FREES UP THE SPACE FOR THE GENERAL CORE EXPANDER

.RETSP::JUMPE	T2,CPOPJ	;CAN NOT GIVE BACK 0
	CAML	T1,TAB.LB(P1)	;MAKE SURE ITS IN BOUNDS
	CAMLE	T1,TAB.AB(P1)
	PUSHJ	P,E$$RUM	;[1174] IT'S NOT, GIVE ERROR
	CAIGE	T2,.IPS		;IF MORE THAN 1 BLOCK
	JRST	ADDWDS		;NO, JUST LINK IN
	MOVE	T3,T1		;GET COPY
	ADDI	T3,(T2)		;END OF AREA
	CAME	T3,TAB.AB(P1)	;ADJACENT TO UPPER USED BOUND?
	JRST	ADDWDS		;NO
	MOVE	T3,T1		;GET COPY
	IORI	T3,.IPM		;MAKE INTO BOUND
	MOVE	T4,T3		;GET A COPY
	EXCH	T4,TAB.AB(P1)	;AND EXCHANGE WITH PREVIOUS COPY
				;HOWEVER WE HAVE TO  ZERO THE AREA
	HRL	T3,T3		;SO BUILD BLT POINTER
	SETZM	(T3)		;CLEAR FIRST WORD
	ADDI	T3,1		;FINISH BLT POINTER
	BLT	T3,(T4)		;CLEAR ALL OF AREA
	MOVE	T3,T2		;GET COPY OF NEW ADDRESS
	ANDCMI	T3,.IPM		;COUNT NO. OF BLOCKS
	MOVN	T3,T3		;NEGATE SO WE CAN ADD
	ADDM	T3,TAB.PT(P1)	; TO FREE SPACE POINTER TO KEEP IN BOUNDS
	ANDI	T2,.IPM		;LESS TO GIVE BACK NOW
	JUMPE	T2,CPOPJ	;FINISHED IF NONE
ADDWDS:	HRLZM	T2,(T1)		;STORE SIZE AND CLEAR ADDRESS
	ADDM	T2,TB.FSP(P1)	;ADD IN THIS BLOCK
	SKIPE	TB.LNK(P1)	;ANYTHING THERE?
	JRST	ADDWD1		;YES, LINK IN CHAIN
	SUB	T1,TAB.LB(P1)	;REMOVE OFFSET
	HRRZM	T1,TB.LNK(P1)	;ADDRESS IN RIGHT HALF
	POPJ	P,		;RETURN

E$$RUM::.ERR.	(MS,,V%L,L%F,S%F,RUM,<Returning unavailable memory>) ;[1174]
ADDWD1:
REPEAT 0,<
	MOVEI	T4,TB.LNK(P1)	;START OF CHAIN
	JRST	ADDWD3		;SKIP FIRST TIME

ADDWD2:	HRL	T4,T4		;SAVE PREVIOUS IN LEFT HALF
	HLR	T4,T3		;SAVE LAST POINTER WITH ADDRESS IN RIGHT
ADDWD3:	MOVE	T3,(T4)		;GET NEXT POINTER
	TRNE	T3,-1		;LEAVE ZERO ALONE
	ADD	T3,TAB.LB(P1)	;ADD OFFSET
	MOVS	T3,T3		;GET SIZE IN RIGHT HALF, ADDRESS IN LEFT
	CAIG	T2,(T3)		;FIND CURRENT HOLE AT LEAST AS BIG
	JRST	ADDWD4		;YES, LINK INTO LIST
	TLNE	T3,-1		;FINISHED LIST IF ADDRESS IS 0
	JRST	ADDWD2		;NO, TRY AGAIN
	SUB	T1,TAB.LB(P1)	;REMOVE OFFSET
	HRRM	T1,(T4)		;YES, LINK ONTO END
	POPJ	P,

ADDWD4:	TRNE	T4,-1		;END OF CHAIN IF 0 ADDRESS
	JRST	ADDWD5		;YES, USE PREV POINTERS
	SUB	T4,TAB.LB(P1)	;REMOVE OFFSET
	HRRM	T4,(T1)		;STORE IN LINK ADDRESS
	SUB	T1,TAB.LB(P1)	;REMOVE OFFSET
	ADD	T4,TAB.LB(P1)	;ADD OFFSET
	HRRM	T1,(T4)
	POPJ	P,

ADDWD5:	SUB	T4,TAB.LB(P1)	;REMOVE OFFSET
	MOVS	T4,T4		;PREVIOUS,,CURRENT
	SUB	T1,TAB.LB(P1)
	HRRM	T1,(T4)		;LINK BACK IN CHAIN
	ADD	T1,TAB.LB(P1)
	HLRM	T4,(T1)		;ANDFORWARDS
	POPJ	P,
>	; [1401] REPEAT 0

;
;[1401]  The following modification converts free space management to a
;	first-fit algorithm and randomizes the free space chain.
;	Credit to Knuth ( who describes it and notes its virtues )
;	and to DZN ( who told me to check it out ).
;

	MOVE	T4,TB.LNK(P1)	;[1401]  PICK UP 1ST LINK
	HRRM	T4,(T1)		;[1401] CHAIN IN RETURNED BLOCK
	HRRZ	T4,T1		;[1401] GET PTR TO RETURNED BLOCK
	SUB	T4,TAB.LB(P1)	;[1401] RELATIVIZE IT
	MOVEM	T4,TB.LNK(P1)	;[1401] AND STORE AS HEAD OF CHAIN
	POPJ	P,		;[1401] DONE
SUBTTL	XX.GBC - SUBROUTINES TO GARBAGE COLLECT SPECIFIC AREA


DEFINE XXX(AREA) <
AREA'.GBC::PUSHJ	P,.SAVE1##	;SAVE P1
	MOVEI	P1,AREA'.IX	;INDEX TO AREA
	PJRST	.GBCSP		;GARBAGE COLLECT
>

	XALL
	AREAS
	SALL
;SUBROUTINE TO GARBAGE COLLECT SPECIFIC AREA
;
;CALLING SEQUENCE
;	PUSH	P,P1		;SAVE P1
;	MOVEI	P1,XXX.IX	;AREA
;	PUSHJ	P,.GBCSP
;
;USES T1, T2, T3, T4
;
;THE FREE SPACE IS IN A LIST ANCHORED TO TB.LNK
;STORED IN ASCENDING ORDER OF SIZE
;FIRST RELINK LIST IN ASCENDING ORDER OF ADDRESS ANCHORED TO TAB.NB
;THEN COLLECT ADJACENT AREAS, GIVE BACK TOP IF ALL FREE
;THEN PUT NEW LIST BACK IN TB.LNK
;NOTE, TEMP LIST CONTAINS ACTUAL ADDRESSES SINCE CORE CANNOT MOVE 

.GBCSP::SKIPN	TB.FSP(P1)	;ANYTHING TO DO?
	POPJ	P,		;NO
	SETZM	TB.FSP(P1)	;WE ARE ABOUT TO TAKE IT ALL
	MOVE	T1,TB.LNK(P1)	;FIRST TIME JUST STORE
	ADD	T1,TAB.LB(P1)	;ADD IN BASE
	MOVE	T2,(T1)		;GET NEXT POINTER
	HRRZM	T2,TB.LNK(P1)	;SAVE FOR 2ND
	HLLZS	(T1)		;CLEAR LINK
	HRRZM	T1,TAB.NB(P1)	;USED TO HOLD TEMP LIST
GBCSP1:	SKIPN	T1,TB.LNK(P1)	;GET ADDRESS OF BLOCK
	JRST	GBCSP5		;ALL DONE, NOW COLLECT
	ADD	T1,TAB.LB(P1)	;ADD IN BASE
	HRRZ	T2,(T1)		;GET NEXT POINTER
	HRRZM	T2,TB.LNK(P1)	;STORE NEXT BLOCK POINTER
	HLLZS	(T1)		;CLEAR FORWARD POINTER
	MOVE	T3,TAB.NB(P1)	;START OF TEMP CHAIN
	SETZ	T4,		;FIRST TIME
GBCSP2:	CAIG	T1,(T3)		;FIND CURRENT HOLE AT HIGHER ADDRESS
	JRST	GBCSP3		;YES, LINK INTO LIST
	MOVE	T4,T3		;CURRENT GETS FUTURE
	HRRZ	T3,(T4)		;GET NEXT POINTER
	JUMPN	T3,GBCSP2	;NOT FINISHED YET
	HRRM	T1,(T4)		;YES, LINK ONTO END
	JRST	GBCSP1		;SEE IF MORE TO DO

;HERE WHEN CURRENT ADDRESS IS NOT HIGHEST
GBCSP3:	JUMPN	T4,GBCSP4	;0 IF LOWEST ADDRESS
	HRRM	T3,(T1)		;STORE IN LINK ADDRESS
	HRRZM	T1,TAB.NB(P1)	;STORE BACK AS LOWEST
	JRST	GBCSP1		;SEE IF MORE TO DO

;HERE IF ADDRESS IS IN MIDDLE OF LIST
GBCSP4:	HRRM	T3,(T1)		;LINK FORWARDS
	HRRM	T1,(T4)		;LINK BACK IN CHAIN
	JRST	GBCSP1		;SEE IF MORE TO DO
;NOW TO COLLECT ADJACENT SPACES

GBCSP5:	SKIPA	T4,TAB.NB(P1)	;GET START OF LIST
GBCSP6:	HRRZ	T4,T1		;NEXT NON-CONTIGUOUS AREA
	JUMPE	T4,GBCSP8	;END OF LIST IF 0
GBCSP7:	MOVE	T1,(T4)		;GET SIZE,, NEXT POINTER
	HLRZ	T2,T1		;SIZE OF THIS BLOCK
	ADDI	T2,(T4)		;END OF THIS +1
	HRRZ	T3,T4		;SAVE T4 INCASE END IN SIGHT
	CAIE	T2,(T1)		;ADJACENT?
	JRST	GBCSP6		;NO
	HLLZS	(T4)		;CLEAR CURRENT POINTER IN FIRST BLOCK
	MOVE	T2,(T1)		;GET FUTURE POINTER AND CURRENT SIZE
	ADDM	T2,(T4)		;ADD NEW SIZE AND POINTER
	SETZM	(T1)		;CLEAR OLD POINTER IN 2ND BLOCK
	JRST	GBCSP7		;GET NEXT ADJACENT

;HERE TO GIVE BACK TOP PIECE IF POSSIBLE

GBCSP8:	MOVS	T1,T1		;PUT SIZE IN RIGHT
	ADD	T1,TAB.FR(P1)	;ADD IN UNALLOCATED SPACE IN LAST BLOCK
	CAMN	T2,TAB.PT(P1)	;COMPARE WITH UNALLOCATED POINTER
	CAIGE	T1,.IPS		;MUST BE 1 OR MORE BLOCKS
	JRST	GBCSP9		;NOT ENOUGH
	MOVE	T2,T3		;GET COPY OF LOWEST FREE ADDRESS IN LAST BLOCK
	IORI	T2,.IPM		;ROUND UP
	MOVE	T4,TAB.PT(P1)	;SAVE TOP OF CURRENTLY ZEROED CORE
	MOVEM	T2,TAB.AB(P1)	;MAKE NEW TOP OF USED CORE
	MOVEM	T3,TAB.PT(P1)	;SAVE NEW UNALLOCATED POINTER
	ANDI	T1,.IPM		;NO. OF WORDS FREE IN LAST BLOCK
	MOVEM	T1,TAB.FR(P1)	;AS UNALLOCATED IN LAST BLOCK
	MOVEI	T1,TAB.NB(P1)	;NOW WE MUST CLEAR LAST FORWARD POINTER
	CAIA
	MOVE	T1,T2		;CURRENT GETS PREV FUTURE
	HRRZ	T2,(T1)		;SET NEW FUTURE
	CAIE	T2,(T3)		;FOUND IT?
	JRST	.-3		;NO
	HLLZS	(T1)		;YES, CLEAR FORWARD LINK
	HRL	T3,T3		;FORM BLT PTR TO CLEAR CORE
	ADDI	T3,1		;FROM NEW TAB.PT
	SETZM	-1(T3)		; UP TO
	BLT	T3,(T4)		; OLD TAB.PT

;HERE TO RE-LINK IN ORDER OF SIZE

GBCSP9:	SKIPN	T1,TAB.NB(P1)	;GET NEXT POINTER
	POPJ	P,		;ALL DONE
	MOVE	T2,(T1)		;GET SIZE,,NEXT POINTER
	HRRZM	T2,TAB.NB(P1)	;STORE NEXT
	HLRZ	T2,T2		;SIZE ONLY
	PUSHJ	P,.RETSP	;RETURN THIS BLOCK
	JRST	GBCSP9		;LOOP
SUBTTL	XX.TST - SUBROUTINES TO SEE IF SPECIFIED ADDRESS IS FREE (TO EXPAND CURRENT BLOCK)


;CALLING SEQUENCE IS
;	PUSHJ	P,XX.TST
;	WITH T1 = REQUIRED ADDRESS
;	RETURN 0 FAILED
;	RETURN 1 T2 = SIZE OF BLOCK AVAILABLE

DEFINE XXX(AREA) <
AREA'.TST::PUSH	P,P1		;SAVE P1
	MOVEI	P1,AREA'.IX	;INDEX TO AREA
.TSTBK:	PUSHJ	P,.TSTSP	;GENERAL SIMPLE CORE TESTER
	  CAIA			;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,P1		;RESTORE
	POPJ	P,
DEFINE XXX(%AREA) <
%AREA'.TST::PUSH	P,P1		;SAVE P1
	MOVEI	P1,%AREA'.IX	;INDEX TO %AREA
	PJRST	.TSTBK		;COMMON RETURN
>>
	XALL
	AREAS
	SALL
;SUBROUTINE TO TEST IF ADDRESS IS FREE


.TSTSP:	ENTRY	.TSTSP
	SKIPN	T2,TB.LNK(P1)	;GET START OF CHAIN
	POPJ	P,		;NO START
	HRL	T1,T2		;STORE BACK ADDRESS
	JRST	.TSTS2		;FIRST TIME
.TSTS1:	HRL	T1,T2		;STORE BACK ADDRESS
	HRRZ	T2,(T2)		;GET NEXT ADDRESS
	JUMPE	T2,CPOPJ	;ZERO IS END
	ADD	T2,TAB.LB(P1)	;RELOCATE IT
.TSTS2:	CAIE	T2,(T1)		;WHAT WE WANT?
	JRST	.TSTS1		;NO, TRY NEXT
	HLRZ	T2,(T2)		;GET SIZE
	JRST	CPOPJ1		;AND SKIP RETURN
SUBTTL	XX.REM - SUBROUTINES TO REMOVE SPECIFIED BLOCK (TO ADD TO CURRENT IN USE)


;CALLING SEQUENCE IS
;	PUSHJ	P,XX.REM
;	WITH T1 =BACK ADDRESS,, REQUIRED ADDRESS
;	T2 = SIZE REQUIRED

DEFINE XXX(AREA) <
AREA'.REM::PUSH	P,P1		;SAVE P1
	MOVEI	P1,AREA'.IX	;INDEX TO AREA
.REMBK:	PUSHJ	P,.TSTSP	;GENERAL SIMPLE CORE REMOVER
	POP	P,P1		;RESTORE
	POPJ	P,
DEFINE XXX(%AREA) <
%AREA'.REM::PUSH	P,P1		;SAVE P1
	MOVEI	P1,%AREA'.IX	;INDEX TO %AREA
	PJRST	.REMBK		;COMMON RETURN
>>

	XALL
	AREAS
	SALL
;SUBROUTINE TO REMOVE DESIRED CHUNK

.REMSP:	ENTRY	.REMSP
	PJRST	.GETSR		;USE GENERAL PURPOSE ROUTINE
SUBTTL	XX.ZAP ROUTINE TO REMOVE ALL OF ONE AREA


;CALLING SEQUENCE
;	MOVEI	T1, AREA TO BE REMOVED
;	PUSHJ	P,XX.ZAP
;ALSO USES T2

XX.ZAP::SKIPN	T2,TAB.LB(T1)	;GET LOWER BOUND
	JRST	ZAP0		;JUST CLEAR POINTERS
IFE TOPS20,<
	HRL	T2,T2		;FORM BLT POINTER
	ADDI	T2,1		;WELL ALMOST
	SETZM	-1(T2)		;CLEAR FIRST WORD
	BLT	T2,@TAB.AB(T1)	;AND REST
>  ;[1401] IFE TOPS20
IFN TOPS20,<
	ADDI	T2,1
	MOVE	T3,TAB.AB(T1)	;[1401] PICK UP LAST ADDR
	SUB	T3,T2		;[1401] LENGTH
	LSH	T3,-9		;[1401] IN PAGES
	AOJE	T3,XXZAP1	;[2202] NO, INCLUDE ALL PAGES
	TXO	T3,<PM%CNT>	;[2202] MARK IT A COUNT
	PUSH	P,T1		;[1401] SAVE INDEX
	LSH	T2,-9		;[1401] IN PAGES
	HRLI	T2,.FHSLF	
	SETOM	T1
	PMAP%
	POP	P,T1		;[1401] RESTORE INDEX
XXZAP1:				;[2202]
> ;[1401] IFN TOPS20
	MOVE	T2,TAB.UB(T1)	;GET UPPER BOUND
	PUSH	P,T1		;SAVE T1
	SKIPN	TAB.LB-1(T1)	;SEE WHO TO GIVE IT TO
	SOJA	T1,.-1		;WILL GET DY EVENTUALLY
	MOVEM	T2,TAB.UB-1(T1)	;GIVE IT TO NEXT LOWER AREA SETUP
	POP	P,T1		;RESTORE ORIGINAL AREA
ZAP0:	SETZM	TAB.LB(T1)	;CLEAR ALL POINTERS
	SETZM	TAB.AB(T1)
	SETZM	TAB.UB(T1)
	SETZM	TAB.PT(T1)
	SETZM	TAB.FR(T1)
	SETZM	TB.LNK(T1)
	SETZM	TB.FSP(T1)
	POPJ	P,		;RETURN
SUBTTL	GIVE BACK BLOCKS OF CORE


;CALLING SEQUENCE
;	HRRI	T1,UPPER ADDRESS TO RETURN
;	HRLI	T1,UPPER ADDRESS TO CLEAR
;	PUSHJ	P,GBCK.L
;ALSO USES T2

GBCK.L::
	HLRZ	T2,T1		;[647] GET UPPER ADDRESS TO CLEAR
	JUMPE	T2,[PUSH P,T1	;[647] UPPER ADDRESS TO CLEAR SAME AS RETURN
		JRST GBCKL1]
	HRRZS	T1,T1		;[647] CLEAR LH
	CAMLE	T2,T1		;[647] CLEARING MORE THAN GIVING BACK?
	MOVE	T2,T1		;[647] YES, DON'T CLEAR TOO FAR
	PUSH	P,T2		;[647] SAVE HIGHEST TO CLEAR TO
GBCKL1:
IFN DEBSW,<
	HRRZ	T2,T1
	ANDI	T2,.IPM	;ADDRESS MUST END IN .IPM
	CAIE	T2,.IPM
	HALT
>
	MOVEI	T2,HG.TAB	;START AT TOP
GBCKL2:	JUMPL	T2,CPOPJ	;[1755] STOP WHEN THROUGH
	SKIPE	TAB.LB(T2)	;IGNORE IF NOT SETUP
	CAMGE	T1,TAB.LB(T2)	;FOUND RIGHT BLOCK YET?
	SOJA	T2,.-2		;NO, BUT WE WILL
	HRRZ	T3,TAB.LB(T2)	;GET 1ST ADDRESS
	MOVEM	T1,TAB.LB(T2)	;[2215] UPDATE NEW LOWER BOUND
	POP	P,T1		;[2215] GET UPPER ADDRESS TO CLEAR
IFN TOPS20,<			;[2215] ALWAYS BLT ON TOPS-10
	CAIG	T1,T3		;[2215] ANYTHING TO CLEAR?
	JRST	GBCKL3		;[2215] NO
> ;[2215] IFN TOPS20
	SETZM	(T3)		;ZERO FIRST ADDRESS
	HRL	T3,T3
	ADDI	T3,1		;FORM BLT PTR
	BLT	T3,@T1		;CLEAR ALL OF CORE
GBCKL3:	MOVE	T1,TAB.LB(T2)	;[647] GET NEW LOWER BOUND
	AOSA	TAB.LB(T2)	;AS NEXT HIGHER ADDRESS
	SKIPN	TAB.LB(T2)	;LOOK FOR NEXT LOWER AREA SETUP
	SOJA	T2,.-1		;WILL FIND ONE EVENTUALLY
	MOVEM	T1,TAB.UB(T2)	;GIVE FREE SPACE TO IT
	POPJ	P,
SUBTTL	DSK OVERFLOW ROUTINES


;USE STANDARD OPEN BLOCK, EASIER TO DEBUG AND DUMP DATA BASE
LNKOVF:	SKIPN	AS.LB		;IS THERE AN AS AREA?
	JRST	LSCOVF		;NO, CHECK LS AREA
	SKIPE	PAG.AS		;AS AREA ALREADY PAGED OUT?
	JRST	ASREDU		;YES, TRY TO REDUCE IT FURTHER
	PUSHJ	P,AS.DMP	;NO, PUT IT OUT
	  JRST	LSCOVF		;[650] DIDN'T WIN ANYTHING
	JRST	LNKCON		;AND TRY AGAIN

LSCOVF:	SKIPN	LS.PP		;ALLOWED TO THINK ABOUT LS AREA?
	SKIPN	LS.LB		;DO WE STIL HAVE SYMBOLS?
	JRST	LHCOVF		;NO, TRY CORE
	SKIPE	PAG.LS		;ALL LOCAL SYMBOLS STILL IN CORE?
	JRST	LSREDU		;NO
	PUSHJ	P,LS.DMP	;YES, GET RID OF THEM
	  JRST	LHCOVF		;[650] DIDN'T GET ANYWHERE
	JRST	LNKCON		;AND TRY AGAIN


;HERE TO SEE IF THE AS AREA IS BIGGER THAN ONE PAGE, AND REDUCE
;IT UNMERCIFULLY IF SO. THERE IS NO PERCENTAGE IN KEEPING IT IN.

ASREDU:	MOVE	T2,AS.PT	;[2202] GET ABS POINTER TO FIRST FREE
	SUB	T2,AS.LB	;[2202] SUBTRACT FIRST USED
	ANDCMI	T2,.IPM		;[2202] FIND HOW MANY WORDS WE CAN OUTPUT
	JUMPE	T2,LSCOVF	;[2202] IF NONE, TRY LS AREA
	ADD	T2,LW.AS	;[2202] CONVERT TO NEW LW.AS
	PUSH	P,T2		;[2202] SAVE THE NEW LOW VIRTUAL ADDRESS
	SUBI	T2,1		;[2202] FIND HIGHEST ADDR TO OUTPUT
	MOVE	T1,LW.AS	;[2202] LAST TO OUTPUT
	PUSHJ	P,AS.OUT	;DUMP THE CORE
	POP	P,LW.AS		;RESTORE NEW LOWEST ADDR IN CORE
	MOVE	T1,AS.PT	;GET POINTER TO 1ST PAGE STILL IN
	ANDCMI	T1,.IPM		;FIND FIRST ADDR TO KEEP
	SUBI	T1,1		;MAKE LAST LOC TO RETURN
IFN TOPS20,<			;[2215] DON'T HAVE GBCK.L ZERO THE AREA
	HRLI	T1,1		;[2215] SINCE AS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
	PUSHJ	P,GBCK.L	;GIVE BACK THE CORE
	MOVE	T1,LW.AS	;GET LOWEST ADDR IN CORE
	ADD	T1,AS.AB	;CALCULATE HIGHEST VIRT ADDR
	SUB	T1,AS.LB	;AS LW+AB-LB
	MOVEM	T1,UW.AS	;STORE FOR THE WORLD
	JRST	LNKCON		;TRY THE ALLOCATION AGAIN
;HERE TO SEE IF IT IS WORTHWHILE TO OUTPUT MORE OF THE SYMBOL TABLE

LSREDU:	MOVE	T2,LS.AB	;[2202] SEE IF ITS WORTH IT
	SUB	T2,LS.LB	;[2202] GET THE SIZE
	ANDCMI	T2,.IPM		;[2202] BUT NOT INCLUDING LAST BLOCK
	JUMPE	T2,LHCOVF	;[2202] NOTHING TO DO, TRY CORE OVERFLOW
	MOVE	T2,LSYM		;[2202] HIGHEST
	ANDCMI	T2,.IPM		;[2202] EXCEPT FOR LAST BLOCK
	PUSH	P,T2		;[2202] SAVE AS IT WILL BE LOWEST AFTER OUTPUT
	SUBI	T2,1		;[2202] HIGHEST IS ONE LESS
	MOVE	T1,LW.LS	;[2202] LOWEST NOW
	PUSHJ	P,LS.OUT	;OUTPUT WINDOW
	POP	P,LW.LS		;RESET LOWER WINDOW
	MOVE	T1,LS.PT	;POINTER INTO PAGE STAYING IN
	ANDCMI	T1,.IPM		;GET ADDRESS OF START OF PAGE
	SUBI	T1,1		;LAST GOING OUT IS 1 LESS
IFN TOPS20,<			;[2215] DON'T HAVE GBCK.L ZERO THE AREA
	HRLI	T1,1		;[2215] SINCE LS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
	PUSHJ	P,GBCK.L	;GIVE IT AWAY
	JRST	LNKCON		;TRY AGAIN
;HERE TO CHECK FOR EITHER LC OR HC TO BE PAGED
;THE ALGORITHM IS
;IF ONLY A LOW SEGMENT REDUCE ITS SIZE
;IF TWO SEGMENTS THEN
; IF NEITHER HAS YET BEEN OUTPUT, OUTPUT THE LARGER
; IF BOTH HAVE BEEN OUTPUT, THEN  OUTPUT SOME OF CURRENT LARGER
; IF ONLY ONE HAS BEEN OUTPUT, THEN OUTPUT SOME OF CURRENT LARGER

LHCOVF:	SKIPN	HC.LB		;IF NO HIGH SEGMENT
	JRST	LCOVF		;NO CHOICE BUT TO PAGE LOW SEG
				;SEE IF WE ARE PAGING BOTH ALREADY
	DGET	T1,LC.AB,HC.AB	;GET UPPER BOUNDS
	SUB	T1,LC.LB
	SUB	T2,HC.LB	;FIND LENGTHS
IFE TOPS20,<			;[2247]
	CAIN	T1,.IPM		;[650] BOTH SEGMENTS MINIMUM SIZE?
	CAIE	T2,.IPM		;[650] MAYBE, ARE THEY?
	JRST	LHCOV1		;[650] NO
	PUSHJ	P,CHKMAX	;[650] YES, SEE IF MAXCOR REASONABLE
	  JRST	LNKCON		;[650] MORE ROOM! EXPAND CORE...
	DGET	T1,LC.AB,HC.AB	;[650] RECALCULATE WHAT CHKMAX WIPED OUT
	SUB	T1,LC.LB	;[650]
	SUB	T2,HC.LB	;[650]
LHCOV1:	SKIPE	PAG.S1
	SKIPN	PAG.S2
	JRST	LCHCHK		;NO
>;[2247] END IFE TOPS20
;HERE IF BOTH AREAS ARE PAGED
	CAMG	T2,T1		;LOW .GT. HIGH
	JRST	LCREDU		;YES, IF EQUAL TAKE FROM LOW
	JRST	HCREDU		;NO TRY HIGH
IFE TOPS20,<			;[2247]
;HERE TO DECIDE WHETHER TO REDUCE THE SIZE OF SEGMENT ALREADY
;PAGED, OR TO START PAGING ONE

;WE NEED SOME GOOD WAY TO DECIDE WHICH
;TO OUTPUT FIRST
;FOR NOW JUST OUTPUT BIGGER
;PERHAPS SHOULD OUTPUT ONE WITH MOST BLANK DATA

;CHECK THAT PAGING THE LARGER WILL
;BE ENOUGH -- IF NOT JUST PAGE
;REQUIRED ONE

LCHCHK:	MOVEI	T3,LC.IX	;ASSUME LOW IS BIGGEST
	CAMGE	T1,T2		;WHICH SEGMENT IS BIGGER?
	MOVEI	T3,HC.IX	;HIGH IS, USE IT
	CAMGE	P2,T1-LC.IX(T3)	;IS IT BIG ENOUGH? 
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(T3) ;YES, DO BIGEST
	CAIE	P1,LC.IX	;CAN ONLY PAGE REQUESTED IF
	CAIN	P1,HC.IX	;LC OR HC, OTHERWISE USE T3
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(P1) ;NO, DO REQUESTED
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(T3)	;JUST USE BIGGEST
>;[2247] IFE TOPS20
LCOVF:	SKIPN	LC.LB		;[1113] LAST CHANCE--IS THERE AN LC AREA?
	JRST	E$$MEF		;[1174] NO--JUST RAN OUT OF LUCK
IFN TOPS20,<			;[2247]
	 JRST	LCREDU		;[2247] REDUCE LOW SEGMENT
>;[2247] IFN TOPS20
IFE TOPS20,<			;[2247]
	MOVE	T1,LC.AB	;[650] FIND SIZE
	SUB	T1,LC.LB	;[650]
	CAIE	T1,.IPM		;[650] ONLY ONE PAGE?
	JRST	LCOVF1		;[650] NO, CONTINUE
	PUSHJ	P,CHKMAX	;[650] YES, MAXCOR REASONABLE?
	  JRST	LNKCON		;[650] WASN'T, TRY AGAIN
LCOVF1:	SKIPN	PAG.S1		;ALREADY PAGING?
	JRST	LC.DMP		;NO DO SO
	JRST	LCREDU		;YES, REDUCE SIZE OF WINDOW

;HERE TO TEST /MAXCORE TO MAKE SURE SIZE IS REASONABLE
;IF NOT INCREASE MAXCOR BUT WARN USER

CHKMAX:	SKIPN	MAXCOR		;MAXCOR SET?
	JRST	CPOPJ1		;NO, SKIP RETURN
	MOVE	T1,DY.AB	;SEE HOW MUCH WE ABSOLUTELY NEED
	ADD	T1,GS.AB
	SUB	T1,GS.LB	;+GLOBAL AREA
	ADD	T1,FX.AB
	SUB	T1,FX.LB	;+FIXUPS
IFN FTOVERLAY,<
	ADD	T1,RT.AB	;[650]
	SUB	T1,RT.LB	;[650] +RELOCATION TABLES
	ADD	T1,BG.AB	;[650]
	SUB	T1,BG.LB	;[650] +BOUND GLOBALS
> ;END OF IFN FTOVERLAY
	ADDI	T1,2*.IPS	;SYMBOLS + LOW CODE
	SKIPE	HC.LB
	ADDI	T1,.IPS		;+ HIGH CODE
	SKIPE	AS.LB		;[650] ALGOL SYMBOLS?
	ADDI	T1,.IPS		;[650] YES, ONE BIGGER
	CAIE	P1,LC.IX	;[1130] COUNT THIS REQUEST TOO
	CAIN	P1,HC.IX	;[1130]   UNLESS THE REQUEST IS FOR
	JRST	CHKMX1		;[1130]   A PAGABLE AREA, I.E.,
	CAIE	P1,LS.IX	;[1130]   LC, HC, LS OR AS
	CAIN	P1,AS.IX	;[1130]   ..
	JRST	CHKMX1		;[1130]   ..
	ADD	T1,P2		;[1130] NOT PAGABLE--COUNT THIS REQUEST TOO
CHKMX1:	IOR.	T1,.PGSIZ	;[1130] GET PAGE BOUND
	CAMG	T1,MAXCOR	;TROUBLE IF MAXCOR TOO SMALL
	JRST	CPOPJ1		;OK, ITS NOT
	MOVE	T2,HIORGN	;[650] GET BOTTOM OF HIGH SEG
	SUBI	T2,1001		;[650] MAX MAXCORE, WITH 1P FOR HELPER
	CAMLE	T1,T2		;[650] NEED LESS THAN MAX??
	JRST	CPOPJ1		;[650] NO, DON'T INCREASE ANY MORE
	MOVEM	T1,MAXCOR	;SAVE NEW MINIMUM
E$$MSS::.ERR.	(MS,.EC,V%L,L%W,S%W,MSS,</MAXCOR: set too small, expanding to >) ;[1174]
	.ETC.	(COR,.EP,,,,T1)
	SETZM	CORFUL		;[650] LET LDCOR2 TRY AGAIN
	POPJ	P,
;HERE FOR LOW SEGMENT
LCREDW:	SKIPN	PAG.S1		;ALREADY SETUP?
	JRST	LC.DMP		;NO, FIRST TIME
>;[2247] IFE TOPS20
LCREDU:	PUSH	P,R		;SAVE R
	MOVEI	R,LC.IX		;INDEX FOR LOW
	JRST	CREDU		;REDUCE SIZE

;HERE FOR HIGH SEGMENT
IFE TOPS20,<			;[2247]
HCREDW:	SKIPN	PAG.S2		;ALREADY SETUP
	JRST	HC.DMP		;NO, FIRST TIME
>;[2247] IFE TOPS20
HCREDU:	PUSH	P,R		;SAVE R
	MOVEI	R,HC.IX		;INDEX FOR HIGH
				;FALL INTO CREDU

;HERE TO REDUCE LOW/HIGH SEGMENT WINDOW TO HALF SIZE AND TRY AGAIN
;IF THIS IS NOT ENOUGH, LNKCOR WILL LOOP UNTIL
;EITHER ALL WINDOWS ARE DOWN TO 200 WORDS OR IT GETS ENOUGH SPACE

CREDU:	MOVE	T2,TAB.AB(R)	;[2202] TOP
	SUB	T2,TAB.LB(R)	;[2202] -BOTTOM
	ADDI	T2,1		;[2202] LENGTH
	LSH	T2,-1		;[2202] CUT IN HALF
	ANDCMI	T2,.IWM		;[2202] AT LEASET RESERVE WINDOW SIZE
	JUMPE	T2,TPOVF	;[2270] TRY THE TYPECHECKING AREA
	PUSH	P,T2		;[2202] SAVE LENGTH TO REMOVE
IFE TOPS20,<
	ADD	T2,LW.S0(R)	;[2202] NEW BOTTOM
	SUBI	T2,1		;[2202] THEREFORE TOP TO OUTPUT
	MOVE	T1,LW.S0(R)	;[2202] FROM HERE UP
> ;[1401] IFE TOPS20
IFN TOPS20,<
	MOVE	T1,LW.S0(R)	;[2202] SEND THE WHOLE AREA AWAY
	MOVE	T2,UW.S0(R)	;[2202]
> ;[1401] IFN TOPS20
	PUSHJ	P,@[EXP LC.OUT,HC.OUT]-1(R)
	POP	P,T1		;GET BACK LENGTH
IFE TOPS20,<
	ADDM	T1,LW.S0(R)	;SHORTEN WINDOW
	ADD	T1,TAB.LB(R)	;FIX IN CORE
	SUBI	T1,1		;HIGHEST ADDRESS TO GIVE AWAY
	PUSHJ	P,GBCK.L	;TO NEXT LOWER AREA IN USE
>  ;[1401] IFE TOPS20
IFN TOPS20,<
	MOVE	T2,TAB.LW(R)	;[1532] SHORTEN WINDOW
	ADD	T2,T1		;[1532] NEW WINDOW STARTS
	MOVEM	T2,TAB.LW(R)	;[1532] MIDWAY THRU CURRENT WINDOW
	ADDB	T1,TAB.LB(R)	;[1401] SUBTRACT FROM THIS AREA
	PUSH	P,R		;[1401] SAVE THE INDEX
	SOSA	T1		;[1401] NEW TOP OF NEXT LOWER AREA
	SKIPN	TAB.LB(R)	;[1401] FIND THE NEXT LOWER AREA
	SOJN	R,.-1		;[1401] KEEP GOING TILL WE DO
	MOVEM	T1,TAB.UB(R)	;[1401] HAVING DONE SO, RESET IT'S UPPER BOUND
	POP	P,R		;[1401] RESTORE THE INDEX
	MOVE	T1,LW.S0(R)	;[2202] GET HALF AREA BACK
	MOVE	T2,UW.S0(R)	;[2202]
	PUSHJ	P,@[EXP LC.IN,HC.IN]-1(R)
> ;[1401] IFN TOPS20
	POP	P,R		;RESTORE R
	JRST	LNKCON		;TRY AGAIN, MAY RETURN

TPOVF:	POP	P,R		;[2270] RESTORE R
	SKIPE	TP.AB		;[2270] HAVE A TYPECHECKING AREA?
	SKIPE	TP.PP		;[2270] AND ALOWED TO PAGE IT?
	POPJ	P,		;[2270] NO, RETURN NON-SKIP
	SKIPE	PAG.TP		;[2270] ALREADY OVERFLOWED?
	JRST	TPREDU		;[2270] NO
	PUSHJ	P,TP.DMP	;[2270] YES, GET RID OF THEM
	  POPJ	P,		;[2270] DIDN'T GET ANYWHERE
	JRST	LNKCON		;[2270] AND TRY AGAIN

TPREDU:	MOVE	T1,UW.TP	;[2270] GET THE UPPER BOUND
	SUB	T1,LW.TP	;[2270] GET THE SIZE
	CAIGE	T1,2*.IPS	;[2270] MORE THAN TWO PAGES LEFT?
	 POPJ	P,		;[2270] NO, NOTHING TO DO
	LSH	T1,-1		;[2270] GET HALF THE SIZE
	TRO	T1,.IPM		;[2270] SET ON A PAGE BOUNDARY
	ADD	T1,LW.TP	;[2270] PLUS BOTTOM IS HIGHEST TO KEEP
	MOVE	T2,UW.TP	;[2270] GET THE OLD UPPER WINDOW
	MOVEM	T1,UW.TP	;[2270] SET IT AS THE NEW UPPER WINDOW
	ADDI	T1,1		;[2270] FIRST WORD TO REMOVE
	PUSHJ	P,TP.OUT	;[2270] REMOVE IT
	MOVE	T1,UW.TP	;[2270] GET THE UPPER BOUND
	SUB	T1,LW.TP	;[2270] GET THE NEW SIZE
	ADD	T1,TP.LB	;[2270] GET NEW HIGH ADDRESS
	MOVEM	T1,TP.AB	;[2270] SAVE IT
	JRST	LNKCON		;[2270] TRY AGAIN

SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS10


;CALLED BY
;	MOVE	T1,[FIRST,,LAST ADDRESS TO OUTPUT]
;	PUSHJ	P,LC.OUT/HC.OUT/LS.OUT
;USES T1, T2, T3

	IFE TOPS20,<

DEFINE PAGOUT (%AREA,CHAN,WD)<
%AREA'.OUT::
	CAMLE	T2,HB.'WD	;BIGGEST SO FAR?
	MOVEM	T2,HB.'WD	;YES

	IFIDN <%AREA><LC>,<	;[2366] Special if LC area

;[2366] Build byte pointer to the map.  Point at the first page
;[2366] to write.

	SPUSH	<P1,P2,P3,P4>	;[2366] Need lots of acs
	LSH	T1,-.DBS2W	;[2366] From address into 128 word blocks
	LSH	T2,-.DBS2W	;[2366] To address into 128 word blocks
	MOVE	T3,T1		;[2366] Get the from address
	LSH	T3,-.LMS2D	;[2366] Make index into map
	ADJBP	T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry
	
;[2366] Get the next disk block
	
LCOUTL:	LDB	T4,T3		;[2366] Get the window base block
	JUMPN	T4,LCOUTN	;[2366] Check for non-zero

;[2366] Found a zero entry.  Fill in as many zero entries as necessary

	PUSH	P,T3		;[2366] Save the pointer
	PUSH	P,T1		;[2366] And the from block

	MOVE	P1,LC.UM	;[2366] Get the new block number
LCOUTZ:	ADDI	P1,1		;[2366] Actually one higher
	DPB	P1,T3		;[2366] Store the block number
	ADDI	P1,.LMS-1	;[2366] Point to next block group
	MOVEM	P1,LC.UM	;[2366] Adjust upper bound
	ADDI	T1,.LMS		;[2366] Address for next group
	CAML	T1,T2		;[2366] Last index for this write?
	JRST	LCOUTA		;[2366] Yes, go pop acs and continue
	ILDB	T4,T3		;[2366] No, get the next index
	JUMPE	T4,LCOUTZ	;[2366] Get an index if it is zero
LCOUTA:	POP	P,T1		;[2366] Get the from block
	POP	P,T3		;[2366] And the pointer
	JRST	LCOUTL		;[2366] Go output these blocks

;[2366] Found an index.  Add the offset and do USETO

LCOUTN:	MOVE	P1,T1		;[2366] Get the from block
	ANDI	P1,.LMM		;[2366] Get the offset part
	MOVE	P2,T4		;[2366] Get the index base
	ADD	T4,P1		;[2366] Get the actual disk block
	USETO	CHAN,(T4)	;[2366] Set on block
	MOVE	P4,T4		;[2366] Remember the starting block
	
;[2366] Loop looking for contiguous blocks.  Stop when there is
;[2366] either no contiguous block, or when the last block needed
;[2366] is seen.

;[2366] P1 Contains the number of blocks to write
;[2366] P2 Contains the index base for the current block
;[2366] P3 contains the block number to write

	SUBI	P1,.LMS		;[2366] Get the number of blocks
	MOVN	P1,P1		;[2366] As a positive quantity
	MOVE	P3,T1		;[2366] Get a copy of the from block
	TRZ	P3,.LMM		;[2366] Get beginning block for this index

LCOUTM:	ADDI	P3,.LMS		;[2366] Beginning of next index
	CAML	P3,T2		;[2366] Need next index?
	JRST	LCOUTE		;[2366] No
	ILDB	T4,T3		;[2366] Get the next block index
	ADDI	P2,.LMS		;[2366] Increment the previous index
	CAMN	P2,T4		;[2366] Are they the same?
	 CAIL	P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit?
	JRST	LCOUTF		;[2366] No, write what we have
	ADDI	P1,.LMS		;[2366] Got a contiguous chunk, add more blocks
	JRST	LCOUTM		;[2366] Do the next chunk

;[2366] Found the last chunk.  Set P1 to reflect the correct
;[2366] number of blocks.

LCOUTE:	MOVEI	P1,1(T2)	;[2366] Highest block to write
	SUB	P1,T1		;[2366] Minus lowest (for this time)

;[2366] Write the blocks.

LCOUTF:	MOVE	T4,P1		;[2366] Get the number of blocks
	IMULI	T4,-.DBS	;[2366] Make it negative words
	
	MOVE	P2,T1		;[2366] Get back the start
	LSH	P2,.DBS2W	;[2366] In words
	SUB	P2,LW.LC	;[2366] Minus window start (may not be origin)
	ADD	P2,LC.LB	;[2366] Fix in core
	SUBI	P2,1		;[2366] IOWD is one less
	HRL	P2,T4		;[2366] Left half is -count
	SETZ	P3,		;[2366] Terminate list
	OUT	CHAN,P2		;[2366] Dump block
	 CAIA			;[2366] It worked
	 JRST	E$$OLC		;[2366] It failed
	ADDI	P4,-1(P1)	;[2366] Get last block written
	CAMLE	P4,LC.UP	;[2366] Largest physical block written?
	 MOVEM	P4,LC.UP	;[2366] Yes, remember it
	ADD	T1,P1		;[2366] Account for blocks written
	CAMG	T1,T2		;[2366] All done?
	 JRST	LCOUTL		;[2366] No, do some more
	SPOP	<P4,P3,P2,P1>	;[2366] Restore the acs

>;[2366] IFIDN LC

	IFDIF <%AREA><LC>,<	;[2366] FOR NON-LC AREA

	MOVE	T3,T1		;[2330] GET FIRST ADDRESS
	LSH	T3,-.DBS2W	;[2330] INTO 128 WORD BLOCKS
	USETO	CHAN,1(T3)	;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
	MOVE	T3,T1		;FROM
	SUB	T3,T2		;[2330] -TO = -LENGTH
	SUBI	T3,1		;[2330] CORRECT COUNT
	MOVE	T2,T1		;FROM
	SUB	T2,LW.'WD	;MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,%AREA'.LB	;FIX IN CORE
	SUBI	T2,1		;IOWD IS ONE LESS
	HRL	T2,T3		;LEFT HALF IS -COUNT
	SETZ	T3,		;TERMINATE LIST
	OUT	CHAN,T2		;DUMP BLOCK

>;[2366] IFDIF LC
	  POPJ	P,		;OK
E$$O'%AREA::PUSH	P,[CHAN]		;[1174] STACK ERROR CHAN
	.ERR.	(ST,0,V%L,L%F,S%F,O'%AREA,<Error outputting area %AREA>)
>
>	;[1401] END IFE TOP20

SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS20

;[2202] CALLED BY
;[2202]		MOVE	T1,<FIRST ADDRESS TO OUTPUT>
;[2202]		MOVE	T2,<LAST ADDRESS TO OUTPUT>
;[2202]		PUSHJ	P,LC.OUT/HC.OUT/LS.OUT
;[2202]		USES T1, T2, T3, T4

IFN TOPS20,<
DEFINE PAGOUT (%AREA,CHAN,WD)<

%AREA'.OUT::
	MOVEI	T4,%AREA'.IX	;[2202] CHANNEL INFO
	PUSHJ	P,OVF.OU	;[1426] DO THE I/O
	POPJ	P,
E$$O'%AREA::
	PUSHJ	P,JSERR##	;[2264] SET UP THE JSYS ERROR
	..FORK==0		;[2247] ASSUME NOT TO FORK
	IFIDN <%AREA>,<LC>,<..FORK==1> ;[2247] FORK IF LC AREA
	IFIDN <%AREA>,<HC>,<..FORK==1> ;[2247] FORK IF HC AREA
	.ERR.	(MS,.EC,V%L,L%F,S%F,O'%AREA,<Error writing area %AREA>)
IFE ..FORK,<			;[2264]
	.ETC.	(STR,.EC,,,,,< to file >)
	.ETC.	(FSP,.EC,,,,'CHAN) ;[2301]
>;[2247] IFE ..FORK
	.ETC.	(NLN,.EC)	;[2264]	NEW LINE FOR ERROR TEXT
	.ETC.	(STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT
> ;[1426] END PAGOUT

OVF.OU:
OVFOU0:	CAML	T1,T2		;[2247] UPPER LESS THAN LOWER?
	 POPJ	P,		;[2247] YES, DON'T DO ANYTHING
	PUSH	P,T2		;[2202] -1(P): LAST
	PUSH	P,T1		;[2202]  0(P): FIRST
	MOVE	T1,TB.CHN(T4)	;[2202] T1: CHANNEL
	SKIPN	T1,CHAN.JF(T1)	;[2202] JFN?
	 JRST	@TB.OER(T4)	;[2202] GIVE THE ERROR
	CAMG	T2,TAB.HB(T4)	;[2202] BIGGER THAN WHAT WE HAVE?
	JRST	OVFOU1		;[1401] NO, CONTINUE.
	EXCH	T2,TAB.HB(T4)	;[2202] SWAP OLD BOUND FOR NEW
	JUMPN	T2,OVFOU1	;[2202] IF WE'RE STARTING UP A NON-0 SECTION
	MOVE	T2,0(P)		;[2202] T2: FIRST ADDR OF DEST
	LSH	T2,-9		;[1401] T2: FIRST PAGE OF DEST
	MOVE	T3,-1(P)	;[2202] T3: LAST ADDR 
	LSH	T3,-9		;[1401] T3: LAST PAGE 
	SUBI	T3,-1(T2)	;[2202] T3: PAGE COUNT.   NOTE THAT
				;[2202] (FIRST-LAST)+1 = FIRST-(LAST-1)
	TXO	T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
	HRL	T2,T1		;[1401]  T2: JFN,,FIRST PAGE
	MOVE	T1,0(P)		;[2202] LOWER BOUND OF BLOCK
	SUB	T1,TAB.LW(T4)	;[2202] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T1,TAB.LB(T4)	;[2202] FIX IN CORE
	LSH	T1,-9		;[1401] RELOCATE TO REAL PAGE
	HRLI	T1,.FHSLF	;[1401] T1: SELF,,SOURCE PAGE
	PMAP%			;[1401] OUT THEY GO
	  ERCAL	PMAPER		;[2023] TRY EXPUNGE IF QUOTA EXCEEDED

OVFOU1:	MOVE	T2,0(P)		;[2202] T2: First addr of dest
	MOVE	T3,-1(P)	;[2202] T3: Last addr 
	SUB	T3,T2		;[2202] T3: Number of words
	LSH	T3,-9		;[2202] T3: Number of pages
	ADDI	T3,1		;[2302] T3: Size of area
	TXO	T3,PM%CNT	;[2302] SET COUNT
	SUB	T2,TAB.LW(T4)	;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,TAB.LB(T4)	;[1401] FIX IN CORE
	LSH	T2,-9		;[1401]  RELOCATE TO REAL PAGE
	HRLI	T2,.FHSLF	;[1401]  T2: SELF,,SOURCE PAGE
	SETOM	T1		;[1401] UNMAP
	PMAP%			;[1401]  OUT THEY GO
	  ERCAL	@TB.OER(T4)	;[1426] GIVE THE ERROR
	POP	P,T1		;[2202] LOWER BOUND
	POP	P,T2		;[2202] UPPER BOUND
	POPJ	P,		;[1401]  NORMAL RETURN


;This routine expunges the directory if a PMAP fails with a Quota Exceeded
;violation



PMAPER: DMOVEM	T1,CRTMP1	;[2024] Save AC's from PMAP%
	MOVEM	T3,CRTMP3	;[2024] in CRTMP1-3
	MOVEI	T1,.FHSLF	;[2024] This process
	GETER%			;[2024] Get last error
	 ERJMP @TB.OER(T4)	;[2202] 
	HRRZS	T2		;[2024] Just the error number
	CAIE	T2,IOX11	;[2024] Is it Quota Exceeded error?
	JRST	@TB.OER(T4)	;[2215] No - just give error
	PUSHJ	P,EXPNG		;[2024] Yes - Try expunging the directory
	POPJ 	P,		;[2024] Return to PMAPER caller

EXPNG::	PUSH	P,T4
	HLRZ	T2,CRTMP2	;[2024] Get the JFN
	SETZB	T1,T3		;[2024] No flags - no directory groups
	RCDIR%			;[2024] Just get the directory number
	 ERJMP	BADRET
	MOVE 	T2,T3		;[2024] Directory number to T2
	DELDF%			;[2024] Expunge the directory
	 ERJMP	BADRET
	SETZ	T3,		;[2024] Zero T3
	MOVE	T1,CRTMP2	;[2024] Destination to T1
	HRRZ	T4,CRTMP3	;[2024] Number of pages attempted
MAPPAG:	HRRZ	T2,CRTMP2	;[2024] Starting page of destination
	ADD	T2,T3		;[2024] Calculate page to check for
	HRR	T1,T2		;[2024] That page to T1
	RPACS%			;[2024] Get access bits for that page
         ERJMP	BADRET		;[2024]
	TXNN	T2,PA%PEX	;[2024] Does that page exist?
	JRST	NOPAGE		;[2024] No
	AOS	T3		;[2024] Yes - increment count
	SOJG	T4,MAPPAG	;[2024] Check the next page
	 JRST	BADRET
NOPAGE:	DMOVE	T1,CRTMP1	;[2024] Restore PMAP% source and destination
	ADD	T1,T3		;[2024] Page number of source to start from
	ADD	T2,T3		;[2024] Page number of destination to start at
	MOVE 	T3,CRTMP3	;[2024] Flag bits for PMAP%
	HRR	T3,T4		;[2024] Count of pages left to map
	PMAP%			;[2024] Try again
	 ERJMP	BADRET		;[2024] Failed again give up and go home
	POP	P,T4
	POPJ	P,		;[2024] Success - pop,pop home and go on
BADRET:	POP	P,T4
	AOS	(P)		;[2024] Skip return for failures
	POPJ	P,

DEFINE XXX(%AREA)<			;;[1230] DEFINE ERROR MESSAGE ADDRS
  IFDEF %AREA'.OUT,<			;;[2264] IF OVERFLOW ROUTINE EXISTS
	EXP	E$$O'%AREA			;[1230] ERROR WITH %AREA FILE
  >
  IFNDEF %AREA'.OUT,<			;;[2264] IF NO OVERFLOW ROUTINE EXISTS
	EXP	[HALT]			;[1230] %AREA AREA DOES NOT PAGE
  >
>

	XALL				;[1230]
TB.OER:	AREAS				;[1230]  GENERATE ERROR MESSAGE ADDRS
	SALL				;[1230]

>	;[1401] END IFN TOP20


	XALL
;LOW SEGMENT
PAGOUT	(LC,LC,S1)
;HIGH SEGMENT
PAGOUT (HC,HC,S2)
;SYMBOL TABLE
PAGOUT	(LS,SC,LS)
;ALGOL SYMBOLS
PAGOUT	(AS,AC,AS)
;ARGUMENT TYPECHECKING [2270]
PAGOUT	(TP,PC,TP) ;[2270]
	SALL
SUBTTL DISK OVERFLOW ROUTINES -- INPUT -- TOPS10


;CALLED BY
;	MOVE	T1,[FIRST,,LAST ADDRESS TO INPUT]
;	PUSHJ	P,LC.IN/HC.IN/LS.IN
;USES T1, T2, T3

	IFE TOPS20,<

DEFINE	PAGIN (%AREA,CHAN,WD,FIXUP,%OK)<
%AREA'.IN::

	IFIDN <%AREA><LC>,<	;[2366] Special if LC area

	CAMLE	T2,HB.LC	;[2366] Bigger than what we have?
	MOVEM	T2,HB.LC	;[2366] Yes, reset highest

;[2366] Build byte pointer to the map.  Point at the first page
;[2366] to read.

	SPUSH	<P1,P2,P3,P4>	;[2366] Need lots of acs
	LSH	T1,-.DBS2W	;[2366] From address into 128 word blocks
	LSH	T2,-.DBS2W	;[2366] To address into 128 word blocks
	MOVE	T3,T1		;[2366] Get the from address
	LSH	T3,-.LMS2D	;[2366] Make index into map
	ADJBP	T3,[POINT 18,LC.MAP,17] ;[2366] Find the offset into the entry
	
;[2366] Get the next disk block
	
LCINL:	LDB	T4,T3		;[2366] Get the window base block
	JUMPN	T4,LCINN	;[2366] Check for non-zero

;[2366] Found a zero entry.  Zero memory as necessary, disk space will
;[2366] be allocated when the pages are written.  The disk pages are
;[2366] not allocated here because the .EXE file writer sometimes tries
;[2366] to read in much more than it needs.

	MOVE	P1,T1		;[2366] Get the from block
	LSH	P1,.DBS2W	;[2366] In words
	SUB	P1,LW.LC	;[2366] Minus window start (may not be origin)
	ADD	P1,LC.LB	;[2366] Fix in core

	TRO	T1,.LMM		;[2366] End of this area
	MOVE	P2,T1		;[2366] Get the from block
	CAML	P2,T2		;[2366] Beyond what's wanted?
	MOVE	P2,T2		;[2366] Yes, use top wanted
	LSH	P2,.DBS2W	;[2366] In words
	TRO	P2,.DBM		;[2366] At top of page
	SUB	P2,LW.LC	;[2366] Minus window start (may not be origin)
	ADD	P2,LC.LB	;[2366] Fix in core

	SETZM	(P1)		;[2366] Zero the first word
	HRLS	P1		;[2366] Build BLT word
	ADDI	P1,1		;[2366] As from,,to
	BLT	P1,(P2)		;[2366] Zero memory

	IBP	T3		;[2366] Go to the next block
	AOJA	T1,LCINZ	;[2366] Do next area

;[2366] Found an index.  Add the offset.

LCINN:	MOVE	P1,T1		;[2366] Get the from block
	ANDI	P1,.LMM		;[2366] Get the offset part
	MOVE	P2,T4		;[2366] Get the index base
	ADD	T4,P1		;[2366] Get the actual disk block
	MOVE	P4,T4		;[2366] Remember initial block
	
;[2366] Loop looking for contiguous blocks.  Stop when there is
;[2366] either no contiguous block, or when the last block needed
;[2366] is seen.

;[2366] P1 Contains the number of blocks to read
;[2366] P2 Contains the index base for the current block
;[2366] P3 Contains the block number to read

	SUBI	P1,.LMS		;[2366] Get the number of blocks
	MOVN	P1,P1		;[2366] As a positive quantity
	MOVE	P3,T1		;[2366] Get a copy of the from block
	TRZ	P3,.LMM		;[2366] Get beginning block for this index

LCINM:	ADDI	P3,.LMS		;[2366] Beginning of next index
	CAML	P3,T2		;[2366] Need next index?
	JRST	LCINE		;[2366] No
	ILDB	T4,T3		;[2366] Get the next block index
	ADDI	P2,.LMS		;[2366] Increment the previous index
	CAMN	P2,T4		;[2366] Are they the same?
	 CAIL	P1,<<400000/.DBS>-.LMS> ;[2366] And IOWD below limit?
	JRST	LCINF		;[2366] No, write what we have
	ADDI	P1,.LMS		;[2366] Got a contiguous chunk, add more blocks
	JRST	LCINM		;[2366] Do the next chunk

;[2366] Found the last chunk.  Set P1 to reflect the correct
;[2366] number of blocks.

LCINE:	MOVEI	P1,1(T2)	;[2366] Highest block to write
	SUB	P1,T1		;[2366] Minus lowest (for this time)

;[2366] Make sure the blocks exist in the overflow file
				;

LCINF:	MOVE	T4,P4		;[2366] Get the first block to read
	ADDI	T4,-1(P1)	;[2366] Get the highest block to be read
	CAMG	T4,LC.UP	;[2366] Higher than exists in file?
	 JRST	LCINR		;[2366] No, read the file

	USETO	CHAN,1(T4)	;[2366] Create new blocks to read
	MOVEM	T4,LC.UP	;[2366] Remember new highest block

;[2366] Read the blocks.

LCINR:	USETI	CHAN,(P4)	;[2366] Set on block
	MOVE	T4,P1		;[2366] Get the number of blocks
	IMULI	T4,-.DBS	;[2366] Make it negative words
	
	MOVE	P2,T1		;[2366] Get back the start
	LSH	P2,.DBS2W	;[2366] In words
	SUB	P2,LW.LC	;[2366] Minus window start (may not be origin)
	ADD	P2,LC.LB	;[2366] Fix in core
	SUBI	P2,1		;[2366] Iowd is one less
	HRL	P2,T4		;[2366] Left half is -count
	SETZ	P3,		;[2366] Terminate list
	IN	CHAN,P2		;[2366] Read block
	 CAIA			;[2366] It worked
	 JRST	E$$ILC		;[2366] It failed
	ADD	T1,P1		;[2366] Account for blocks written
LCINZ:	CAMG	T1,T2		;[2366] All done?
	 JRST	LCINL		;[2366] No, do some more
	SPOP	<P4,P3,P2,P1>	;[2366] Restore the acs

>;[2366] IFIDN LC

	IFDIF <%AREA><LC>,<	;[2366] FOR NON-LC AREA

	MOVE	T3,T2		;[2330] GET LAST ADDRESS WE NEED
	CAMG	T2,HB.'WD	;BIGGER THAN WHAT WE HAVE?
	JRST	%OK		;NO
	MOVEM	T2,HB.'WD	;YES, RESET HIGHEST
	LSH	T3,-.DBS2W	;[2330] MUST DO USETO TO ZERO FILE
				;SO WE WILL INPUT ZERO DATA
	USETO	CHAN,2(T3)	;[2330] YES, GET THIS MUCH
%OK:!	MOVE	T3,T1		;[2330] GET FIRST ADDRESS
	LSH	T3,-.DBS2W	;[2330] INTO 128 WORD BLOCKS
	USETI	CHAN,1(T3)	;[2330] SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
	MOVE	T3,T1		;[2330] FROM
	SUB	T3,T2		;[2330] -TO = -LENGTH
	SUBI	T3,1		;[2330] CORRECT LENGTH
	MOVE	T2,T1		;[2330] FROM
	SUB	T2,LW.'WD	;MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,%AREA'.LB	;FIX IN CORE
	SUBI	T2,1		;IOWD IS ONE LESS
	HRL	T2,T3		;LEFT HALF IS -COUNT
	SETZ	T3,		;TERMINATE LIST
	IN	CHAN,T2		;DUMP BLOCK

>;[2366] IFDIF LC

IFB <FIXUP>,<
	  POPJ	P,		;OK
>
IFNB <FIXUP>,<
	  PJRST	%AREA'.FXR		;DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::PUSH	P,[CHAN]		;[1174] SAVE ERROR CHAN
	.ERR.	(ST,0,V%L,L%F,S%F,I'%AREA,<Error inputting area %AREA>)
>

>	;[1401] END IFE TOPS20
SUBTTL DISK OVERFLOW -- INPUT -- TOPS20

;[2202] CALLED BY
;[2202]		MOVE	T1,<FIRST ADDRESS TO INPUT>
;[2202]		MOVE	T2,<LAST ADDRESS TO INPUT>
;[2202]		PUSHJ	P,LC.IN/HC.IN/LS.IN
;[2202]		USES T1, T2, T3, T4
IFN TOPS20,<
DEFINE	PAGIN (%AREA,CHAN,WD,FIXUP)<
%AREA'.IN::
	MOVEI	T4,%AREA'.IX	;[2202] CHANNEL INFO
	PUSHJ	P,OVF.IN	;[1426] DO THE I/O
IFB <FIXUP>,<
	  POPJ	P,		;[1401] OK
>
IFNB <FIXUP>,<
	  PJRST	%AREA'.FXR	;[1401] DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::
	PUSHJ	P,JSERR##	;[2264] SET UP THE JSYS ERROR
	..FORK==0		;[2247] ASSUME NOT TO FORK
	IFIDN <%AREA>,<LC>,<..FORK==1> ;[2247] FORK IF LC AREA
	IFIDN <%AREA>,<HC>,<..FORK==1> ;[2247] FORK IF HC AREA
	.ERR.	(MS,.EC,V%L,L%F,S%F,I'%AREA,<Error reading area %AREA>)
IFE ..FORK,<			;[2264]
	.ETC.	(STR,.EC,,,,,< from file >)
	.ETC.	(FSP,.EC,,,,'CHAN) ;[2301]
>;[2247] IFE ..FORK
	.ETC.	(NLN,.EC)	;[2264]	NEW LINE FOR ERROR TEXT
	.ETC.	(STR,,,,,ERRJSY) ;[2264] TYPE ERSTR% TEXT
	POPJ	P,
> ;[1426] END PAGIN

OVF.IN:
	PUSH	P,P1		;[1426] SAVE REGISTER
	PUSH	P,T2		;[2202] -1(P): LAST
	PUSH	P,T1		;[2202]  0(P): FIRST
	CAIE	T4,LC.IX	;[2202] LOW SEGMENT?
	 CAIN	T4,HC.IX	;[2247] OR HIGH SEGMENT?
	 CAIA			;[2247] YES, MUST CHECK SECTIONS
	 JRST	OVFIN1		;[2202] NO
	MOVE	P1,T1		;[2247] GET THE LOWER BOUND
	PUSHJ	P,NEWSCT	;[2202] MAKE SURE IT EXISTS
	MOVE	P1,-1(P)	;[2247] GET THE UPPER BOUND
	PUSHJ	P,NEWSCT	;[2202] MAKE SURE IT EXISTS
OVFIN1:	MOVE	T1,TB.CHN(T4)	;[2202] GET THE CHANNEL
	SKIPN	T1,CHAN.JF(T1)	;[2202] JFN?
	 JRST	@TB.IER(T4)	;[2202] GIVE THE ERROR
	HRLS	T1		;[1401] JFN IN RH
	MOVE	T2,0(P)		;[2202] T2: FIRST ADDRESS
	CAIE	T4,HC.IX	;[2321] HIGH SEGMENT?
	 JRST	OVFIN2		;[2321] NO, LOW SEGMENT
	HRRZ	T3,LL.S2	;[2321] YES, GET OFFSET INTO FILE
	ADD	T2,T3		;[2321] ADD IT
OVFIN2:	LSH	T2,-9		;[2321] IN PAGES, PLEASE
	HRR	T1,T2		;[1401] JFN,,FILE PAGE
	MOVE	T3,-1(P)	;[2202] GET LAST ADDRESS
	CAMLE	T3,TAB.HB(T4)	;[2202] BIGGER THAN WHAT WE HAVE?
	MOVEM	T3,TAB.HB(T4)	;[2202] YES, RESET HIGHEST
	SUB	T3,0(P)		;[2247] T3:LAST-FIRST
	LSH	T3,-9		;[1401] IN PAGES
	ADDI	T3,1		;[2302] NUMBER OF PAGES TO MAP
	TXO	T3,<PM%CNT!PM%RWX> ;[2202] SET COUNT, READ/WRITE/EXEC FLAGS
	MOVE	T2,0(P)		;[2202] LOWER BOUND OF BLOCK
	SUB	T2,TAB.LW(T4)	;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,TAB.LB(T4)	;[1401] FIX IN CORE
	LSH	T2,-9		;[1401] IN PAGES
	HRLI	T2,.FHSLF	;[1401] PROCESS IS SELF
	PMAP%			;[1401] MAP THESE PAGES
	  ERCAL	@TB.IER(T4)	;[2202] GIVE THE ERROR
	POP	P,T1		;[1401] CLEAN UP STACK
	POP	P,T2
	POP	P,P1
	POPJ	P,		;[1426] AND RETURN

NEWSCT::			;[2242]
	PUSH	P,T4		;[2365] SAVE T4
	HRRZ	T2,LL.S0(T4)	;[2321] GET THE SEGMENT OFFSET
	ADD	P1,T2		;[2321] ADD IT
	HLRZS	P1		;[2247] GET THE SECTION NUMBER
	MOVN	T2,P1		;[2202] GET THE NEGATED SECTION NUMBER
	SKIPE	OVERLW		;[2235] DOING OVERLAYS?
	 JUMPN	P1,E$$CBO	;[2235] YES, MUST BE DOING SECTION ZERO
	CAIN	T4,HC.IX	;[2247] HIGH SEGMENT?
	 JUMPN	P1,E$$NHN##	;[2247] YES, MUST BE DOING SECTION ZERO
	HRLZI	T1,400000	;[1450] SET B0
	LSH	T1,(T2)		;[2213] B(N)=SECT(N)
	TDNE	T1,FXSBIT	;[2200] THIS BIT SET IN ARRAY MAP WORD?
	 JRST	NEWSC1		;[2365] YES, THE SECTION'S THERE ALREADY
	IORM	T1,FXSBIT	;[1450] NO, SAY IT'S THERE
	PUSHJ	P,E$$CRS	;[1450] SAY WE'RE CREATING THE SECTION
	JUMPE	P1,NEWSC1	;[2365] DON'T REALLY CREATE SECTION ZERO
	SETZM	T1		;[1450] CREATE THE SECTION
	HRRZ	T2,P1		;[1450] SPECIFY WHICH
	HRL	T2,LC.JF	;[2247] AND WHERE
	MOVE	T3,[SM%RD!SM%WR!SM%EX!1] ;[2202] CREATE ONE SECTION
	SMAP%
	  ERCAL E$$CCS
NEWSC1:	POP	P,T4		;[2365] RESTORE T4
	POPJ	P,		;[1450] AND RETURN

E$$CCS::.ERR.	(MS,.EC,V%L,L%F,S%F,CCS,<Cannot create section >) ;[2202]
	.ETC.	(OCT,.EP!.EC,,,,P1)	;[2264]
	.ETC.	(JMP,,,,,.ETIMF##)	;[2264] Type the filename

>	;[2301] END IFN TOPS20

E$$CBO::.ERR.	(MS,,V%L,L%F,S%F,CBO,<Cannot build overlays outside section zero>) ;[2235]

DEFINE XXX(%AREA)<			;;[1230] DEFINE ERROR MESSAGE ADDRS
  IFDEF %AREA'.IN,<			;;[2264] IF OVERFLOW ROUTINE EXISTS
	EXP	E$$I'%AREA			;[1230] ERROR WITH %AREA FILE
  >
  IFNDEF %AREA'.IN,<			;;[2264] IF NO OVERFLOW ROUTINE EXISTS
	EXP	[HALT]			;[1230] %AREA AREA DOES NOT PAGE
  >
>

	XALL				;[1230]
TB.IER:	AREAS				;[1230]  GENERATE ERROR MESSAGE ADDRS
	SALL				;[1230]


	XALL
;LOW SEGMENT
PAGIN	(LC,LC,S1,)
;HIGH SEGMENT
PAGIN	(HC,HC,S2,)
;SYMBOL FILE
PAGIN	(LS,SC,LS,LS.FXR)
;ALGOL SYMBOLS
PAGIN	(AS,AC,AS,)
;ARGUMENT TYPECHECKING [2270]
PAGIN	(TP,PC,TP,) ;[2270]
	SALL
;TABLES OF XX.IN AND XX.OUT, INDEXED BY XX.IX

DEFINE	XXX(%AREA)<
IFDEF %AREA'.IN,<
	EXP	%AREA'.IN
>
IFNDEF %AREA'.IN,<
	EXP	[HALT]
>>
	XALL

TB.IN::	AREAS


DEFINE XXX(%AREA)<
IFDEF %AREA'.OUT,<
	EXP	%AREA'.OUT
>
IFNDEF %AREA'.OUT,<
	EXP	[HALT]
>>

TB.OUT::AREAS

	SALL
SUBTTL	TABLES USED BY ??.DMP, INDEXED BY ??.IX


DEFINE XXX(%AREA)<			;;[1230] DEFINE TEMP FILE NAMES
  IFDEF %AREA'.DMP,<
	EXP	'L'%AREA''			;[1230] FOR nnn'%AREA'.TMP
  >
  IFNDEF %AREA'.DMP,<
	EXP	0			;[1230] %AREA AREA DOES NOT PAGE
  >
>

	XALL				;[1230]
TB.NAM:	AREAS				;[1230] GENERATE TEMP FILE NAMES
	SALL				;[1230]


TB.CHN:	EXP	0			;[1230] DY AREA DOES NOT PAGE
	XWD	0,LC			;[1230] LC AREA CHANNELS
	XWD	0,HC			;[1230] HC AREA CHANNELS
	XWD	%SC,AC			;[1230] AS AREA CHANNELS
	EXP	0			;[1230] RT AREA DOES NOT PAGE
	XWD	%SC,SC			;[1230] LS AREA CHANNELS
	EXP	0			;[1230] FX AREA DOES NOT PAGE
	XWD	0,PC			;[2270] TP AREA CHANNELS
	EXP	0			;[1230] BG AREA DOES NOT PAGE
	EXP	0			;[1230] GS AREA DOES NOT PAGE
DEFINE XXX(%AREA)<			;;[1230] DEFINE PAGING MESSAGE ADDRS
  IFDEF %AREA'.DMP,<
	EXP	E$$P'%AREA			;[1230] PAGING AREA %AREA
  >
  IFNDEF %AREA'.DMP,<
	EXP	[HALT]			;[1230] %AREA AREA DOES NOT PAGE
  >
>

	XALL				;[1230]
TB.PAG:	AREAS				;[1230] GENERATE PAGING MESSAGE ADDRS
	SALL				;[1230]

IFE TOPS20,<				;[2247]
E$$PLC::.ERR.	(MS,0,V%L,L%I,S%I,PLC,<Area LC overflowing to disk>) ;[1230]
	POPJ	P,			;[1230] RETURN

E$$PHC::.ERR.	(MS,0,V%L,L%I,S%I,PHC,<Area HC overflowing to disk>) ;[1230]
	POPJ	P,			;[1230] RETURN
>;[2247] IFE TOPS20

E$$PLS::.ERR.	(MS,0,V%L,L%I,S%I,PLS,<Area LS overflowing to disk>) ;[1230]
	POPJ	P,			;[1230] RETURN

E$$PAS::.ERR.	(MS,0,V%L,L%I,S%I,PAS,<Area AS overflowing to disk>) ;[1230]
	POPJ	P,			;[1230] RETURN

E$$PTP::.ERR.	(MS,0,V%L,L%I,S%I,PTP,<Area TP overflowing to disk>) ;[2270]
	POPJ	P,			;[2270] RETURN

IFN TOPS20,<	;[2202]
E$$CRS::
	.ERR.	(MS,.EC,V%L,L%I,S%I,CRS,<Creating section >) ;[1450]
	.ETC.	(OCT,.EP,,,,P1)		;[1450]
	POPJ	P,			;[1450] RETURN
> ;[2202] IFN TOPS20


DEFINE XXX(%AREA)<			;;[1230] DEFINE ERROR MESSAGE ADDRS
  IFDEF %AREA'.DMP,<
	EXP	E$$E'%AREA			;[1230] ERROR WITH %AREA FILE
  >
  IFNDEF %AREA'.DMP,<
	EXP	[HALT]			;[1230] %AREA AREA DOES NOT PAGE
  >
>

	XALL				;[1230]
TB.ERR:	AREAS				;[1230]  GENERATE ERROR MESSAGE ADDRS
	SALL				;[1230]

IFE TOPS20,<				;[2270]
E$$ELC::PUSH	P,[LC]			;[2051] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>)

E$$EHC::PUSH	P,[HC]			;[2051] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>)

E$$ELS::PUSH	P,[SC]			;[2051] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>)

E$$EAS::PUSH	P,[AC]			;[2051] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>)

E$$ETP::PUSH	P,[PC]			;[2270] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,ETP,<Error creating area TP overflow file>) ;[2270]

>;[2301] IFE TOPS20
IFN TOPS20,<				;[2301]
E$$ELS::PUSH	P,[SC]			;[2301] INDICATE WHICH CHANNEL
	.ERR.	(LRE,.EC,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[2301]
	.ETC.	(NLN,.EC)	 ;[2301] CRLF
	.ETC.	(STR,,,,,ERRJSY) ;[2301] Type error text

E$$EAS::PUSH	P,[AC]			;[2301] INDICATE WHICH CHANNEL
	.ERR.	(LRE,.EC,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[2301]
	.ETC.	(NLN,.EC)	 ;[2301] CRLF
	.ETC.	(STR,,,,,ERRJSY) ;[2301] Type error text

E$$ETP::PUSH	P,[PC]			;[2301] INDICATE WHICH CHANNEL
	.ERR.	(LRE,.EC,V%L,L%F,S%F,ETP,<Error creating area TP overflow file>) ;[2301]
	.ETC.	(NLN,.EC)	 ;[2301] CRLF
	.ETC.	(STR,,,,,ERRJSY) ;[2301] Type error text
>;[2301] IFN TOPS20
SUBTTL	DUMP LOCAL SYMBOL AREAS (LS AND AS) WHEN MEMORY IS FULL


LS.DMP::SPUSH	<R,P1>			;[1230] SAVE SOME ACS
	MOVX	R,LS.IX			;[1230] SET UP LS AREA INDEX
	PUSHJ	P,LA.DMP		;[1230] COMMON CODE TO SET UP FILE
	  JRST	LARET			;[1230] DIDN'T NEED TO OVERFLOW--RETURN
	MOVE	P1,TAB.AB(R)		;[1230] SIZE OF LS AREA
	SUB	P1,TAB.LB(R)		;[1230] ALMOST ANYWAY
  IFE TOPS20,<
	SUBI	P1,.IPS			;[1230] HIGHEST TO OUTPUT
  >  ;[1401]
	SETZ	T1,			;[2202] START AT ZERO
	MOVE	T2,P1			;[2202] GIVE BACK THIS MUCH
	PUSHJ	P,@TB.OUT(R)		;[1230] GENERAL OUTPUT ROUTINE

IFN TOPS20,<
	SUBI	P1,.IPS		;[1401] KEEP ONE PAGE
	ADDI	P1,1		;[1401] LOWEST TO KEEP
	MOVEM	P1,LW.S0(R)	;[1401] WILL BECOME WINDOW LOWER LIMIT
	MOVE	T1,P1		;[2202] BRING IT BACK
	PUSHJ	P,@TB.IN(R)	;[1401] ...
	MOVE	T1,TAB.AB(R)	;[1401] RESET ALLOCATION POINTER
	SUBM	T1,TAB.PT(R)	;[1401] ...
	MOVE	T1,TAB.LB(R)	;[1401] PICK UP LOWERBOUND
	ADDI	T1,.IPS-1	;[1401] RESET TAB.AB(R) TO NEW LIMITS
	MOVEM	T1,TAB.AB(R)
	SUBM	T1,TAB.PT(R)	;[1401] RESET LS.PT
>	;[2202]  IFN TOPS20
	MOVE	T1,P1		;[1401] 
	ADD	T1,TAB.LB(R)	;[1230] ADD IN OFFSET
IFE TOPS20,<
	ADDI	P1,1			;[1230] LOWEST TO KEEP FOR GBCK.L
>	;[1401] IFE TOPS20
	JRST	LARET1			;[1230] GIVE BACK FREED MEM AND RETURN


TP.DMP::SPUSH	<R,P1>			;[2270] SAVE SOME ACS
	MOVX	R,TP.IX			;[2270] SET UP LS AREA INDEX
	PUSHJ	P,LA.DMP		;[2270] COMMON CODE TO SET UP FILE
	  JRST	LARET			;[2270] DIDN'T NEED TO OVERFLOW--RETURN
	MOVE	T2,TP.AB		;[2270] GET THE TOP
	SUB	T2,TP.LB		;[2270] MINUS BOTTOM IS SIZE
	SETZ	T1,			;[2270] START FROM THE BEGINNING
	MOVEM	T2,TPPTR		;[2422] SAVE SIZE
	PUSHJ	P,TP.OUT		;[2270] WRITE IT
	MOVE	T2,TPPTR		;[2422] SIZE OF TP AREA WE JUST WROTE
	AOS	TPPTR			;[2422] +1=POINTER TO NEXT FREE
	MOVE	T1,T2			;[2270] GET THE SIZE
	LSH	T1,-1			;[2270][2422] GET HALF OF THE AREA
	TRZ	T1,.IPM			;[2270] AS BEGINNING OF A PAGE
	MOVEM	T1,LW.TP		;[2270] STORE AS LOWER WINDOW
	MOVEM	T2,UW.TP		;[2270] AND UPPER WINDOW
	PUSHJ	P,TP.IN			;[2270] READ IT
	MOVE	T2,UW.TP		;[2422] UPPER WINDOW
	SUB	T2,LW.TP		;[2422] -LOWER WINDOW = SIZE OF AREA
	ADD	T2,TP.LB		;[2270] HIGHEST LOC IN AREA
	MOVEM	T2,TP.AB		;[2270] STORE IT
	JRST	LARET2			;[2270] DONE

AS.DMP::SPUSH	<R,P1>			;[1230] SAVE SOME ACS
	MOVX	R,AS.IX			;[1230] SET UP AS AREA INDEX
	PUSHJ	P,LA.DMP		;[1230] COMMON CODE TO SET UP FILE
	  JRST	LARET			;[1230] DIDN'T NEED TO OVERFLOW--RETURN
	MOVE	P1,TAB.PT(R)		;[1230] FIGURE SIZE OF AS AREA
	SUB	P1,TAB.LB(R)		;[1230] NOT COUNTING THAT ABOVE PT
	ANDCMI	P1,.IPM			;[1230] FIND EXTRANEOUS BLOCKS
	SETZ	T1,			;[2202] STARTING AT ZERO
	MOVE	T2,P1			;[2202] COPY
	SUBI	T2,1			;[2202] GET ADDR OF LAST TO OUTPUT
	PUSHJ	P,@TB.OUT(R)		;[1230] WRITE OUT THE DATA
	MOVE	T1,TAB.PT(R)		;[1230] GET FIRST PHYS PAGE TO KEEP
	ANDCMI	T1,.IPM			;[1230] POINT TO 1ST WORD IN PAGE
	SUBI	T1,1			;[1230] WORD BEFORE IS HIGHEST TO RETURN
;	JRST	LARET1			;[1230] FALL INTO IT


LARET1:
	SETOM	TAB.UW(R)		;[1230] SIGNAL PAGING BUT NO UPPER LIMIT
 IFE TOPS20,<
	MOVEM	P1,TAB.LW(R)		;[1230] FIX WINDOW LOWER LIMIT
	PUSHJ	P,GBCK.L		;[1230] GIVE IT AWAY
  > ;[1401]
LARET2:	PUSHJ	P,GETIOM		;[2270] USE SOME OF NEW AREA FOR IO.EMG
	AOS	-2(P)			;[1230] INDICATE SKIP RETURN
LARET:	SPOP	<P1,R>			;[1230] COMMON RETURN--RESTORE ACS
	POPJ	P,			;[1230] DONE
LA.DMP::MOVE	T1,TAB.AB(R)		;[1230] COMPUTE SIZE OF LS AREA
	SUB	T1,TAB.LB(R)		;[1230]   ..
	ANDCMI	T1,.IPM			;[1230] BUT NOT LAST PAGE
	JUMPE	T1,CPOPJ		;[1230] IF 1P, DON'T BOTHER
	PUSHJ	P,@TB.PAG(R)		;[1230] GIVE OVERFLOW MESSAGE
	MOVE	T1,IO.EMG		;[1230] ALLOCATE EMERG. AREA
	HRRZ	T2,TB.CHN(R)		;[1230]   FOR PROPER CHANNEL
	MOVEM	T1,IO.PTR(T2)		;[1230]   ..
	SETZM	IO.EMG			;[1230] NOT FREE NOW (RESET LATER)
	MOVEI	T2,.IODPR		;[1230] USE DUMP RECORDS MODE
	MOVEM	T2,I.MOD(T1)		;[1230]   ..
	MOVEI	T2,LN.RIB-1		;[1230] SIZE OF EXTENDED ENTER BLOCK
	MOVEM	T2,I.RIB(T1)		;[1230]   ..
	MOVE	T2,JOBNUM		;[1230] BUILD nnnL?? FILE NAME
	HRR	T2,TB.NAM(R)		;[1230]   ..
	MOVEM	T2,I.NAM(T1)		;[1230]   ..
	MOVSI	T2,'TMP'		;[1230] BUILD EXTENSION TOO
	MOVEM	T2,I.EXT(T1)		;[1230]   ..
	SETZM	I.PRV(T1)		;[1230] STANDARD PROTECTION
	MOVE	T2,TAB.AB(R)		;[1230] GET LENGTH OF AREA
	SUB	T2,TAB.LB(R)		;[1230]   ..
	LSH	T2,-<.DBS2W-1>		;[1230] ASSUME THIS IS HALF OF IT
	MOVEM	T2,I.EST(T1)		;[1230] AS GOOD A GUESS AS ANY OTHER
	SKIPLE	T2,SYMFRM		;[1230] USER REQUESTING A SYMBOL FILE?
	CAME	T2,[EXP $SYMALGOL,0,$SYMTRIPLET]-AS.IX(R) ;[1230]   ..
	JRST	LADMP1			;[1230] NO--JUST OVERFLOW TO DSK:[-]

	HLRZ	T1,TB.CHN(R)		;[1230] WRITING A SYMBOL FILE--TRY TO
	HRRZ	T2,TB.CHN(R)		;[1230]   WRITE OVERFLOW FILE THERE
	PUSHJ	P,DVSUP.##		;[1230]   ..
	  PUSHJ	P,@TB.ERR(R)		;[1230] CAN'T--GO PRINT ERROR AND DIE
	JRST	CPOPJ1			;[1230] DONE

LADMP1:	MOVX	T2,'DSK   '		;[1230] WRITE OVERFLOW FILE TO DSK:[-]
	MOVEM	T2,I.DEV(T1)		;[1230]   ..
	SETZM	I.RIB+.RBPPN(T1)	;[1230]   ..
	HRRZ	T1,TB.CHN(R)		;[1230] OVERFLOW AREA ON PROPER CHANNEL
	PUSHJ	P,DVUPD.##		;[1230]   ..
	  PUSHJ	P,@TB.ERR(R)		;[1230] CAN'T--GO PRINT ERROR AND DIE
	JRST	CPOPJ1			;[1230] DONE
SUBTTL	DUMP LOW/HIGH SEG DATA WHEN CORE IS FULL

IFE TOPS20,<			;[2247]
;HERE FOR LOW SEG
LC.DMP::PUSH	P,R		;[1230] SAVE R
	MOVEI	R,LC.IX		;INDEX FOR LOW
	JRST	LH.DMP		;GO DUMP IT



;HERE FOR HIGH SEG
HC.DMP::PUSH	P,R		;[1230] SET UP INDEX FOR HC AREA
	MOVEI	R,HC.IX
				;FALL INTO LH.DMP
;HERE TO DUMP EITHER LOW OR HIGH
;ENTER WITH R=LC.IX OR HC.IX

LH.DMP:
	PUSHJ	P,@TB.PAG(R)	;[1230] PRINT OVERFLOW MESSAGE
	MOVE	T1,IO.EMG	;[604] GET TEMP SPACE
	HRRZ	T2,TB.CHN(R)	;[1230]   FOR PROPER CHANNEL
	MOVEM	T1,IO.PTR(T2)	;[1230]   ..
	SETZM	IO.EMG		;NOT FREE NOW (RESET LATER)
	MOVSI	T2,'DSK'	;[1230] PUT OVERFLOW FILE ON DSK:[-]
	MOVEM	T2,I.DEV(T1)	;[1230]   ..
	MOVEI	T2,.IODPR	;USE MODE 16
	MOVEM	T2,I.MOD(T1)
	MOVEI	T2,LN.RIB-1	;SIZE OF EXTENDED ENTER BLOCK
	MOVEM	T2,I.RIB(T1)
	MOVE	T2,JOBNUM	;GET SIXBIT JOB NUMBER
	HRR	T2,TB.NAM(R)	;[1230]   ..
	MOVEM	T2,I.NAM(T1)	;TO FORM TEMP NAME
	MOVSI	T2,'TMP'
	MOVEM	T2,I.EXT(T1)
	SETZM	I.PRV(T1)	;[1230] STANDARD PROTECTION
	MOVE	T2,HL.S0(R)	;GET HIGHEST LOC LOADED
	LSH	T2,-<.DBS2W-1>	;[650] 2* NUMBER OF 128 WORDS
	MOVEM	T2,I.EST(T1)	;GOOD GUESS?
	HRRZ	T1,TB.CHN(R)	;[1230] GET CHANNEL FOR OVERFLOW FILE
	PUSHJ	P,DVUPD.##	;UPDATE MODE
	  PUSHJ	P,@TB.ERR(R)	;[1230] CAN'T--GO PRINT ERROR AND DIE
;NOW FOR OUTPUT, SETUP IOWD FOR DATA TO BE OUTPUT
;AND GET RID OF  AREA
LHDMP2:
	MOVE	T1,TAB.AB(R)	;SEE HOW LONG A BUFFER WE USED
	SUB	T1,TAB.LB(R)	;THIS IS LENGTH
	MOVEM	T1,UW.S0(R)	;THIS IS THE UPPER WINDOW BOUND
	MOVEI	T2,1(T1)	;MAKE INTO 128 WORDS &
	LSH	T2,-<1+.IPS2W>	;[650] CUT IN HALF
	LSH	T2,.IPS2W	;[650] BUT KEEP IN 128 WORD CHUNKS
	CAIGE	T2,.IPS		;[1104] IN CASE 1/2 IS .LT. 1 PAGE,
	MOVEI	T2,.IPS		;[1104]   DUMP ONE PAGE TO MARK PAGING
	SUBI	T1,-1(T2)	;GET NEW BOTTOM WINDOW BOUND
	PUSH	P,T1		;SAVE IT
	SKIPN	T1		;IF SEG IS ONLY 1 BLOCK
	MOVEI	T1,.IPS		;[2366] OUTPUT IT TO MARK PAGING
	HRRZI	T2,-1(T1)	;[2202] UPPER WINDOW (ALWAYS UNDER ONE SECTION)
	SETZ	T1,		;[2202] START AT ZERO
	PUSHJ	P,@[EXP LC.OUT,HC.OUT]-1(R)
	POP	P,T1		;RECOVER LOWEST ADDRESS NOT OUTPUT
	JUMPE	T1,LHSET1	;[1751] SPECIAL IF BASE STILL 0
	MOVEM	T1,LW.S0(R)	;SET IT
	ADD	T1,TAB.LB(R)	;BOTTOM IN REAL CORE
	SUBI	T1,1		;[650] SET FOR GBCK.L
	PUSHJ	P,GBCK.L	;RETURN FREE SPACE
LHSET1:	PUSHJ	P,GETIOM	;RESET IO.EMG
	PUSHJ	P,LNKCON	;TRY AGAIN, IN CASE ORIG CALL WAS FOR
	 CAIA			;THIS AREA (NEED TO UPDATE UW CORRECTLY)
	AOS	-1(P)		;PRESERVE LNKCOR RETURN
	MOVE	T1,TAB.AB(R)	;ACTUAL TOP
	SUB	T1,TAB.LB(R)	;LENGTH -1
	ADD	T1,LW.S0(R)	;NEW TOP
	MOVEM	T1,UW.S0(R)
	POP	P,R		;RESTORE
	POPJ	P,		;RETURN TO LNKCOR CALLER
> ;[1755] IFE TOPS20
SUBTTL	FIXUPS


;HERE TO SEE IF ANY SYMBOL FIXUP HAVE TO BE DONE FOR THIS WINDOW
;CHECK CURRENT LW.LS-UW.LS AGAINST ENTRIES IN FXP.LS
;FORMAT OF FXP.LS IS
;	PTR TO LAST,,PTR TO FIRST
;USES T1, T2, T3

LS.FXR::
	SKIPN	FS.SS		;ANY FIXUPS TO DO?
	POPJ	P,		;NO, JUST RETURN
	PUSH	P,R		;MUST SAVE R INCASE FROM LNKXIT
	PUSH	P,[0]		;[2200] LOWER ADDRESS  TO OUTPUT
	PUSH	P,[0]		;[2200] UPPER ADDRESS TO OUTPUT
	PUSHJ	P,SYMCHN	;SEE IF ANY FIXUPS FOR THIS AREA
	POP	P,T2		;[2200] GET BACK UPPER
	POP	P,T1		;[2200] GET BACK LOWER
	POP	P,R		;SAFE TO RESTORE R NOW
IFE TOPS20,<
	JUMPE	T1,CPOPJ	;NO FIXUPS DONE
	TRZ	T1,.IPM		;[2202] MAKE INTO TRUE OUTPUT PTR
	IORI	T2,.IPM		;[2202] POINT TO END OF BLOCK
	PJRST	LS.OUT		;OUTPUT AND RET
> ;[1401] IFE TOPS20
IFN TOPS20,<
	POPJ	P,		;[1401] RETURN 
> ;[1401] IFN TOPS20



;GETIOM - GET SPACE FOR IO.EMG AND RESERVE IT
;CALLED BY
;	PUSHJ	P,GETIOM
;USES T1, T2

GETIOM:	MOVEI	T2,LN.IO	;SPACE WE NEED
	PUSHJ	P,DY.GET	;GET IT
	MOVEM	T1,IO.EMG
	POPJ	P,
;CHKSYM - SEE IF ANY FIXUPS EXIST FOR THE NEW SYMBOL WINDOW
;IF SO LINK THEM INTO FXT.S0
;AND DO THEM
;USES T1-T4

SYMCHN:	SETZM	FXT.S0		;CLEAR TEMP PTR
	HRRZ	T1,FS.SS	;GET PTR TO LOWEST
	ADD	T1,FX.LB	;+OFFSET
	LDB	T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
	ADDI	T2,.L-1		;MAKE SURE LAST WORD IN CORE
	HLRZ	T1,FS.SS	;PTR TO HIGHEST
	ADD	T1,FX.LB	;+OFFSET
	LDB	T3,[ADDRESS 1(T1)] ;[2200] 30 BIT ADDRESS
	CAMG	T2,UW.LS	;IS LOWEST ADDRESS TOO HIGH?
	CAMGE	T3,LW.LS	;OR HIGHEST TOO LOW?
	POPJ	P,		;YES, JUST GIVE UP
				;MAKE QUICK TEST INCASE ALL IN CORE
				;IN WHICH CASE WE NEED NOT CHASE CHAIN
	SUBI	T2,.L-1		;ACCOUNT FOR ALL 3 WORDS
	ADDI	T3,.L-1		;IN ALL CHECKS
	CAML	T2,LW.LS	;IS LOWEST ADDRESS .GT. LOW WINDOW?
	CAMLE	T3,UW.LS	;AND HIGHEST ADDRESS .LE. HIGH WINDOW
	JRST	.+5		;NO, DO THE SLOW WAY
	MOVE	T1,FS.SS	;GET POINTER WORD
	MOVEM	T1,FXT.S0	;MOVE IT ALL OVER
	SETZM	FS.SS		;REMOVE FROM LIST TO CONSIDER
	JRST	FXSLP0		;AND DO IT
	MOVEI	T1,FS.SS	;GET INITIAL PTR
				;START AT BACK SINCE MOST USUAL CASE
				;IS TO READ FILE BACKWARDS
CHKSYL:	HLRZ	T1,(T1)		;GET NEXT
	JUMPE	T1,CPOPJ	;NOTHING TO DO
	ADD	T1,FX.LB	;OFFSET
	LDB	T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
	ADDI	T2,.L-1		;ALL 3 WORDS MUST BE INCORE
	CAMLE	T2,UW.LS	;INCORE?
	JRST	CHKSYL		;NO, LOOP
	HRRZ	T3,(T1)		;GET FORWARD LINK
	JUMPE	T3,[MOVEI T3,FS.SS	;IF ZERO THIS IS TOP OF CHAIN
		JRST	CHKSYM]	;SO WE CAN FIXUP
	HRL	T3,T3		;STORE UNRELOCATED IN LEFT HALF
	ADD	T3,FX.LB	;RELOCATED IN RIGHT
	HLLZS	(T1)		;CLEAR FORWARD PTR OF REMOVED PART
CHKSYM:	SUB	T1,FX.LB	;-OFFSET
	MOVSM	T1,FXT.S0	;TEMP PTR TO HIGHEST TO DO
	ADD	T1,FX.LB	;+OFFSET
CHKSYH:	HLRZ	T1,(T1)		;GET NEXT
	JUMPE	T1,[MOVEI T1,FS.SS	;GET FIRST IF
		JRST	SYMFIN]	;REACHED END OF CHAIN
	ADD	T1,FX.LB	;+OFFSET
	LDB	T2,[ADDRESS 1(T1)] ;[2200] ADDRESS
	CAML	T2,LW.LS	;STILL IN CORE?
	JRST	CHKSYH		;YES
	MOVE	T2,T1		;GET ABS ADDRESS
	SUB	T2,FX.LB	;REMOVE OFFSET
	HRL	T1,T2		;STORE LINK IN LEFT HALF FOR LATER
SYMFIN:	HRRZ	T2,(T1)		;GET 1ST FIXUP WE CAN DO
	HRRM	T2,FXT.S0	;STORE IN PTR
	ADD	T2,FX.LB	;RELOCATE IN FIXUP BLOCK
	HRRZS	(T2)		;AND CLEAR BACK LINK
				;NOW CLOSE PTRS OVER HOLE
	HLRM	T3,(T1)		;LINK TOP TO BOTTOM
	HLLM	T1,(T3)		;AND BOTTOM TO TOP
;NOW TO EXECUTE THE FIXUPS
FXSLP0:	HRRZ	T1,FXT.S0	;GET  FIRST ADDRESS
	ADD	T1,FX.LB	;IN CORE
	LDB	T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS (REL TO ORIGIN)
	MOVEM	T1,-2(P)	;[2200] PUT LOW ADDRESS ON STACK INPLACE OF [0]
	HLRZ	T1,FXT.S0	;SAME FOR UPPER ADDRESS
	ADD	T1,FX.LB
	LDB	T1,[ADDRESS 1(T1)] ;[2200] GET SYMBOL ADDRESS
	ADDI	T1,.L-1		;FIXED UP ALL 3 WORDS
	MOVEM	T1,-1(P)	;[2200] SAVE UPPER ADDRESS ON STACK

FXSLUP:	HRRZ	T1,FXT.S0	;GET NEXT PTR
	JUMPE	T1,CPOPJ	;ALL DONE FOR THIS LIST
	.JDDT	LNKCOR,FXSLUP,<<CAMN T1,$FIXUP>>	;[632]
	ADD	T1,FX.LB	;+OFFSET
	HRRZ	T2,(T1)		;NEXT PTR
	HRRM	T2,FXT.S0	;STORED
	LDB	T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
	LDB	T3,[HIGH6 1(T1)] ;[2200] AND INDEX FROM HIGH SIX BITS
	MOVE	T4,2(T1)	;VALUE
	ADD	T2,LS.LB	;ADD IN BASE
	SUB	T2,LW.LS	;MINUS WINDOW BASE
	PUSHJ	P,@SYMTAB(T3)	;GO TO RIGHT ROUTINE
	MOVEI	T2,3		;SIZE OF BLOCK
	PUSHJ	P,FX.RET	;RESTORE NOW (INCASE REQUIRED AGAIN)
	JRST	FXSLUP		;AND CONTINUE

IFN DEBSW,<

;SET THE FOLLOWING LOCATION TO THE OFFSET FROM THE BEGINNING OF THE FX
;AREA OF THE FIRST WORD OF A FIXUP BLOCK THAT IS INTERESTING FOR
;DEBUGGING PURPOSES. LINK WILL HIT A BREAKPOINT WHEN THE FIXUP BLOCK
;IS PROCESSED, OR WHEN A NEW FIXUP IS STORED IN THAT BLOCK.

$FIXUP::BLOCK	1		;[632] PLACE FOR FX OFFSET FOR .JDDT
> ;END IFN DEBSW
DEFINE X (A)<
	EXP	STF.'A
>

	XALL
SYMTAB:	SFIXUPS
	SALL

;ENTER WITH :-
;T1 = ADDRESS OF FIXUP IN FX (FROM)
;T2 = ADDRESS OF FIXUP RECIPIENT IN LS (TO)
;T3 = INDEX (SCRATCH)
;T4 = VALUE OF FIXUP

;RELOCATABLE
STF.RR:!			;[2214] ALL RELOCATABLE DISPATCH HERE
STF.RL:!			;[2214]
STF.RE:!			;[2214]
STF.RF:	PUSH	P,T1		;[2214] SAVE A SCRATCH AC
	MOVX	T1,PS.REL	;GET 'I AM RELOCATABLE' BIT
	IORM	T1,0(T2)	;MAKE SURE SET IN FLAG WORD
	POP	P,T1		;RESTORE SCRATCH AC
	SUBI	T3,<<SPF.RR-SPF.AR>_<-^D30>> ;[2200] CONVERT TO CORRESPONDING
	PJRST	@SYMTAB(T3)	; ADDITIVE TYPE AND DISPATCH

;RIGHT HALF
STF.AR:	HRRZ	T3,2(T2)	;GET CURRENT VALUE
	ADD	T3,T4		;ADD IN FIXUP
	HRRM	T3,2(T2)	;PUT NEW VALUE BACK
	MOVX	T3,PS.UDR	;WE CAN NOW TURN THIS FLAG OFF
	JRST	STF.FL		;JOIN COMMON CODE

;LEFT HALF
STF.AL:	HLRZ	T3,2(T2)	;GET CURRENT VALUE
	ADD	T3,T4		;ADD IN FIXUP
	HRLM	T3,2(T2)	;PUT BACK NEW
	MOVX	T3,PS.UDL	;LEFT HALF NOW DEFINED
	JRST	STF.FL

;FULL WORD
STF.AF:	ADDM	T4,2(T2)	;ADD IN FIXUP
	MOVX	T3,PS.UDF	;FULLY DEFINED NOW
	JRST	STF.FL		;[2214] FALL INTO COMMON CODE

;[2214] Thirty bit
STF.AE:	LDB	T3,[ADDRESS 2(T2)] ;[2214] Get current value
	ADD	T3,T4		   ;[2214] Add in fixup
	DPB	T3,[ADDRESS 2(T2)] ;[2214] Put back new value
	MOVX	T3,PS.UDF	;[2214] Fully defined now
;	JRST	STF.FL		;[2214] Fall into common code

;FALL THROUGH TO NEXT PAGE
;HERE WITH T3 CONTAINING THE BITS WE'RE DEFINING. CLEAR IN LS AREA
;AND CHECK FOR POSSIBLE MULTIPLE DEFINITION IF GLOBAL.

STF.FL:	MOVX	T4,PS.GLB	;CHECK GLOBAL DEFINITION, SINCE
	TDNN	T4,0(T2)	;LOCALS CAN'T BE MULT. DEFINED
	JRST	STF.LC		;LOCAL SYMBOL, NO PROBLEM


;**** TEMP CROCK TO AVOID HALT IF DOING FIXUPS WHILE SORTING SYMBOL
;**** TABLE LATE IN LNKXIT, AFTER LNKXIT HAS DELETED GS AREA. THE REAL
;**** SOLUTION IS TO HAVE LNKXIT KEEP THE GS AREA AROUND LONGER, BUT
;**** THAT SOLUTION IS FAR TOO COMPLEX TO IMPLEMENT AT THE PRESENT TIME,
;**** DUE TO LNKXIT'S HORRIBLE HABIT OF DOING CORE UUO'S AND REFERENCING
;**** .JBREL DIRECTLY (THE GS ARE WOULD BE OVERWRITTEN BY THE FX OR LS
;**** AREAS EVEN IF IT WASN'T DELETED). THIS SHOULD BE FIXED!!!!
	SKIPN	GS.LB		;GS AREA EXIST?
	JRST	STF.LC		;NO (**CROCK**) SKIP THIS CHECK
;**** END OF TEMP CROCK

	SPUSH	<W1,W2,W3,P1,P2,T1,T2,T3>	;SAVE THE WORLD
	TMOVE	W1,0(T2)	;PICK UP THE SYMBOL WE NEED
	PUSHJ	P,TRYSYM##	;GET THE REAL VALUE
	  HALT	.		;THEN WHY IS IT IN THE LS AREA?
	  JFCL			;DOESN'T MATTER IF UNDEFINED
	SPOP	<T3,T2>		;RESTORE DEFINING BITS AND LS PTR
	MOVE	W1,0(P1)	;PICKUP REAL FLAGS FROM GLOBALS
	TXNN	W1,PS.UDF!PS.REQ ;SYMBOL COMPLETELY DEFINED?
	JRST	STF.PV		;YES, P2 POINTS TO REAL VALUE
	TXNN	W1,PT.EXT	;NO, MUST GET PART VALUE FROM PVS
	JRST	STF.GU		;NO PVS, GIVE UP
STF.NX:	ADDI	P1,.L		;ADVANCE TO NEXT TRIPLET
	SKIPG	P2,0(P1)	;PICK UP SECONDARY FLAGS
	JRST	STF.GU		;PRIMARY HERE?? GIVE UP!
	TXNE	P2,S.PVS	;IS THIS THE ONE WE'RE LOOKING FOR
	JRST	STF.PV		;YES, GO COMPARE VALUES
	TXNN	P2,S.LST	;NO, BUT ARE THERE MORE TRIPLETS?
	JRST	STF.NX		;YES, GO EXAMINE THEM
	JRST	STF.GU		;NO, NOT MULTIPLY DEFINED AT ALL
;HERE WITH THE ABS ADDR OF THE PVS TRIPLET ON THE GLOBAL SYMBOL IN
;P2. THIS SYMBOL MUST BE MULTIPLY DEFINED IF FULLY DEFINED AND A PVS
;TRIPLET STILL EXISTS, BUT CHECK VALUES ANYWAY IN CASE NOT FULLY DEFINED
;(/MAP:NOW OR AN UNDEFINED GLOBAL) SO MAP WILL BE CORRECT.

STF.PV:	MOVE	T4,2(T2)	;GET THE NEW VALUE WE JUST FOUND
	TXNE	T3,PS.UDR	;NOT DEFINING RH?
	TXNE	W1,PS.UDR	;OR IS RH UNKNOWN?
	HRR	T4,2(P1)	;YES, CAN'T POSSIBLY BE CONFICTING
	TXNE	T3,PS.UDL	;SAME LOGIC FOR LH
	TXNE	W1,PS.UDL	;..
	HLL	T4,2(P1)	;T4 NOW DIFFERENT IF MULT. DEF.
	CAMN	T4,2(P1)	;IS IT?
	TDZA	T4,T4		;NO, CLEAR T4
	MOVX	T4,PS.MDF	;YES, FLAG AS MULTIPLY DEFINED
	IORM	T4,0(T2)	;SET PS.MDF IF NEEDED
STF.GU:	SPOP	<T1,P2,P1,W3,W2,W1>	;RESTORE THE WORLD
STF.LC:	ANDCAB	T3,0(T2)	;CLEAR ALL UNDEF BITS JUST DEFINED
	TXNE	T3,PS.UDF	;IF SYMBOL IS NOW FULLY DEFINED
	POPJ	P,		;NO, WAIT SOME MORE
	MOVX	T3,PS.REQ	;WE CAN TURN OFF THE REQUEST BIT
	ANDCAM	T3,0(T2)
	POPJ	P,
;HERE TO FIXUP NAME STUFF IN TITLE BLOCK
STF.TL:	MOVE	T3,0(T2)	;GET FLAGS
	TXNN	T3,PT.TTL	;BETTER BE A TITLE
	JRST	BADSTF		;IT'S NOT, REPORT ERROR
	MOVEM	T4,2(2)		;[2254] STORE POINTER BACK
	POPJ	P,

;HERE TO FIXUP SEG STUFF IN TITLE BLOCK
STF.SG:	SKIPL	T3,0(T2)	;GET FLAGS
	TXNN	T3,S.SEG	;LOOK FOR SEGMENT STUFF
	JRST	BADSTF		;REPORT ERROR
	SKIPN	T4		;[2254] DID USER PROGRAM HAVE THIS SEG?
	SETZB	T4,1(T2)	;[2254] NO, CLEAR LENGTH WORD
	MOVEM	T4,2(T2)	;[2254] YES, STORE BACK
	POPJ	P,

;HERE TO FIXUP SEGMENT ORIGINS IN TITLE BLOCK

STF.SL:	SKIPL	T3,(T2)		;CHECK SECONDARY TRIPLET
	TXNN	T3,S.SEG	;THAT DESCRIBES SEGMENT DATA
	JRST	BADSTF		;REPORT THE ERROR
	MOVEM	T4,1(T2)	;[2254] OTHERWISE, STORE NEW VALUE
	POPJ	P,		;DONE

;HERE ON A BAD TRIPLET
BADSTF:	PUSH	P,T1		;NEED T1 FOR CONTINUE ATTEMPT
E$$SFU::.ERR.	(MS,0,V%L,L%W,S%W,SFU,<Symbol table fouled up>)	;[1174] OUCH!
	POP	P,T1		;RECOVER FIXUP POINTER
	POPJ	P,		;TRY TO CONTINUE

E$$MMF::.ERR.	(MS,0,V%L,L%F,S%F,MMF,<Memory manager error>)	;[2202]


CORLIT:	END