Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - formem.mac
There are 11 other files named formem.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORMEM	MEMORY MANAGEMENT,10(4205)
	SUBTTL	CHRIS SMITH/CKS/DAW/JLC/BL/EGM/AHM/PLB

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

1100	CKS	5-Jun-79
	New for version 6

1160	CKS	9-Oct-80	Q1244
	When memory fills up, scrounge pages from STARTP going upward.

1275	DAW	20-Feb-81
	Return whole 30-bit address of memory at %GTBLK

1410	JLC	07-Apr-81
	Change %MVBLK to return new size in T3.

1464	DAW	12-May-81
	Error messages.

1466	CKS	18-May-81
	Add TOPS-20 PSI interface

1510	BL	4-Jun-81	Q10-06197
	Fix IllMemRef bug due to all pages being initialized as existing.

1523	JLC	04-Jul-81
	1022 interface. Rerouted all core expansion and contraction
	requests through one routine (EXPADR), called indirectly
	through %EXPNT, with the desired expansion value in %DESHG.
	Made all references to .JBFF indirect through %JBFPT.

1527	JLC/BL	09-Jul-81
	Fixes to BL's code (VMDDT fix), removal of some crocks.

1531	JLC	10-Jul-81
	Integrated %GTPGS for below and above page 600. Restricted
	page use to below 775.

1542	JLC	17-Jul-81
	Fixed %MVBLK for slightly changed calling sequence in FORIO.

1633	JLC	24-Aug-81
	Cleaned up some comments that were misleading

1667	JLC	9-Sep-81
	One-word patch at GETLP+11 makes lowseg core request work.

1727	JLC	18-Sep-81
	Another fix to low-core memory manager. Free-list was one word off.

1740	JLC	23-Sep-81
	Yet more fixes to low segment memory manager. Fixed so that
	free-list memory is included in larger requests if the
	free-list memory is at .JBFF.

1756	JLC	1-Oct-81
	Fix ots memory manager. For GTPGS, start at STARTP minus number
	of pages desired, and go down. Then at TRYHRD, start at STARTP+1
	minus number of pages desired and go up.

1773	DAW	8-Oct-81
	Change name of error code "CMU" to "IEM", for "internal error in
	memory manager".

2015	DAW	20-Oct-81
	AC T1 was being smashed in CREPG (TOPS-10).

2025	JLC	26-Oct-81
	Fix LSTRIM for the 1022 folks - we were using a non-transparent
	subroutine.

2033	JLC	19-Nov-81
	Incorrect calling sequence for %MVBLK.
	Don't smash LH(back-link) in %FREBLK, it is useful for debugging.

2052	EGM	27-Apr-82
	Add routine to cut back core for the block structured (OTS) core area.
	Cause %FREPGS to kill off pages returned for TOPS-10. Cause CREPGS for
	TOPS-10 to kill off any pages obtained for an incomplete request.
	Make KILPGS for TOPS-10 more forgiving of 'page non existent' errors.

2053	EGM	23-Apr-82
	Improve paged core usage when getting additional pages by:
	1. Trying to get specific pages contiguous with the start of
	   the block list, and
	2. Considering any initial free block size when determining
	   the number of new pages to get.
	Also preserve the saved PC when linking in a new free block.

***** Begin Version 7 *****

3021	JLC	10-Nov-81
	Fix lowseg memory manager bug. %MVBLK was called incorrectly.
	Done in V6 as part of edit 2033.

3026	JLC	24-Nov-81
	Change FUNCT., ALCOR., and DECOR. to call %FSAVE instead of
	%SAVE, to avoid argument copying.

3027	JLC	30-Nov-81
	Fix overlay symbol table problem - we were marking the page(s)
	where the symbol table resides as allocated. This is not necessarily
	true. OVRLAY sometimes purposely uses the area around and in the
	place where the symbol table was. This complex patch marks the
	area between .JBFF and the symbol table as a free list entry,
	and marks just the symbol table as allocated; then if a lowseg
	memory request fails we add the symbol table to the free list
	and try again.

3056	JLC	23-Mar-82
	Remove calls to %FSAVE.

3122	JLC	28-May-82
	Changed some global refs.

3125	JLC	3-Jun-82
	Moved the AC save routine back to the hiseg.

3126	JLC	7-Jun-82
	Fixed ALCOR., which was using AU.ACS with an indirect. Since
	it can be a negative stack pntr, this didn't work too well.

3131	JLC	11-Jun-82
	Install $SNH non-skip return after call to LSFREE in F.GADX,
	was skipping over valuable instruction.

3134	AHM	22-Jun-82
	Make the FUNCT% dispatch table contain IFIWs.

3135	AHM	24-Jun-82
	Make %MEMINI compute global addresses  for .JBFF and EOL,  and
	prevent BLTUP  from trying  to  shift the  free list  by  zero
	words, since the POP dies in a non-zero section.

3136	JLC	26-Jun-82
	Support for moving spaces (rather than nulls) into allocated
	space. Integration of TSG cut-back-core patches.

3141	JLC	2-Jul-82
	Reinsertion of symbol table into free list had too many bounds
	checks. It now just blindly puts it back into the free list.

3176	JLC	9-Sep-82
	Install disk quota exceeded trap in FOROTS. FUNCT% detects
	whether the routine address is that of FOROTS, and allows user
	to overwrite it.

3200	JLC	24-Sep-82
	Install new routines %MRKBL and %UNMBL to mark the pages used
	by layered products in the page table.

3202	JLC	26-Oct-82
	Install code to mark pages allocated or free, and new FUNCT
	calls to utilize it, for SORT and DBMS.

3203	JLC	31-Oct-82
	Fix SPCWD problem.

3211	AHM	10-Nov-82
	Fix alternate return for bad  args in CHKPGA.  Insert  missing
	AC field in SKIPN in F.GPSI.  Speed up some other code.

3223	JLC	22-Nov-82
	Kill pages on %FREPGS calls on both -10 and -20 so that
	we can leave the "don't overlay pages" bit on for DBMS.

3224	AHM	22-Nov-82
	Reverse  the  sense  of  a  test  in  one  of  the   premature
	optimizations in edit 3211.

3226	JLC	29-Nov-82
	Remove check for DBMS in MINILP.

3231	JLC	14-Dec-82
	Use FENTRY for entry points for DBMS interface.

3233	AHM/JLC	14-Dec-82
	Fix extended addressing bug at %FREPGS.

3236	JLC	17-Dec-82
	Move setup of FUNCT in .JBBLT here.

3244	JLC	31-Dec-82
	Moved setup of FUNCT back to FORINI after all.

3245	JLC	5-Jan-83
	Use ENDP for end page of core.

***** End V7 Development *****

3330	TGS	6-Jul-83	SPR:10-33967
	In order to preserve the user symbol table in case of overlays,
	FORMEM resets .JBFF above .JBSYM(rh).  It does not consider the
	case of a program loaded /SYMSEG:HIGH.

3333	TGS	22-Jul-83	SPR:NONE
	Allow Edit 3330 to handle the /OTS:NONSHARE case where there is
	no hiseg (.JBHRL=0)

3345	MRB	29-Aug-83	SPR:10-34134
	The code at CHKPFH: munges the registers before calling INUSCK.

3441	TGS	7-Sep-84	SPR:20-20332
	%MRKPG/%UMKPG use the wrong instruction in their calls to DOPGS when 
	testing whether any page within the range is already allocated or
	non-allocated. Since the instruction skips on the first non-allocated 
	or allocated page, the full range may never be tested.

3442	TGS	17-Sep-84	SPR:20-20357
	Check if DDT is in core at memory initialization time. If it is,
	leave pages above 763  marked as unavailable, as is done now.  If
	no DDT, mark ENDP:777 (TOPS20 only) as available.  This allows
	TOPMEM calls above original ENDP to be honored if DDT is absent.
	(Edit 4200 in V10)


BEGIN V10

4017	PLB	23-Jun-83
	Make Lowseg memory manager (LSGET/LSFREE) return/take
	global addresses.  Lowseg memory comes from FOROTS' section.

4023	JLC	29-Jun-83
	Use F.TOP and F.BOT as the bottom and top of FOROTS,
	both set to zero for /OTS:NONSHARE, set in the CCL
	file for OTS:SHARE.

4035	JLC	22-Jul-83
	Create local AC save routine for
	FUNCT., since it can be called from within an I/O
	statement which does dynamic concatenation.

4044	JLC	19-Sep-83
	Added new variables to keep track of the number of blocks
	and pages allocated, for debugging purposes.

4050	JLC	6-Oct-83
	Changed deallocation error reporting. Fixed MINILP so
	it avoids the bug-halt at KILPGS.

4065	JLC	6-Dec-83
	Make STARTP and ENDP into variables %STRTP and %ENDP.

4105	JLC	28-Feb-84
	Modify the calling sequence for error calls.

4111	JLC	16-Mar-84
	Modify the calling sequence for error calls again.

4120	PLB	26-Apr-84
	Modify %MEMINI to use PDVs for initial memory map.

4122	JLC	2-May-84
	Destroy pages on restart for TOPS-20.

4131	JLC	12-Jun-84
	Modify %GTBLK, %GTSPC, %MVBLK, and %MVSPC so that they have
	non-skip error returns, so that proper diagnostics can be
	given for memory full.

4152	JLC	24-Sep-84
	Add code in PDV checking to fill in .JBSYM with IOWD-format
	symbol table pointer if the symbol table is in the same section,
	or symbol vector if not in the same section.

4156	JLC	25-Oct-84
	Fix day-one problem in F.COR: if the request crossed into
	section 1, the code truncated it to a halfword; it now
	gives an error (not enough memory available).

4170	JLC	20-Nov-84
	Fix another day-one problem in TRYHRD: stop counting down when
	the bottom page is zero.

4174	JLC	9-Jan-85
	Always mark page 0 as used and allocated, since we do not
	want to give it to the memory manager to allocate, and
	LINK does not mark it used for extended addressing programs.

4175	JLC	15-Jan-85
	Fix F.GAD, F.RAD, and F.ROT to accept address arguments
	with section numbers, as long as it is the same section
	as FOROTS.

4200	TGS	28-Jan-85
	Implement V7 edit 3442: Initialize ENDP/%ENDP to 777. In section
	0, set %ENDP for MINILP to 763 if DDT is in core; if not, leave
	at 777. For non-zero sections, simply set page 777 as unavailable,
	unless old UDDT is in core.
	(Modules FORPRM, FORMEM)

4202	JLC	15-Feb-84
	Move ALCHN. and DECHN. to here, so that a local SAVAC routine
	can be called instead of %SAVAC (which turns on %UDBAD, and
	nobody was turning it off). Fix DOPDVS so that it unmaps
	unallocated pages.

4203	JLC	13-Mar-85
	Use FMACS, the local saved AC0, and not @AU.ACS.

4205	JLC	29-Mar-85
	Fix a bug in the page-marking algorithm, and expand
	the PDV scan to all PDVs.

***** End V10 Development *****

***** End Revision History *****
\
	SUBTTL	OTS MEMORY MANAGER


	INTERN	%MEMINI,%FUNCX,%MRKPG,%UMKPG,%ALCHF,%DECHF
	INTERN	%GTBLK,%FREBLK,%MVBLK,%GTSPC,%MVSPC
	INTERN	%GTPGS,%FREPGS
	INTERN	%LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB,%JBASE
	INTERN	%STRTP,%ENDP

	EXTERN	%POPJ,%POPJ1,%POPJ2,%SAVE1,%SAVE2,%SAVE3,%SAVE4
	EXTERN	I.XSIR,%LEVTAB,%CHNTAB,%FCHTB,%BLCNT,%PGCNT,%CHMSK
	EXTERN	I.RUNTM,%FSECT,%SVCNV
IF10,<	EXTERN	I.DEV,I.FILE,I.PPN	>
	EXTERN	%ABORT,%HALT
	EXTERN	F.BOT,F.TOP
	EXTERN	%ABFLG


	SEGMENT	CODE

	COMMENT	&

FOROTS dynamic memory is allocated in pages starting at STARTP (the highest
usable page), growing downward.  Memory for overlays is allocated at .JBREL,
growing upward.  If the two segments meet, the user is out of memory.

The memory from STARTP up to page %ENDP will be used when the rest of memory is
full.  This memory is also used by SORT, RMS, and DDT, and conflicts can occur.
The conflicts are preferable to the alternative, giving up and exiting.

Memory is strung together in blocks, chained in a doubly linked list.  Both
allocated and free blocks are on the list.  All blocks are consecutive, so the
%FREBLK routine can examine the previous and next blocks to see if they should
be coalesced with the block being freed.

Each block is preceded by a two-word header with forward and backward links, a
flag telling whether the block is allocated or free, and the size of the block
if it is free.  The list is terminated by a zero word.

To facilitate debugging, the unused left half of the second word of an
allocated block header is set to the return address in the routine that
allocated the block.  This helps find routines that fail to free their blocks.

	&



;FORMAT OF BLOCK HEADER

HFLNK==0			;(LH) -1 IF BLOCK ALLOCATED, 0 IF FREE
				;(RH) LINK TO FOLLOWING BLOCK
HSIZE==1			;(LH) SIZE OF BLOCK IF FREE, ELSE
				;     RETURN ADDRESS IN ALLOCATING ROUTINE
HBLNK==1			;(RH) LINK TO PRECEDING BLOCK
HLEN==2				;LENGTH OF BLOCK HEADER



M==10				;FREE BLOCK WHICH IS WITHIN M WORDS
				;OF DESIRED SIZE IS CONSIDERED EXACT FIT
				;(MUST BE AT LEAST HLEN)

;THIS IS PART OF THE 1022 INTERFACE
;ALL REFERENCES TO .JBFF ARE INDIRECT REFERENCES THROUGH JBFPNT, WHICH IS 
;SET TO .JBFF IN %MEMINI. 1022 WILL, BEHIND OUR BACKS, CHANGE THE CONTENTS
;OF JBFPNT. LSEXP, THE "CORE UUO" SIMULATOR, IS HANDLED IN A SIMILAR
;FASHION.

	DEFINE	JOBFF	<@%JBFPT>	
	DEFINE	LSEXP	<@%EXPNT>

;ROUTINE TO GET A BLOCK OF MEMORY
;ARGS:	 T1 = LENGTH OF BLOCK
;RETURN: T1 = ADDRESS OF BLOCK, CLEARED TO ZERO

%GTSPC:	SKIPA	T2,SPCWD(D)	;GET A WORD OF SPACES
%GTBLK:	SETZ	T2,		;RETURN BLOCK WITH ZEROES
	MOVEM	T2,BLTWRD	;SET FILL WORD
CGTBLK:	JUMPE	T1,[$SNH]	;ZERO-LENGTH CALL IS A BUG
	PUSHJ	P,GTBLKX	;TRY IT
	 POPJ	P,		;[4131] MEMORY FULL
	MOVE	T2,(P)		;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	JRST	%POPJ1		;[4131]  SKIP RETURN


GTBLKX:	MOVE	T4,FREPTR	;POINT TO START OF LIST
	SETOM	WRAP		;FLAG NO WRAPAROUND YET

GBSRCH:	SKIPGE	T4,(T4)		;GET LINK TO NEXT BLOCK.  IS IT FREE?
	  JRST	GBSRCH		;NO, KEEP LOOKING
	JUMPE	T4,GBEOL	;ZERO MEANS END OF LIST, GO WRAP AROUND
	HRRZ	T2,HBLNK(T4)	;GET START ADDRESS OF THE FREE BLOCK
	HLRZ	T3,HSIZE(T2)	;GET SIZE OF FREE BLOCK
	CAIGE	T3,(T1)		;IS IT BIG ENOUGH?
	  JRST	GBSRCH		;NO, KEEP LOOKING


GOTBLK:	CAIG	T3,M(T1)	;IS SIZE CLOSE ENOUGH?
	  JRST	GBFIT		;YES, DON'T SPLIT BLOCK
	SUBI	T3,HLEN(T1)	;COMPUTE LENGTH OF REMAINING FREE BLOCK
	HRLM	T3,HSIZE(T2)	;STORE IN HEADER
	ADDI	T3,HLEN(T2)	;GET START ADDRESS OF ALLOCATED BLOCK
	HRROM	T4,HFLNK(T3)	;FIX UP POINTERS
	HRRZM	T2,HBLNK(T3)
	HRRZM	T3,HFLNK(T2)
	HRRM	T3,HBLNK(T4)
	MOVEM	T2,FREPTR	;START NEXT SEARCH AT NEW FREE BLOCK
	MOVEI	T1,HLEN(T3)	;GET ADDRESS OF NEW ALLOCATED BLOCK
	JRST	GBZERO		;GO CLEAR NEW BLOCK, RETURN

