Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - lnkcor.mac
There are 50 other files named lnkcor.mac in the archive. Click here to see a list.
TITLE LNKCOR - CORE MANAGEMENT MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JBC/JNG/DZN/PAH/PY/HD	6-Jan-83



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

SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC

IFN TOPS20,<

SEARCH MONSYM
OPDEF SMAP[JSYS 767]

> ;[1401] IFN TOPS20

SALL

ENTRY	LNKCOR
EXTERN	LNKLOG


CUSTVR==0		;CUSTOMER VERSION
DECVER==5		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==2026		;DEC EDIT VERSION


SEGMENT
SUBTTL	REVISION HISTORY


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

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

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

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

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

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

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

;START OF VERSION 5A
;1520	Use GBCK.L to fix pointers in LSREDU.
;1525	Adjust TAB.PT when high or low segment overflows to disk.
;1532	Map 2nd half of overflow window, not 1st half, at CREDU.
;1536	Fix paging of multisection LS areas on the -20.
;1771	Add 1 to t2 before call to DY.RET near NEWSC0
;2023	Try expunging directory for quota exceeded failures with PMAPs.
;2024	Fix edit 2023 and fix typo at OVFOU2+5.
;2026	Update copyright and delete edit banners.

SUBTTL SIMPLE TESTS FIRST


LNKCOR:	JUMPE	P2,LDCR7Y	;JUST WANT TO SHUFFLE CORE
	ADDI	P2,.IPM		;MAKE SURE ITS A 128 WORD BLOCK
	ANDCMI	P2,.IPM
	MOVE	T1,TAB.UB(P1)	;GET UPPER BOUND
LDCOR0:	SUB	T1,TAB.AB(P1)	;MINUS ACTUAL BOUND
	CAMGE	T1,P2		;BIG ENOUGH?
	JRST	LDCOR1		;NO, TRY ONE ABOVE
IFN TOPS20,<
	SKIPN	T2,@TB.JFD(P1)	;[1401] IS THIS AREA PAGED?
	JRST	LCR1.5		;[1401] NO, NOTHING SPECIAL
	PUSH	P,TAB.AB(P1)	;[1401] REMEMBER ACTUAL BOUND
	ADDM	P2,TAB.AB(P1)	;[1401] FIX ACTUAL BOUND TO REFLECT INCREASE
	ADDM	P2,TAB.FR(P1)	;[1401] AND FREE SPACE COUNTER
	MOVE	T3,P2		;[1401] TAKE THE BLOCK
	LSH	T3,-9		;[1401] MAKE IT PAGES
	SKIPE	T3		;[1401] IF NONZERO
	IOR	T3,[PM%CNT]	;[1401] MARK IT AS A COUNT
	IOR	T3,[PM%RD!PM%WR!PM%PLD];[1401] READ/WRITE ACCESS
	MOVE	T1,TAB.UW(P1)	;[1401] UPPER WINDOW INTO FILE
	SKIPG	T1		;[1401] IF TAB.UW IS -1
	 JRST	[ MOVE	T1,0(P)	;[1401]  OLD TAB.AB
		  SUB	T1,TAB.LB(P1)	;[1401]
		  ADD	T1,TAB.LW(P1)	;[1401]
		  JRST	.+1
		]		;[1401]  CALCULATE CORRECT UW
	AOS	T1		;[1401] START AT PAGE AFTER CURRENT UW
	LSH	T1,-9		;[1401] AS PAGES
	HRL	T1,T2		;[1401] T1: JFN,,FILEPAGE
;[1450]	SKIPGE	T1		;[1412] REALLY A JFN?
;[1450]	ADD	T1,NONZER	;[1412] NO, ADD IN SECTION NUMBER
	POP	P,T2		;[1401] T2: PROCESSPAGE
	AOS	T2		;[1401] 
	LSH	T2,-9		;[1401] ...
	HRLI	T2,.FHSLF	;[1401] ...
	PMAP			;[1401]
	  ERJMP E$$MEF		;[1401] ERROR
	SKIPL	TAB.UW(P1)	;[1401]
	ADDM	P2,TAB.UW(P1)	;[1401] UPDATE WINDOW BOUNDS
	JRST	CPOPJ1		;[1401]  AND RETURN
LCR1.5:
>	;[1401] END IFN TOPS20

	ADDM	P2,TAB.AB(P1)	;FIX ACTUAL BOUND TO REFLECT INCREASE
	ADDM	P2,TAB.FR(P1)	;AND FREE SPACE COUNTER
IFN TOPS20&FTFORK,<
	JRST	@CORTBL		;INCASE ANYTHING SPECIAL TO DO
>
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,

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

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


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

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

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


;HERE TO SEE IF ENOUGH CORE IN LOW SEGMENT

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

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

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

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

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

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

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

> ;END IFE TOPS20


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

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

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

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


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

IFN TOPS20,<
	SKIPN	TAB.PG(T2)	;[1401] IS THIS AREA PAGING?
	JRST	LDCR6D		;[1401] NO, DO ORDINARY BLTS
