Google
 

Trailing-Edge - PDP-10 Archives - BB-4172G-BM - language-sources/lnkcor.mac
There are 50 other files named lnkcor.mac in the archive. Click here to see a list.
TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JBC/JNG/DZN	24-Aug-79


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL

ENTRY	LNKCOR
EXTERN	LNKLOG


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==1220		;DEC EDIT VERSION


SEGMENT
SUBTTL	REVISION HISTORY


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

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

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

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

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

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


LNKCOR:	JUMPE	P2,LDCR7Y	;JUST WANT TO SHUFFLE CORE
	ADDI	P2,.IPM		;MAKE SURE ITS A 128 WORD BLOCK
	ANDCMI	P2,.IPM
	MOVE	T1,TAB.UB(P1)	;GET UPPER BOUND
LDCOR0:	SUB	T1,TAB.AB(P1)	;MINUS ACTUAL BOUND
	CAMGE	T1,P2		;BIG ENOUGH?
	JRST	LDCOR1		;NO, TRY ONE ABOVE
	ADDM	P2,TAB.AB(P1)	;FIX ACTUAL BOUND TO REFLECT INCREASE
	ADDM	P2,TAB.FR(P1)	;AND FREE SPACE COUNTER
IFN TOPS20&FTFORK,<
	JRST	@CORTBL		;INCASE ANYTHING SPECIAL TO DO
>
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,

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

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


IFN TOPS20&FTFORK,<
DEFINE XXX (ABC)<
 IFNDEF ABC'.COR,<CPOPJ1>
 IFDEF  ABC'.COR,<ABC'.COR>
>
	XALL
CORTBL:	AREAS
	SALL

LC.COR:	TDZA	T3,T3		;LOW SEG OFFSET
HC.COR:	MOVEI	T3,1		;HIGH SEG ORIGIN
	MOVE	T4,P2		;HOW MUCH WE INCREASED BY
	LSH	T4,-9		;IN PAGES
	MOVE	1,LC.AB(T3)	;HIGHEST NOW IN USE
	SUBI	1,-1(P2)	;HIGHEST NEW ADDRESS
	MOVE	2,1
	SUB	1,LC.LB(T3)	;REMOVE BASE
	ADD	1,LL.S1(T3)	;ADD IN ORIGIN
	ADD	1,LW.S1(T3)	;INCASE PAGED IN SUPERIOR FORK
	LSH	1,-9			;IN PAGES
	HRL	1,LC.FRK	;SOURCE IS INFERIOR FORK
	LSH	2,-9
	HRLI	2,(1B0)		;DESTINATION IS CURRENT
	SETZ	T3,		;NO SPECIAL PRIVS
	PMAP
	SOJLE	T4,CPOPJ	;DONE IF ONLY ONE PAGE
	ADDI	1,1		;INCREMENT PAGE#
	AOJA	2,.-3		;AND CREATE IT

>;END OF IFN TOPS20&FTFORK
SUBTTL	TABLE DRIVEN CORE MOVER


;HERE TO SEE IF ENOUGH CORE IN LOW SEGMENT

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

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

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

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

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

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

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

> ;END IFE TOPS20


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

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

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

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


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

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

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

ADJTBL:	SKIPN	T1,TAB.NB(T2)	;GET NEW ORIGIN
	POPJ	P,		;IF O JUST IGNORE
	SETOM	TAB.ZE(T2)	;[755] NEED TO CLEAR FREE SPACE LATER.
	SUB	T1,TAB.LB(T2)	;FIND DIFFERENCE
	ADDM	T1,TAB.LB(T2)	;ADJUST ALL TABLES
	ADDM	T1,TAB.AB(T2)
	ADDM	T1,TAB.PT(T2)
	POPJ	P,		;[650] RETURN
;HERE IF NOT ENOUGH CORE ABOVE WHERE WE ARE
;SEE IF ENOUGH JUST BELOW
LDCOR7:	JUMPE	P1,LDCR7X	;NOTHING BELOW IF AREA=0?
	MOVEI	T1,-1(P1)	;GET NEXT LOWER POINTER
	SKIPN	T2,TAB.UB(T1)	;GET BOUND IF NOT ZERO
	SOJGE	T1,.-1		;AREA 0 ALWAYS SET UP
	SUB	T2,TAB.AB(T1)	;GET FREE SPACE
	SUB	T2,P2		;MINUS WHAT WE WANT
	JUMPL	T2,LDCR7X	;NO SUCH LUCK
	LSH	T2,-.IPS2W	;[650] FORM 128 WORD BLOCKS
	IDIVI	T2,2		;[650] HALF IT
	ADD	T2,T3		;[650] GIVE REMAINDER TO EXPANDING AREA
	LSH	T2,.IPS2W	;[650] BACK TO WORDS
	ADD	T2,P2		;ALSO ADD IN WHAT WE WANTED