GBFIT:	HRROM	T4,HFLNK(T2)	;JUST MARK WHOLE BLOCK ALLOCATED
	MOVEM	T4,FREPTR	;START NEXT SEARCH AT FOLLOWING BLOCK
	MOVEI	T1,HLEN(T2)	;POINT TO BLOCK

GBZERO:	MOVE	T2,BLTWRD	;SET 1ST WORD TO DESIRED QUANTITY
	MOVEM	T2,(T1)
	MOVSI	T2,(T1)		;MAKE BLT POINTER TO CLEAR BLOCK
	HRRI	T2,1(T1)
	CAILE	T4,(T2)		;CHECK FOR 1-WORD BLOCK
	  BLT	T2,-1(T4)	;CLEAR REST OF BLOCK
	XMOVEI	T1,(T1)		;Section number in left half
	AOS	%BLCNT		;INCREMENT # BLOCKS ALLOCATED
	JRST	%POPJ1		;SUCCESS RETURN
GBEOL:	HRRZ	T4,BEGPTR	;RESET FREE POINTER TO START OF LIST
	MOVEM	T4,FREPTR
	AOSG	WRAP		;ALREADY LOOKED THROUGH WHOLE LIST?
	  JRST	GBSRCH		;NO, DO SO

	STKVAR	<SAVET,NP,SAVEP,> ;[2053] ALLOCATE SPACE ON STACK
	MOVEM	T1,SAVET	;SAVE T1
	HRRZ	T2,BEGPTR	;[2053] Get beginning of list
	SKIPN	(T2)		;[2053] EOL?
	JRST	GBANYP		;[2053] Yes - Get any pages, mark initial hole
	SKIPG	(T2)		;[2053] Is first block free?
	JRST	GBSSIZ		;[2053] No - use same size
	HLRZ	T3,HSIZE(T2)	;[2053] Free block size
	SUBI	T1,HLEN(T3)	;[2053] Reduce words needed
GBSSIZ:	DMOVEM	P1,SAVEP	;[2053] Save P ACs
	MOVEI	P1,(T2)		;[2053] Free block address, always top of page
	MOVEI	P2,HLEN+777(T1)	;[2053] Size + header, rounded to page
	LSHC	P1,-^D9		;[2053] Last page number + 1/no. of pages
	SUBI	P1,(P2)		;[2053] First page number
	PUSHJ	P,CREPGS	;[2053] Try to get prefered pages
	  JRST	[DMOVE	P1,SAVEP ;[2053] No luck, restore P ACs
		 MOVE	T1,SAVET ;[2053] Get original size
		 JRST	GBANYP]	 ;[2053] Get any pages, mark hole
	MOVEI	T1,(P1)		;[2053] Got them, get first page number
	LSH	T1,^D9		;[2053] New free block address
	HRRZ	T4,BEGPTR	;[2053] First block contiguous with new one
	SKIPL	(T4)		;[2053] Is first block free?
	HRRZ	T4,HFLNK(T4)	;[2053] Yes - new core ends at successor
	DMOVE	P1,SAVEP	;[2053] Restore P ACs
	JRST	GBCONT		;[2053] Use prefered pages
GBANYP:	MOVEI	T1,2*HLEN+777(T1) ;[2053] ADD 2 HEADERS, ROUND UP TO PAGE BOUND
	LSH	T1,-9		;CONVERT TO PAGES
	MOVEM	T1,NP		;SAVE PAGES TO ALLOCATE
	PUSHJ	P,%GTPGS	;GET SOME PAGES
	  JRST	[UNSTK		;CAN'T, GIVE ERROR RETURN
		 POPJ P,]

	MOVE	T2,NP		;GET LENGTH IN PAGES
	LSHC	T1,9		;CONVERT ADDRESS, LENGTH TO WORDS
	ADDI	T2,(T1)		;GET END+1 ADDRESS OF NEW CORE
	HRRZ	T3,BEGPTR	;GET POINTER TO START OF OLD CORE
				;[2053]

GBHOLE:	MOVEI	T4,-HLEN(T2)	;MAKE HOLE LOOK LIKE PERMANENTLY ALLOCATED BLOCK
	HRLI	T3,400000	;[2052] Unique hole marker for CBC function
	MOVEM	T3,HFLNK(T4)	;[2052] Set forward link of hole
	HRRM	T4,HBLNK(T3)	;SET BACKWARD LINK

GBCONT:	HRROM	T1,BEGPTR	;NEW START OF LIST IS START OF NEW CORE
	MOVEM	T1,FREPTR	;ALSO START NEXT SEARCH THERE
	HRRZM	T4,HFLNK(T1)	;POINT FREE BLOCK TO ITS SUCCESSOR
	HRRM	T1,HBLNK(T4)	;[2053] POINT SUCCESSOR BACK TO NEW FREE BLOCK
	MOVEI	T3,BEGPTR	;POINT FREE BLOCK BACK TO LIST HEAD
	HRRZM	T3,HBLNK(T1)

	MOVEI	T3,(T4)		;COMPUTE LENGTH OF FREE BLOCK
	SUBI	T3,HLEN(T1)

	MOVEI	T2,(T1)		;PUT POINTER TO FREE BLOCK IN RIGHT AC
	MOVE	T1,SAVET	;RESTORE T1
	UNSTK			;RESTORE P
	JRST	GOTBLK		;DONE, RETURN TO MAIN CODE
;ROUTINE TO FREE A BLOCK OF MEMORY
;ARGS:	T1 = ADDRESS OF BLOCK TO BE FREED (AS RETURNED BY %GTBLK)

%FREBL:	SKIPE	%ABFLG		;ABORTING?
	 POPJ	P,		;YES. DO NOT DEALLOCATE CORE

	CAIN	T1,0		;BAD CALL IF ARG=0
	 $ECALL	IEM,%ABORT		;REPORT ERROR
	SOSGE	%BLCNT		;DECREMENT COUNT OF BLOCKS ALLOCATED
	 $ECALL	IEM,%ABORT	;DEALLOCATED MORE THAN WE ALLOCATED!
	HRRZ	T2,HBLNK-HLEN(T1) ;POINT TO PREDECESSOR BLOCK
	HRRZ	T3,HFLNK-HLEN(T1) ;POINT TO SUCCESSOR BLOCK

	HRRZ	T4,HFLNK(T2)	;GET FWD LINK OF PREDECESSOR
	CAIE	T4,-HLEN(T1)	;DOES IT POINT TO CURRENT BLOCK?
	 $ECALL	IEM,%ABORT	;No, error
	HRRZ	T4,HBLNK(T3)	;GET BACK LINK OF SUCCESSOR
	CAIE	T4,-HLEN(T1)	;CHECK IT
	 $ECALL	IEM,%ABORT	;WRONG, ERROR

	SKIPGE	HFLNK(T2)	;IF PREDECESSOR IS FREE, POINT TO IT
	  HRRZ	T2,HFLNK(T2)	; ELSE POINT TO BLOCK BEING FREED
	SKIPLE	HFLNK(T3)	;IF SUCCESSOR IS FREE, POINT TO ITS SUCCESSOR
	  HRRZ	T3,HFLNK(T3)
	HRRZM	T3,HFLNK(T2)	;FIX POINTERS
	HRRM	T2,HBLNK(T3)	;(LH = return address of GTBLK caller..)

	CAMGE	T2,FREPTR	;DOES FREPTR POINT TO INTERIOR OF NEW BLOCK?
	CAMG	T3,FREPTR
	  JRST	.+2		;NO, OK
	MOVEM	T2,FREPTR	;MAKE SURE FREPTR POINTS TO START OF SOME BLOCK

	SUBI	T3,HLEN(T2)	;COMPUTE LENGTH OF NEW FREE BLOCK
	HRLM	T3,HSIZE(T2)	;STORE IN BLOCK HEADER
	JUMPG	T3,%POPJ	;AND RETURN
	$SNH			;NEGATIVE FREE BLOCK SIZE!

;ROUTINE TO MOVE A CORE BLOCK INTO A BIGGER BLOCK
;ARGS:	 T1 = OLD ADDRESS
;	 T2 = OLD LENGTH
;	 T3 = NEW LENGTH
;RETURN: T1 = NEW ADDRESS
;	 T2 = END+1 ADDR OF OLD DATA IN NEW BLOCK (I.E. NEW ADDR + OLD LENGTH)
;	 T3 = NEW LENGTH (FOR CONVENIENCE IN EXPRB)

%MVSPC:	MOVE	T4,SPCWD(D)	;GET A WORD OF SPACES
	MOVEM	T4,BLTWRD	;RETURN NEW BLOCK WITH SPACES
	JRST	CMVBLK		;JOIN COMMON CODE

%MVBLK:	SETZM	BLTWRD		;RETURN NEW BLOCK WITH ZEROES
CMVBLK:	EXCH	T1,T3		;GET NEW LENGTH IN T1, OLD ADDR IN T3
	MOVEM	T1,NLEN		;SAVE NEW LENGTH FOR LATER
	MOVEM	T2,OLEN		;SAVE OLD LENGTH
	MOVEM	T3,OADR		;SAVE OLD ADDRESS
	PUSHJ	P,CGTBLK	;GET NEW BLOCK
	 POPJ	P,		;[4131] CAN'T. NON-SKIP RETURN

	MOVE	T2,OLEN		;GET OLD LENGTH BACK
	HRLZ	T3,OADR		;GET OLD ADDRESS IN LH
	HRRI	T3,(T1)		;NEW ADDRESS IN RH
	ADDI	T2,(T1)		;NEW ADDRESS + OLD LENGTH
	BLT	T3,-1(T2)	;MOVE OLD DATA TO NEW BLOCK

	EXCH	T1,OADR		;SAVE NEW ADDRESS, GET OLD ADDRESS
	MOVEM	T2,OLEN		;SAVE NEW END+1 ADDRESS ON STACK

	PUSHJ	P,%FREBLK	;FREE OLD BLOCK

	MOVE	T1,OADR		;GET NEW ADDR FOR RETURN
	MOVE	T2,OLEN		;GET ADDR OF 1ST FREE WORD IN EXPANDED AREA
	MOVE	T3,NLEN		;GET NEW LENGTH
	JRST	%POPJ1		;[4131] SKIP RETURN FOR SUCCESS

	SEGMENT	DATA

%STRTP:	BLOCK	1		;START PAGE FOR TOP OF MEMORY
%ENDP:	BLOCK	1		;LAST-DITCH TOP OF MEMORY
OADR:	BLOCK	1		;OLD ADDRESS OF DATA
OLEN:	BLOCK	1		;OLD LENGTH
NLEN:	BLOCK	1		;NEW LENGTH
BLTWRD:	BLOCK	1		;BLOCK INITIALIZATION VALUE

	SEGMENT	CODE

;ROUTINE TO FIND AND ALLOCATE CONSECUTIVE PAGES OF MEMORY
;ARGS:	 T1 = NUMBER OF PAGES TO GET
;RETURN: T1 = PAGE NUMBER OF FIRST PAGE
;NONSKIP RETURN IF CAN'T, SKIP IF OK

%GTPGS:	PUSHJ	P,%SAVE3	;SAVE P ACS

	MOVE	P1,%STRTP	;START LOOKING AT THE TOP OF FOROTS DATA AREA
	SUBI	P1,-1(T1)	;MINUS # PAGES DESIRED
	MOVEI	P2,(T1)		;SET NUMBER OF PAGES TO GET

GETPLP:	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH PAGE BIT MAP
	  TDNN	T1,PTAB(T2)	;SEE IF PAGES ARE ALL NOT ALLOCATED
	   JRST	TRYRET		;ALL FREE, FINE
	SOJGE	P1,GETPLP	;SOME PAGE ALLOCATED, TRY AGAIN

;HERE WHEN REQUEST CAN'T BE SATISFIED USING PAGES 0 THROUGH STARTP.
;LOOK FROM STARTP+1 TO ENDP FOR ENOUGH CONSECUTIVE PAGES.

TRYHRD:	MOVE	P1,%ENDP	;START AT THE END OF CORE
	SUBI	P1,-1(P2)	;FIND BASE PAGE # WE WANT

TRYLP2:	MOVEI	T1,(P1)		;COPY TEST PAGE BOTTOM
	ADDI	T1,-1(P2)	;GET TOP PAGE DESIRED
	CAMG	T1,%STRTP	;REACH WHERE WE FAILED BEFORE?
	  POPJ	P,		;YES, GIVE UP
	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH PAGE BIT MAP
	  TDNN	T1,PTAB(T2)	;SEE IF PAGES ARE ALL NOT ALLOCATED
	   JRST	TRYRET		;ALL FREE, FINE
	SOJGE	P1,TRYLP2	;[4170] SOME PAGE ALLOCATED, TRY AGAIN
	 POPJ	P,		;[4170] DON'T GO BELOW PAGE 0, HOWEVER

TRYRET:	PUSHJ	P,CREPGX	;CREATE THE PAGES
	  POPJ	P,		;CAN'T, TOO BAD

	MOVEI	T1,(P1)		;RETURN STARTING PAGE TO CALLER
	OR	T1,PAGSEC	;In current section
	JRST	%POPJ1		;SUCCESS


;MARK A BLOCK OF CORE ALLOCATED IN THE PAGE TABLE. THIS ROUTINE
;IS CALLED WHENEVER A SHARABLE SEGMENT OF A LAYERED PRODUCT
;IS LOADED VIA GET% (GETSEG) BY FOROTS. THIS SHOULD PROBABLY
;BE MADE A FUNCT. CALL EVENTUALLY.
;[3441] ARGS:	T1 = STARTING PAGE
;[3441]	T2 = NUMBER OF PAGES

%MRKPG:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	DMOVE	P1,T1		;GET INTO THE CORRECT ACS
				;[3441]
	MOVEI	T1,3		;CHECK IF USED ALREADY
	PUSHJ	P,DOPGS		;MOVE THROUGH THE BIT MAP
	 TDNN	T1,PTAB(T2)	;[3441] WITH THIS INSTRUCTION
	  TRNA			;[3441] NONE ALLOCATED IN RANGE, OK
	 POPJ	P,		;[3441] AT LEAST ONE ALLOCATED, ERROR
	MOVEI	T1,3		;SET PAGE-ALLOCATED AND PAGE-EXIST
	PUSHJ	P,DOPGS		;MOVE THROUGH THE BIT MAP
	 IORM	T1,PTAB(T2)	;WITH THIS INSTRUCTION
	JRST	%POPJ1		;SKIP RETURN

;UNMARK A BLOCK OF CORE IN THE PAGE TABLE. WHEN A LAYERED PRODUCT
;DECIDES TO LEAVE (SUCH AS SORT), THE USER SHOULD BE ABLE TO GET
;THE PAGES USED BY IT.

%UMKPG:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	DMOVE	P1,T1		;GET INTO THE CORRECT ACS
	MOVEI	T1,1		;CHECK IF THEY ARE INDEED ALLOCATED
	PUSHJ	P,DOPGS		;MOVE THROUGH BITMAP
	 TDNE	T1,PTAB(T2)	;[3441] WITH THIS INSTRUCTION
	  TRNA			;[3441] ALL ALLOCATED, OK
	 POPJ	P,		;[3441] SKIP MEANS AT LEAST ONE WASN'T
	MOVEI	T1,3		;NOW FREE THEM
	PUSHJ	P,DOPGS		;MOVE THROUGH BITMAP
	 ANDCAM	T1,PTAB(T2)	;WITH THIS INSTRUCTION
	JRST	%POPJ1		;SKIP RETURN


;ROUTINE TO FREE PAGES
;ARGS:	 T1 = FIRST PAGE
;	 T2 = NUMBER OF PAGES
;[2052] On Return, pages are marked free in bit map for TOPS-20,
;[2052] or have been removed and marked free/non existent for TOPS-10

%FREPGS:
	PUSHJ	P,%SAVE2	;SAVE P1-P2
	DMOVE	P1,T1		;PUT ARGS IN RIGHT ACS
	ANDI	P1,777		;[3233] MAKE PAGE LOCAL
	PJRST	KILPGS		;[2052] Remove the pages and update bit map

;ROUTINE TO CREATE PAGES
;ARGS:	 P1 = FIRST PAGE TO ALLOCATE
;	 P2 = NUMBER OF PAGES TO ALLOCATE
;ERROR RETURN IF PAGES ARE ALLREADY ALLOCATED
;OR (10 ONLY) IF PAGES CAN'T BE CREATED (CORE LIMIT EXCEEDED OR SOMETHING)