LDCR6C:	PUSH	P,T2		;[1401] SET ASIDE INDEX -- WE WILL USE T2
	MOVE	T3,TAB.AB(T2)	;[1401] TOP OF AREA
	SUB	T3,TAB.LB(T2)	;[1401] -BOTTOM OF AREA = LENGTH
	LSH	T3,-9		;[1401] LENGTH IN PAGES
	SKIPE	T3		;[1401] ZERO?
	AOS	T3		;[1401] NO, INCLUDE ALL PAGES
	SKIPE	T3		;[1401] ZERO?
	IOR	T3,[PM%CNT]	;[1401] NO, MARK IT A COUNT
	IOR	T3,[PM%WR!PM%RD];[1401] READABLE AND WRITEABLE
	MOVE	T1,TAB.LB(T2)	;[1401] ADDRESS TO MAP AWAY
	LSH	T1,-9		;[1401] IN PAGES, PLEASE
	HRLI	T1,.FHSLF	;[1401] SELF,,PROCESSPAGE
	MOVE	T2,T1		;[1401] T2 GETS IT
	SETOM	T1		;[1401] T1 GETS -1 -- UNMAP, PLEASE
	PMAP			;[1401] OUT THEY GO!
	  ERJMP	[ POP P,(P)	;[1401] ERROR -- CLEAR STACK
		  JRST E$$MEF ]	;[1401] AND RETIRE
	POP	P,T2		;[1401] GET INDEX BACK
	PUSH	P,T3		;[1401] SET ASIDE BITS AND COUNT
	SKIPN	T3,@TB.JFD(T2)	;[1401] PICK UP THE JFN
	JRST	[ POP	P,(P)	;[1401] ERROR -- CLEAR STACK
		  POP	P,(P)
		  JRST E$$MEF ]	;[1401]  AND RETIRE
	MOVE	T1,TAB.LW(T2)	;[1401] NOTE ADDRESS IN OVF FILE
	LSH	T1,-9		;[1401] MAKE IT PAGES
	HRL	T1,T3		;[1401] JFN,,FILEPAGE
	SKIPGE	T1		;[1412] REALLY A JFN?
	ADD	T1,NONZER	;[1412] NO, ADD IN SECTION NUMBER
	POP	P,T3		;[1401] PUT COUNT BACK
	PUSH	P,T2		;[1401] SAVE INDEX ONCE MORE
	MOVE	T2,TAB.NB(T2)	;[1401] FETCH DESTINATION
	LSH	T2,-9		;[1401] IN PAGES, PLEASE
	HRLI	T2,.FHSLF	;[1401] PROCESS IS OURSELF
	PMAP
	  ERJMP	[ POP P,(P)	;[1401] ERROR -- CLEAR STACK
		  JRST E$$MEF ]	;[1401] AND RETIRE
	POP	P,T2		;[1401] PUT THE INDEX BACK
	PUSHJ	P,ADJTBL	;[1401] ADJUST THE TABLES
	JRST	LDCR6B		;[1401] AND TRY AGAIN

; [1401] DISPATCH TABLE GIVING JFNS FOR OVERFLOW FILES

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

LDCR6D:	>			;[1401] IFN TOPS20

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

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

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

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


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

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

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

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

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

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


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

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

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

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


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

;  ..
;  ..

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


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

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


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

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

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

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

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

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


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

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

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

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

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

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

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

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

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


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

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

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


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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

;HERE TO GIVE BACK TOP PIECE IF POSSIBLE

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

;HERE TO RE-LINK IN ORDER OF SIZE

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


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

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


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


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

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

	XALL
	AREAS
	SALL
;SUBROUTINE TO REMOVE DESIRED CHUNK

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


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

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


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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

RPOPJ:	POP	P,R		;RESTORE R
	POPJ	P,
SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS10


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

	IFE TOPS20,<

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

SUBTTL DISK OVERFLOW ROUTINES -- OUTPUT -- TOPS20

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

IFN TOPS20,<

DEFINE PAGOUT (%AREA,CHAN,WD)<

%AREA'.OUT::
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
	HLR	T2,LW.LS	;[1536] PICK UP SECTION NUMBER
	LSH	T2,9		;[1536] MAKE IT PAGE NUMBER
	PUSH	P,NONZER	;[1536] SAVE NONZER IF IN USE
	MOVEM	T2,NONZER	;[1536] SET IT FOR LS.OUT
> ;[1536] END IFN FTFRK2
> ;[1536] END IFIDN
	MOVEI	T2,%AREA'.IX	;[1426] CHANNEL INFO
	PUSHJ	P,OVF.OU	;[1426] DO THE I/O
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
	POP	P,NONZER	;[1536]
> ;[1536] END IFN FTFRK2
> ;[1536] END IFIDN
	POPJ	P,