;NOW ADJUST TABLES AND MOVE  CODE
	MOVN	T2,T2
	CAIN	P1,GS.IX	;GLOBAL SYMBOL AREA MOVED DOWN?
	ADDM	T2,HT.PTR	;YES, ADJUST HASH TABLE POINTER
	ADDM	T2,TAB.UB(T1)	;PREVIOUS UPPER BOUND OF LOWER AREA
IFN FTVM,<
	SKIPE	USEVM		;[650] VM AVAILABLE?
	JRST	LDCR7V		;[650] YES, USE FAST WAY
> ;END OF IFN FTVM
	ADDM	T2,TAB.AB(P1)	;NEW ACTUAL BOUND
	ADDM	T2,TAB.PT(P1)	;ADJUST POINTER
	HRLZ	T3,TAB.LB(P1)	;GET FROM ...
	ADDB	T2,TAB.LB(P1)	;ADJUST LOWER
	HLL	T2,T3		;FROM ...TO
	BLT	T2,@TAB.AB(P1)	;BLT OF AREA
	MOVE	T3,TAB.AB(P1)	;GET LAST WORD IN USE
	SETZM	1(T3)		;CLEAR FIRST FREE WORD
	HRLI	T3,1(T3)	;FORM BLT POINTER
	HRRI	T3,2(T3)	;TO ZERO FREE AREA
	BLT	T3,@TAB.UB(P1)
	JRST	LNKCON		;TRY AGAIN


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

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

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

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

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

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


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

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

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

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


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

;  ..
;  ..

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


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

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


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

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

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

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

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

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


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

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

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

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

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

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

;HERE IF WE HAVE TO EXPAND TO GET SOME ROOM
GETWD2:	PUSH	P,T2		;SAVE NUMBER OF WORDS REQUIRED
	PUSH	P,P2		;DESTROYS P2
	MOVE	P2,T2		;NUMBER OF WORDS WE NEED
	SUB	P2,TAB.FR(P1)	;MINUS WHAT WE HAVE NOW
	PUSHJ	P,LNKCOR	;GENERAL CORE EXPANDER
	  JRST	E$$MEF		;[1174] FAILED
	POP	P,P2		;RESTORE P2
	POP	P,T2		;RESTORE T2
	JRST	GETWDM		;TRY AGAIN
;HERE TO CREATE A NEW AREA (USUALLY FX)
;CALLED BY 
;	MOVE	T2,SIZE REQUIRED
;	MOVE	P1,AREA
;	PUSHJ	P,FX.INI
;RETURNS WITH AREA SETUP
;SAVES T2
;USES T1, AND T3

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

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


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

;HERE IF LOCAL SYMBOLS ARE PAGED
;IF GOING IN FORWARDS DIRECTION (UW.LS=-1) AREA IS 0 
;IF NOT CLEAR AREA
CNA.LS:	SKIPGE	UW.LS		;TEST FOR -1
	POPJ	P,		;JUST RETURN
	ADDM	T1,UW.LS	;BACKUP UPPER POINTER
CNABLT:	MOVE	T1,TAB.AB(P1)	;TOP OF WHAT WE KEEP
	ADDI	T1,2
	HRLI	T1,-1(T1)	;FORM BLT PTR.
	SETZM	-1(T1)		;CLEAR FIRST WORD
	MOVEI	T2,.IPS-2(T1)	;DESTINATION OF BLT
	BLT	T1,(T2)		;CLEAR ALL OF BLOCK
	POPJ	P,

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


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

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

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

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

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

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

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

ADDWD5:	SUB	T4,TAB.LB(P1)	;REMOVE OFFSET
	MOVS	T4,T4		;PREVIOUS,,CURRENT
	SUB	T1,TAB.LB(P1)
	HRRM	T1,(T4)		;LINK BACK IN CHAIN
	ADD	T1,TAB.LB(P1)
	HLRM	T4,(T1)		;ANDFORWARDS
	POPJ	P,
SUBTTL	XX.GBC - SUBROUTINES TO GARBAGE COLLECT SPECIFIC AREA


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

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

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

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

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

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

;HERE TO GIVE BACK TOP PIECE IF POSSIBLE

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