CREPGS:	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE THROUGH BIT MAP
	  TDNN	T1,PTAB(T2)	;ARE PAGES ALREADY ALLOCATED?
	   JRST	CREPGX		;ALL FREE, FINE
	POPJ	P,		;SOME PAGE ALLOCATED, ERROR

CREPGX:				;ENTRY POINT FOR PAGES ALREADY CHECKED
	ADDM	P2,%PGCNT	;INCREMENT ALLOCATED PAGE COUNT

IF20,<
	DMOVE	T1,P1		;TOUCH THE PAGE
	LSH	T1,9
	XMOVEI	T1,(T1)		;In current section
CR20LP:	SKIP	(T1)		;TO CREATE IT
	ADDI	T1,1000
	SOJG	T2,CR20LP

>;END IF20

IF10,<
	PUSHJ	P,%SAVE4	;SAVE P1-P4
	MOVEI	P3,(P1)		;INITIALIZE P3, NUMBER OF PAGE BEING CREATED
	MOVE	P4,[-PLEN,,1]	;GET AOBJN POINTER TO PAGE. BLOCK
	MOVEI	T1,2		;GET PAGE-EXISTS BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH BIT MAP
	  PUSHJ	P,CREPG		;GO CREATE PAGE IF IT DOESN'T EXIST
	   JRST	.+2		;CREATED OK, SKIP
	PJRST	KILPGS		;[2052] Can't get them all, kill any created

	TRNE	P4,-2		;IF ARG BLOCK IS NONEMPTY,
	PUSHJ	P,PGUUO		;DO FINAL UUO
	  JRST	.+2		;WORKED, FINE
	PJRST	KILPGS		;[2052] Can't get them all, kill any created
>

	MOVEI	T1,3		;GET PAGE-ALLOCATED AND PAGE-EXISTS BITS
	PUSHJ	P,DOPGS		;MOVE THROUGH BIT MAP
	  IORM	T1,PTAB(T2)	;MARK PAGE EXISTING AND ALLOCATED

	JRST	%POPJ1		;SUCCESS RETURN
IF10,<

;ROUTINE TO CREATE A PAGE IF NECESSARY
;CALLED FROM INSIDE DOPGS, SO MUST BE CAREFUL
;ARGS:	 T1, T2 = BIT AND OFFSET FROM DOPGS
;		  (TO CHECK IF PAGE IS MARKED NONEXISTENT IN BIT MAP)
;	 P3 = PAGE NUMBER TO CREATE
;	 P4 = AOBJN POINTER TO PAGE. ARG BLOCK
;RETURN: P1-P2, T1-T4 UNCHANGED
;	 P3, P4 UPDATED FOR NEXT ITERATION OF DOPGS
;NONSKIP RETURN IF PAGE CREATED OK
;SKIP RETURN (TO TERMINATE DOPGS) IF PAGE COULDN'T BE CREATED

CREPG:	TDNE	T1,PTAB(T2)	;DOES PAGE EXIST ALREADY?
	  AOJA	P3,%POPJ	;YES, FINE

	HLL	P3,VRTBIT	;SET PA.GCD IF WANT A VIRTUAL PAGE
	MOVEM	P3,PBLK(P4)	;PUT PAGE NUMBER IN ARG BLOCK
	ADDI	P3,1		;INCREMENT FOR NEXT TIME
	AOBJN	P4,%POPJ	;RETURN IF BLOCK NOT FULL YET

PGUUO:	SUBI	P4,1		;UNDO EXTRA INCREMENT FROM AOBJN
	HRRZM	P4,PBLK		;STORE COUNT WORD
PGUUO1:	MOVE	P4,[.PAGCD,,PBLK] ;POINT TO ARG BLOCK
	PAGE.	P4,		;TRY TO CREATE PAGES
	  JRST	VIRT		;DIDN'T WORK, GO TRY TO GO VIRTUAL
	MOVE	P4,[-PLEN,,1]	;RESET AOBJN POINTER
	POPJ	P,		;DONE