E$$O'%AREA::
	MOVEI	T2,%AREA'.IX	;[1426] AREA NAME
	PUSHJ	P,OVFER1	;[1426] SET UP .TEMP
	.ERR.	(MS,.EC,V%L,L%F,S%F,O'%AREA,<Error writing area %AREA>)
	.ETC.	(STR,.EC,,,,,< to file >)
	.ETC.	(STR,,,,,.TEMP)
	POPJ	P,
> ;[1426] END PAGOUT

OVF.OU:
OVFOU0:	PUSH	P,P1		;[1426] SAVE REGISTER
	PUSH	P,T2		;[1426] -1(P): AREA
	PUSH	P,T1		;[1401] 0(P): FIRST,,LAST
	MOVE	P1,TB.CHN(T2)	;[1426] P1:CHANNEL
	HRL	P1,T2		;[1426] P1:AREA,,CHANNEL
	SKIPN	T1,CHAN.JF(P1)	;[1401]  JFN?
	JRST	[POP P,0(P)
		 POP P,T2	;[1426] AREA
		 POP P,P1	;[1426] RESTORE REGISTER
		 JRST	@TB.OER(T2) ] ;[1426] GIVE THE ERROR
	HRRZ	T2,0(P)		;[1401] GET UPPER ADDRESS
	HLRZ	T3,0(P)		;[1412]
	CAMG	T2,T3		;[1412]
	TLO	T2,1		;[1412] SECTION BOUND CROSSING
	MOVE	T3,NONZER	;[1412]
	LSH	T3,9		;[1412] MAKE IT AN ADDRESS
	ADD	T2,T3		;[1412] AND ADD IT IN
	MOVSS	P1		;[1426] P1: CHANNEL,,WD
	CAMG	T2,TAB.HB(P1)	;[1426] BIGGER THAN WHAT WE HAVE?
	JRST	OVFOU1		;[1401] NO, CONTINUE.
	EXCH	T2,TAB.HB(P1)	;[1442] SWAP OLD BOUND FOR NEW
IFN FTFRK2,<
	SKIPN	T2		;[1442] IF WE'RE STARTING UP A NON-0 SECTION
	SKIPE	EXTFLG		;[1442] DON'T WRITE NONEXISTENT SECT-0 PAGES
	JRST	OVFOU1		;[1401] NO, UNMAP THE PAGES
				;[1401] OTHERWISE WRITE THE PAGES
	HLRZ	T2,0(P)		;[1401] T2: FIRST ADDR OF DEST
	LSH	T2,-9		;[1401] T2: FIRST PAGE OF DEST
	HRRZ	T3,0(P)		;[1401] T3: LAST ADDR 
	LSH	T3,-9		;[1401] T3: LAST PAGE 
	SUB	T3,T2		;[1401] T3: PAGE COUNT
	SKIPE	T3		;[1401] ZERO?
	AOS	T3		;[1401] NO, INCLUDE ALL PAGES
	SKIPE	T3		;[1401]  IF NONZERO
	IOR	T3,[PM%CNT]	;[1401]  SET COUNT FLAG
	IOR	T3,[PM%RWX]	;[1401]  SET READ/WRITE/EXEC
	HRL	T2,T1		;[1401]  T2: JFN,,FIRST PAGE
	SKIPGE	T2		;[1412] REALLY A JFN?
	ADD	T2,NONZER	;[1412] NO, ADD SECTION NUMBER
	SKIPE	T1,NONZER	;[1426] REMEMBER BASE SECTION
	LSH	T1,9		;[1426] CONVERT TO ADDRESS
	HLR	T1,0(P)		;[1426] LOWER BOUND OF BLOCK
	SUB	T1,TAB.LW(P1)	;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T1,TAB.LB(P1)	;[1401] FIX IN CORE
	LSH	T1,-9		;[1401] RELOCATE TO REAL PAGE
	HRLI	T1,.FHSLF	;[1401] T1: SELF,,SOURCE PAGE
	SETZM	T4		;[2023] ZERO T4 - USE TO INDICATE FIRST TRY
	PMAP			;[1401] OUT THEY GO
	  ERCAL	PMAPER		;[2023] TRY EXPUNGE IF QUOTA EXCEEDED

> ;[1426] IFN FTFRK2
OVFOU1:
	HLRZ	T2,0(P)		;[1401] T2: FIRST ADDR OF DEST
	LSH	T2,-9		;[1401] T2: FIRST PAGE OF DEST
	HRRZ	T3,0(P)		;[1401] T3: LAST ADDR 
	LSH	T3,-9		;[1401] T3: LAST PAGE 
	SUB	T3,T2		;[1401] T3: PAGE COUNT
	SKIPGE	T3		;[1426] LAST .LT. FIRST?
	ADDI	T3,1000		;[1536] ABSOLUTE DIFFERENCE
	JUMPE	T3,OVFOU2	;[1426]
	AOS	T3		;[1426] INCLUDE ALL PAGES
	IOR	T3,[PM%CNT]	;[1426] IN COUNT
OVFOU2:	IOR	T3,[PM%RD!PM%WR];[1401]  SET READ/WRITE
	HLR	T2,0(P)		;[1450]  T2: FIRST ADDR OF SOURCE
	SKIPE	T1,NONZER	;[1536] REMEMBER BASE SECTION
	LSH	T1,9		;[1536] CONVERT TO ADDRESS
	HLL	T2,T1		;[1536] AND ADD IN SECTION
	SUB	T2,TAB.LW(P1)	;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,TAB.LB(P1)	;[1401] FIX IN CORE
	LSH	T2,-9		;[1401]  RELOCATE TO REAL PAGE
	HRLI	T2,.FHSLF	;[1401]  T1: SELF,,SOURCE PAGE
	SETOM	T1		;[1401] UNMAP
	PMAP			;[1401]  OUT THEY GO
	  ERJMP	[POP P,0(P)
		 POP P,T2	;[1426] AREA
		 POP P,P1	;[1426] RESTORE REGISTER
		 JRST	@TB.OER(T2) ] ;[1426] GIVE THE ERROR
	POP	 P,T1		;[1426] BOUNDS
	POP	 P,T2		;[1426] AREA
	POP	 P,P1		;[1426] RESTORE REGISTER
	POPJ	P,		;[1401]  NORMAL RETURN


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



PMAPER: DMOVEM	T1,CRTMP1	;[2024] Save AC's form PMAP%
	MOVEM	T3,CRTMP3	;[2024] in CRTMP1-3
	MOVEI	T1,.FHSLF	;[2024] This process
	GETER%			;[2024] Get last error
	 ERJMP ERMAP		;[2024] 
	HRRZS	T2		;[2024] Just the error number
	CAIE	T2,IOX11	;[2024] Is it Quota Exceeded error?
	JRST	ERMAP		;[2024] No - just give error
	PUSHJ	P,EXPNG		;[2024] Yes - Try expunging the directory
	POPJ 	P,		;[2024] Return to PMAPER caller
ERMAP:	POP	P,0(P)		;[2024] Throw away ERCAL address
	POP	P,0(P)		;[2024] Toss arg to OVF.OU
	POP	P,T2		;[2024] Area number
	POP	P,P1		;[2024] Restore P1
	JRST	@TB.OER(T2)


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

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

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

>	;[1401] END IFN TOP20


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


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

	IFE TOPS20,<

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

>	;[1401] END IFE TOPS20
SUBTTL DISK OVERFLOW -- INPUT -- TOPS20
;CALLED BY
;	MOVE	T1,[FIRST,,LAST ADDRESS TO INPUT]
;	PUSHJ	P,LC.IN/HC.IN/LS.IN
;USES T1, T2, T3

IFN TOPS20,<
DEFINE	PAGIN (%AREA,CHAN,WD,FIXUP)<
%AREA'.IN::
IFIDN <%AREA>,<LS>,<
IFN FTFRK2,<
	HLR	T2,LW.LS	;[1536] PICK UP SECTION NUMBER
	LSH	T2,9		;[1536] MAKE IT PAGE NUMBER
	PUSH	P,NONZER	;[1536] SAVE NONZER IF IN USE
	MOVEM	T2,NONZER	;[1536] SET IT FOR LS.OUT
> ;[1536] IFN FTFRK2
> ;[1536] END IFIDN
	MOVEI	T2,%AREA'.IX	;[1426] CHANNEL INFO
	PUSHJ	P,OVF.IN	;[1426] DO THE I/O
IFIDN <%AREA>,<LS>,<
	POP	P,NONZER	;[1536]
> ;[1536] END IFIDN

IFB <FIXUP>,<
	  POPJ	P,		;[1401] OK
>
IFNB <FIXUP>,<
	  PJRST	%AREA'.FXR	;[1401] DO ANY FIXUPS REQUIRED
>
E$$I'%AREA::
	MOVEI	T2,%AREA'.IX	;[1426] AREA NAME
	PUSHJ	P,OVFER1	;[1426] SET UP .TEMP
	.ERR.	(MS,.EC,V%L,L%F,S%F,I'%AREA,<Error reading area %AREA>)
	.ETC.	(STR,.EC,,,,,< from file >)
	.ETC.	(STR,,,,,.TEMP)
	POPJ	P,
> ;[1426] END PAGIN

OVF.IN:
OVFIN0:	PUSH	P,P1		;[1426] SAVE REGISTER
	PUSH	P,T2		;[1426] -1(P): AREA
	PUSH	P,T1		;[1401]  0(P): FIRST,,LAST
	MOVE	P1,TB.CHN(T2)	;[1426] P1:CHANNEL
	HRL	P1,T2		;[1426] P1:AREA,,CHANNEL
	SKIPN	T1,CHAN.JF(P1)	;[1401]  JFN?
	JRST	[POP P,0(P)
		 POP P,T2	;[1426] AREA
		 POP P,P1	;[1426] RESTORE REGISTER
		 JRST	@TB.IER(T2) ] ;[1426] GIVE THE ERROR
	HRRZ	T2,0(P)		;[1401]  GET LAST ADDRESS
	HLRZ	T3,0(P)		;[1412]
	CAMG	T2,T3		;[1412]
	TLO	T2,1		;[1412] SECTION BOUND CROSSING
	MOVE	T3,NONZER	;[1412]
	LSH	T3,9		;[1412] MAKE IT AN ADDRESS
	ADD	T2,T3		;[1412] AND ADD IT IN
	MOVSS	P1		;[1426] P1: CHANNEL,,WD
	CAMLE	T2,TAB.HB(P1)	;[1426] BIGGER THAN WHAT WE HAVE?
	MOVEM	T2,TAB.HB(P1)	;[1426] YES, RESET HIGHEST
IFN FTFRK2,<
	PUSHJ	P,NEWSCT	;[1450] YES, GET THE NEXT ONE
> ;[1450] IFN FTFRK2
	HRLS	T1		;[1401] JFN IN RH
	HLRZ	T2,0(P)		;[1401] T2: FIRST ADDRESS
	LSH	T2,-9		;[1401] IN PAGES, PLEASE
	HRR	T1,T2		;[1401] JFN,,FILE PAGE
	SKIPGE	T1		;[1412] REALLY A JFN?
	ADD	T1,NONZER	;[1412] NO, ADD SECTION NUMBER
	HRRZ	T3,0(P)		;[1401] T3:LAST ADDRESS
	AOS	T3
	LSH	T3,-9		;[1401] IN PAGES
	SUB	T3,T2		;[1401] T3:LAST-FIRST
	SKIPGE	T3		;[1426] IF LAST .LE. FIRST
	ADDI	T3,1000		;[1536] SECTION BOUND WAS CROSSED
	SKIPE	T3		;[1401]  IF NONZERO,
	IOR	T3,[PM%CNT]	;[1401] SET COUNT BIT
	IOR	T3,[PM%RD!PM%WR];[1401] SET ACCESS
	SKIPE	T2,NONZER	;[1426] REMEMBER BASE SECTION
	LSH	T2,9		;[1426] CONVERT TO ADDRESS
	HLR	T2,0(P)		;[1426] LOWER BOUND OF BOCK
	SUB	T2,TAB.LW(P1)	;[1401] MINUS WINDOW START (MAY NOT BE ORIGIN)
	ADD	T2,TAB.LB(P1)	;[1401] FIX IN CORE
	LSH	T2,-9		;[1401] IN PAGES
	HRLI	T2,.FHSLF	;[1401] PROCESS IS SELF
	PMAP			;[1401] MAP THESE PAGES
	  ERJMP	[POP P,0(P)
		 POP P,T2	;[1426] AREA
		 POP P,P1	;[1426] RESTORE REGISTER
		 JRST	@TB.IER(T2) ] ;[1426] GIVE THE ERROR
	POP	P,T1		;[1401] CLEAN UP STACK
	POP	P,T2
	POP	P,P1
	POPJ	P,		;[1426] AND RETURN

IFN FTFRK2,<
NEWSCT:
	SKIPE	TAB.HB(P1)	;[1450] DON'T DO ANYTHING FIRST TIME
	SKIPN	EXTFLG		;[1450] ANY NONZERO SECTIONS SEEN?
	POPJ	P,		;[1450] NO, DO NOTHING
	PUSH	P,T1		;[1450] SAVE THE TEMPS
	PUSH	P,T2
	PUSH	P,T3
	PUSH	P,P1		;[1450] AND OTHER REGISTERS
	MOVE	T2,NONZER	;[1450] PICK UP SECTION
	LSH	T2,-9		;[1450] AS SECT NUMBER
	MOVNS	T2		;[1450]
	HRLZI	T1,400000	;[1450] SET B0
	LSH	T1,1(T2)	;[1450] B(N)=SECT(N-1)
	MOVE	T3,FXSPTR	;[1450]
	TDNE	T1,(T3)		;[1450] THIS BIT SET IN ARRAY MAP WORD?
	JRST	NEWSC1		;[1450] YES, THE SECTION'S THERE ALREADY
	IORM	T1,(T3)		;[1450] NO, SAY IT'S THERE
	HLRZ	T1,FXSPTR	;[1450] IS IT BEYOND THE CURRENT ALLOCATON?
	MOVNS	T2		;[1450] POSITIVE AGAIN
	CAMG	T2,T1		;[1450]
	JRST	NEWSC0		;[1450] NO, NO NEED TO REALLOCATE ARRAY
	MOVEI	T2,1(T2)	;[1450] YES, ASK FOR ANOTHER BLOCK
	PUSHJ	P,DY.GET	;[1450]

; ON GETTING HERE, COPY THE OLD BLOCK TO THE NEW ONE, UPDATE FXSPTR, AND
; FREE UP THE OLD BLOCK.

	MOVE	T3,FXSPTR	;[1450]	SAVE OLD BLOCK PTR
	HRRM	T1,FXSPTR	;[1450] UPDATE BLOCK PTR
	SUBI	T2,1		;[1450] COUNT IS ONE LESS THAN ARRAYSIZE
	HRLM	T2,FXSPTR	;[1450]
	HRL	T1,T3		;[1450]	CONSTRUCT BLT PTR
	HLRZ	T2,T3		;[1450] GET OLD COUNT
	ADDI	T2,(T1)		;[1771] AND END POINT
	BLT	T1,(T2)		;[1450] COPY OLD TO NEW
	HRRZ	T1,T3		;[1450] FREE OLD BLOCK
	HLRZ	T2,T3		;[1450]
	AOS	T2		;[1771] MAKE COUNT CORRECT FOR CALL
	PUSHJ	P,DY.RET	;[1450]
NEWSC0:	MOVE	P1,NONZER	;[1450] PICK UP SECTION
	LSH	P1,-9		;[1450] AS SECT NUMBER
	PUSHJ	P,E$$CRS	;[1450] SAY WE'RE CREATING THE SECTION
	SETZM	T1		;[1450] CREATE THE SECTION
	HRRZ	T2,P1		;[1450] SPECIFY WHICH
	TLO	T2,PRGFRK	;[1450] AND WHERE
	MOVE	T3,[PM%CNT!PM%RWX!PM%IND!1]
	SMAP
	  ERJMP E$$MEF
NEWSC1:
	POP	P,P1		;[1450] RESTORE REGS
	POP	P,T3
	POP	P,T2
	POP	P,T1
	POPJ	P,		;[1450] AND RETURN

> ;[1450] IFN FTFRK2

OVFER1:
	MOVE	T2,TB.CHN(T2)	;[1426] FETCH CHANNEL FOR AREA
	MOVE	T2,CHAN.JF(T2)	;[1401] AND PICK UP JFN
	HRROI	T1,.TEMP	;[1401] PUT THE STRING IN .TEMP
	SETZM	T3		;[1401] NOTHING FANCY
	SETZM	T4
	JFNS
	POPJ	P,		;[1426] NAME IN .TEMP


>	;[1401]END IFN TOPS20

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

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


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

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

TB.IN::	AREAS


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

TB.OUT::AREAS

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


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

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


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

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

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

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

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

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

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


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

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

E$$ELC::
IFE TOPS20,<
	PUSH	P,[LC]			;[1230] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,ELC,<Error creating area LC overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
;	MOVE	T2,LC.JF	;[1401] PICK UP LC JFN
;	HRROI	T1,.TEMP	;[1401] PUT THE STRING IN .TEMP
;	SETZM	T3		;[1401] NOTHING FANCY
;	SETZM	T4
;	JFNS
	MOVE	T2,LC.IX	;[1511] PUT INDEX IN IO.CHN
	MOVEM	T2,IO.CHN##	;[1511] TO HAVE DVTXT1 FETCH FILENAME
	MOVEI	T1,.TEMP	;[1511] INTO .TEMP
	PUSHJ	P,DVTXT1	;[1511]

	.ERR.	(MS,.EC,V%L,L%F,S%F,ELC,<Error creating area LC overflow file >)
	.ETC.	(STR,,,,,.TEMP)
> ;[1401] IFN TOPS20
	POPJ	P,

E$$EHC::
IFE TOPS20,<
	PUSH	P,[HC]			;[1230] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,EHC,<Error creating area HC overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
;	MOVE	T2,HC.JF	;[1401] PICK UP HC JFN
;	HRROI	T1,.TEMP	;[1401] PUT THE STRING IN .TEMP
;	SETZM	T3		;[1401] NOTHING FANCY
;	SETZM	T4
;	JFNS
	MOVE	T2,HC.IX	;[1511] PUT INDEX IN IO.CHN
	MOVEM	T2,IO.CHN##	;[1511]
	MOVEI	T1,.TEMP	;[1511] SO DVTXT1 CAN RETURN A FILENAME
	PUSHJ	P,DVTXT1	;[1511]
	.ERR.	(MS,.EC,V%L,L%F,S%F,EHC,<Error creating area HC overflow file >)
	.ETC.	(STR,,,,,.TEMP)
> ;[1401] IFN TOPS20
	POPJ	P,

E$$ELS::
IFE TOPS20,<
	PUSH	P,[SC]			;[1230] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,ELS,<Error creating area LS overflow file>) ;[1174]
> ;[1401] IFE TOPS20
IFN TOPS20,<
;	MOVE	T2,SC.JF	;[1401]  PICK UP LS JFN
;	HRROI	T1,.TEMP	;[1401]  PUT THE STRING IN .TEMP
;	SETZM	T3		;[1401]  NOTHING FANCY
;	SETZM	T4
;	JFNS
	MOVE	T2,LS.IX	;[1511]
	MOVEM	T2,IO.CHN##	;[1511]
	MOVEI	T1,.TEMP	;[1511]
	PUSHJ	P,DVTXT1##	;[1511]
	.ERR.	(MS,.EC,V%L,L%F,S%F,ELS,<Error creating area LS overflow file >)
	.ETC.	(STR,,,,,.TEMP)
> ;[1401]  IFN TOPS20
	POPJ	P,


E$$EAS::
	IFE TOPS20,<
	PUSH	P,[AC]			;[1230] INDICATE WHICH CHANNEL
	.ERR.	(LRE,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>) ;[1230]
	> ;[1401] IFE TOPS20
	IFN TOPS20,<
	MOVE	T2,AS.IX		;[1511] PUT INDEX IN IO.CHN
	MOVEM	T2,IO.CHN##		;[1511]
	MOVEI	T1,.TEMP		;[1511] PUT THE FILENAME IN .TEMP
	PUSHJ	P,DVTXT1##		;[1511]
	.ERR.	(MS,0,V%L,L%F,S%F,EAS,<Error creating area AS overflow file>)
	.ETC.	(STR,,,,,.TEMP)
	> ;[1511] IFN TOPS20
	POPJ	P,			;[1511] RETURN

SUBTTL	DUMP LOCAL SYMBOL AREAS (LS AND AS) WHEN MEMORY IS FULL


LS.DMP::SPUSH	<R,P1>			;[1230] SAVE SOME ACS
	MOVX	R,LS.IX			;[1230] SET UP LS AREA INDEX
	PUSHJ	P,LA.DMP		;[1230] COMMON CODE TO SET UP FILE
	  JRST	LARET			;[1230] DIDN'T NEED TO OVERFLOW--RETURN
	MOVE	P1,TAB.AB(R)		;[1230] SIZE OF LS AREA
	SUB	P1,TAB.LB(R)		;[1230] ALMOST ANYWAY
  IFE TOPS20,<
	SUBI	P1,.IPS			;[1230] HIGHEST TO OUTPUT
  >  ;[1401]
	MOVE	T1,P1			;[1230]
	PUSHJ	P,@TB.OUT(R)		;[1230] GENERAL OUTPUT ROUTINE
	MOVE	T1,P1			;[1230] HIGHEST REL ADDRESS TO GIVE AWAY
IFN TOPS20,<
	SUBI	P1,.IPS		;[1401] KEEP ONE PAGE
	ADDI	P1,1		;[1401] LOWEST TO KEEP
	MOVEM	P1,LW.S0(R)	;[1401] WILL BECOME WINDOW LOWER LIMIT
	HRL	T1,P1		;[1401] BRING IT BACK
	PUSHJ	P,@TB.IN(R)	;[1401] ...
	MOVE	T1,TAB.AB(R)	;[1401] RESET ALLOCATION POINTER
	SUBM	T1,TAB.PT(R)	;[1401] ...
	MOVE	T1,TAB.LB(R)	;[1401] PICK UP LOWERBOUND
	ADDI	T1,.IPS-1	;[1401] RESET TAB.AB(R) TO NEW LIMITS
	MOVEM	T1,TAB.AB(R)
	SUBM	T1,TAB.PT(R)	;[1401] RESET LS.PT
	MOVE	T1,P1		;[1401] 
>	;[1401]  IFN TOPS20
	ADD	T1,TAB.LB(R)	;[1230] ADD IN OFFSET
IFE TOPS20,<
	ADDI	P1,1			;[1230] LOWEST TO KEEP FOR GBCK.L
>	;[1401] IFE TOPS20
	JRST	LARET1			;[1230] GIVE BACK FREED MEM AND RETURN


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


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

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

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


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



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

LH.DMP:
IFE FTFRK2,<
	PUSHJ	P,@TB.PAG(R)	;[1230] PRINT OVERFLOW MESSAGE
> ;[1450] IFE FTFRK2
IFN TOPS20&FTFRK2,<
	SKIPN	EXTFLG		;[1442] DOING A NONZERO SECTION?
	JRST	LHDMP1		;[1412] NO, OVERFLOW TO DISK
	PUSH	P,P1		;[1450] SAVE A REGISTER
	MOVE	P1,NONZER	;[1450] PASS SECTION INFO
	LSH	P1,-9		;[1450] AS A SECT NUMBER
	PUSHJ	P,E$$CRS	;[1450]
	POP	P,P1		;[1450] RESTORE REGISTER
	SETZM	T1		;[1412] CREATE THE SECTION
	MOVE	T2,NONZER	;[1412] PICK UP SECTION NUMBER
	LSH	T2,-9		;[1412] REMOVE PAGE INFO	
	TLO	T2,PRGFRK	;[1450]
	MOVE	T3,[PM%CNT!PM%RWX!PM%IND!1]
				;[1412] CREATE ONE SECTION...
	SMAP			;[1412]
	  ERJMP	E$$MEF		;[1412] NOGOOD
	HLRZM	T2,@TB.JFD(R)	;[1412] FAKE UP JFN
	MOVEI	T2,4		;[1442] GET AN ARG BLOCK
	PUSHJ	P,DY.GET	;[1442]
	PUSH	P,AP		;[1450] DON'T LOSE CURRENT CONTENTS
	MOVE	AP,T1		;[1442] SET ARG PTR
	MOVEI	T2,LC.IX	;[1442] LOWSEG
	CAME	T2,R		;[1442] IT IS LOWSEG, RIGHT?
	JRST	E$$NHN##	;[1442] NO HIGHSEG IN NONZERO SECTIONS
	MOVEI	T2,LC.JF	;[1442]
	MOVEM	T2,WNAM(AP)	;[1442] LC AREA
	MOVE	T1,NONZER	;[1442] SECT,,0
;[1450]	LSH	T1,-9		;[1442] AS PAGES
	MOVEM	T1,WSRC(AP)	;[1442] PAGE IN PROGRAM FORK
	MOVE	T1,TAB.LB(R)	;[1442] PAGE IN LINK
	MOVE	T2,TAB.AB(R)	;[1442] CALC SIZE OF AREA
	SUB	T2,T1		;[1442]
	AOS	T2		;[1442]
	LSH	T2,-9		;[1442] IN PAGES, PLEASE
	MOVEM	T2,WSIZ(AP)	;[1442]
	LSH	T1,-9		;[1442] AS A PAGE
	MOVEM	T1,WDST(AP)	;[1442]
	PUSHJ	P,CRTFRK	;[1442] SETUP
	  JRST E$$MEF		;[1442] COULDN'T DO IT
	MOVE	T1,NONZER	;[1450] CALC SECT NUMBER
	LSH	T1,-9		;[1450]
	HRLM	T1,FXSPTR	;[1450] SIZE OF SECT FIXUP ARRAY
	MOVEI	T2,1(T1)	;[1450] ASK FOR STORAGE
	PUSHJ	P,DY.GET	;[1450]
	HRRM	T1,FXSPTR	;[1450] SET POINTER TO ARRAY
	MOVNI	T2,-1(T2)	;[1450] PICK UP SECTION
	HRLZI	T1,400000	;[1450] SET B0
	LSH	T1,1(T2)	;[1450] B(N)=SECT(N-1)
	MOVE	T2,FXSPTR	;[1450]
	MOVEM	T1,(T2)		;[1450] SET THIS BIT
	POP	P,AP		;[1450]
	POP	P,R		;[1442] FIX STACK, RESTORE R
	POPJ	P,		;[1442] AND EXIT

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


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

LS.FXR::
	MOVE	T1,LW.LS	;[1536] MORE THAN A SECTION?
	TLNN	T1,-1		;[1536] DON'T DO FIXUPS, WON'T HELP
	SKIPN	FS.SS		;ANY FIXUPS TO DO?
	POPJ	P,		;NO, JUST RETURN
	PUSH	P,R		;MUST SAVE R INCASE FROM LNKXIT
	PUSH	P,[0]		;ADDRESS  TO OUTPUT IF WE DO ANY FIXUPS
	PUSHJ	P,SYMCHN	;SEE IF ANY FIXUPS FOR THIS AREA
	POP	P,T1		;GET BACK POINTER WORD
	POP	P,R		;SAFE TO RESTORE R NOW
IFE TOPS20,<
	JUMPE	T1,CPOPJ	;NO FIXUPS DONE
	TLZ	T1,.IPM		;MAKE INTO TRUE OUTPUT PTR
	IORI	T1,.IPM
	PJRST	LS.OUT		;OUTPUT AND RET
> ;[1401] IFE TOPS20
IFN TOPS20,<
	POPJ	P,		;[1401] RETURN 
> ;[1401] IFN TOPS20



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

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

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

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

IFN DEBSW,<

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

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

	XALL
SYMTAB:	SFIXUPS
	SALL

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

IFN FTFRK2,<

CRTFRK::

; Routine CRTFRK.
; Expects an argument block address in register 16
;  having the format
;	virtual page in area
;	real page in LINK's lowseg
;	size of area in pages
;	where to put the new fork handle
;

; ** Should we ever want a multifork loader, here is where the
; CFORK goes...***

	MOVEI	T1,PRGFRK	;[1450]
	MOVEM	T1,@WNAM(AP)	; tell the forkname
	HRLS	T1		; set up mapping
	HRR	T1,WSRC(AP)	; T1: source page
	DMOVE	T2,WDST(AP)	; T2: destination page	
	HRLI	T2,.FHSLF	; T3: area size
	TXO	T3,PM%CNT!PM%RWX
	PMAP			; set up mapping
	  ERJMP CRTFR0		; error, noskip return
	MOVE	T1,WNAM(AP)	; What area is being set up?
	SETZM	T2
	CAME	T1,TB.JFD(T2)	; find out whose jfn
	AOJA	T2,.-1		; try again
	HRRZS	T3		; Get a page count
	LSH	T3,9		; Make a word count
	SOS	T3
	HRRZ	T1,WSRC(AP)	;[1450] Add to base
	LSH	T1,9
	ADD	T3,T1
	MOVEM	T3,TAB.UW(T2)	; Window bound set up
	AOS	(P)		; skip return, all ok
CRTFR0:	POPJ	P,

>	;[1426] IFN FTFRK2
SUBTTL	THE END


CORLIT:	END