;HERE TO RE-LINK IN ORDER OF SIZE

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


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

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


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


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

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

	XALL
	AREAS
	SALL
;SUBROUTINE TO REMOVE DESIRED CHUNK

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


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

XX.ZAP::SKIPN	T2,TAB.LB(T1)	;GET LOWER BOUND
	JRST	ZAP0		;JUST CLEAR POINTERS
	HRL	T2,T2		;FORM BLT POINTER
	ADDI	T2,1		;WELL ALMOST
	SETZM	-1(T2)		;CLEAR FIRST WORD
	BLT	T2,@TAB.AB(T1)	;AND REST
	MOVE	T2,TAB.UB(T1)	;GET UPPER BOUND
	PUSH	P,T1		;SAVE T1
	SKIPN	TAB.LB-1(T1)	;SEE WHO TO GIVE IT TO
	SOJA	T1,.-1		;WILL GET DY EVENTUALLY
	MOVEM	T2,TAB.UB-1(T1)	;GIVE IT TO NEXT LOWER AREA SETUP
	POP	P,T1		;RESTORE ORIGINAL AREA
ZAP0:	SETZM	TAB.LB(T1)	;CLEAR ALL POINTERS
	SETZM	TAB.AB(T1)
	SETZM	TAB.UB(T1)
	SETZM	TAB.PT(T1)
	SETZM	TAB.FR(T1)
	SETZM	TB.LNK(T1)
	SETZM	TB.FSP(T1)
	POPJ	P,		;RETURN
SUBTTL	GIVE BACK BLOCKS OF CORE


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

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


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

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


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

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

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

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

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

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

LCHCHK:	MOVEI	T3,LC.IX	;ASSUME LOW IS BIGGEST
	CAMGE	T1,T2		;WHICH SEGMENT IS BIGGER?
	MOVEI	T3,HC.IX	;HIGH IS, USE IT
	CAMGE	P2,T1-LC.IX(T3)	;IS IT BIG ENOUGH? 
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(T3) ;YES, DO BIGEST
	CAIE	P1,LC.IX	;CAN ONLY PAGE REQUESTED IF
	CAIN	P1,HC.IX	;LC OR HC, OTHERWISE USE T3
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(P1) ;NO, DO REQUESTED
	PJRST	@[EXP LCREDW,HCREDW]-LC.IX(T3)	;JUST USE BIGGEST

LCOVF:	SKIPN	LC.LB		;[1113] LAST CHANCE--IS THERE AN LC AREA?
	JRST	E$$MEF		;[1174] NO--JUST RAN OUT OF LUCK
	MOVE	T1,LC.AB	;[650] FIND SIZE
	SUB	T1,LC.LB	;[650]
	CAIE	T1,.IPM		;[650] ONLY ONE PAGE?
	JRST	LCOVF1		;[650] NO, CONTINUE
	PUSHJ	P,CHKMAX	;[650] YES, MAXCOR REASONABLE?
	  JRST	LNKCON		;[650] WASN'T, TRY AGAIN
LCOVF1:	SKIPN	PAG.S1		;ALREADY PAGING?
	JRST	LC.DMP		;NO DO SO
	JRST	LCREDU		;YES, REDUCE SIZE OF WINDOW
;HERE TO TEST /MAXCORE TO MAKE SURE SIZE IS REASONABLE
;IF NOT INCREASE MAXCOR BUT WARN USER

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

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

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

CREDU:	MOVE	T1,TAB.AB(R)	;TOP
	SUB	T1,TAB.LB(R)	;-BOTTOM
	ADDI	T1,1		;LENGTH
	LSH	T1,-1		;CUT IN HALF
	ANDCMI	T1,.IWM		;[750] AT LEASET RESERVE WINDOW SIZE
	JUMPE	T1,RPOPJ	;NOTHING TO DO
	PUSH	P,T1		;SAVE LENGTH TO REMOVE
	ADD	T1,LW.S0(R)	;NEW BOTTOM
	SUBI	T1,1		;THEREFORE TOP TO OUTPUT
	HRL	T1,LW.S0(R)	;FROM HERE UP
	PUSHJ	P,@[EXP LC.OUT,HC.OUT]-1(R)
	POP	P,T1		;GET BACK LENGTH
	ADDM	T1,LW.S0(R)	;SHORTEN WINDOW
	ADD	T1,TAB.LB(R)	;FIX IN CORE
	SUBI	T1,1		;HIGHEST ADDRESS TO GIVE AWAY
	PUSHJ	P,GBCK.L	;TO NEXT LOWER AREA IN USE
	POP	P,R		;RESTORE R
	JRST	LNKCON		;TRY AGAIN, MAY RETURN