VIRTER:	MOVE	T1,PBLK+1	;T1:= page number (for ERR call)
;	  ERR	(CCP,999,106,?,Can't create page $O (PAGE. error $O),<T1,P4>)
	$ECALL	CCP,%ABORT	;"?Can't create page n"

VIRT:	CAIN	P4,PAGNX%	;NO VIRTUAL PRIVS?
	  JRST	%POPJ1		;YES, GIVE UP ON CREATING PAGE
	CAIE	P4,PAGLE%	;Skip if "Core limit exceeded"
	 JRST	VIRTER		;NO, all other errors are fatal
	SKIPE	VRTBIT		;ALREADY WENT VIRTUAL?
	  JRST	%POPJ1		;YES, GIVE UP.  PAGE CAN'T BE CREATED

	MOVSI	T0,(PA.GCD)	;GET VIRTUAL BIT
	MOVEM	T0,VRTBIT	;SET FOR FUTURE CALLS
	MOVE	P4,[-PLEN,,1]	;MAKE AOBJN POINTER TO PAGE. ARG BLOCK
	HLLM	T0,PBLK(P4)	;PUT BIT INTO ARG BLOCK
	  AOBJN	P4,.-1

	SKIPE	.JBPFH		;PFH ALREADY READ IN, OR USER PFH?
	  JRST	PGUUO1		;YES, WONDERFUL, GO TRY AGAIN
;NOW THE TRICK IS TO MAKE ROOM FOR THE PAGE FAULT HANDLER.  PHYSICAL
;MEMORY IS FULL, BUT THE PFH MUST RESIDE IN PHYSICAL MEMORY.  THEREFORE
;PAGE OUT 1 OR 2 PAGES TO MAKE ROOM FOR IT.  THEN TOUCH ONE OF THE
;PAGED-OUT PAGES TO FORCE THE MONITOR TO READ IN THE PFH NOW.  THE ONLY
;PURPOSE FOR THAT IS TO CATCH MONITOR AND FOROTS BUGS HERE, NOT IN SOME
;RANDOM MEMORY REFERENCE SOMEWHERE ELSE.

	STKVAR	<SAVEP,,PCNT>	;ALLOCATE SOME TEMP VARIABLES
	DMOVEM	P1,SAVEP	;SAVE P1-P2
	SETOM	PCNT		;PCNT WILL GO POSITIVE AFTER 2 PAGES
	MOVEI	P2,1		;FIRST PAGE NUMBER IS 1

VIRTLP:	TRNE	P2,777000	;PAGE NUMBER OVER 1000?
	  JRST	VRTRET		;YES, RAN OUT OF PAGES.  NICE TRY

	MOVSI	P1,.PAGCA	;SET TO CHECK PAGE ACCESS BITS
	HRRI	P1,(P2)		;PUT IN PAGE NUMBER
	PAGE.	P1,		;GET BITS FOR THE PAGE
	 $SNH			;Shouldn't fail
	TXNE	P1,PA.GNE+PA.GPO+PA.GCP ;CHECK EXISTING PAGE, IN CORE, CAN BE PAGED OUT
	  AOJA	P2,VIRTLP	;NO DICE, TRY NEXT PAGE

	MOVE	P4,[.PAGIO,,P1] ;POINT TO ARG BLOCK
	MOVEI	P1,1		;SET COUNT WORD TO 1
	TXO	P2,PA.GAF	;SET TO PAGE THE PAGE OUT
	PAGE.	P4,		;DO IT
	  JRST	VRTRET		;DIDN'T MAKE IT, GIVE UP
	AOSG	PCNT		;INCREMENT COUNT OF PAGES WE'VE DONE
	  AOJA	P2,VIRTLP	;NOT ENOUGH YET, LOOP

	LSH	P2,9		;CONVERT PAGE NUMBER TO ADDRESS
	SKIP	(P2)		;READ IN PFH

VRTRET:	DMOVE	P1,SAVEP	;RESTORE P1-P2
	UNSTK			;RESTORE P
	JRST	PGUUO1		;GO TRY UUO AGAIN

>;END IF10
;ROUTINE TO DESTROY PAGES
;ARGS:	 P1 = FIRST PAGE TO DESTROY
;	 P2 = NUMBER OF PAGES TO DESTROY
;ON RETURN, PAGES ARE GONE

KILPGS:	MOVN	T1,P2		;GET NEGATIVE # PAGES TO DESTROY
	ADDB	T1,%PGCNT	;DECREMENT ALLOCATED PAGE COUNT
	JUMPGE	T1,KILPGX	;OK
	$ECALL	PGD,%ABORT	;TRYING TO DEALLOCATE MORE THAN ALLOCATED
KILPGX:
IF20,<
	SETO	T1,		;UNMAP THE PAGES
	MOVSI	T2,.FHSLF	;FROM THIS FORK
	HRRI	T2,(P1)		;STARTING AT GIVEN PAGE NUMBER
	MOVSI	T3,(PM%CNT)	;WE ARE GIVING A COUNT
	HRRI	T3,(P2)		;WHICH IS IN P2
	PMAP%			;DESTROY THE PAGES
>

IF10,<
	STKVAR	<SAVEP,>	;SAVE P1-P2
	DMOVEM	P1,SAVEP
KILLP:	MOVE	T3,[-PLEN,,1]	;[2052] GET AOBJN POINTER TO PAGE. BLOCK
KILLP0:	MOVE	T1,T3		;[2052] Get working AOBJN pointer
	HRLI	P1,(PA.GAF)	;SET TO DESTROY THE PAGES
KILLP1:	MOVEM	P1,PBLK(T1)	;PUT PAGE NUMBER IN BLOCK
	ADDI	P1,1		;INCREMENT PAGE NUMBER
	SOJLE	P2,EKILLP	;IF COUNT HIT 0, DONE
	AOBJN	T1,KILLP1	;KEEP GOING UNTIL BLOCK FILLS UP
	SUBI	T1,1		;UNDO EXTRA INCREMENT FROM AOBJN

EKILLP:	HRRZM	T1,PBLK		;SET COUNT IN ARG BLOCK
	MOVE	T1,[.PAGCD,,PBLK] ;SET TO DESTROY PAGES
	MOVE	T2,PBLK+1	;Get page number incase error
	PAGE.	T1,		;DO IT
	  JRST	[CAIE	T1,PAGME%	;[2052] Page does not exist?
;[2052]	  ERR	(CDP,999,106,?,<Can't destroy page $O (PAGE. error $O)>,<T2,T1>)
		 $ECALL	CDP,%ABORT	;[2052] No - some fatal error
		 HRRZ	T1,PBLK		;[2052] Get number of pages
		 CAIN	T1,1		;[2052] Doing 1 page at a time?
		 JRST	.+1		;[2052] Yes - just continue loop
					;[2052] Don't know which page had error
		 SUBI	P1,(T1)		;[2052] Back to first page
		 ADDI	P2,(T1)		;[2052] Reset count
		 MOVE	T3,[-1,,1]	;[2052] Use single step AOBJN ptr.
		 JRST	KILLP0]		;[2052] From this page on
	JUMPG	P2,KILLP0	;[2052] IF MORE LEFT TO DO, DO THEM

	DMOVE	P1,SAVEP	;RESTORE P1-P2
	UNSTK
>

	MOVEI	T1,3		;GET BOTH BITS
	PUSHJ	P,DOPGS		;MOVE T1 THROUGH BITS IN PTAB
	  ANDCAM T1,PTAB(T2)	;MARK PAGES FREE AND NONEXISTENT
	POPJ	P,		;DONE
;ROUTINE TO HANDLE PAGE BIT MAP
;CALL:
;	MOVEI	P1,FIRSTPAGE	;FIRST PAGE TO DO
;	MOVEI	P2,NPAGES	;NUMBER OF PAGES TO DO
;	MOVEI	T1,N		;BIT PATTERN
;	PUSHJ	P,DOPGS		;MOVE IT THROUGH BIT MAP
;	  INST	T1,PTAB(T2)	;ANY INSTRUCTION
;	    <INST DIDN'T SKIP, EVER>
;	<INST SKIPPED, AT LEAST ONCE>
;
;THE INSTRUCTION AFTER THE CALL IS EXECUTED REPEATEDLY WITH T1
;CONTAINING THE ORIGINAL BIT PATTERN, SHIFTED OVER APPROPRIATELY, AND
;T2 CONTAINING THE APPROPRIATE INDEX INTO PTAB.  IF THE INSTRUCTION
;SKIPS, CONTROL RETURNS FROM DOPGS IMMEDIATELY; IF IT NEVER SKIPS,
;THE INSTRUCTION IS EXECUTED FOR ALL PAGES FROM P1 TO P1+P2-1.

DOPGS:	STKVAR	<FIRSTP,NP,BITPAT> ;ALLOCATE SPACE ON STACK
	DMOVEM	P1,FIRSTP	;SAVE FIRST PAGE, NUMBER OF PAGES
	MOVEM	T1,BITPAT	;SAVE BIT PATTERN
	IDIVI	P1,^D18		;GET BYTE POS WITHIN WORD
	LSH	P2,1		;BYTES ARE 2 BITS LONG
	LSH	T1,(P2)		;MOVE BIT PATTERN TO RIGHT POSITION
	MOVEI	T2,(P1)		;GET OFFSET WITHIN TABLE
	MOVE	P2,NP		;GET COUNT BACK
	JRST	DOPLP1		;START AT BEGINNING

DOPLP:	LSH	T1,2		;MOVE BIT PATTERN OVER
	JUMPN	T1,DOPLP1	;LOOP IF STILL IN WORD
	MOVE	T1,BITPAT	;RESET T1 TO BEGINNING OF NEXT WORD
	ADDI	T2,1		;BUMP INDEX TO NEXT WORD
DOPLP1:	SOJL	P2,DOPRET	;QUIT WHEN DONE
	XCT	@-.L(P)		;DO THE INSTRUCTION
	  JRST	DOPLP		;NONSKIP

	AOS	-.L(P)		;PASS ON SKIP RETURN
DOPRET:	DMOVE	P1,FIRSTP	;RESTORE P1-P2
	UNSTK			;RESTORE P
	JRST	%POPJ1		;RETURN, SKIPPING OVER INST
;[2052]Routine to trim block structured (OTS) core area
;[2052]No arguments
;[2052]
;[2052] Trim back the block structured core area by removing all free pages
;[2052] at the beginning of the list. Stop triming when an allocated block
;[2052] or EOL is found, or after having split a block such that there are
;[2052] no more free pages at the beginning of the list.

PGTRIM:	STKVAR	<NXTBLK>	;[2052] Place to save pointer to next block
	HRRZ	T1,BEGPTR	;[2052] Start with first block
PGTNXT:	SKIPG	T2,(T1)		;[2052] Is it free, and not EOL?
	JRST	PGTDON		;[2052] No - finished
	HLRZ	T3,HSIZE(T1)	;[2052] Get block size for later
	HLRZ	T4,(T2)		;[2052] Get allocated marker for next block
	CAIE	T4,400000	;[2052] Is it a hole?
	JRST	PGTNHL		;[2052] No - just look at this block
	ADDI	T3,HLEN		;[2052] Yes - absorb its length
	HRLM	T3,HSIZE(T1)	;[2052] Into current block
	HRRZ	T2,HFLNK(T2)	;[2052] Get its successor
	HRRM	T2,HFLNK(T1)	;[2052] Link hole out of the
	HRRM	T1,HBLNK(T2)	;[2052] Block structure entirely
	JRST	PGTPGS		;[2052] Go release some pages
PGTNHL:	MOVEI	T4,HLEN(T3)	;[2052] Actual block size
	CAIGE	T4,^D512	;[2052] Have at least a page?
	JRST	PGTDON		;[2052] No - nothing more to do
	TRZ	T4,777000	;[2052] Excess words in next page
	JUMPE	T4,PGTNSU	;[2052] None - release some pages from 1 block
	CAIG	T4,HLEN		;[2052] Enough room for a block of 1 word?
	ADDI	T4,^D512	;[2052] No - one less page to free
	SUBI	T3,(T4)		;[2052] Reduce current block size
	JUMPLE	T3,PGTDON	;[2052] If no words left forget it
	HRLM	T3,HSIZE(T1)	;[2052] Save new block size
	ADDI	T3,HLEN(T1)	;[2052] Excess block address
	HRRZM	T2,HFLNK(T3)	;[2052] Setup forward link
	HRRM	T1,HBLNK(T3)	;[2052] Back link
	SUBI	T4,HLEN		;[2052] Actual size
	HRLM	T4,HSIZE(T3)	;[2052] Save away
	HRRM	T3,HFLNK(T1)	;[2052] Update predecessor pointer
	HRRM	T3,HBLNK(T2)	;[2052] And successor back pointer
PGTNSU:	SETZ	T2,		;[2052] No successor block to consider
PGTPGS:	HRRZM	T2,NXTBLK	;[2052] Save next block address
	HRRZ	T3,HBLNK(T1)	;[2052] Get block predecessor
	HRRZ	T4,HFLNK(T1)	;[2052] And successor
	HRRM	T4,HFLNK(T3)	;[2052] Link pages out of
	HRRM	T3,HBLNK(T4)	;[2052] Block structure
	CAMN	T1,FREPTR	;[2052] Giving up first free block?
	MOVEM	T4,FREPTR	;[2052] Yes - advance to next block
	HLRZ	T2,HSIZE(T1)	;[2052] Get size of block to free
	ADDI	T2,HLEN		;[2052] Actual size
	LSHC	T1,-^D9		;[2052] Page number/no. of pages
	PUSHJ	P,%FREPGS	;[2052] Free pages
	SKIPE	T1,NXTBLK	;[2052] Get next block to do if any
	JRST	PGTNXT		;[2052] Check further
PGTDON:	UNSTK			;[2052] Free local storage
	POPJ	P,		;[2052] Done
;ROUTINE TO INITIALIZE MEMORY

;CALLED FROM INIT. ON PROGRAM START OR RESTART

;PUTS MEMORY INTO A KNOWN, CONSISTENT STATE BY DELETING ALL
;PAGES IT DOESN'T LIKE.  IT LIKES PAGES BELOW .JBFF, PAGES
;BETWEEN RH(.JBHRL)-LH(.JBHRL)+1 AND RH(.JBHRL), PAGES IN FOROTS,
;AND PAGES ABOVE STARTP.  ALL OTHERS GO.
;[4120] DELETION OCCURS ONLY UNDER TOP-10

;ALSO SETS UP FREE LIST POINTERS BEGPTR, FREPTR, AND FLBEG,
;AND THE PAGE BIT MAP PTAB.

%MEMINI:
	PUSHJ	P,%SAVE4	;SAVE P1-P4

	XMOVEI	T2,.		;Get section number
	HLRZ	T2,T2
	LSH	T2,^D9		;Get page # to "OR"
	MOVEM	T2,PAGSEC	;Page # of start of this section

	XMOVEI	T1,.JBFF	;[3135] SETUP .JBFF PNTR
	MOVEM	T1,%JBFPT
	XMOVEI	T1,EXPADR	;SETUP ADDR OF MEMORY EXPANDER/CONTRACTOR
	MOVEM	T1,%EXPNT
	SETZM	EOL		;MAKE A ZERO TO END FREE LIST
	XMOVEI	T1,EOL		;[3135] POINT TO THE ZERO
	MOVEM	T1,FREPTR	;START SEARCHING THERE
	HRROM	T1,BEGPTR	;IT'S ALSO START OF FREE LIST

	SETZM	FLBEG		;NO LOW SEG FREE LIST YET

	SETZM	VRTBIT		;START BY TRYING FOR PHYSICAL PAGES

	SKIPN	.JBCOR		;[4120] DO WE HAVE A LINK CREATED LOCAL JOBDAT?
	 PJRST	DOPDVS		;[4120] NO, MUST SCAN FOR PDVS

	MOVE	T1,[252525,,252525] ;INIT TO '010101....010101'
	MOVEM	T1,PTAB		;PAGE BIT TABLE = ALL UAVAILABLE & NONEXISTENT
	MOVE	T1,[PTAB,,PTAB+1]
	BLT	T1,PTAB+^D28

	SETZM	SYMFP		;CLEAR "BETWEEN .JBFF AND .JBSYM" PNTR
	SKIPN	.JBSYM		;SYMBOL TABLE?
	 JRST	SETJFF		;NO
	HRRZ	T1,.JBSYM	;YES. GET ITS ADDR
	CAMG	T1,JOBFF	;HOLE BETWEEN JBFF AND JBSYM?
	 JRST	MRKSYM		;NO. JUST START MINILP ABOVE TABLE
	HRRZ	T2,.JBHRL	;[3330] GET HIGHSEG BREAK
	JUMPE	T2,MRKHOL	;[3333] NO HISEG?
	HLRZ	T1,.JBHRL	;[3330] GET SEG SIZE
	SUBI	T2,-1(T1)	;[3330] T2/ BEGINNING OF HISEG
	ANDI	T2,777000	;[3330] ROUNDED DOWN TO PAGE BOUNDARY
	HRRZ	T1,.JBSYM	;GET THE TABLE ADDR AGAIN
	CAML	T1,T2		;[3330] IS IT IN THE HISEG?
	 JRST	SETJFF		;[3330] YES, DON'T POINT .JBFF INTO HISEG
MRKHOL:	HRL	T1,JOBFF	;[3333] GET FIRST FREE LOC IN HOLE
	MOVEM	T1,SYMFP	;SAVE FUTURE FREE LIST ENTRY
MRKSYM:	HRRZ	T1,.JBSYM	;GET SYMBOL TABLE PNTR AGAIN
	HLRE	T2,.JBSYM	;CALC TOP OF TABLE+1
	SUB	T1,T2		;P1 NOW POINTS TO TOP OF SYMTAB+1
	CAMLE	T1,JOBFF	;IF GREATER THAN CURRENT .JBFF
	 MOVEM	T1,JOBFF	;SAVE AS NEW .JBFF
	HRL	T1,.JBSYM	;CREATE A SYMBOL TABLE FREE LIST ENTRY
	MOVEM	T1,SYMTP	;TO USE IF A CORE REQUEST FAILS
SETJFF:	MOVE	P1,JOBFF	;GET END+1 OF LOW SEGMENT
	MOVEM	P1,%JBASE	;SAVE FOR MEMORY MANAGER DEBUGGER
	ADDI	P1,777		;ROUND UP TO A PAGE BOUNDARY
	LSH	P1,-9		;GET FIRST PAGE AFTER LOW SEGMENT
	MOVEM	P1,LPAGE	;SAVE IT FOR LOW SEG CORE ALLOCATION
;PTAB NOW HAS ALL PAGES MARKED AS UNAVAILABLE.  GO THROUGH IT, PAGE
;BY PAGE, AND MARK EACH PAGE AVAILABLE IF IT PASSES ALL THE TESTS.
;THE LOOP GOES FROM .JBFF TO PAGE %ENDP, CHECKING EACH PAGE TO SEE IF
;IT'S IN THE DATA AREA OR IN FOROTS OR IN VMDDT OR IN THE PFH OR IN
;THE SYMBOL TABLE.

	PUSHJ	P,DDTCHK	;[4200] CHECK IF DDT IS IN CORE AND SET %ENDP
MINILP:	CAMG	P1,%ENDP	;[4200] HAVE WE HIT TOP OF OUR CORE?
	 JRST	NOTTOP		;NO

	SKIPN	SYMFP		;ANY SPACE BETWEEN .JBFF AND .JBSYM?
	 POPJ	P,		;NO
	PUSHJ	P,LSINIT	;YES. MUST MARK A FREE BLOCK
	AOS	FLLEN		;MAKE AN ENTRY
	MOVE	T1,SYMFP	;GET THE FREE LIST ENTRY
	MOVEM	T1,(P3)		;STORE IT
	POPJ	P,

NOTTOP:	HRRZ	T1,.JBHRL	;GET HS BREAK
	MOVEI	T2,(T1)		;COPY IT
	HLRZ	T3,.JBHRL	;GET HS LENGTH
	SUBI	T1,-1(T3)	;SUBTRACT, GIVING HS ORIGIN
	JUMPL	T1,CHKDAT	;NO HS. CHECK DATA AREA
	PUSHJ	P,INUSCK	;CHECK FOR IN USE
	 AOJA	P1,MINILP	;IN USE. DON'T BOTHER

CHKDAT:
	CAIGE	P1,F.TOP/1000
	CAIGE	P1,F.BOT/1000	;IS PAGE IN FOROTS?
	  JRST	CHKDDT		;NO
	AOJA	P1,MINILP	;YES, LEAVE IT

CHKDDT:	HRRZ	T1,JOBDDT	;[4200] DDT ADDR
	JUMPE	T1,CHKPFH	;NO DDT. GO CHECK PFH
	HLRZ	T2,JOBDDT	;[4200] HIGH ADDR
	PUSHJ	P,INUSCK	;PAGE IN DDT?
	 AOJA	P1,MINILP	;YES, LEAVE IT

CHKPFH:	HRRZ	T1,.JBPFH	;[3345]FIRST PFH ADDR
	JUMPE	T1,PAGOK	;[3345]NO PFH IF ZERO
	HLRZ	T2,.JBPFH	;[3345]LAST PFH ADDR
	PUSHJ	P,INUSCK	;PAGE IN PFH?
	 AOJA	P1,MINILP	;YES, LEAVE IT

PAGOK:	MOVEI	P2,1		;SET LENGTH OF 1 PAGE
	MOVEI	T1,(P1)		;COPY PAGE NUMBER FOR CHKNEX
	PUSHJ	P,CHKNEX	;SEE IF PAGE EXISTS
	  PUSHJ	P,KILPGX	;YES, MAKE IT NOT EXIST
	MOVEI	T1,3		;MARK PAGE AVAILABLE AND NONEXISTENT
	PUSHJ	P,DOPGS		;SHIFT T1 TO RIGHT PLACE IN BIT MAP
	  ANDCAM T1,PTAB(T2)

	AOJA	P1,MINILP	;LOOP ON TO NEXT PAGE

;ROUTINE TO CHECK IF PAGE IS WITHIN GIVEN BOUNDARIES
;
;	CALLED WITH LOW ADDR IN T1, HIGH ADDR IN T2, PAGE NUMBER IN P1
;	SKIP RETURN IF PAGE IS FREE

INUSCK:	LSH	T1,-9		;TO PAGE
	LSH	T2,-9		;TO PAGE
	CAMG	P1,T2		;PAGE IN USE?
	CAMGE	P1,T1
	 JRST	%POPJ1		;NO
	POPJ	P,		;YES

;DDTCHK
;[4200] ROUTINE TO CHECK IF DDT IS IN CORE
; PURPOSE: TO DETERMINE WHETHER MINILP SHOULD LEAVE DDT PAGES IN-
; VIOLATE (I.E. UNAVAILABLE AND NONEXISTENT) OR AVAILABLE IN THE BITMAP,
; DEPENDING ON WHETHER DDT IS PART OF THE CORE IMAGE.  IT SETS %ENDP
; (MINILP LOOP LIMIT) AND A FAKE JOBDDT.
; ON TOPS10, THIS ROUTINE SIMPLY SETS UP JOBDDT WITH .JBDDT FOR USE BY
; CHKDDT.
; ON TOPS20, WE CHECK IF DDT IS IN CORE. IF IT IS NOT, LEAVE %ENDP AT 777
; AND RETURN. IF DDT IS MAPPED, SETUP JOBDDT FOR CHKDDT WITH TOP,,START
; ADDRESSES OF DDT AND SET %ENDP TO 763 (I.E. LEAVE DDT INVIOLATE)


IF10,<				;[4200] Created this routine
DDTCHK:	MOVE	T1,.JBDDT	;IF10, JUST SET JOBDDT TO .JBDDT
	MOVEM	T1,JOBDDT
	POPJ	P,		;AND RETURN
>;END IF10

IF20,<				;[4200] Created this routine
DDTCHK:	SETZM	JOBDDT		;ASSUME DDT ABSENT
	PUSHJ	P,DDTINC	;SEE IF DDT IS REALLY THERE
	 POPJ	P,		;NO DDT, LEAVE %ENDP AT TOP OF CORE
	MOVEI	T1,763		;DDT IS THERE, SET TOP OF RANGE TO
	MOVEM	T1,%ENDP	; 763, NOT TOP OF CORE
	MOVE	T1,[777000,,764000] ;AND SET JOBDDT TO DDT RANGE
	MOVEM	T1,JOBDDT
	POPJ	P,		;RETURN

>;END IF20

;[4200] ROUTINE TO CHECK IF DDT'S ENTRY VECTOR IS PRESENT
; RETURNS +1 IF DDT IS NOT IN CORE
; RETURNS +2 IF DDT IS PRESENT

IF20,<				;[4200] Created this routine
DDTINC:	MOVE	T1,[.FHSLF,,770] ;SEE IF DDT'S PAGE EXISTS
	RPACS%			;GET ACCESS BITS FOR THE PAGE
	TXNN	T2,PA%PEX	;DOES IT EXIST?
	 POPJ	P,		;NO, NO DDT
	MOVE	T1,770000	;YES, SEE IF IT LOOKS LIKE DDT
	CAME	T1,[JRST 770002] ;SAME BIRTHMARK?
	 POPJ	P,		;NO, NO DDT
	JRST	%POPJ1		;YES,  SKIP RETURN
>;END IF20

	SUBTTL	DOPDVS - Process PDVs to set up PTAB and JOBDAT

;++
; FUNCTIONAL DESCRIPTION:
;
;	New in 4120 /PLB
;
;	The PDV scan works as following: The memory bit map PTAB in
;	intialized to all available.  Then all PDVs located within the
;	current (FOROTS) section are stepped through.  If the .PVMEM
;	pointer is present, then we scan all subtables, marking all
;	pages indicated in the current section as allocated in PTAB.
;	Lastly we scan upwards through PTAB looking for the first
;	suitable unused page.  Local JOBDAT locations .JBFF, .JBREL,
;	and .JBSA<LH> will be set up pointing to this page.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DOPDVS
;	(ONLY CALL IS A PJRST FROM %MEMINI)
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	PDVs in current section
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	Sets up PTAB, the memory bitmap, as well as .JBFF, .JBREL,
;	and .JBSA<LH> of the section local JOBDAT for use by FOROTS.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Yes
;
;--

IF10,<
DOPDVS:	POPJ	P,		;DOES NOTHING ON TOPS-10
> ;END IF10

IF20,<
DOPDVS:	SETZM	PTAB		;[4200] CLEAR BIT TABLE
	MOVE	T1,[PTAB,,PTAB+1] ;[4200]
	BLT	T1,PTAB+^D28	;[4200]

	MOVEI	T1,1		;[4174] BUT EXCLUDE PAGE 0 NO MATTER WHAT
	IORM	T1,PTAB		;[4174] BECAUSE ALLOCATING PAGE 0 IS A BIG MISTAKE!

	SETZM	PDVCNT		;NO PDVS SEEN YET
	SETZM	PDVTTL		;NO TOTAL YET

	MOVSI	T1,1		;[4205] START IN SECTION 1
	MOVEM	T1,PDVBLK+.POADR ;[4205] FOR PDV SEARCH
	HRLOI	T1,777		;[4205] END IN SECTION 777
	MOVEM	T1,PDVBLK+.POADE ;[4205]
	XMOVEI	T1,.		;[4205] GET SECTION,,.
	HLLZM	T1,LOWADR	;[4205] SAVE LOWEST ADDR IN THIS SECTION
	HLLOM	T1,HIADR	;[4205] AND HIGHEST ADDR IN THIS SECTION

PDVGET:	MOVEI	T1,.POADE+1	;GET PDVOP% ARG BLOCK LENGTH
	MOVEI	T2,.FHSLF	;AND FORK HANDLE (US)
	DMOVEM	T1,PDVBLK+.POCT1 ;STORE
	MOVEI	T1,MAXPDV	;GET LENGTH
	XMOVEI	T2,PDVA		;AND ADDR OF PDVA BLOCK
	DMOVEM	T1,PDVBLK+.POCT2 ;STORE
	MOVEI	T1,.POGET	;FUNCTION TO GET PDVA'S
	XMOVEI	T2,PDVBLK	;GET BLOCK ADDR
	PDVOP%			;GO FISH
	 ERJMP	NOMORE		;FAILED, END OF THE LINE
	HRRZ	P4,PDVBLK+.POCT2 ;GET NUMBER RETURNED
	JUMPE	P4,NOMORE	;GET ANY?
	HLRZ	T1,PDVBLK+.POCT2 ;GET NUMBER EXISTING
	SKIPN	PDVTTL		;SEEN THE TOTAL YET?
	 MOVEM	T1,PDVTTL	;STORE AS TOTAL

	MOVN	P4,P4		;GET -COUNT OF PDVS
	MOVSI	P4,(P4)		;GET -COUNT,,0
PDVCHK:	MOVE	P2,PDVA(P4)	;GET PDV -- TOP OF PDV LOOP
	MOVE	T2,.PVCNT(P2)	;GET COUNT OF WORDS IN PDV
	CAIGE	T2,.PVMEM+1	;LONG ENOUGH FOR US?
	 JRST	NXTPDV		;NOPE.
	SKIPG	.PVSYM(P2)	;DOES IT HAVE A GLOBAL SYMBOL VECTOR ADDRESS?
	 JRST	PDVNS		;NO. SKIP IT FOR .JBSYM
	XMOVEI	T1,@.PVSYM(P2)	;YES. GET ITS GLOBAL ADDRESS
	MOVEM	T1,.JBSYM	;SAVE FOR FORERR AND FORDDT
	PUSHJ	P,%SVCNV	;CONVERT TO ADDRESS AND LENGTH
	HLLZ	T0,T1		;GET JUST SECTION NUMBER
	CAMN	T0,%FSECT	;SAME AS THIS SECTION?
	 CAILE	T2,777000	;AND IS SYMBOL TABLE .LE. 511 PAGES?
	  JRST	PDVNS		;NO
	MOVNI	T2,(T2)		;YES. MAKE LENGTH NEGATIVE
	HRLI	T1,(T2)		;MAKE IT AN IOWD
	MOVEM	T1,.JBSYM	;SAVE IT AGAIN

PDVNS:	XMOVEI	P3,@.PVNAM(P2)	;GET ADDRESS OF NAME STRING
	$BLDBP	P3		;MAKE ME A BP!
	MOVE	T1,P3		;GET COPY OF BP
	HRROI	T2,[ASCIZ 'FOROTS%'] ;GET OFFICIAL NAME
	STCMP			;COMPARE STRINGS
	JUMPE	T1,NXTPDV	;A PERFECT MATCH! - IGNORE THIS PDV
	MOVE	T1,P3		;GET BP AGAIN
	HRROI	T2,[ASCIZ 'FOROTS'] ;GET LESS OFFICIAL NAME
	STCMP			;COMPARE AGAIN
	JUMPE	T1,NXTPDV	;LOOKS LIKE FOROTS... IGNORE
				;SINCE THE LOW SEG INFO IS WRONG

	XMOVEI	P3,@.PVMEM(P2)	;GET MEMORY BLOCK ADDR
	JUMPE	P3,NXTPDV	;NONE
	MOVN	T2,.PMCNT(P3)	;GET -BLOCK COUNT
	AOJE	T2,NXTPDV	;REMOVE COUNT WORD
	MOVEM	T2,MEMCNT	;STORE WORDS LEFT
	ADDI	P3,1		;POINT TO FIRST SUB-TABLE
MEMLOP:	XMOVEI	P1,@.PMLOW(P3)	;GET LOW ADDR
	CAMN	P1,[1,,0]	;[4205] WAS IT AN IFIW 0?
	HLL	P1,P3		;[4205] YES. GET PDV SECTION
	CAMLE	P1,HIADR	;[4205] COMPARE TO OUR HIGH
	 JRST	NXTBLK		; WHOLE BLOCK IS ABOVE US
	CAMGE	P1,LOWADR	;COMPARE TO OUR LOW
	 MOVE	P1,LOWADR	; TAKE LARGER OF THE TWO
	XMOVEI	P2,@.PMHI(P3)	;GET HI ADDR
	CAMGE	P2,LOWADR	;COMPARE TO LOW RANGE
	 JRST	NXTBLK		; WHOLE BLOCK IS BELOW US
	CAMLE	P2,HIADR	;[4205] COMPARE TO HIGH LIMIT
	 MOVE	P2,HIADR	;[4205] TAKE SMALLER OF THE TWO
;; NOTE THAT WE ROUND THE WORD ADDRESS TO PAGE ADDRESSES
;; IT IS POSSIBLE TO ADD THE UNUSED FRAGMENT TO THE FREE-LIST.
	MOVEI	P1,(P1)		;GET LOCAL ADDR
	LSH	P1,-^D9		;GET LOW PAGE
	MOVEI	P2,(P2)		;GET LOCAL ADDR
	LSH	P2,-^D9		;GET HIGH PAGE
	SUBI	P2,(P1)		;[4205] GET PAGE COUNT
	ADDI	P2,1		;[4205]
	MOVEI	T1,3		;BIT PATTERN (EXISTS + ALLOCATED)
	PUSHJ	P,DOPGS		;CALL BIT MAP HACKER
	 IORM	T1,PTAB(T2)	;MARK AS IN USE
NXTBLK:	HRRZ	T1,.PMDAT(P3)	;GET CURRENT SUBTABLE LENGTH
	ADDI	P3,(T1)		;BUMP SUBTABLE POINTER BY THAT MUCH
	ADDB	T1,MEMCNT	;INCREMENT WORDS SEEN BY THAT MUCH
	JUMPL	T1,MEMLOP	;STILL MORE WORDS? LOOP.
NXTPDV:	AOS	T1,PDVCNT	;SAY WE HAVE SEEN ONE MORE PDV
	AOBJN	P4,PDVCHK	;LOOP FOR NEXT PDV

; NO MORE PDVAs IN THIS BATCH, DO WE NEED TO DO ANOTHER PDVOP%???
; I DON'T KNOW HOW YOU GOT THAT MANY PDV'S BUT IT WAS
; EASY ENOUGH TO ADD THE CODE TO DO IT RIGHT.

	CAML	T1,PDVTTL	;MORE TO GO?
	 JRST	NOMORE		;NOPE.. SEEN IT ALL
	MOVE	T1,PDVA+MAXPDV-1 ;GET LAST PDVA
	ADDI	T1,1		;GET LAST PDVA+1
	MOVEM	T1,PDVBLK+.POADR ;STORE AS LOW ADDRESS
	JRST	PDVGET		;GO LOOK FOR MORE

; HERE WHEN NO MORE PDV'S ARE TO BE FOUND; MARK PAGES USED BY DDT
NOMORE:	PUSHJ	P,DDTCHK	;[4200] SET %ENDP FOR UDDT
	MOVE	P1,%ENDP	;[4200] GET TOP OF CORE
	MOVEI	P2,777		;[4200] GET COUNT OF PAGES
	SUB	P2,P1		;[4200] IN P2
	SKIPN	P2		;[4200] BUT MARK AT LEAST ONE
	 MOVEI	P2,1		;[4200]
	MOVEI	T1,3		;GET BITS (EXISTS + ALLOCATED)
	PUSHJ	P,DOPGS		;HACK THE BITMAP
	 IORM	T1,PTAB(T2)	;INSTRUCTION TO SET BITS

; MARK FOROTS PAGES
	MOVEI	P1,F.BOT/1000	;GET FOROTS START PAGE
	JUMPE	P1,DOSEAR	;ZERO? MUST BE NONSHARE
	MOVEI	P2,<<F.TOP-F.BOT>/1000> ;GET LENGTH
	MOVEI	T1,3		;GET BITS (EXISTS + ALLOCATED)
	PUSHJ	P,DOPGS		;HACK THE BITMAP
	 IORM	T1,PTAB(T2)	;INSTRUCTION TO SET BITS

;NOW SEARCH FOR THE FIRST FREE GAP, AND SET UP LOCAL JOBDAT
DOSEAR:	MOVEI	P1,1		;START AT PAGE 1
;;;	MOVEI	P2,1		;GAP NEED ONLY BE ONE PAGE LONG
	MOVEI	P2,2		;EXPERIMENT: REQUIRE GAP TO BE 2 PAGES
	MOVEI	P3,F.BOT/1000	;GET BOTTOM OF FOROTS
	JUMPN	P3,SRCLOP	;OK?
	MOVEI	P3,ENDP		;NO, MUST BE NONSHARE: SEARCH ALL
SRCLOP:	CAIL	P1,(P3)		;ARE WE AT END OF ROPE?
	 $ECALL	MFU,%ABORT	; MEMORY FULL
	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE THROUGH BIT MAP
	 TDNE	T1,PTAB(T2)	;ALLOCATED?
	  AOJA	P1,SRCLOP	; YES, KEEP LOOKING

	MOVEI	T1,(P1)		;NO, COPY PAGE NUMBER
	LSH	T1,^D9		;MAKE INTO ADDRESS
	CAIGE	T1,1000		;ABOVE PAGE 1?
	 MOVEI	T1,.JBDA	;NO!! START ABOVE JOBDAT
	MOVEM	T1,.JBFF	;STORE AS NEXT WORD TO USE
	HRLM	T1,.JBSA	;AND INITIAL VALUE THEREOF
	SUBI	T1,1		;GET END OF LAST PAGE
	ORI	T1,777		;MAKE SURE IT LOOKS GOOD
	MOVEM	T1,.JBREL	;STORE AS LIMIT WORD

;[4202] NOW WE MUST UNMAP ALL THE PAGES FROM THIS SECTION THAT
;HAVE BEEN MAPPED BEFORE BY FOROTS. WE GO THROUGH THE BITMAP,
;A PAGE AT A TIME, AND CALL KILPGX FOR ALL PAGES FOR WHICH
;THE PAGE IS NOT ALLOCATED.

	MOVEI	P1,777		;START AT THE TOP
	MOVEI	P2,1		;1 PAGE AT A TIME
RUNMLP:	MOVEI	T1,1		;USE ALLOCATED BIT AS THE MASK
	PUSHJ	P,DOPGS		;ONLY 1 PAGE AT A TIME, THOUGH
	 TDNN	T1,PTAB(T2)	;CHECK IF ALLOCATED
	  PUSHJ	P,KILPGX	;NOT ALLOCATED. KILL IT!
	SOJGE	P1,RUNMLP	;LOOP DOWN TO 0
	RET			;OUR WORK IS DONE

> ;IF20
;ROUTINE TO CHECK IF A PAGE EXISTS
;ARGS:	 T1 = PAGE NUMBER
;SKIP RETURN IF PAGE IS NONEXISTENT

IF20,<
CHKNEX:	HRLI	T1,.FHSLF	;THIS FORK, PAGE NUMBER IS IN T1
	RPACS%			;READ PAGE ACCESS
	TXNN	T2,P1%PEX	;CHECK PAGE-EXISTS BIT (IN RH SO UNWRITTEN
				;  FILE PAGES ARE CONSIDERED TO EXIST)
	  AOS	(P)		;PAGE NONEXISTENT
	POPJ	P,		;PAGE EXISTS
>

IF10,<
CHKNEX:	HRLI	T1,.PAGCA	;CHECK ACCESS
	PAGE.	T1,		;TO PAGE NUMBER IN T1
	 $SNH			;SHOULD NEVER FAIL
	TXNE	T1,PA.GNE	;CHECK PAGE-NONEXISTENT BIT
	  AOS	(P)		;PAGE NONEXISTENT
	POPJ	P,		;PAGE EXISTS
>
	SEGMENT	DATA

REQBOT:	BLOCK	1		;BOTTOM OF CORE REQUEST
REQTOP:	BLOCK	1		;TOP+1 OF CORE REQUEST
JOBDDT:	BLOCK	1		;[4200] FAKE .JBDDT
%JBASE:	BLOCK	1		;.JBFF POINTING AFTER SYMBOL TABLE
SYMFP:	BLOCK	1		;SPACE BETWEEN .JBFF AND SYMTAB
SYMTP:	BLOCK	1		;BOTTOM,,TOP+1 OF SYMBOL TABLE
BEGPTR:	BLOCK	1		;POINTER TO START OF LIST
FREPTR:	BLOCK	1		;POINTER TO BLOCK TO START SEARCH AT
EOL:	BLOCK	2		;THE ZERO WORD AT END OF LIST

WRAP:	BLOCK	1		;-1 IF FIRST PASS THROUGH LIST

PAGSEC:	BLOCK	1		;Page # of start of this section

%PTAB:
PTAB:	BLOCK	^D29		;THE BIT TABLE
				;2 BITS PER PAGE. 01 = PAGE ALLOCATED
				;		  10 = PAGE EXISTS (TOPS-10)
				;		       OR IS USED (TOPS-20)
				;PAGE 0 IS RIGHT 2 BITS OF FIRST WORD

VRTBIT:	BLOCK	1		;0 IF TRYING FOR PHYSICAL PAGES,
				; PA.GCD IF TRYING FOR VIRTUAL PAGES

IF10,<
PBLK:	BLOCK	1		;ARG COUNT WORD
	BLOCK	PLEN		;ARGS

> ;END IF10

IF20,<				;[4120]
PDVBLK:	BLOCK	.POADE+1	;[4120] BLOCK FOR PDVOP%
PDVA:	BLOCK	MAXPDV		;[4120] BLOCK OF PDVA'S
PDVCNT:	BLOCK	1		;[4120] NUMBER OF PDV'S SEEN
PDVTTL:	BLOCK	1		;[4120] TOTAL PDVS IN RANGE
LOWADR:	BLOCK	1		;[4120] LOWEST ADDR IN SECTION
HIADR:	BLOCK	1		;[4205] HIGHEST ADDR IN SECTION
MEMCNT:	BLOCK	1		;[4120] COUNT OF WORDS LEFT IN .PVMEM BLOCK
> ;END IF20

	SUBTTL	OVERLAY (LOW SEGMENT) MEMORY MANAGER

	SEGMENT	CODE

	COMMENT	&

"Low segment" in these routines means the pages between 0 and .JBREL which
are used to hold the root segment and all of the user's overlays.  Note that
in the strict TOPS-10 sense, the low segment is these pages and also the
pages at the top of core with the OTS free storage and data in them.

The free list for the low segment is kept in one contiguous block of memory
in OTS free core.  Each word in the list gives the start and end address of
one block of free memory, the start address in the left half and the end
address + 1 in the right half.  The list is in increasing order on address.
All blocks are disjoint and not contiguous.

The free list table is pointed to by FLBEG and its length is in FLLEN.  The
maximum size of the free list is determined by the size of the table; this
number is in FLMAX.

	&
;ROUTINE TO MARK A BLOCK OF THE LOW SEG "ALLOCATED"
;ARGS:	 T1 = ADDRESS OF BEGINNING OF BLOCK
;	 T2 = ADDRESS OF END+1 OF BLOCK
;NONSKIP RETURN:  NOT ENOUGH MEMORY
;1 SKIP:  	  BLOCK ALREADY ALLOCATED OR OVERLAPS ALLOCATED BLOCK
;2 SKIPS:	  OK, BLOCK ALLOCATED

LSGET:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	SKIPN	P3,FLBEG	;POINT TO START OF FREE LIST
	  PUSHJ	P,LSINIT	;NONE YET, GO MAKE ONE

	MOVE	P4,FLLEN	;GET LENGTH OF FREE LIST
GETLP:	SOJGE	P4,EXPRET	;IF ONE THERE, WE'RE OK
	CAMGE	T2,JOBFF	;TRYING TO ALLOCATE BELOW .JBFF?
	 JRST	%POPJ1		;YES. ALREADY ALLOCATED
	MOVEM	T1,DESLOW	;SAVE T1,T2 FOR EXPAND ROUTINE
	MOVEM	T2,DESHGH
	PUSHJ	P,LSEXP		;GO EXPAND CORE
	 POPJ	P,		;NON-SKIP MEANS CAN'T (INSUFFICIENT MEMORY)
	MOVE	T1,DESLOW	;RESTORE T1,T2
	MOVE	T2,DESHGH
	MOVE	P2,T2		;COPY HIGH ADDR + 1
	ADDI	P2,777		;ROUND END+1 UP TO MULTIPLE OF 1000
	TRZ	P2,777

	HRRZ	P1,-1(P3)	;GET END+1 OF TOP EXISTING FREE BLOCK
	CAML	P1,JOBFF	;DOES BLOCK END AT .JBFF?
	  SOJA P3,EXPMRG	;YES, MERGE IN THE NEW CORE WITH TOP BLOCK
	MOVE	P1,JOBFF	;NO, NEW CORE IS A NEW FREE BLOCK
	PUSHJ	P,BLTUP		;MOVE LIST UP TO MAKE ROOM FOR NEW BLOCK
	HRLZM	P1,(P3)		;STORE START ADDRESS OF NEW FREE BLOCK
EXPMRG:	HRRM	P2,(P3)		;STORE NEW END+1 ADDRESS OF FREE BLOCK
	MOVEM	P2,JOBFF	;STORE UPDATED .JBFF
	ADDI	P2,777		;WANT PAGE BEYOND ALLOCATED CORE
IF20,<	TRZ	P2,777		;MAKE IT A PAGE
	MOVEI	P1,-1(P2)	;TOPS-10 PROGS NEED .JBREL, SO KEEP IT RIGHT
	MOVEM	P1,.JBREL  >
	LSH	P2,-9		;GET HIGHEST PAGE + 1 THAT WE ALLOCATED
	MOVEM	P2,LPAGE	;REMEMBER IT

EXPRET:	HLRZ	P1,(P3)		;GET BEG ADRESS OF A FREE BLOCK
	HRRZ	P2,(P3)		;GET END+1

	CAIGE	P2,(T2)		;DOES FREE BLOCK END BEFORE ALLOCATED BLOCK?
	  AOJA	P3,GETLP	;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADDR

	CAILE	P1,(T1)		;DOES FREE BLOCK START AFTER ALLOCATED BLOCK?
	  JRST	%POPJ1		;YES, ALREADY ALLOCATED

	MOVEI	T3,(P2)		;CALCULATE MAX SIZE OF BLOCK ALLOCATABLE
	SUBI	T3,(T1)		; AT THIS ADDRESS FOR FUNCT.
	MOVEM	T3,BLKSIZ

	CAIE	P1,(T1)		;DO BLOCKS BEGIN AT SAME PLACE?
	  JRST	GECHK		;YES, GO COMPARE END POINTERS
	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	GTOP		;NO, ALLOCATE TOP PART OF BLOCK

;BLOCK TO BE ALLOCATED IS ALL OF AN EXISTING FREE BLOCK
GALL:	PUSHJ	P,BLTDWN	;ALLOCATE WHOLE BLOCK BY REMOVING IT
	XMOVEI	T1,(T1)		;[4017] GET GLOBAL ADDRESS
	JRST	%POPJ2		; COMPLETELY FROM THE FREE LIST

;BLOCK TO BE ALLOCATED IS TOP OF AN EXISTING FREE BLOCK
GTOP:	HRLM	T2,(P3)		;END ADDRESS OF ALLOCATED BLOCK IS NEW
	XMOVEI	T1,(T1)		;[4017] GET GLOBAL ADDRESS
	JRST	%POPJ2		; START ADDRESS OF FREE BLOCK

GECHK:	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	GMIDDL		;NO, ALLOCATE CHUNK FROM MIDDLE

;BLOCK TO BE ALLOCATED IS BOTTOM OF AN EXISTING FREE BLOCK
GBOT:	HRRM	T1,(P3)		;START ADDRESS OF ALLOCATED BLOCK IS NEW
	XMOVEI	T1,(T1)		;[4017] GET GLOBAL ADDRESS
	JRST	%POPJ2		; END ADDRESS OF FREE BLOCK

;BLOCK TO BE ALLOCATED IS IN MIDDLE OF AN EXISTING FREE BLOCK
GMIDDL:	PUSHJ	P,BLTUP		;MAKE A HOLE IN THE FREE LIST
	HRRM	T1,(P3)		;SET NEW END ADDRESS
	HRLM	T2,1(P3)	;AND NEW START ADDRESS
	XMOVEI	T1,(T1)		;[4017] GET GLOBAL ADDRESS
	JRST	%POPJ2		;DONE
;HERE WHEN LOW SEG MUST BE EXPANDED TO ALLOCATE CORE.  FAKE A CORE UUO

EXPADR:	MOVE	T2,DESHGH	;GET DESIRED HIGH ADDR

	MOVE	P1,LPAGE	;GET HIGHEST PAGE NUMBER IN LOW SEG
	MOVEI	P2,777(T2)	;ROUND TOP ADDRESS TO ALLOCATE UP TO A PAGE
	LSH	P2,-9		;GIVING TOP PAGE TO ALLOCATE
	SUBI	P2,(P1)		;COMPUTE NUMBER OF PAGES TO CREATE
	JUMPE	P2,%POPJ1	;IF NONE, SKIP
	JUMPL	P2,DEALC	;CORE HAS TO BE REDUCED
	  PUSHJ	P,CREPGS	;CREATE THE PAGES
	 POPJ	P,		;INSUFFICIENT MEMORY
	JRST	%POPJ1		;OK. DONE

DEALC:	ADD	P1,P2		;GET LOWEST PAGE TO KILL
	MOVM	P2,P2		;MAKE COUNT POSITIVE
	PUSHJ	P,KILPGS	;KILL THE PAGES
	JRST	%POPJ1		;SKIP RETURN, LIKE ABOVE

LSINIT:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	MOVEI	T1,FLSIZE+1	;GET INITIAL SIZE OF FREE LIST BLOCK
	PUSHJ	P,%GTBLK	;GET CORE FOR FREE LIST
	 $ECALL	MFU,%ABORT	;[4131] CAN'T
	MOVEI	P3,1(T1)	;PUT IN RIGHT AC
	MOVEM	P3,FLBEG	;SAVE START ADDRESS
	SETZM	FLLEN		;TABLE HAS ZERO LENGTH INITIALLY
	SETZM	-1(P3)		;MAKE A FAKE FREE BLOCK STARTING AT 0 AND
				; ENDING AT 0 FOR BOUNDARY CONDITION IN LSFREE
	MOVEI	T1,FLSIZE	;SET FLMAX
	MOVEM	T1,FLMAX
	DMOVE	T1,SAVET	;RESTORE T1-T2
	UNSTK			;FIX STACK
	POPJ	P,		;ALL DONE
;ROUTINE TO MARK A BLOCK IN THE LOW SEGMENT "FREE"
;ARGS:	 T1 = BEG ADDRESS
;	 T2 = END+1 ADDRESS
;NONSKIP RETURN IF BLOCK WASN'T ALLOCATED, ELSE SKIP RETURN

LSFREE:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	SKIPN	P3,FLBEG	;POINT TO FREE LIST
	  POPJ	P,		;NONE SET UP, ERROR RETURN

	MOVEI	T1,(T1)		;[4017] MAKE LOCAL ADDRESS
	MOVEI	T2,(T2)		;[4017] MAKE LOCAL ADDRESS
	SKIPA	P4,FLLEN	;GET LENGTH OF FREE LIST
FREELP:	ADDI	P3,1		;BUMP TO NEXT ENTRY IN FREE LIST
	SOJL	P4,FREEFF	;END OF FREE LIST, GO CHECK .JBFF
	HRRZ	P1,-1(P3)	;GET START ADDRESS OF ALLOCATED BLOCK
	HLRZ	P2,(P3)		;GET END ADDRESS OF SAME ALLOCATED BLOCK

	CAIGE	P2,(T2)		;DOES ALLOCATED BLOCK END BEFORE FREE BLOCK?
	  JRST	FREELP		;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADR
	CAILE	P1,(T1)		;DOES ALLOCATED BLOCK START AFTER FREE BLOCK?
	  POPJ	P,		;YES, FREE BLOCK IS ALREADY FREE

	CAIE	P1,(T1)		;DO BLOCKS START AT SAME PLACE?
	  JRST	FECHK		;NO, GO COMPARE END POINTERS
	CAIE	P2,(T2)		;DO BLOCKS START AT SAME PLACE?
	  JRST	FTOP		;NO, FREE TOP PART OF BLOCK

;BLOCK TO BE FREED IS ALL OF AN EXISTING ALLOCATED BLOCK
	HRRZ	T2,(P3)		;SAVE POINTER TO END OF FREE BLOCK
	PUSHJ	P,BLTDWN	;REMOVE FREE BLOCK FROM LIST
;	HRRM	T2,-1(P3)	;COMBINE PREVIOUS AND FOLLOWING FREE BLOCKS
;	JRST	%POPJ1		;BLOCK FREED

;BLOCK TO BE FREED IS TOP OF AN EXISTING FREE BLOCK
FTOP:	HRRM	T2,-1(P3)	;NEW START ADDRESS OF FOLLOWING FREE BLOCK
	JRST	%POPJ1		; IS START ADDRESS OF BLOCK BEING FREED

FECHK:	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	FMIDDL		;NO, FREE BLOCK IN MIDDLE

;BLOCK TO BE FREED IS BOTTOM OF AN EXISTING ALLOCATED BLOCK
FBOT:	HRLM	T1,(P3)		;NEW END ADDRESS OF FREE BLOCK IS START
	JRST	%POPJ1		; ADDRESS OF BLOCK BEING FREED

;BLOCK TO BE FREED IS IN MIDDLE OF AN EXISTING ALLOCATED BLOCK
FMIDDL:	PUSHJ	P,BLTUP		;MAKE A HOLE IN THE FREE LIST
	HRLM	T1,(P3)		;PUT A NEW ENTRY IN THE LIST
	HRRM	T2,(P3)
	JRST	%POPJ1		;BLOCK FREED
;HERE WHEN USER FREES A BLOCK ABOVE THE TOP EXISTING FREE BLOCK.
;SEE IF IT IS BELOW .JBFF AND IF SO, FREE IT

FREEFF:	CAMLE	T2,JOBFF	;TRYING TO FREE BLOCK ABOVE .JBFF?
	  POPJ	P,		;YES, ALREADY FREE
	SUBI	P3,1		;POINT TO TOP EXISTING FREE BLOCK

	HRRZ	P1,(P3)		;GET END ADDRESS OF TOP BLOCK
	CAILE	P1,(T1)		;DOES IT END AFTER THE ONE USER IS FREEING?
	  POPJ	P,		;YES, USER'S BLOCK IS ALREADY FREE

	CAIE	P1,(T1)		;IS USER'S BLOCK CONTIGUOUS WITH TOP BLOCK?
	  JRST	FNEW		;NO, GO CREATE NEW ENTRY IN FREE LIST
	HRRM	T2,(P3)		;MERGE FREE BLOCKS TOGETHER
	JRST	%POPJ1		;RETURN

FNEW:	PUSHJ	P,BLTUP		;MAKE NEW ENTRY IN FREE LIST
	HRLZM	T1,1(P3)	;BEG ADDRESS IS IN T1
	HRRM	T2,1(P3)	;END+1 ADDRESS IS IN T2
	JRST	%POPJ1		;ALL DONE
;ROUTINE TO LOCATE A FREE BLOCK OF SUFFICIENT SIZE
;ARGS:	 T2 = SIZE OF BLOCK TO FIND
;RETURN: T1 = ADDRESS OF A BLOCK TO ALLOCATE
;	 T2 UNCHANGED

LSFIND:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	MOVE	T1,JOBFF	;IF ALL ELSE FAILS, ALLOCATE AT .JBFF
	SKIPN	P3,FLBEG	;POINT TO FREE LIST
	  POPJ	P,		;NO FREE LIST, USE .JBFF
	MOVE	P4,FLLEN	;GET LENGTH OF LIST
FINDLP:	SOJL	P4,TOPCOR	;NO NEXT ENTRY, CHECK LAST ENTRY
	HLRZ	P1,(P3)		;GET START OF FREE BLOCK
	HRRZ	P2,(P3)		;AND END+1
	SUBI	P2,(P1)		;COMPUTE LENGTH
	CAIGE	P2,(T2)		;BIG ENOUGH?
	  AOJA	P3,FINDLP	;NO, KEEP LOOKING
	MOVEI	T1,(P1)		;PUT ADDRESS IN RIGHT AC
	POPJ	P,		;RETURN

TOPCOR:	HRRZ	P1,-1(P3)	;GET TOP+1 OF LAST FREE BLOCK
	CAMN	P1,JOBFF	;IS IT .JBFF?
	 HLRZ	T1,-1(P3)	;YES. USE BOTTOM OF BLOCK AS BASE LOC
	POPJ	P,
;ROUTINE TO CUT BACK THE LOW SEG SIZE TO MINIMUM
;NO ARGS

LSTRIM:	PUSHJ	P,%SAVE2	;SAVE P1-P2
	MOVE	P1,JOBFF	;GET HIGHEST ADDRESS WE NEED TO KEEP
	SKIPG	T1,FLLEN	;GET FREE LIST LENGTH
	  JRST	CALEXP		;NO FREE LIST, USE .JBFF
	ADD	T1,FLBEG	;POINT TO END OF FREE LIST
	HRRZ	T2,-1(T1)	;GET END+1 ADDRESS OF TOP FREE BLOCK
	CAIGE	T2,(P1)		;DOES TOP BLOCK END AT .JBFF?
	  JRST	CALEXP		;NO, CUT BACK TO .JBFF
	HLRZ	P1,-1(T1)	;CUT BACK TO START OF TOP FREE BLOCK
	SOS	FLLEN		;DELETE BLOCK FROM FREE LIST
CALEXP:	MOVEM	P1,DESHGH	;TELL LSEXP WE WANT TO SHRINK
	PUSHJ	P,LSEXP
	JFCL			;WILL ALWAYS SKIP RETURN

TRIMFF:	MOVE	P1,DESHGH	;GET NEW HIGH ADDR
	MOVEM	P1,JOBFF	;STORE NEW .JBFF
	ADDI	P1,777		;ROUND UP TO PAGE NUMBER
IF20,<	TRZ	P1,777		;ON TOPS-20, STORE .JBREL TOO
	MOVEI	P2,-1(P1)	; FOR OLD PROGS
	MOVEM	P2,.JBREL  >
	LSH	P1,-9		;GET FIRST PAGE GIVEN BACK
	MOVEM	P1,LPAGE	;STORE NEW HIGHEST PAGE+1
	POPJ	P,		;DONE
;ROUTINES TO EXPAND AND CONTRACT THE FREE LIST
;ARGS:	 P3 = ADDRESS IN LIST TO EXPAND OR CONTRACT AT
;RETURN: P3 UNCHANGED, T1-T4 UNCHANGED

;TO BE PRECISE:
;
;	BEFORE		  BLTUP		  BLTDWN
;
;   !-------------!  !-------------!  !-------------!
;   !             !  !             !  !             !  <-- FLBEG
;   !             !  !             !  !             !
;   !             !  !             !  !             !
;   !------!------!  !------!------!  !------!------!
;   !  B1  !  E1  !  !  B1  !  E1  !  !  B1  !  E1  !
;   !------!------!  !------!------!  !------!------!
;   !  B2  !  E2  !  !  B2  !  E2  !  !  B3  !  E3  !  <-- P3
;   !------!------!  !------!------!  !------!------!
;   !  B3  !  E3  !  !  B2  !  E2  !  !             !
;   !------!------!  !------!------!  !             !
;   !             !  !  B3  !  E3  !  !             !
;   !             !  !------!------!  !             !
;   !             !  !             !  !-------------!
;   !             !  !             !
;   !-------------!  !             !
;                    !             !
;                    !-------------!


BLTDWN:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	SOSG	T1,FLLEN	;DECREMENT LS TABLE LENGTH
	  JRST	BLTRET		;ZERO LENGTH, ALL DONE
	ADD	T1,FLBEG	;COMPUTE END+1 OF TABLE
	MOVSI	T2,1(P3)	;SET BLT FROM ADDRESS
	HRRI	T2,(P3)		;AND BLT TO ADDRESS
	CAILE	T1,(T2)		;CHECK FOR 1-WORD TABLE
	  BLT	T2,-1(T1)	;MOVE THE TABLE DOWN ONE
	JRST	BLTRET		;ALL DONE

BLTUP:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	AOS	T1,FLLEN	;INCREMENT TABLE LENGTH
	CAMLE	T1,FLMAX	;IN BOUNDS?
	  PUSHJ	P,BLTEXP	;NO, GO MOVE TO BIGGER TABLE
	ADD	T1,FLBEG	;COMPUTE END+1 OF NEW TABLE
	MOVEI	T2,-2(T1)	;GET END ADDR OF OLD TABLE
	SUBI	T2,(P3)		;COMPUTE LENGTH-1 WE NEED TO POP
	JUMPL	T2,BLTRET	;[3135] Don't try to do 0 POPs
	HRLI	T1,400000(T2)	;PUT INTO POP POINTER
	HRRI	T1,-2(T1)	;MAKE RH OF POINTER
	POP	T1,1(T1)	;BACKWARDS BLT
	JUMPL	T1,.-1

BLTRET:	DMOVE	T1,SAVET	;RESTORE T1-T2
	UNSTK
	POPJ	P,		;ALL DONE
;HERE WHEN FREE LIST TABLE FILLS UP
;MOVE THE FREE LIST INTO A BIGGER BLOCK.  FIX ALL POINTERS INTO THE FREE LIST
;TO POINT TO THE NEW BLOCK.  (THE ONLY THINGS THAT POINT TO THE FREE LIST ARE
;FLBEG AND P3.)

BLTEXP:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T3,SAVET	;SAVE T3-T4

	MOVE	T2,FLMAX	;GET OLD LENGTH OF TABLE
	MOVEI	T3,FLSIZE(T2)	;GET NEW LENGTH
	MOVEM	T3,FLMAX	;SAVE NEW LENGTH
	MOVE	T1,FLBEG	;GET OLD ADDRESS
	ADDI	T3,1		;FIX THINGS UP BECAUSE OF PHANTOM 0 WORD
	ADDI	T2,1		; BEFORE START OF LIST.  IT'S THERE BECAUSE
	SUBI	T1,1		; LSFREE USES -1(P3) SOMETIMES

	SUBI	P3,(T1)		;UNRELOCATE P3
	PUSHJ	P,%MVBLK	;MOVE TABLE TO BIGGER BLOCK
	 $ECALL	MFU,%ABORT	;[4131] CAN'T. OUT OF MEMORY
	ADDI	P3,(T1)		;RERELOCATE P3

	ADDI	T1,1		;SKIP PAST PHANTOM 0 WORD AT START OF TABLE
	MOVEM	T1,FLBEG	;STORE NEW ADDRESS OF TABLE

	MOVE	T1,FLLEN	;RESTORE T1
	DMOVE	T3,SAVET	;RESTORE T3-T4
	UNSTK			;FIX UP STACK POINTER
	POPJ	P,		;RETURN

	SEGMENT	DATA

FLBEG:	BLOCK	1		;START ADDRESS OF LS FREE STORAGE TABLE
FLLEN:	BLOCK	1		;LENGTH
FLMAX:	BLOCK	1		;MAX LENGTH

%EXPNT:	BLOCK	1		;ADDRESS OF "CORE UUO" SIMULATOR
%JBFPT:	BLOCK	1		;ADDRESS OF .JBFF
%LPAGE:
LPAGE:	BLOCK	1		;HIGHEST PAGE + 1 ALLOCATED IN LOW SEG
DESLOW:	BLOCK	1		;BOTTOM OF DESIRED BLOCK
%DESHG:
DESHGH:	BLOCK	1		;TOP OF DESIRED BLOCK

BLKSIZ:	BLOCK	1		;MAX SIZE OF ALLOCATABLE BLOCK FROM LSGET
	SUBTTL	ALCOR. AND DECOR.

	SEGMENT	CODE

;ROUTINES TO PROVIDE STANDARD INTERFACE TO FOROTS CORE MANAGEMENT FOR
;MACRO PROGRAMS.  STANDARD FORTRAN CALLING SEQUENCE, WITH ONE ARGUMENT
;POINTED TO BY AC 16.  RESULT RETURNED IN AC 0.


;ALCOR.  ALLOCATE A BLOCK OF CORE
;ARG:	 SIZE TO ALLOCATE
;RETURN: AC 0 = ADDRESS OF BLOCK, OR -1 IF NONE AVAILABLE

	FENTRY	(ALCOR)
	PUSHJ	P,SAVAC		;SAVE USER'S ACS
	MOVE	T1,@(L)		;GET NUMBER OF WORDS TO ALLOCATE
	PUSHJ	P,GTBLKX	;ALLOCATE A BLOCK
	  SETO	T1,		;NONE AVAILABLE
	MOVEM	T1,FMACS	;GIVE ADDRESS TO USER IN AC0
	JUMPL	T1,%POPJ	;DONE NOW IF ERROR
	MOVE	T2,-1(P)	;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	POPJ	P,		;RETURN



;DECOR.  DEALLOCATE A BLOCK OF CORE
;ARG:	ADDRESS OF BLOCK

	FENTRY	(DECOR)
	PUSHJ	P,SAVAC		;SAVE USER'S ACS
	MOVE	T1,@(L)		;GET ADDRESS OF BLOCK
	PJRST	%FREBLK		;FREE IT AND RETURN


IF10,<

;ALLOCATE I/O CHANNEL

;TWO ENTRY POINTS:

;ALCHN.: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
;	 ARG = 0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T0 = CHANNEL NUMBER ALLOCATED, OR -1 IF NO FREE CHANNELS

;%ALCHF: T1 =  0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T1 = CHANNEL NUMBER ALLOCATED.  NONSKIP RETURN IF NO FREE CHANNELS

	FENTRY	(ALCHN)
	PUSHJ	P,SAVAC		;SAVE USER'S ACS
	MOVE	T1,@0(L)	;GET USER'S ARG
	TDNE	T1,[-20]	;IF NEGATIVE OR OVER 17, ERROR
	  JRST	ALCHNX
	PUSHJ	P,%ALCHF	;TRY TO ALLOCATE CHANNEL
ALCHNX:	  SETO	T1,		;CAN'T
	MOVEM	T1,FMACS	;[4203] STORE FOR USER
	POPJ	P,		;RETURN


%ALCHF:	JUMPN	T1,ALCHN1	;IF SPECIFIC REQUEST, GO TRY TO ALLOCATE IT

ALCHN:	MOVE	T0,%CHMSK	;GET ALLOCATED CHANNEL MASK
	JFFO	T0,ALCHN1	;FIND FIRST FREE CHANNEL
	  POPJ	P,		;NONE, ERROR RETURN

ALCHN1:	MOVNI	T3,(T1)		;GET SHIFT COUNT FOR CHANNEL
	MOVSI	T2,(1B0)	;GET A 1 BIT
	LSH	T2,(T3)		;SHIFT INTO POSITION
	TDNN	T2,%CHMSK	;CHANNEL FREE?
	  POPJ	P,		;NO, ERROR RETURN
	ANDCAM	T2,%CHMSK	;MARK IT ALLOCATED
	JRST	%POPJ1		;SUCCESS RETURN

;DEALLOCATE CHANNEL

;TWO ENTRY POINTS:

;DECHN.: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
;	 ARG = CHANNEL NUMBER TO DEALLOCATE
;RETURN: T0 = 0 IF DEALLOCATED OK, -1 IF CHANNEL WASN'T ALLOCATED

;%DECHF: T1 = CHANNEL NUMBER TO DEALLOCATE
;NONSKIP RETURN IF CHANNEL NOT ALLOCATED, SKIP RETURN IF OK

	FENTRY	(DECHN)
	PUSHJ	P,SAVAC		;SAVE USER'S ACS
	MOVE	T1,@0(L)	;GET ARG
	TDNE	T1,[-20]	;RANGE CHECK
	  JRST	DECHNX		;ILLEGAL CHANNEL, ERROR
	PUSHJ	P,%DECHF	;DEALLOCATE THE CHANNEL
DECHNX:	  SKIPA	T1,[-1]		;CAN'T
	SETZ	T1,		;CAN, DID
	MOVEM	T1,FMACS	;[4203] STORE FOR RETURN TO USER
	POPJ	P,		;RETURN

%DECHF:	MOVNI	T1,(T1)		;GET SHIFT COUNT
	MOVSI	T2,(1B0)	;GET A 1 BIT
	LSH	T2,(T1)		;SHIFT INTO POSITION
	TDNE	T2,%CHMSK	;CHANNEL ALLOCATED?
	  POPJ	P,		;NO, ERROR
	IORM	T2,%CHMSK	;DEALLOCATE IT
	JRST	%POPJ1		;SUCCESS


>;END IF10
IF20,<

	FENTRY	(ALCHN)
	SETO	T0,		;NO CHANNELS AVAILABLE ON -20
%ALCHF:	POPJ	P,		;SAY SO AND RETURN

	FENTRY	(DECHN)
	SETO	T0,		;NO CHANNEL CAN BE ALLOCATED
%DECHF:	POPJ	P,		;ERROR RETURN

>;END IF20

;SAVAC - SAVE THE AC'S LOCALLY IN FORMEM, AS THESE ROUTINES CAN BE
;CALLED WITHIN I/O STATEMENTS.
SAVAC:	POP	P,RETA		;SAVE THE RETURN ADDR
	MOVEM	0,FMACS		;SAVE AC 0
	MOVE	0,[1,,FMACS+1]	;SAVE THE REST
	BLT	0,FMACS+17
	PUSHJ	P,@RETA		;RETURN TO FOROTS, LEAVE RESTORE RETURN ADDR
	HRLZI	16,FMACS	;RESTORE THE ACS
	BLT	16,16		;WITH A BLT
	POPJ	P,		;RETURN TO USER'S PROGRAM

	SEGMENT	DATA

FMACS:	BLOCK	20		;LOCAL AC SAVE AREA
RETA:	BLOCK	1		;RETURN ADDRESS

	SUBTTL	FUNCT.

	SEGMENT	CODE

;GENERAL-PURPOSE OTS INTERFACE.  USES STANDARD FORTRAN CALLING SEQUENCE,
;WITH ARG BLOCK POINTED TO BY AC 16.  THE FIRST THREE ARGS ARE STANDARD,
;THE REST ARE FUNCTION-SPECIFIC.  THIS ROUTINE DOES NOT CHECK THAT IT IS
;GIVEN THE CORRECT NUMBER OF ARGUMENTS, OR THAT THEY HAVE THE CORRECT TYPE.

;FUNCT. ARGS

	FN==0			;FUNCTION CODE
	ERRPFX==1		;3-CHAR PREFIX FOR ERRORS, ASCIZ
	STATUS==2		;RETURNED STATUS, NONZERO MEANS ERROR
	ARG1==3			;FUNCTION-DEPENDENT ARGS
	ARG2==4
	ARG3==5

;FUNCTION DISPATCH TABLE

FDISP:	IFIW	F.ILL		;0  ILLEGAL
	IFIW	F.GAD		;1  GET LS MEMORY AT ADDRESS
	IFIW	F.COR		;2  GET LS MEMORY ANYWHERE
	IFIW	F.RAD		;3  RETURN LS MEMORY
	IFIW	F.GCH		;4  GET I/O CHANNEL
	IFIW	F.RCH		;5  RETURN I/O CHANNEL
	IFIW	F.GOT		;6  GET OTS MEMORY
	IFIW	F.ROT		;7  RETURN OTS MEMORY
	IFIW	F.RNT		;10 GET INITIAL RUNTIME
	IFIW	F.IFS		;11 GET INITIAL RUN FILESPEC
	IFIW	F.CBC		;12 CUT BACK LS TO MINIMUM
	IFIW	F.RRS		;13 READ RETAIN STATUS (DBMS)
	IFIW	F.WRS		;14 WRITE RETAIN STATUS (DBMS)
	IFIW	F.GPG		;15 GET PAGES
	IFIW	F.RPG		;16 RETURN PAGES
	IFIW	F.GPSI		;17 GET TOPS-20 PSI CHANNEL
	IFIW	F.RPSI		;20 RETURN TOPS-20 PSI CHANNEL
	IFIW	F.MPG		;21 SET PAGES USED
	IFIW	F.UPG		;22 SET PAGES FREE
	IFIW	F.USD		;23 GET # PAGES USED
	IFIW	F.MAP		;24 GET CORE BITMAP
LDISP==.-FDISP-1		;MAX LEGAL FUNCTION CODE


;HERE IT IS

	FENTRY	(FUNCT)
FUNCT:	PUSHJ	P,SAVAC		;SAVE USER'S ACS
%FUNCX:	SKIPLE	T1,@FN(L)	;GET FUNCTION CODE
	CAILE	T1,LDISP	;LEGAL?
	  SETZ	T1,		;NO, SET TO ILLEGAL FUNCTION
	JRST	@FDISP(T1)	;DISPATCH
;FUNCTION 0:  ILLEGAL
;
;RETURNS STATUS -1 (NOT IMPLEMENTED)


F.ILL:	SETOM	@STATUS(L)	;SET RETURN STATUS TO -1
	POPJ	P,		;AND RETURN





;FUNCTION 1:  GET LOW SEGMENT MEMORY AT GIVEN ADDRESS
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF ALLOCATED OK
;		1 IF INSUFFICIENT MEMORY
;		2 IF ALREADY ALLOCATED AT THAT ADDRESS
;		3 IF ARGUMENT ERROR


F.GAD:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND LENGTH
	  JRST	GADX		;NEGATIVE LENGTH MEANS GET BIG BLOCK
	TLNN	T1,-1		;CHECK FOR REASONABLE ADDRESS
	 JRST	GADOK1		;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
	HLLZ	T3,T1		;[4175] GET THE SECTION NUMBER
	XMOVEI	T4,.		;[4175] GET FOROTS' SECTION NUMBER
	HLLZ	T4,T4		;[4175] 
	CAME	T3,T4		;[4175] THE SAME?
	 JRST	ERR3		;[4175] NO. JUNK CALL
	MOVEI	T1,(T1)		;[4175] YES. JUST GET LOCAL ADDRESS
GADOK1:	ADD	T2,T1		;[4175] COMPUTE END+1 OF REQUESTED CORE
	TLNE	T2,-1		;CHECK END+1 FOR REASONABLE ADDRESS
	 JRST	ERR3		;JUNK CALL, REJECT IT

	DMOVEM	T1,REQBOT	;SAVE BOTTOM, TOP+1 OF REQUEST
	PUSHJ	P,LSGET		;ALLOCATE THE CORE
	  JRST	ERR1		;NOT ENOUGH MEMORY
	  JRST	TRYSYM		;ALREADY ALLOCATED. SEE IF SYMBOL TABLE
	JRST	OKRET		;ALLOCATED


;HERE IF F.GAD CALL FAILS WITH CORE ALREADY ALLOCATED.
;IF THE TOP OF THE CORE REQUEST IS WITHIN THE BOUNDS OF THE
;ORIGINAL SYMBOL TABLE, RECORDED AS ALLOCATED, THE SYMBOL
;TABLE IS INSERTED INTO THE FREE-CORE LIST. IT IS ASSUMED
;THAT THE USER (OR OVRLAY) KNOWS WHAT HE/SHE/IT IS DOING...
TRYSYM:	SKIPN	SYMTP		;ANY OLD SYMBOL TABLE?
	 JRST	ERR2		;NO
	SKIPE	FLLEN		;ANY ENTRIES IN FREE-LIST YET?
	 JRST	INSSYM		;YES. GO INSERT THE SYMTAB ENTRY
	PUSHJ	P,LSINIT	;NO. CREATE A FREE LIST
	AOS	FLLEN		;INCR # ENTRIES
	MOVE	T1,SYMTP	;GET THE SYMBOL TABLE ENTRY
	MOVEM	T1,(P3)		;DROP IT INTO THE FREE LIST
	JRST	GADAGN		;GO TRY AGAIN

INSSYM:	HLRZ	T1,SYMTP	;GET BOTTOM OF OLD SYMBOL TABLE
	HRRZ	T2,SYMTP	;GET TOP+1 OF OLD SYMBOL TABLE
	PUSHJ	P,LSFREE	;PUT THE SYMBOL TABLE IN THE FREE-LIST
	 $SNH			;BETTER BE A FREE-LIST!
GADAGN:	SETZM	SYMTP		;DON'T TRY THIS AGAIN
	DMOVE	T1,REQBOT	;GET THE ORIGINAL CORE REQUEST PARAMS
	PUSHJ	P,LSGET		;TRY TO GET IT
	 JRST	ERR1		;MEMORY FULL
	 JRST	ERR2		;ALREADY ALLOCATED
	JRST	OKRET		;GOT IT!

GADX:	AOJN	T2,ERR3		;ONLY LEGAL NEGATIVE ARG IS -1
	MOVEI	T2,1(T1)	;TRY TO ALLOCATE 1 WORD
	DMOVEM	T1,DTEMP	;SAVE BEG AND END+1 OF BLOCK
	PUSHJ	P,LSGET		;TRY FOR 1 WORD AT GIVEN ADDRESS
	  JRST	ERR1		;NOT ENOUGH MEMORY
	  JRST	TRYSYM		;ALREADY ALLOCATED. TRY FREEING SYMBOLS

	DMOVE	T1,DTEMP	;GET BEG AND END+1 OF THE WORD
	PUSHJ	P,LSFREE	;FREE THE 1 WORD
	 $SNH			;Not allocated, internal error

	MOVE	T1,DTEMP	;GET ADDRESS
	MOVE	T2,BLKSIZ	;AND SIZE, RETURNED BY FIRST LSGET
	MOVEM	T2,@ARG2(L)	;GIVE ALLOCATED LENGTH TO USER
	ADDI	T2,(T1)		;COMPUTE END+1 OF BLOCK
	PUSHJ	P,LSGET		;ALLOCATE MAX SPACE
	  $SNH			;Not enough memory
	  $SNH			;Already allocated

	JRST	OKRET		;ALL OK





;FUNTION 2:  GET LOW SEGMENT MEMORY AT ANY ADDRESS
;
;ARG2:	SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF INSUFFICIENT MEMORY
;		3 IF ARGUMENT ERROR


F.COR:	SKIPLE	T2,@ARG2(L)	;GET SIZE
	TLNE	T2,-1		;CHECK IT
	  JRST	ERR3		;WRONG

	PUSHJ	P,LSFIND	;FIND A SPOT WITH ENOUGH SPACE
	ADD	T2,T1		;COMPUTE END+1 OF CORE TO ALLOCATE
	TLNE	T2,-1		;DID WE GO TO THE NEXT SECTION?
	 JRST	ERR1		;YES. WE CAN'T DO THAT!
	PUSHJ	P,LSGET		;ALLOCATE IT
	 JRST	ERR1		;NOT ENOUGH MEMORY
	  $SNH			;Already allocated, internal error
	MOVEM	T1,@ARG1(L)	;STORE ADDRESS FOR CALLER
	JRST	OKRET		;RETURN




;FUNCTION 3:  RETURN LOW SEGMENT MEMORY
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF MEMORY WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR


F.RAD:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND SIZE
	  JRST	ERR3		;ILLEGAL SIZE
	TLNN	T1,-1		;CHECK ARGS
	 JRST	RADOK1		;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
	HLLZ	T3,T1		;[4175] GET THE SECTION NUMBER
	XMOVEI	T4,.		;[4175] GET FOROTS' SECTION NUMBER
	HLLZ	T4,T4		;[4175] 
	CAME	T3,T4		;[4175] THE SAME?
	 JRST	ERR3		;[4175] NO. JUNK CALL
	MOVEI	T1,(T1)		;[4175] YES. JUST GET LOCAL ADDRESS
RADOK1:	ADD	T2,T1		;[4175] COMPUTE END+1 OF REQUESTED CORE
	TLNE	T2,-1
	  JRST	ERR3		;BAD

	PUSHJ	P,LSFREE	;DEALLOCATE BLOCK
	  JRST	ERR1		;WASN'T ALLOCATED
	JRST	OKRET		;OK, RETURN





;FUNCTION 4:  GET I/O CHANNEL
;
;RETURNS ARG1 = CHANNEL NUMBER
;	 STATUS 0 IF CHANNEL ALLOCATED OK
;		1 IF NO CHANNEL AVAILABLE (OR TOPS-20)


F.GCH:	SETZ	T1,		;REQUEST ANY AVAILABLE CHANNEL
	PUSHJ	P,%ALCHF	;ALLOCATE CHANNEL
	  JRST	ERR1		;NONE AVAILABLE
	MOVEM	T1,@ARG1(L)	;GIVE TO USER
	JRST	OKRET		;OK, RET





;FUNCTION 5:  RETURN I/O CHANNEL
;
;ARG1:	CHANNEL NUMBER
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF CHANNEL WASN'T ALLOCATED


F.RCH:	MOVE	T1,@ARG1(L)	;GET CHANNEL NUMBER
	TDNN	T1,[-20]	;ERROR IF ARG NOT IN 0-17
	PUSHJ	P,%DECHF	;FREE THE CHANNEL
	  JRST	ERR1		;WASN'T ALLOCATED
	JRST	OKRET		;OK




;FUNCTION 6:  GET MEMORY FROM OTS LIST
;
;ARG2:	SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF NOT ENOUGH MEMORY
;		3 IF ARGUMENT ERROR


F.GOT:	SKIPLE	T1,@ARG2(L)	;GET SIZE
	TLNE	T1,-1		;CHECK FOR LEGALITY
	  JRST	ERR3		;BAD ARG
	PUSHJ	P,GTBLKX	;GET IT
	  JRST	ERR1		;NOT ENOUGH MEMORY
	MOVEM	T1,@ARG1(L)	;TELL USER THE ADDRESS
	MOVE	T2,-1(P)	;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	JRST	OKRET		;OK





;FUNTION 7:  RETURN MEMORY TO OTS LIST
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR


F.ROT:	SKIPLE	T1,@ARG1(L)	;GET ADDRESS
	TLNN	T1,-1		;[4175] CHECK
	 JRST	ROTOK1		;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
	HLLZ	T3,T1		;[4175] GET THE SECTION NUMBER
	XMOVEI	T4,.		;[4175] GET FOROTS' SECTION NUMBER
	HLLZ	T4,T4		;[4175] 
	CAME	T3,T4		;[4175] THE SAME?
	 JRST	ERR3		;[4175] NO. JUNK CALL
	MOVEI	T1,(T1)		;[4175] YES. JUST GET LOCAL ADDRESS
ROTOK1:	PUSHJ	P,%FREBLK	;FREE BLOCK
	JRST	OKRET		;OK





;FUNCTION 10:  GET PROGRAM INITIAL RUNTIME
;
;RETURNS ARG1 = JOB (FORK) RUNTIME WHEN PROGRAM STARTED, IN MILLISECONDS
;	 STATUS 0, ALWAYS


F.RNT:	MOVE	T1,I.RUNTM	;GET RUNTIME
	MOVEM	T1,@ARG1(L)	;RETURN IT TO USER
	JRST	OKRET		;RETURN





;FUNCTION 11:  GET RUN FILESPEC (TOPS-10 ONLY)
;
;RETURNS ARG1 = DEVICE, SIXBIT
;	 ARG2 = FILENAME, SIXBIT
;	 ARG3 = PPN
;	 STATUS 0, ALWAYS


IF20,<
F.IFS==F.ILL			;NO RUNTIME FILESPEC AVAILABLE ON 20
>

IF10,<
F.IFS:	MOVE	T1,I.DEV	;GET DEVICE
	MOVEM	T1,@ARG1(L)
	MOVE	T1,I.FILE	;AND FILENAME
	MOVEM	T1,@ARG2(L)
	MOVE	T1,I.PPN	;AND PPN
	MOVEM	T1,@ARG3(L)
	JRST	OKRET		;OK, RET
>





;FUNCTION 12:  CUT BACK CORE TO MINIMUM
;
;[2052] Returns status 0 always, with low seg and OTS core shrunk if possible


F.CBC:	PUSHJ	P,LSTRIM	;TRIM LS SIZE, IF POSSIBLE
	PUSHJ	P,PGTRIM	;[2052] Trim OTS core size if possible
	JRST	OKRET		;RETURN OK ALWAYS





;FUNCTIONS 13-14:  READ AND WRITE RETAIN STATUS (RESERVED FOR DBMS)
;
;RETURNS ARG1 = 0
;	 STATUS 0, ALWAYS


F.RRS:
F.WRS:	SETZM	@ARG1(L)	;SET ARG TO ZERO
	JRST	OKRET		;OK RETURN





;FUNCTION 15:  GET PAGES
;
;ARG2:	SIZE TO BE ALLOCATED, WORDS
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY, ON PAGE BOUNDARY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF NOT ENOUGH MEMORY
;		3 IF ARGUMENT ERROR

F.GPG:	SKIPG	T1,@ARG2(L)	;GET SIZE
	  JRST	ERR3		;BAD ARG
	ADDI	T1,777		;ROUND UP TO NUMBER OF PAGES
	LSH	T1,-9		;CONVERT WORDS TO PAGES
	TDNE	T1,[777777777000] ;CHECK
	  JRST	ERR3		;BAD ARG
	PUSHJ	P,%GTPGS	;ALLOCATE SOME PAGES
	  JRST	ERR1		;NOT ENOUGH MEMORY
	LSH	T1,9		;CONVERT PAGE NUMBER TO WORD ADDRESS
	MOVEM	T1,@ARG1(L)	;GIVE TO CALLER
	JRST	OKRET		;OK





;FUNCTION 16:  RETURN PAGES
;
;ARG1:	ADDRESS (WORD)
;ARG2:	SIZE (WORDS)
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR

F.RPG:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND SIZE
	  JRST	ERR3		;BAD SIZE, ERROR
	ADDI	T2,777		;ROUND SIZE UP TO MULTIPLE OF 1 PAGE
	LSH	T1,-9		;CONVERT ADDRESS TO PAGE
	LSH	T2,-9		;CONVERT SIZE
	TDNN	T1,[777777777000] ;RANGE CHECK
	TDNE	T2,[777777777000]
	  JRST	ERR3		;BAD
	PUSHJ	P,%FREPGS	;FREE THE PAGES
	JRST	OKRET		;OK



;FUNCTION 17:  GET TOPS-20 PSI CHANNEL
;
;ARG1:	CHANNEL NUMBER, OR -1 TO ALLOCATE ANY USER-ASSIGNABLE CHANNEL
;ARG2:	LEVEL NUMBER
;ARG3:	ADDRESS OF INTERRUPT ROUTINE
;
;RETURNS ARG1 = CHANNEL NUMBER ALLOCATED (IF -1 WAS SENT)
;	 STATUS 0 IF OK
;		1 IF CHANNEL WAS ALREADY ASSIGNED
;	 	2 IF NO FREE CHANNELS
;		3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT WILL ARRANGE THAT THE TABLES EXIST AND THAT SIR AND EIR HAVE BEEN DONE
;BUT DOES NOT DO AIC OR ANY OTHER JSYS NECESSARY TO SET UP THE CHANNEL (ATI
;OR MTOPR, FOR EXAMPLE). IF FOROTS WAS THE PREVIOUS OWNER OF
;THE CHANNEL (BY EVIDENCE OF THE %FCHTB ENTRY BEING IDENTICAL
;TO THE %CHNTAB ENTRY), IT IS NOT CONSIDERED AN ERROR CONDITION.

F.GPSI:	SKIPL	T1,@ARG1(L)	;GET CHANNEL NUMBER
	  JRST	GPSI1
	PUSHJ	P,GETPSI	;ALLOCATE A USER-ASSIGNABLE PSI CHANNEL
	  JRST	ERR2		;CAN'T
GPSI1:	CAIL	T1,^D36		;IN RANGE?
	  JRST	ERR3		;NO, BAD ARG
	SKIPN	T2,%CHNTAB(T1)	;[3211] CHANNEL IN USE?
	 JRST	GPNIU		;NO. OK
	CAME	T2,%FCHTB(T1)	;WAS FOROTS USING IT?
	 JRST	ERR1		;NO. GENUINE ERROR
GPNIU:	SKIPLE	T2,@ARG2(L)	;GET PSI LEVEL
	CAILE	T2,3		;RANGE CHECK
	  JRST	ERR3		;BAD
	MOVE	T3,@ARG3(L)	;GET ADDRESS
	MOVEI	T4,-1		;ASSUME ADDRESS MUST FIT IN 18 BITS
	SKIPE	I.XSIR		;XSIR FORMAT TABLES?
	  MOVEI	T4,770000	;YES, ADDRESS MUST FIT IN 30 BITS
	TLNE	T3,(T4)		;DOES ADDRESS FIT?
	  JRST	ERR3		;DOESN'T, BAD ARGUMENT

	MOVEM	T1,@ARG1(L)	;RETURN CHANNEL TO USER
	MOVEM	T3,%CHNTAB(T1)	;STORE LEVEL AND ADDRESS IN TABLE
	SKIPN	I.XSIR		;SIR FORMAT?
	  HRLM	T2,%CHNTAB(T1)	;YES
	SKIPE	I.XSIR		;XSIR FORMAT?
	  DPB	T2,[POINT 6,%CHNTAB(T1),5] ;YES

	JRST	OKRET		;OK



;FUNCTION 20:  RETURN TOPS-20 PSI CHANNEL
;
;ARG1:	CHANNEL NUMBER
;
;RETURNS STATUS 0 IF OK
;		1 IF CHANNEL WASN'T IN USE
;		3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT DOES NOT DO DIC OR ANY OTHER JSYS NECESSARY TO RELEASE A CHANNEL,
;IT JUST CLEARS THE LEVEL AND INTERRUPT ADDRESS FIELDS IN CHNTAB.

F.RPSI:	SKIPL	T1,@ARG1(L)	;GET ARG
	CAIL	T1,^D36		;RANGE CHECK
	  JRST	ERR3		;BAD
	SKIPN	%CHNTAB(T1)	;CHANNEL IN USE?
	  JRST	ERR1		;NO
	SETZM	%CHNTAB(T1)	;MARK CHANNEL FREE
	JRST	OKRET		;OK


;ROUTINE TO FIND A FREE PSI CHANNEL
;RETURNS T1 = CHANNEL NUMBER, IN 0:5 OR 23:35, THE USER-ASSIGNABLE CHANNELS

GETPSI:	MOVSI	T1,-6		;TRY 0-5 FIRST
	PUSHJ	P,GPSIX
	  JRST	%POPJ1		;WON, RETURN
	MOVE	T1,[-^D13,,^D23] ;NOW 23-35
	PUSHJ	P,GPSIX
	  JRST	%POPJ1		;SUCCEED
	POPJ	P,		;FAIL

GPSIX:	SKIPE	%CHNTAB(T1)	;TRY ONE
	  AOBJN	T1,.-1
	JUMPGE	T1,%POPJ1	;IF WE RAN OUT, FAILURE RETURN
	MOVEI	T1,(T1)		;CLEAR COUNT OUT OF LH
	POPJ	P,		;SUCCESS RETURN


;FUNCTION 21: MARK PAGES USED IN BITMAP
;
;ARG1: 1ST PAGE NUMBER, IN RANGE [0:777]
;ARG2: NUMBER OF PAGES, IN RANGE [1:777]
;(ALSO, ARG1+ARG2 MUST BE IN RANGE[1:1000])
;
;RETURNS STATUS 0 IF OK
;		1 IF ONE OR MORE PAGES ALREADY MARKED ALLOCATED
;		3 IF ARGUMENT ERROR
;
F.MPG:	PUSHJ	P,CHKPGA	;CHECK PAGE ARGS
	 JRST	ERR3		;[3211] Invalid args, punt
	PUSHJ	P,%MRKPG	;MARK THE PAGES USED
	 JRST	ERR1		;AT LEAST ONE PAGE ALREADY IN USE
	JRST	OKRET		;MARKED

;FUNCTION 22: MARK PAGES FREE IN BITMAP
;
;ARG1: 1ST PAGE NUMBER, IN RANGE [0:777]
;ARG2: NUMBER OF PAGES, IN RANGE [1:777]
;(ALSO, ARG1+ARG2 MUST BE IN RANGE[1:1000])
;
;RETURNS STATUS 0 IF OK
;		1 IF ONE OR MORE PAGES ALREADY MARKED FREE
;		3 IF ARGUMENT ERROR
;

F.UPG:	PUSHJ	P,CHKPGA	;CHECK PAGE ARGUMENTS
	 JRST	ERR3		;[3211] Invalid args, punt
	PUSHJ	P,%UMKPG	;MARK PAGES FREE
	 JRST	ERR1		;AT LEAST ONE WAS ALREADY FREE
	JRST	OKRET		;ALL MARKED FREE


CHKPGA:	SKIPL	T1,@ARG1(L)	;[3211] GET PAGE #
	 CAILE	T1,777		;[3211] MUST BE A LOCAL PAGE ADDR
	  POPJ	P,		;[3211] BAD CALL
	SKIPG	T2,@ARG2(L)	;[3224] GET # PAGES
	 POPJ	P,		;[3211] BAD CALL
	MOVE	T3,T1		;CHECK TOTAL
	ADD	T3,T2		;[3211] COMPUTE TOP+1
	CAILE	T3,1000		;[3211] TOP PAGE+1 MUST BE IN RANGE [1:1000]
	 POPJ	P,		;[3211] BAD CALL
	JRST	%POPJ1		;[3211] All OK, give skip return

;FUNCTION 23 - RETURN USED CORE INFO - NOT IMPLEMENTED
;RETURNS STATUS 3 FOR NOW
F.USD:	JRST	ERR3

;FUNCTION 24 - RETURN MEMORY BITMAP - NOT IMPLEMENTED
;RETURNS STATUS 3 FOR NOW
F.MAP:	JRST	ERR3

;EXIT ROUTINES


OKRET:	SETZM	@STATUS(L)	;NORMAL RETURN
	POPJ	P,

ERR1:	MOVEI	T1,1		;ERROR RETURN 1
	MOVEM	T1,@STATUS(L)
	POPJ	P,

ERR2:	MOVEI	T1,2		;ERROR RETURN 2
	MOVEM	T1,@STATUS(L)
	POPJ	P,

ERR3:	MOVEI	T1,3		;ERROR RETURN 3
	MOVEM	T1,@STATUS(L)
	POPJ	P,


	SEGMENT	DATA

DTEMP:	BLOCK	2		;TEMP DOUBLEWORD

	SEGMENT	CODE

	END