RPOPJ:	POP	P,R		;RESTORE R
	POPJ	P,
SUBTTL	OUTPUT  CORE WINDOW


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

DEFINE PAGOUT (%AREA,CHAN,WD)<
%AREA'.OUT::HRRZ	T2,T1		;GET UPPER ADDRESS
	CAMLE	T2,HB.'WD	;BIGGEST SO FAR?
	MOVEM	T2,HB.'WD	;YES
	HLRZ	T2,T1		;GET FIRST ADDRESS
	LSH	T2,-.DBS2W	;[650] INTO 128 WORD BLOCKS
	USETO	CHAN,1(T2)	;SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
	HLRZ	T3,T1		;FROM
	SUBI	T3,1(T1)	;-TO = -LENGTH
	HLRZ	T2,T1		;FROM
	SUB	T2,LW.'WD	;MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,%AREA'.LB	;FIX IN CORE
	SUBI	T2,1		;IOWD IS ONE LESS
	HRL	T2,T3		;LEFT HALF IS -COUNT
	SETZ	T3,		;TERMINATE LIST
	OUT	CHAN,T2		;DUMP BLOCK
	  POPJ	P,		;OK
E$$O'%AREA::PUSH	P,[CHAN]		;[1174] STACK ERROR CHAN
	.ERR.	(ST,0,V%L,L%F,S%F,O'%AREA,<Error outputting area %AREA>)
>

	XALL
;LOW SEGMENT
PAGOUT	(LC,LC,S1)
;HIGH SEGMENT
PAGOUT (HC,HC,S2)
;SYMBOL TABLE
PAGOUT	(LS,SC,LS)
;ALGOL SYMBOLS
PAGOUT	(AS,AC,AS)
	SALL
SUBTTL	INPUT  CORE WINDOW


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

DEFINE	PAGIN (%AREA,CHAN,WD,FIXUP,%OK)<
%AREA'.IN::	HRRZ	T2,T1		;GET LAST ADDRESS WE NEED
	CAMG	T2,HB.'WD	;BIGGER THAN WHAT WE HAVE?
	JRST	%OK		;NO
	MOVEM	T2,HB.'WD	;YES, RESET HIGHEST
	LSH	T2,-.DBS2W	;[650] MUST DO USETO TO ZERO FILE
				;SO WE WILL INPUT ZERO DATA
	USETO	CHAN,2(T2)	;YES, GET THIS MUCH
%OK:!	HLRZ	T2,T1		;[1174] GET FIRST ADDRESS
	LSH	T2,-.DBS2W	;[650] INTO 128 WORD BLOCKS
	USETI	CHAN,1(T2)	;SET ON BLOCK (0 ADDRESS IS IN BLOCK 1)
	HLRZ	T3,T1		;FROM
	SUBI	T3,1(T1)	;-TO = -LENGTH
	HLRZ	T2,T1		;FROM
	SUB	T2,LW.'WD	;MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,%AREA'.LB	;FIX IN CORE
	SUBI	T2,1		;IOWD IS ONE LESS
	HRL	T2,T3		;LEFT HALF IS -COUNT
	SETZ	T3,		;TERMINATE LIST
	IN	CHAN,T2		;DUMP BLOCK
IFB <FIXUP>,<
	  POPJ	P,		;OK
>
IFNB <FIXUP>,<
	  PJRST	%AREA'.FXR		;DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::PUSH	P,[CHAN]		;[1174] SAVE ERROR CHAN
	.ERR.	(ST,0,V%L,L%F,S%F,I'%AREA,<Error inputting area %AREA>)
>

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

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

TB.IN::	AREAS


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

TB.OUT::AREAS

	SALL
SUBTTL	DUMP LOCAL SYMBOLS WHEN CORE IS FULL


LS.DMP::	MOVE	T1,LS.AB	;[650] SIZE OF LS AREA
	SUB	T1,LS.LB	;[650]
	ANDCMI	T1,.IPM		;[650] BUT NOT LAST PAGE
	JUMPE	T1,CPOPJ	;[650] IF 1P, DON'T BOTHER
E$$PLS::.ERR.	(MS,0,V%L,L%I,S%I,PLS,<Area LS overflowing to disk>) ;[1174]
	SKIPLE	T1,SYMFRM	;[604] USER REQUESTING A SYMBOL FILE?
	CAIE	T1,1		;[604] NEW STYLE?
	JRST	LSDMP0		;[604] NO, JUST OVERFLOW TO DSK:
	MOVEI	T1,%SC		;[604] YES, SEE IF THERE'S AN OLD ONE
	MOVEM	T1,IO.CHN	;[604] SO WE CAN PUT THE NEW ONE ON
	PUSHJ	P,DVSUP.##	;[604]   THE SAME STR TO SUPERCEDE
	  JRST	LSDMP0		;[604] /SYFILE DEVICE USELESS - USE DSK:
	MOVE	T3,IO.PTR+%SC	;[604] DVSUP. SAID TO USE %SC DEVICE
	SKIPA	T3,I.DEV(T3)	;[604]   SO PICK IT UP FROM I/O DATA BLK
LSDMP0:	MOVSI	T3,'DSK'	;[604] /SYFILE DEVICE USELESS - USE DSK:
	MOVE	T1,IO.EMG	;GET SPACE
	MOVEM	T1,IO.PTR+SC	;SAVE IT
	SETZM	IO.EMG		;NOT FREE NOW (RESET LATER)
	MOVEI	T2,.IODPR	;USE MODE 16
	MOVEM	T2,I.MOD(T1)
	MOVEM	T3,I.DEV(T1)	;[604] USE CHOSEN DEVICE
	MOVEI	T2,LN.RIB-1	;SIZE OF EXTENDED ENTER BLOCK
	MOVEM	T2,I.RIB(T1)
	MOVE	T2,JOBNUM	;GET SIXBIT JOB NUMBER
	HRRI	T2,'LLS'	;FILL IN RIGHT HALF
	MOVEM	T2,I.NAM(T1)	;TO FORM TEMP NAME
	MOVSI	T2,'TMP'
	MOVEM	T2,I.EXT(T1)
	SETZ	T2,		;[736] STANDARD PROTECTION
	MOVEM	T2,I.PRV(T1)
	MOVE	T2,LS.AB	;GET LENGTH OF INCORE TABLE
	SUB	T2,LS.LB
	LSH	T2,-<.DBS2W-1>	;[650] ASSUME THIS IS HALF OF IT
	MOVEM	T2,I.EST(T1)	;AS GOOD A GUESS AS ANY OTHER

LS.SET:	MOVEI	T1,SC		;PUT CHAN IN T1
	PUSHJ	P,DVUPD.##	;GET UPDATE  MODE FILE
	  PUSHJ	P,E$$ELS	;[1174] ERROR
;NOW FOR OUTPUT, SETUP IOWD FOR ALL SYMBOLS NOT IN CURRENT PROG
	PUSH	P,P1		;SAVE AN AC
	MOVE	P1,LS.AB	;[650] SIZE OF LS AREA
	SUB	P1,LS.LB	;[650] ALMOST ANYWAY
	SUBI	P1,.IPS		;[650] HIGHEST TO OUTPUT
	MOVE	T1,P1
	PUSHJ	P,LS.OUT	;GENERAL OUTPUT ROUTINE
	MOVE	T1,P1		;HIGHEST REL ADDRESS TO GIVE AWAY
	ADD	T1,LS.LB	;ADD IN OFFSET
	ADDI	P1,1		;LOWEST TO KEEP
	MOVEM	P1,LW.LS	;WILL BECOME WINDOW LOWER LIMIT
	SETOM	UW.LS		;SIGNAL PAGING BUT NO UPPER LIMIT
	MOVE	T2,P1		;TEMP STORE
	POP	P,P1		;RESTORE
	PUSHJ	P,GBCK.L	;GIVE IT AWAY
	PUSHJ	P,GETIOM	;[650] USE SOME OF NEW AREA FOR IO.EMG
	JRST	CPOPJ1		;[650] INDICATE SUCCESS

E$$ELS::PUSH	P,[SC]		;[1174]
	.ERR.	(LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[1174]
	POPJ	P,
SUBTTL	DUMP ALGOL SYMBOLS IF CORE FILLING


AS.DMP::	MOVE	T1,AS.AB	;[650] SIZE OF AS AREA
	SUB	T1,AS.LB	;[650]
	ANDCMI	T1,.IPM		;[650] EXCEPT LAST PAGE
	JUMPE	T1,CPOPJ	;[650] DON'T BOTHER IF ONLY 1P
E$$PAS::.ERR.	(MS,0,V%L,L%I,S%I,PAS,<Area AS overflowing to disk>) ;[1174]
	SKIPLE	T1,SYMFRM	;[604] USER WANT ALGOL SYFILE?
	CAIE	T1,2		;[604] MAYBE, DOES HE?
	JRST	ASDMP0		;[604] NO, PUT OVERFLOW FILE ON DSK:
	MOVEI	T1,%SC		;[604] OK, LETS CHECK SYFILE DEVICE
	MOVEM	T1,IO.CHN	;[604] AND PUT OVERFLOW FILE THERE TOO
	PUSHJ	P,DVSUP.##	;[604] PUT ON SAME STR AS OLD FILE
	  JRST	ASDMP0		;[604] /SYFILE DEVICE USELESS
	MOVE	T3,IO.PTR+%SC	;[604] OK, PICKUP /SYFILE DEVICE
	SKIPA	T3,I.DEV(T3)	;[604] FORM I/O DATA BLOCK
ASDMP0:	MOVSI	T3,'DSK'	;[604] USE DSK IF NOTHING BETTER
	MOVE	T1,IO.EMG	;GET EMERGENCY FILE BLOCK
	MOVEM	T1,IO.PTR+AC	;USE FOR AS OVERFLOW FILE
	SETZM	IO.EMG		;GET BACK WHEN MORE ROOM IN CORE
	MOVEI	T2,.IODPR	;USE DUMP ACROSS RECORDS MODE
	MOVEM	T2,I.MOD(T1)	;STORE FOR LNKFIO
	MOVEM	T3,I.DEV(T1)	;[604] STORE DEVICE CHOSEN ABOVE
	MOVEI	T2,LN.RIB-1	;SETUP .RBLEN
	MOVEM	T2,I.RIB(T1)	;WITH EXTENDED ENTER LENGTH
	MOVE	T2,JOBNUM	;JOB NUMBER IN SIXBIT
	HRRI	T2,'LAS'	;MAKE NAME OF OVERFLOW FILE
	MOVEM	T2,I.NAM(T1)	;STORE IN FILE BLOCK
	MOVSI	T2,'TMP'	;EXTENSION .TMP FOR LOGOUT
	MOVEM	T2,I.EXT(T1)	;IN FILE BLOCK
	SETZ	T2,		;[736]STANDARD PROTECTION
	MOVEM	T2,I.PRV(T1)	;SO ALGOL SYMBOLS ARE SECURE
	MOVE	T2,AS.AB	;LENGTH OF AREA IN CORE
	SUB	T2,AS.LB	;SO CAN PUT IN FILE ESTIMATE
	LSH	T2,-<.DBS2W-1>	;[650] ASSUME FILE WILL BE 2*CURRENT
	MOVEM	T2,I.EST(T1)	;BETTER THAN 4* FOR MOST CASES
	MOVEI	T1,AC		;POINT TO THE AS CHANNEL
	PUSHJ	P,DVUPD.##	;GET FILE IN UPDATE MODE
	  PUSHJ	P,E$$EAS	;[1174] ERROR CREATING AS AREA FILE
	MOVE	T1,AS.PT	;FIGURE SIZE OF AS AREA
	SUB	T1,AS.LB	;NOT COUNTING THAT ABOVE PT
	ANDCMI	T1,.IPM		;FIND EXTRANEOUS BLOCKS
	PUSH	P,T1		;SAVE OVER AS.OUT
	SUBI	T1,1		;GET ADDR OF LAST TO OUTPUT
	PUSHJ	P,AS.OUT	;WRITE OUT THE DATA
	POP	P,LW.AS		;RESTORE LOWEST VIRT ADDRESS
	MOVE	T1,AS.PT	;GET FIRST PHYS PAGE TO KEEP
	ANDCMI	T1,.IPM		;POINT TO 1ST WORD IN PAGE
	SUBI	T1,1		;WORD BEFORE IS HIGHEST TO RETURN
	PUSHJ	P,GBCK.L	;GIVE BACK FREED UP CORE
	SETOM	UW.AS		;[650] INDICATE AS AREA STILL GROWING
	PUSHJ	P,GETIOM	;[650] USE SOME OF EXTRA TO SETUP IO.EMG
	JRST	CPOPJ1		;[650] INDICATE SUCCESS TO CALLER


E$$EAS::PUSH	P,[AC]		;[1174] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[1174]
	POPJ	P,		;NEVER GET HERE
SUBTTL	DUMP LOW/HIGH SEG DATA WHEN CORE IS FULL


;HERE FOR LOW SEG
LC.DMP::			;[1174]
E$$PLC::.ERR.	(MS,0,V%L,L%I,S%I,PLC,<Area LC overflowing to disk>) ;[1174]
	PUSH	P,R		;SAVE R
	MOVEI	R,LC.IX		;INDEX FOR LOW
	JRST	LH.DMP		;GO DUMP IT

;HERE FOR HIGH SEG
HC.DMP::			;[1174]
E$$PHC::.ERR.	(MS,0,V%L,L%I,S%I,PHC,<Area HC overflowing to disk>) ;[1174]
	PUSH	P,R
	MOVEI	R,HC.IX
				;FALL INTO LH.DMP
;HERE TO DUMP EITHER LOW OR HIGH
;ENTER WITH R=LC.IX OR HC.IX

LH.DMP:	SKIPN	@[EXP IO.PTR+%XC,IO.PTR+%VC]-1(R)	;[604]
	  JRST	LHDMP0		;[604] /XPN OR /SAVE NOT SPECIFIED
	MOVE	T1,[EXP %XC,%VC]-1(R)	;[604] ONE WAS, GET CHANNEL #
	MOVEM	T1,IO.CHN	;[604] SAVE IT FOR LNKFIO
	PUSHJ	P,DVSUP.##	;[604] SEE IF CAN OVERFLOW TO SAME STR
	  JRST	LHDMP0		;[604] CAN'T, JUST USE DSK:
	MOVE	T3,@[EXP IO.PTR+%XC,IO.PTR+%VC]-1(R)	;[604]
	SKIPA	T3,I.DEV(T3)	;[604] GET STR OLD SAVE/XPN FILE IS ON
LHDMP0:	MOVSI	T3,'DSK'	;[604] NONE EXISTS, USE DSK:
	MOVE	T1,IO.EMG	;[604] GET TEMP SPACE
	MOVEM	T1,IO.PTR+LC-1(R)	;SAVE IT
	SETZM	IO.EMG		;NOT FREE NOW (RESET LATER)
	MOVEM	T3,I.DEV(T1)	;[604] SET UP DEVICE CORRECTLY
	MOVEI	T2,.IODPR	;USE MODE 16
	MOVEM	T2,I.MOD(T1)
	MOVEI	T2,LN.RIB-1	;SIZE OF EXTENDED ENTER BLOCK
	MOVEM	T2,I.RIB(T1)
	MOVE	T2,JOBNUM	;GET SIXBIT JOB NUMBER
	HRR	T2,[EXP <'LLC'>,<'LHC'>]-1(R)
	MOVEM	T2,I.NAM(T1)	;TO FORM TEMP NAME
	MOVSI	T2,'TMP'
	MOVEM	T2,I.EXT(T1)
	SETZ	T2,		;[736] STANDARD PROTECTION
	MOVEM	T2,I.PRV(T1)
	MOVE	T2,HL.S0(R)	;GET HIGHEST LOC LOADED
	LSH	T2,-<.DBS2W-1>	;[650] 2* NUMBER OF 128 WORDS
	MOVEM	T2,I.EST(T1)	;GOOD GUESS?

LH.SET:	MOVEI	T1,LC-1(R)	;CHAN#
	PUSHJ	P,DVUPD.##	;UPDATE MODE
	  PUSHJ	P,@[EXP E$$ELC,E$$EHC]-1(R) ;[1174]
;NOW FOR OUTPUT, SETUP IOWD FOR DATA TO BE OUTPUT
;AND GET RID OF  AREA
	MOVE	T1,TAB.AB(R)	;SEE HOW LONG A BUFFER WE USED
	SUB	T1,TAB.LB(R)	;THIS IS LENGTH
	MOVEM	T1,UW.S0(R)	;THIS IS THE UPPER WINDOW BOUND
	MOVEI	T2,1(T1)	;MAKE INTO 128 WORDS &
	LSH	T2,-<1+.IPS2W>	;[650] CUT IN HALF
	LSH	T2,.IPS2W	;[650] BUT KEEP IN 128 WORD CHUNKS
	CAIGE	T2,.IPS		;[1104] IN CASE 1/2 IS .LT. 1 PAGE,
	MOVEI	T2,.IPS		;[1104]   DUMP ONE PAGE TO MARK PAGING
	SUBI	T1,-1(T2)	;GET NEW BOTTOM WINDOW BOUND
	PUSH	P,T1		;SAVE IT
	SKIPN	T1		;IF SEG IS ONLY 1 BLOCK
	TROA	T1,.IPM		;OUTPUT IT TO MARK PAGING
	HRRZI	T1,-1(T1)	;UPPER WINDOW OF WHATS OUTPUT
	PUSHJ	P,@[EXP LC.OUT,HC.OUT]-1(R)
	POP	P,T1		;RECOVER LOWEST ADDRESS NOT OUTPUT
	JUMPE	T1,LHSET0	;SPECIAL IF BASE STILL 0
	MOVEM	T1,LW.S0(R)	;SET IT
	ADD	T1,TAB.LB(R)	;BOTTOM IN REAL CORE
	SUBI	T1,1		;[650] SET FOR GBCK.L
	PUSHJ	P,GBCK.L	;RETURN FREE SPACE
LHSET0:	PUSHJ	P,GETIOM	;RESET IO.EMG
	PUSHJ	P,LNKCON	;TRY AGAIN, IN CASE ORIG CALL WAS FOR
	 CAIA			;THIS AREA (NEED TO UPDATE UW CORRECTLY)
	AOS	-1(P)		;PRESERVE LNKCOR RETURN
	MOVE	T1,TAB.AB(R)	;ACTUAL TOP
	SUB	T1,TAB.LB(R)	;LENGTH -1
	ADD	T1,LW.S0(R)	;NEW TOP
	MOVEM	T1,UW.S0(R)
	POP	P,R		;RESTORE
	POPJ	P,		;RETURN TO LNKCOR CALLER
E$$ELC::PUSH	P,[LC]		;[1174]
	.ERR.	(LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>) ;[1174]
	POPJ	P,

E$$EHC::PUSH	P,[HC]		;[1174]
	.ERR.	(LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>) ;[1174]
	POPJ	P,
SUBTTL	FIXUPS


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

LS.FXR::SKIPN	FS.SS		;ANY FIXUPS TO DO?
	POPJ	P,		;NO, JUST RETURN
	PUSH	P,R		;MUST SAVE R INCASE FROM LNKXIT
	PUSH	P,[0]		;ADDRESS  TO OUTPUT IF WE DO ANY FIXUPS
	PUSHJ	P,SYMCHN	;SEE IF ANY FIXUPS FOR THIS AREA
	POP	P,T1		;GET BACK POINTER WORD
	POP	P,R		;SAFE TO RESTORE R NOW
	JUMPE	T1,CPOPJ	;NO FIXUPS DONE
	TLZ	T1,.IPM		;MAKE INTO TRUE OUTPUT PTR
	IORI	T1,.IPM
	PJRST	LS.OUT		;OUTPUT AND RET



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

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

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

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

IFN DEBSW,<

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

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

	XALL
SYMTAB:	SFIXUPS
	SALL

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

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

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

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

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

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

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


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

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

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

;HERE TO FIXUP LOCAL BLOCK NAME CHAIN IN TITLE BLOCK
STF.TB:	MOVE	T3,0(T2)	;[577] GET FLAGS
	TXNN	T3,PT.TTL	;[577] BETTER BE A TITLE
	JRST	BADSTF		;[577] ITS NOT, REPORT ERROR
	HRLM	T4,2(T2)	;[577] OK, STORE VALUE
	POPJ	P,		;[577] RETURN

;HERE TO FIXUP SEG STUFF IN TITLE BLOCK
STF.SG:	SKIPL	T3,0(T2)	;GET FLAGS
	TXNN	T3,S.SEG	;LOOK FOR SEGMENT STUFF
	JRST	BADSTF		;REPORT ERROR
	HRRM	T4,1(T2)	;STORE BACK LOW
	TLNN	T4,-1		;[566] DID USER PROGRAM HAVE A HIGH SEG?
	SETZB	T4,2(T2)	;[566] NO, CLEAR HI SEG LENGTH WORD
	SKIPE	2(T2)		;ANY HIGH?
	HLRM	T4,2(T2)	;YES, STORE BACK
	POPJ	P,

;HERE TO FIXUP SEGMENT ORIGINS IN TITLE BLOCK (LEFT HALVES)

STF.SL:	SKIPL	T3,(T2)		;CHECK SECONDARY TRIPLET
	TXNN	T3,S.SEG	;THAT DESCRIBES SEGMENT DATA
	JRST	BADSTF		;REPORT THE ERROR
	HRRE	T3,T4		;GET SIGNED LOW SEG VALUE
	AOSE	T3		;-1 MEANS DO NOT CHANGE
	HRLM	T4,1(T2)	;OTHERWISE, STORE NEW VALUE
	HLRE	T3,T4		;NOW LOOK AT HI SEG VALUE
	AOSE	T3		;DON'T STORE IF -1
	HLLM	T4,2(T2)	;PUT NEW VALUE IN PLACE
	POPJ	P,		;DONE

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


CORLIT:	END