;<134-TENEX>FREE.MAC;2     4-Nov-76 06:47:13    EDIT BY LYNCH
; FIXED LONG STANDING BUG IN ASGJFR
;<134-TENEX>FREE.MAC;39    28-APR-75 12:14:22    EDIT BY CLEMENTS
;<134-TENEX>FREE.MAC;38    28-APR-75 11:32:15    EDIT BY CLEMENTS
;<134-TENEX>FREE.MAC;37    24-APR-75 14:15:03    EDIT BY CLEMENTS
;<TENEX-132>FREE.REL;36    13-FEB-73 18:57:03	EDIT BY CLEMENTS
; ADDED JBCLCK IN ASGPAG
;<TENEX-130>FREE.MAC;35    21-NOV-72  7:26:46	EDIT BY WALLACE
;<TENEX-130>FREE.MAC;34    21-NOV-72  7:14:26	EDIT BY WALLACE
;<DLM/TEMP>FREE.MAC;33    28-SEP-72 14:51:38	EDIT BY TOMLINSON
;<DLM/TEMP>FREE.MAC;32    28-SEP-72 14:20:45	EDIT BY TOMLINSON
; Relfre returns biggest block found if failure
;<FILESYSTEM>FREE.MAC;31    29-JUN-72  9:56:22	EDIT BY TOMLINSON

	SEARCH	MONSYM,MACSYM
	SEARCH	STENEX,PROLOG
	TITLE	FREE	; Storage routines
	SUBTTL	R.s.tomlinson

EXTERN	BHC
EXTERN	HSHLUK,MAPDIR,RESAC,SAVAC,SKPRET,USTDIR,XPAND0
EXTERN	BUGCHK,BUGHLT,MSTKOV

	USE	SWAPPC

; Assign space in free storage region
; Call:	RH(A)		; Location of free storage header
;	LH(A)		; Index field for references to a and pointers
;			; I.e. @a references first word of header
;	B		; Size of block needed
;	PUSHJ P,ASGFRE
; Return
;	+1	; Not enough space
;	+2	; Ok, in a, the location of the block (absolute)
; Clobbers a,b,c,d
; Calling routine must take measures to prevent loss of free storage
; Space by inhibiting psi's until the space assigned
; Has been accounted for
; Free storage header format is:
;	0	; Lh points to first free block
;	1	; Lock
;	2	; Space counter
;	3	; Most common block size
;	4	; Lh has max top of free storage
		; Rh has min bottom
;	5	; Temp 2
;	6	; Temp 3

ASGFRE::MOVEI C,@A		; Get origin of header
	CAMLE B,2(C)		; Any possibility of success?
	POPJ P,			; No. return immediately
	LOCK 1(C)		; Lock this free storage list
	PUSH P,B		; Save desired block size
	PUSH P,[0]		; BIGEST BLOCK SEEN SO FAR
	MOVEI B,377777
	MOVEM B,5(C)		; Initial best block size
	SETZM 6(C)		; Initial location of best block
	MOVE B,A		; Start with the header word
	HLLZ C,A		; Initialize index field
	MOVEI A,@A
ASGFR1:	HLR C,@B		; Get pointer to next block
	TRNN C,777777
	JRST ASGFR2		; No more free blocks to examine
	HRRZ D,@C		; Get size of the block
	CAMLE D,0(P)
	 MOVEM D,0(P)
	CAMN D,-1(P)		; Is it the right size?
	JRST ASGFR3		; Just right use it
	CAML D,-1(P)		; Too small
	CAML D,5(A)		; Or bigger than best?
	JRST ASGFR4		; Yes, ignore it
	MOVEM D,5(A)		; This one is better
	MOVEM B,6(A)
ASGFR4:	MOVE B,C		; Step to next block
	JRST ASGFR1		; And repeat

ASGFR2:	SKIPN B,6(A)		; Did we find anything?
	JRST [	UNLOCK 1(A)	; No. unlock and return
		POP P,B		; Make transparent to b on error
		POP P,B		; REALLY RESTORE B!
		POPJ P,]
	MOVE D,-1(P)		; Get desired size
	HLR C,@B		; Get pointer to block to be used
	HRRM D,@C		; Convert to desired size
	ADD D,C			; Pointer remainder of block
	HRLM D,@B		; Point prev to remainder
	HLLZ B,@C		; Get next
	HLLM B,@D		; Point remainder to it
	MOVE B,5(A)
	SUB B,-1(P)		; Size of remainder
	HRRM B,@D		; To header of remainder
ASGFR5:	SUB P,BHC+1
	MOVN B,0(P)
	ADDM B,2(A)		; Reduce count of space left
	UNLOCK 1(A)
	MOVEI A,@C		; Get origin of block
	HRROS (A)		; Set lh to ones
	HRRZ B,(A)		; Get rh
	HRRZI C,2(A)
	HRLI C,1(A)
	ADD B,A
	HRRZS B
	SETZM -1(C)
	CAIGE B,(C)
	BLT C,-1(B)		; Zero the block
	POP P,B
	AOS (P)
	POPJ P,

ASGFR3:	HLL D,@C
	HLLM D,@B		; Point predecessor to successor
	JRST ASGFR5

; Release free storage block
; Call:	A		; Location of free storage header (like asgfre)
;	B		; Location of the block to be returned
;	PUSHJ P,RELFRE
; Clobbers b,c,d

RELFRE::HLLZ C,A
	SUBI B,@C
	HLL B,A
	PUSH P,A
	MOVEI A,@A
	LOCK 1(A)
	HRRZ D,0(A)
	JUMPE D,RELFR0		; Jump if old style free block
	HLRZ D,4(A)
	HRRZ A,4(A)
	CAILE D,0(B)
	CAILE A,0(B)
	 JRST RELFRA
	MOVEI A,@0(P)
	JRST RELFR0
RELFRA:	BUG(CHK,<RELFRE: BLOCK RAN OUT OF RANGE>)
	MOVEI A,@0(P)
	UNLOCK 1(A)
	POP P,A
	POPJ P,
RELFR0:	PUSH P,B
	MOVE B,-1(P)
RELFR1:	HLR C,@B		; Get loc of next block
	TRNN C,777777
	JRST RELFR2		; End of list
	CAML C,0(P)
	JRST RELFR2		; Or above block being returned
	MOVE B,C
	JRST RELFR1

RELFR2:	CAME C,0(P)		; Releasing a block already released?
	JRST RELFRB
	UNLOCK(<1(A)>)
	BUG(CHK,<RELFRE: BLOCK ALREADY RELEASED.>)
	POP P,B
	POP P,A
	POPJ P,
RELFRB:	HRRZ D,@0(P)
	ADDM D,2(A)		; Augment count of remaining storage
	ADD D,0(P)		; Get end of block being returned
	CAME D,C		; Same as following block location?
	JRST RELFR3		; No
	HRRZ D,@C		; Get length of following block
	ADDM D,@0(P)		; Augment length of block being returned
	HLLZ D,@C		; Get loc of successor of successor
	HLLM D,@0(P)
RELFR5:	MOVE C,0(P)
	HRLM C,@B
	HRRZ D,@B		; Length of predecessor
	ADD D,B			; End of predecessor
	CAME D,C		; Same as new block
	JRST RELFR4		; No, done
	MOVE C,@C
	HLLM C,@B
	HRRZS C
	ADDM C,@B
RELFR4:	UNLOCK 1(A)
	POP P,B
	POP P,A
	POPJ P,

RELFR3:	HRLM C,@0(P)		; Point returned block to successor
	JRST RELFR5

; Assign a page in job area
; Call:	PUSHJ P,ASGPAG
; Return
;	+1	; None available
;	+2	; Success
;	A	; Address of origin of page

ASGPAG::LOCK(JBCLCK)		;LOCK THE PAGE ASSIGNMENT
	MOVSI C,-4		; Four words of bits
ASGPG1:	MOVE A,JBCOR(C)
	JFFO A,ASGPG2		; Any bits?
	AOBJN C,ASGPG1		; No, try next word
	UNLOCK(JBCLCK)
	POPJ P,			; No words left

ASGPG2:	MOVN B,A+1
	MOVSI A,400000
	ROT A,(B)
	ANDCAM A,JBCOR(C)		; Mark as used
	UNLOCK(JBCLCK)
	MOVEI A,(C)
	IMULI A,^D36
	SUB A,B
	LSH A,9
	ADDI A,PJMA		; Origin of job mapped area
	JRST SKPRET

; Return page
; Call:	A	; Location of page
;	PUSHJ P,RELPAG

RELPAG::SUBI A,PJMA
	LSH A,-9
	IDIVI A,^D36
	MOVSI C,400000
	MOVNS A+1
	ROT C,(A+1)
	IORM C,JBCOR(A)	; Clear the bit
	POPJ P,

; Assign free storage in directory
; Call:	B	; Size of block needed
;	PUSHJ P,ASGDFR
; Return
;	+1	; Not enough room
;	+2	; Ok, in a, the location of the block
; Clobbers a,b,c,d

ASGDFR::MOVE A,[XWD E,DIRFRE-DIRORG]
	PUSH P,E
	MOVEI E,DIRORG
	PUSHJ P,ASGFRE
	JRST ASGDF1		; No room, try garbage collection
ASGDF3:	AOS -1(P)
ASGDF2:	POP P,E
	POPJ P,

ASGDF1:	PUSHJ P,GCDIR
	MOVE A,[XWD E,DIRFRE-DIRORG]
	PUSHJ P,ASGFRE
	JRST ASGDF4		; Still no room
	JRST ASGDF3		; Now ok

ASGDF4:	MOVE A,FRETOP
	SUB A,DIRFRE+2
	ADDI A,2(B)		; Where fretop must be if moved up +
	PUSH P,B		; Save b
	CAMG A,SYMBOT		; Will this overlap symtab?
	 JRST ASGDF5		; No
	PUSHJ P,XPAND0		; Move symtab up
	 JRST [	POP P,B
		JRST ASGDF2]	; Fail
	SKIPA A,[-10]		; Space to leave for symtab after xpand
ASGDF5:	MOVNI A,2		; Space to leave if no xpand
	ADD A,SYMBOT		; Target fretop
	MOVE B,FRETOP
	HRLM A,DIRFRE+4
	MOVEM A,FRETOP		; New fretop
	SUB A,B			; Length of additional storage
	MOVEM A,DIRORG(B)	; Make block header
	MOVEI B,DIRORG(B)	; Convert to absolute
	PUSHJ P,RELDFR		; Let reldfr put back the storage
	POP P,B
	MOVE A,[XWD E,DIRFRE-DIRORG]
	PUSHJ P,ASGFRE
	JRST ASGDF2
	JRST ASGDF3

; Release free storage in directory
; Call:	B	; Location of the block to be released
;	PUSHJ P,RELDFR
; Returns +1 always
; Clobbers a,b,c,d

RELDFR::MOVE A,[XWD E,DIRFRE-DIRORG]
	PUSH P,E
	MOVEI E,DIRORG
	PUSHJ P,RELFRE
	POP P,E
	POPJ P,

; Assign job storage
; Call:	B	; Size of block needed
;	PUSHJ P,ASGJFR
; Return
;	+1	; Not enough room
;	+2	; Success. location of block in b

ASGJFR::MOVEI A,JSBFRE
	PUSHJ P,ASGFRE		; Attempt to assign
	 JRST ASGJF1		; Not enough
	AOS (P)			; Success
	POPJ P,

ASGJF1:	PUSH P,B
	PUSH P,C
	PUSHJ P,ASGPAG		; Get another page of job storage
	 JRST ASGJF2		; No pages left
	MOVEI B,1000
	HRROM B,(A)		; Make a free block out of it
	MOVEI B,1000(A)
	HLRZ C,4+JSBFRE
	CAMGE C,B
	 HRLM B,4+JSBFRE
	MOVE B,A
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE		; Release the new block
	POP P,C
	POP P,B
	JRST ASGJFR		; Try again

ASGJF2:	POP P,C
	POP P,B
	POPJ P,			; Fail

; Garbage collect a directory
; Call:	PUSHJ P,GCDIR
; Transparent

EXTERN	BITS

GCDIR::	PUSHJ P,SAVAC		; Sav ac's
	ADD P,[XWD 5,5]		; Make room for temps on stack
	JUMPGE P,MSTKOV
	PUSHJ P,ASGPAG		; Get a page for bit table
	 BUG(HLT,<GCDIR: NO FREE PAGE FOR BIT TABLE>)
	HRLI A,A		; Index by a
	MOVEM A,0(P)		; Used to reference bit table
	HRLZ B,A
	HRRI B,1(A)		; Prepare blt pointer
	SETZM 0(A)
	BLT B,777(A)		; And zero page
	JSP D,GCSCAN		; Initialize scanner
GCDI0:	JSP D,0(D)		; Co-routine jump
	 JRST GCDI2		; No more
	 JRST GCDI0		; Pointer only
	CAMGE E,FRETOP
	CAIGE E,DIFREE-DIRORG
	 JRST GCDI0		; Not pointer to dynamic area
	HRRZ A,DIRORG(E)	; Get length of block
	ADDI A,-1(E)		; Last word of block
	IDIVI A,^D36		; Separate bit and word
	MOVEM A,-1(P)		; Save word number
	MOVN C,BITS(B)		; Mask of bits up to and including last
	MOVE A,E
	IDIVI A,^D36		; Separate first word into bit and word
	MOVE B,BITS(B)		; Get bit for beginning of block
	LSH B,1			; Bit to left of desired bits
	SOS B			; Gives bits to right
GCDI1:	CAMN A,-1(P)		; Last word of bits?
	 AND B,C		; Yes, reduce bits
	IORM B,@0(P)		; Or into bit word
	CAMN A,-1(P)		; Done?
	 JRST GCDI0		; Yes, next block
	SETO B,			; All ones for next word
	AOJA A,GCDI1		; No

; Bit table is now formed, prepare for compaction

GCDI2:	MOVE A,FRETOP
	ADDI A,^D35
	IDIVI A,^D36		; End of bit table
	MOVEM A,-1(P)
	MOVEI A,DIFREE-DIRORG
	MOVEM A,-2(P)		; Current top of compacted storage
	SOS A			; Start scanning below good stuff
	MOVEM A,-3(P)		; In order to not miss anything
GCDI3:	MOVE A,-3(P)		; Get current loc
	IDIVI A,^D36		; Separate
	MOVN B,BITS(B)		; Get mask of ones to ignore
GCDI4:	ANDCA B,@0(P)		; Get ones in bit table
	JFFO B,GCDI5		; Find first one and jump
	CAMGE A,-1(P)		; No ones. end check
	 AOJA A,GCDI4		; Not end, try next.  note b has 0
	MOVE A,-2(P)		; Top of compacted storage
	MOVE B,FRETOP		; Top of dynamic area
	SUB B,A			; Recompute length of free area
	MOVEM B,DIRFRE+2
	JUMPE B,[HRRZS DIRFRE	; Empty free list
		JRST GCDID]
	MOVEM B,DIRORG(A)
	HRLM A,DIRFRE
GCDID:	HRRZ A,0(P)		; Page address
	PUSHJ P,RELPAG		; Release
	SUB P,[XWD 5,5]		; Flush stack
	PUSHJ P,RESAC		; Restore ac's
	POPJ P,

; Found a one, now look for a zero

GCDI5:	MOVN B,BITS(B+1)	; Get mask of bits to left inc first 1
	MOVEM B+1,-4(P)
	MOVE C,A
	IMULI C,^D36
	ADDM C,-4(P)		; Location of first good word
GCDI6:	ANDCB B,@0(P)		; Get zeros, ignore those to left
	JFFO B,GCDI7		; Find "zeroes"
	CAMGE A,-1(P)
	 AOJA A,GCDI6		; Try next word, note b=0
	MOVEI B+1,^D36
GCDI7:	IMULI A,^D36
	ADD A,B+1
	MOVEM A,-3(P)		; New bottom of garbage
	MOVE B,-2(P)		; Get "to"
	CAMN B,-4(P)		; Equals "from"?
	 JRST GCDI9		; Move not needed
	HRL B,-4(P)		; And "from"
	ADD B,[XWD DIRORG,DIRORG]
	SUB A,-4(P)		; Length of block
	ADDI A,(B)		; Compute end address
	BLT B,-1(A)		; Blt it

; State now is:
;	-2(P)	; Top of previous compact storage
;	-3(P)	; End of good block+1
;	-4(P)	; Beg of good block

	JSP D,GCSCAN		; Set up scan
GCDI8:	JSP D,0(D)		; Get a pointer
	 JRST GCDI9		; Done
	 JFCL
	CAMGE E,-3(P)		; Beyond end
	CAMGE E,-4(P)		; Or before beg
	 JRST GCDI8		; Needs no adjustment
	ADD E,-2(P)		; Adjust by new bottom
	SUB E,-4(P)		; Minus old bottom
	JRST GCDI8

GCDI9:	MOVE A,-3(P)		; End
	SUB A,-4(P)		; Minus beg = length
	ADDM A,-2(P)		; New top of compacted storage
	JRST GCDI3		; Loop to find next good block

; The gc scanner
; This routine knows where all the good things are
; And operates as a coroutine with the garbage collector
; Started up with
;	JSP D,GCSCAN
; For each datum,
;	JSP D,(D)
; Returns
;	+1	; Nothing left
;	+2	; Possible pointer for updating
;	+3	; Pointer to good stuff to be retained
; Uses f,num,dev
; Returns datum in e

GCSCAN:	MOVE NUM,SYMBOT		; Start with first symbol table entry
	JSP D,(D)
GCSCN1:	CAML NUM,SYMTOP		; Entire table scanned?
	JRST GCSCN4		; Yes. no skip return
	HLRZ E,DIRORG(NUM)	; Get pointer to string
	JSP D,2(D)
	HRLM E,DIRORG(NUM)	; Put back updated pointer
	HRRZ E,DIRORG(NUM)	; Get pointer to data block
	SKIPG DIRNUM
	JRST GCSCN5
	TRZE E,700000
	 AOJA NUM,GCSCN1	; No blocks for current uses of rh
	JSP D,2(D)
	HRRM E,DIRORG(NUM)
GCSCN3:	MOVE DEV,E		; Save root of fdb's
GCSCN2:	MOVE F,E		; Point to current fdb
	HRRZ E,FDBCTL+DIRORG(F)	; Pointer to name
	JSP D,2(D)
	HRRM E,FDBCTL+DIRORG(F)
	HLRZ E,FDBEXT+DIRORG(F)
	JSP D,2(D)
	HRLM E,FDBEXT+DIRORG(F)
	MOVE E,FDBACT+DIRORG(F)
	TLNN E,777777
	JSP D,2(D)
	MOVEM E,FDBACT+DIRORG(F)
	HRRZ E,FDBVER+DIRORG(F)	; Pointer to next version
	JSP D,2(D)
	HRRM E,FDBVER+DIRORG(F)	; Update
	JUMPN E,GCSCN2		; Scan all versions
	HRRZ E,FDBEXT+DIRORG(DEV)
	JSP D,2(D)		; Update
	HRRM E,FDBEXT+DIRORG(DEV)
	JUMPN E,GCSCN3		; Scan all extensions
	AOJA NUM,GCSCN1		; Scan all of the symtab

GCSCN4:	HRRZ E,DIRSAV
	JSP D,2(D)
	MOVEI E,-DIRORG(E)
	JSP D,2(D)
	MOVEI E,DIRORG(E)
	HRRM E,DIRSAV
	HRRZ E,DIRSCN
	JSP D,1(D)
	MOVEI E,-DIRORG(E)
	JSP D,1(D)
	MOVEI E,DIRORG(E)
	HRRM E,DIRSCN
	HRRZ E,DIRLOC
	JSP D,1(D)
	MOVEI E,-DIRORG(E)
	JSP D,1(D)
	MOVEI E,DIRORG(E)
	HRRM E,DIRLOC
	JRST (D)

; Subindex scanner

GCSCN5:	MOVE DEV,E		; Remember directory number
	SETZB E,F		; Zero mask and value
	PUSHJ P,CHGHSH		; Update hash entry bits masked 1
	JSP D,2(D)		; Return pointer
	MOVSI F,7777
	PUSHJ P,CHGHSH		; This really updates it
	MOVE DEV,E		; Remember pointer to ddb
	HLRZ E,DIRORG+DDBNAM(DEV)	; Pointer to password
	JSP D,2(D)
	HRLM E,DIRORG+DDBNAM(DEV)
	HRRZ E,DIRORG+DDBNAM(DEV)	; Pointer to name
	JSP D,2(D)
	HRRM E,DIRORG+DDBNAM(DEV)
	AOJA NUM,GCSCN1

CHGHSH:	PUSH P,A		; Save temps
	PUSH P,B
	PUSH P,C
	PUSH P,DIRNUM		; Remember where to come back to
	MOVE A,DEV		; Get directory number to look up
	PUSHJ P,HSHLUK
	 BUG(HLT,<GCSCAN: HASH TABLE FOULED UP>)
	HRLZS E
	XOR E,DIRORG(B)		; Get difference
	AND E,F			; Retain bits to change
	XORB E,DIRORG(B)	; Change bits, keep result
	HLRZS E
	ANDI E,7777
	PUSHJ P,USTDIR
	POP P,A
	PUSHJ P,MAPDIR		; Return to proper subindex
	POP P,C			; Restore temps
	POP P,B
	POP P,A
	POPJ P,

IFN 0,<
; Put item onto deallocation list
; Call:	LH(A)	; Routine to call to deallocate the item
;	RH(A)	; Item identifier (address usually)
;	PUSHJ P,PUTITM
; Items put on the deallocation are automatically deallocated whenever
; A psi occurs and the user's program changes the pc such that
; The monitor routine in progress does not complete

PUTITM::PUSH P,B		; Free up some ac's
	PUSH P,A
PUTIT0:	MOVE A,INTLVL		; Get current interrupt level
	SKIPE B,ITMHD(A)	; Get the correct item list header
	JRST PUTIT1
	PUSH P,A		; No header, create one
	MOVEI A,PSBFRE
	MOVEI B,6
	PUSHJ P,ASGPAG		; Assign a block of psb free storage
	JSR BUGHLT
	POP P,B
	MOVEM A,ITMHD(B)	; Point the header to the block
	HRLI A,1(B)
	HRRI A,2(B)
	SETZM 1(B)
	BLT A,6(B)		; Clear the block
PUTIT1:	HRLI B,5
	AOS B			; Make aobjn pointer
PUTIT2:	SKIPN (B)		; Search for an empty slot
	JRST PUTIT3		; Found
	AOBJN B,PUTIT2
	MOVE B,INTLVL		; No empty slots
	MOVEI A,0
	EXCH A,ITMHD(B)		; Clear header, get old header
	HRLI A,RELITB		; Make into an item word
	PUSHJ P,PUTITM		; Call self, making first thing on
	JRST PUTIT0		; New block the old block. try again

PUTIT3:	POP P,A
	MOVEM A,(B)
	POP P,B
	POPJ P,

; Release all items on interrupt level specified in a
; Call:	A	; Interrupt level
;	PUSHJ P,RELITM

RELITM::PUSH P,ITMHD(A)
	SETZM ITMHD(A)
	POP P,A
	JUMPN A,RELITB
	POPJ P,

RELITB:	PUSH P,A
	PUSH P,B
	HRLI A,-5
	AOS A
RELIT1:	SKIPN B,(A)
	JRST RELIT2
	PUSH P,A
	HRRZ A,B
	HRLZS B
	PUSHJ P,(B)
	POP P,A
RELIT2:	AOBJN A,RELIT1
	MOVE B,-1(P)
	MOVEI A,PSBFRE
	PUSHJ P,RELFRE
	POP P,B
	POP P,A
	POPJ P,
>

;STORAGE FOR RESIDENT FREE SPACE POOL

	.RESP1==:0		;HIGHEST PRIORITY, ALWAYS TRY TO ASSIGN SPACE
				;NO PAGE FAULTS ALLOWED
	.RESP2==:1		;SECOND LEVEL, NO PAGE FAULTS ALLOWED
				;BUT DONT ASSIGN SPACE IF BELOW RESMIN
	.RESP3==:2		;PROCESS CONTEXT. PAGE FAULTS ALLOWED.
				;LOCK DOWN MORE SPACE IF NECESSARY

	.RESGP==:0		;GENERAL RESIDENT FREE SPACE POOL
	.RESTP==:1		;TERMINAL POOL
	.RESNP==:2		;NETWORK POOL
	.RSTMP==:3		; TIMER pool
	RESQTL==:4		;NUMBER OF POOLS OF RESIDENT FREE SPACE

	.RESGQ==:0		;GENERAL QUOTA - USED BY PHYSIO FOR UDBS
				;   CDBS, KDBS, AND FOR SDBS.
				;   APPROXIMATELY 8 CHANNELS, 40 DRIVES,
				;   AND 16 ONLINE STRUCTURES
	.RESTQ==:0		;NOT USED
	.RESEQ==:0		;NOT USED
	.RESNQ==:14000		;FOR CHAOSNET
	.RSTMQ==:0		;NOT USED
	RESFRM==:<.RESNQ/3>/4	;FOR NETWORK, NEED LOTS LOCKED DOWN
	RESFRA==:RESFRM*3	;AVERAGE AMOUNT OF FREE SPACE LOCKED DOWN
	RESFRB==:RESFRA+^D25	;SMALL INCREMENT OVER RESFRA FOR
				; JOB 0 COMPLETION

LS RESMIN,1			;MINIMUM LEVEL FOR ALL BUT LEVEL 1 REQUESTS
LS RESAVE,1			;AVERAGE AMOUNT OF FREE SPACE LOCKED
LS UPRSAV,1			;LIMIT FOR JOB 0 ACTIVITY
LS RESFRE,1			;COUNT OF FREE BLOCKS LEFT
LS RESFFB,1			;FIRST FREE 4 WORD BLOCK
LS RESIFL,1			;INITIALIZATION FLAG = -1 DURING STARTUP
	NRESFP==:2*<.RESGQ+.RESTQ+.RESNQ+.RSTMQ>/3000
				;# OF PAGES IS 2/3 OF SUM OF QUOTAS
	NRESFB==:NRESFP*PGSIZ/4	;NUMBER OF RESIDENT FREE 4 WORD BLOCKS
;NRP RESFRP,<NRESFP*PGSIZ>	;RESERVE SPACE FOR RESIDENT FREE POOL
LS RESFRP,<<NRESFP+1>*PGSIZ>	;MICROCODE CANNOT HANDLE UNMAPPED PACKETS
				;ALSO THERE SEEMS TO BE A BUG THAT AGES LOCKED
				;PAGES AND CAUSES PAGE FAULTS ON THEM
	RESFRZ==:RESFRP+<NRESFP*PGSIZ>-1 ;END OF RESIDENT FREE POOL
	RESBTL==:<NRESFP*PGSIZ/4+^D35>/^D36 ;LENGTH OF BIT TABLE
LS RESBTB,RESBTL		;RESIDENT FREE SPACE BIT TABLE
LS RESBAS,1			;BASE ADDRESS OF THE RESIDENT FREE POOL
LS RESUTB,RESQTL		;RESIDENT FREE SPACE USAGE TABLE

;ROUTINE TO ASSIGN RESIDENT FREE SPACE

;ACCEPTS IN T1/	PRI ,, LEN
;	    T2/	FLAGS ,, POOL #
;	CALL ASGRES
;RETURNS +1:	FAILED TO GET THE REQUESTED SPACE
;		T1/ ERROR CODE
;	 +2:	ADDRESS OF BLOCK IN T1

	RESCD

ASGRES::ASUBR <ASGREA,ASGREF,ASGREC>
	HRRZI T1,4(T1)		;CONVERT TO THE # OF 4 WORD BLOCKS
	ASH T1,-2		;  PLUS 1 WORD FOR THE LENGTH
	MOVEM T1,ASGREC		;SAVE THE COUNT OF BLOCKS NEEDED
	HRRZ T2,ASGREF		;GET POOL NUMBER
	CAIL T2,RESQTL		;IS THIS A LEGAL NUMBER?
	JRST ASGREQ
	CAML T1,RESUTB(T2)	;IS THERE ENOUGH IN THE POOL?
	RETBAD (MONX01)		;NO. RETURN 'NO RESIDENT FREE SPACE'

;THERE IS ENOUGH SPACE IN THE REQUESTED POOL. IF GIVING THIS SPACE
;AWAY WILL PUT US UNDER A UM, WE MAY WANT TO EXPAND THE POOL.

ASGRE0:	MOVE T2,RESFRE		;GET AMOUNT OF SPACE LEFT
	SUB T2,ASGREC		;DECREMENT BY THE REQUESTED AMOUNT
	HLRZ T3,ASGREA		;GET PRIORITY
	CAILE T3,.RESP3		;LEGAL VALUE?
	JRST ASGREP
	CAMGE T2,RESMIN		;WOULD THIS PUT US UNDER THE MINIMUM?
	JRST [	CAIE T3,.RESP1	;HIGHEST PRIORITY?
		JRST ASGRE1	;NO, GO TRY TO EXPAND THE FREE POOL
		JRST .+1]	;YES, GO TRY TO GET SPACE ANYWAY

;EITHER REQUEST IS OF HIGHEST PRIORITY OR THERE IS SUFFICIENT
;SPACE

	MOVE T1,ASGREC		;GET NUMBER OF BLOCKS DESIRED
	MOVEI T2,RESBTB		;GET START OF BITTABLE
	MOVEI T3,RESBTL		;AND THE LENGTH OF THE BITTABLE
	CALL GETBIT		;GET AND SET THIS NUMBER OF BITS
	 JRST ASGRE1		;COULD NOT GET IT, GO TRY TO EXPAND
	MOVN T2,ASGREC		;GET NUMBER OF BLOCKS REQUESTED
	HRRZ T3,ASGREF		;GET POOL NUMBER
	ADDM T2,RESUTB(T3)	;DECREMENT THE USAGE COUNT
	ADDB T2,RESFRE		;DECREMENT THE COUNT
	MOVE T3,RESFFB		;GET FIRST FREE BLOCK
	CAMGE T2,RESAVE		;BELOW THE AVERAGE DESIRED?
	CAIL T3,NRESFB		;YES, ANY BLOCKS LEFT?
	SKIPA			;NO, DO NOT WAKE UP JOB 0
	AOS JB0FLG##		;YES, WAKE UP JOB 0 TO EXPAND FREE POOL
	LSH T1,2		;GET THE OFFSET IN THE FREE SPACE
	ADD T1,RESBAS		;ADD IN THE BASE ADDRESS OF FREE SPACE

;SET UP THE HEADER WORD (THE WORD PRECEDING THE START OF THE
;BLOCK AS RETURNED TO THE USER). ZERO THE BLOCK OF FREE SPACE

	MOVE T2,ASGREC		;GET THE NUMBER OF BLOCKS ASSIGNED
	HRL T2,ASGREF		;GET POOL # OF ASSIGNMENT
	MOVEM T2,(T1)		;SAVE THIS IN THE HEADER WORD
	AOS T1			;RETURN POINTER TO FIRST FREE WORD
	SETZM 0(T1)		;ZERO THE FIRST WORD OF THE BLOCK
	LSH T2,2		;NOW ZERO THE BLOCK
	HRL T3,T1		;START AT FIRST WORD
	HRRI T3,1(T1)		;WORD +1
	ADD T2,T1		;GET POINTER TO END OF BLOCK (+1)
	HRRZS T2		;STAY IN SAME SECTION
	BLT T3,-2(T2)		;ZERO THE BLOCK
	RETSKP			;AND GIVE THE SUCCESSFUL RETURN

;HERE WHEN THE FREE SPACE NEEDS TO BE EXPANDED. DO IT, AND THEN
;GO TRY AGAIN TO SATISFY USER'S REQUEST

ASGRE1:	HLRZ T1,ASGREA		;GET THE PRIORITY
	CALL GRORES		;TRY TO EXPAND THE FREE POOL
	 RETBAD ()		;COULDNT GET ANY MORE
	JRST ASGRE0		;GOT SOME, GO SEE IF THIS WAS ENOUGH

ASGREQ:	BUG(CHK,<ASGRES: ILLEGAL POOL NUMBER GIVEN TO ASGRES>)
	RETBAD (MONX01)		;RETURN 'MONITOR INTERNAL ERROR'

ASGREP:	BUG(CHK,<ASGRES: ILLEGAL PRIORITY GIVEN TO ASGRES>)
	RETBAD(MONX01)		;RETURN 'MONITOR INTERNAL ERROR'

;ROUTINE TO EXPAND THE RESIDENT FREE POOL
;ACCEPTS IN T1/	PRIORITY NUMBER (.RESP1, .RESP2, OR .RESP3)
;	CALL GRORES
;RETURNS +1:	COULD NOT GET ANY
;		T1/ ERROR CODE
;	 +2:	FOUND SOME

GRORES:	STKVAR <<GRORET,2>>
	CAIE T1,.RESP3		;IN PROCESS CONTEXT?
	SKIPE RESIFL		;OR, IS THIS DURING SYSTEM START UP?
	JRST GRORE1		;YES, PAGES CAN BE LOCKED DOWN
	PIOFF			;ENTER TOUCHY CODE
	MOVE T1,RESFFB		;GET FIRST FREE BLOCK
	TRNE T1,177		;IS THERE ANY LEFT ON THIS PAGE?
	CAIL T1,NRESFB		;OR ANY LEFT IN ENTIRE POOL?
	JRST [	PION		;NO, GIVE ERROR RETURN
		RETBAD (MONX01)] ;RETURN 'NO FREE SPACE'
	MOVEI T2,200(T1)	;YES, GRAB THIS BLOCK
	TRZ T2,177		;GET POINTER TO NEXT FREE BLOCK
	MOVEM T2,RESFFB		;STORE NEW POINTER
	PION
	JRST GRORE2		;GO RETURN THIS BLOCK

GRORE1:	PIOFF			;GET A FULL PAGE (IF NECESSARY)
	MOVE T1,RESFFB		;GET FIRST FREE BLOCK
	CAIL T1,NRESFB		;ANY LEFT?
	JRST [	PION		;NO
		RETBAD(MONX01)]	;RETURN 'NO FREE SPACE'
	MOVEI T2,200(T1)	;GET THIS PAGE (OR PARTIAL BLOCK)
	TRZ T2,177
	MOVEM T2,RESFFB		;STORE NEW POINTER
	PION
	DMOVEM T1,GRORET	;STORE THE BLOCK NUMBER
	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,RESBAS
REPEAT 0,<
	CALL FPTA		;LOCK IT DOWN
	CALL MLKPG##		;...
>;SINCE ALL RESIDENT NOW
	DMOVE T1,GRORET		;GET BLOCK NUMBER BACK AGAIN
GRORE2:	SUB T2,T1		;GET THE SIZE OF THIS BLOCK
	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,RESBAS		;...
	HRRZM T2,(T1)		;STORE SIZE OF THE BLOCK
	MOVNS T2		;FUDGE THE USE COUNT
	ADDM T2,RESUTB		;FOR THE GENERAL POOL
	AOS T1			;GET POINTER TO BLOCK FOR RELRES
	CALL RELRES		;RELEASE THIS BLOCK TO THE FREE POOL
	RETSKP			;AND GIVE SUCCESS RETURN

;ROUTINE TO FIND AND MARK A BLOCK OF CONSECUTIVE FREE BITS IN A TABLE

;ACCEPTS IN T1/	NUMBER OF BITS NEEDED
;	    T2/	ADDRESS OF START OF BITTABLE
;	    T3/	LENGTH OF THE BITTABLE
;	CALL GETBIT
;RETURNS +1:	NOT ENOUGH AVAILABLE
;		T1/ ERROR CODE
;	 +2:	T1/	RELATIVE OFFSET OF FIRST BIT OBTAINED

GETBIT:	SAVEP			;SAVE SOME WORK ACS
	ASUBR <GETBIC,GETBIA,GETBIL>
GETBI1:	MOVE P1,GETBIA		;SET UP FOR GETZ - P1=ADR OF BIT TABLE
	MOVE P2,GETBIL		;P2=LENGTH OF BIT TABLE
	MOVE P3,GETBIC		;P3=COUNT OF BITS NEEDED
	CALL GETZ		;GET THE BITS
	 RETBAD (MONX01)	;NONE FOUND
	CALL SETOS		;MARK THEM AS TAKEN, IF STILL AVAILABLE
	 JRST GETBI1		;OPPS, GRABBED AT INTERRUPT LEVEL
	HRRZ T1,P4		;GOT IT, GET ADR OF FIRST WORD WITH 0'S
	SUB T1,GETBIA		;GET RELATIVE POSITION IN TABLE
	IMULI T1,^D36		;GET BIT POSITION IN TABLE
	MOVN T2,P5		;GET BIT POSITION IN WORD
	ADDI T1,^D36(T2)	;NOW HAVE RELATIVE POSITION
	RETSKP			;GIVE SUCCESSFUL RETURN

;CO-ROUTINE FOR GETBIT TO FIND N CONSECUTIVE 0'S IN A TABLE

;ACCEPTS IN P1/	ADDRESS OF TABLE
;	    P2/	LENGTH OF TABLE
;	    P3/	NUMBER OF BITS NEEDED
;	CALL GETZ
;RETURNS +1:	NONE FOUND
;		T1/ ERROR CODE
;	 +2:	P1-P3	UNCHANGED
;		P4	LOC OF WORD IN TABLE OF FIRST 0 BIT
;		P5	BIT NUMBER WITHIN WORD OF FIRST 0 BIT
;			WHERE POSTION=36 IF BIT 0, 1 IF BIT 35


GETZ:	MOVEI T4,^D36		;SET UP LOCAL COUNT WITHIN WORD
	SETCM T1,(P1)		;GET WORD TO INVESTIGATE
	JUMPE T1,GETZ4		;FULL IF 0
	JUMPG T1,GETZ3		;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1:	SETCA T1,		;SET BACK TO REAL CONTENTS
	JFFO T1,GETZR		;COUNT THE NUMBER OF 0'S
	MOVEI T2,^D36		;36 OF THEM
GETZR:	MOVE T3,T2		;SHIFT COUNT 
	MOVEM P1,P4		;SAVE POSITION IN P4
	MOVEM T4,P5		;SAVE COUNT WITHIN WORD TOO
GETZ2:	CAIL T3,(P3)		;FOUND ENOUGH?
	RETSKP			;YES, THEN DONE
	SUBI T4,(T2)		;NO, DECREASE POSITION COUNTER
	JUMPLE T4,GETZ5		;ARE THERE 0'S ON END?
	SETCA T1,		;NO, NOW WE WANT TO COUNT 1'S
	LSH T1,1(T2)		;REMOVE BIT ALREADY LOOKED AT
	JUMPE T1,GETZ4		;GO IF THE REST OF THE WORD IS ALL 1'S
GETZ3:	JFFO T1,.+1		;GET NUMBER OF REAL 1'S
	LSH T1,(T2)		;GET RID OF THEM
	CAIN T4,^D36		;FIRST POSITION IN WORD?
	ADDI T4,1		;YES, SUBTRACT REAL JFFO COUNT
	SUBI T4,1(T2)		;DECREASE POSITION COUNT
	JUMPG T4,GETZ1		;TRY NEXT 0, IF ANY MORE
GETZ4:	AOS P1			;NO MORE, STEP TO NEXT WORD
	SOJG P2,GETZ		;LOOP BACK IF THERE ARE ANY MORE WORDS
GETZE:	RETBAD (MONX01)		;NO MORE

;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT A WORD HAD 0'S ON THE END

GETZ5:	AOS P1			;STEP TO NEXT WORD
	SOJLE P2,GETZE		;IF NO MORE, THEN ERROR
	SKIPGE T1,(P1)		;NEXT WORD POSITIVE?
	JRST GETZ		;NO, THIS HOLE IS NOT BIG ENOUGH
	JFFO T1,GETZ6		;YES, COUNT THESE 0'S
	MOVEI T2,^D36		;36 OF THEM
GETZ6:	ADDI T3,(T2)		;ADD THEM INTO THE RUNNING TOTAL
	MOVEI T4,^D36		;RESET POSITION COUNT
	JRST GETZ2		;AND TEST THIS HOLE

;CO-ROUTINE TO GETBIT TO MARK A BLOCK OF BITS AS "IN USE"

;ACCEPTS IN P3/	HOW MANY BITS IN BLOCK
;	    P4/	POINTER TO WORD CONTAINING FIRST 0
;	    P5/	POSITION OF FIRST 0
;	CALL SETOS
;RETURNS +1:	BITS WERE ALREADY IN USE
;	 +2:	BITS SUCCESSFULLY MARKED AS "IN USE"

SETOS:	MOVE T4,P4		;WHERE
	HRRZ T3,P3		;COUNT
	MOVE T1,P5		;POSITION IN WORD
	CALL BITMSK		;GENERATE A BIT MASK
SETOS1:	PIOFF			;PREVENT INTERRUPTIONS FROM ABOVE
	TDNE T1,(T4)		;BIT ALREADY ON?
	JRST SETOS2		;YES, GO CLEAN UP AND EXIT
	IORM T1,(T4)		;NO, NOW MARK THESE AS IN USE
	PION			;THROUGH THE TOUCHY PART FOR NOW
	JUMPLE T3,RSKP		;ALL DONE?
	CALL BITMS2		;NO, CONTINUE WITH NEXT WORD IN BLOCK
	JRST SETOS1		;BIT MASK OBTAINED, GO MARK THE BITS

SETOS2:	PION			;BIT ALREADY IN USE, MUST UNDO OTHERS
	PUSH P,T3		;SAVE CURRENT COUNT AS A STOPPING POINT
	MOVE T4,P4		;GET START OF BLOCK AGAIN
	HRRZ T3,P3		;AND ORIGINAL COUNT
	MOVE T1,P5		;AND POSITION OF FIRST 0 BIT
	CALL BITMSK		;GET A BIT MASK
SETOS3:	CAMN T3,(P)		;ARE WE UP TO POINT OF LOSSAGE?
	JRST SETOS4		;YES
	ANDCAM T1,(T4)		;NO, CLEAR THESE BITS
	CALL BITMS2		;CONTINUE THROUGH THE BLOCK
	JRST SETOS3		;LOOP BACK UNTIL ALL CLEANED UP

SETOS4:	POP P,(P)		;CLEAN UP STACK
	RET			;AND GIVE NON-SKIP RETURN

;ROUTINE TO RETURN RESIDENT FREE SPACE TO THE FREE POOL

;ACCEPTS IN T1/	ADDRESS OF THE BLOCK
;	CALL RELRES
;RETURNS +1:	ALWAYS

RELRES::STKVAR <RLRSAD,RLRADJ>	;209
	MOVEM T1,RLRSAD		;209 Stash away the argument
	SOS T2,T1		;GET THE ADDRESS OF THE START OF THE BLOCK
	MOVE T1,(T2)		;GET THE NUMBER OF BLOCKS IN THIS BLOCK
	SUB T2,RESBAS		;GET THE OFFSET INTO THE FREE POOL
	TRNE T1,-1		;ZERO LENGTH BLOCK?
	TDNE T2,[-1,,3]		;THIS MUST START ON A 4 WORD BOUNDRY IN POOL
	JRST RESBAD
	LSH T2,-2		;GET 4 WORD BLOCK NUMBER
	IDIVI T2,^D36		;GET POSITION OF BLOCK WITHIN BIT TABLE
	HRRZ T4,T1		;SEE IF THIS BLOCK IS WITHIN THE POOL
	ADD T4,T2		;GET END OF BLOCK
	CAIL T4,NRESFB		;IS THIS WITHIN THE BIT TABLE LIMITS
	JRST RESBND
	HLRZ T4,T1		;GET POOL NUMBER
	HRL T1,T4		;209 SAVE AWAY POOL,,SIZE
	MOVEM T1,RLRADJ		;209  FOR LATER
	HRRZS T1		;GET THE SIZE OF THE BLOCK
;209	ADDM T1,RESUTB(T4)	;ADD BACK THE SPACE FREED TO USAGE TABLE
;209	ADDM T1,RESFRE		;COUNT UP THE FREE COUNT
	MOVEI T4,RESBTB(T2)	;GET ADR OF FIRST WORD OF BLOCK
	EXCH T3,T1		;SET UP FOR CALL TO CLRBTS
	MOVEI T2,^D36		;GET BIT POSITION IN CORRECT FORMAT
	SUBM T2,T1		;  FOR CLRBTS
	CALL CLRBTS		;FREE UP THIS SPACE
	 JRST RESBAZ
	HRRZ T1,RLRADJ		;209 NOW ADJUST FOR THE FREEAGE
	HLRZ T4,RLRADJ		;209
	ADDM T1,RESUTB(T4)	;209
	ADDM T1,RESFRE		;209
	RET			;EXIT

RESBAD:	BUG(CHK,<RELRES: ILLEGAL ADDRESS PASSED TO RELRES>)
	RET

RESBAZ:	BUG(CHK,<RELRES: RELEASING SPACE BEYOND END OF RESIDENT FREE POOL>)
	RET

RESBND:	BUG(CHK,<RELRES: RELEASING SPACE BEYOND END OF RESIDENT FREE POOL>)
	RET			;YES, JUST EXIT


;ROUTINE TO CLEAR BITS IN A BIT TABLE

;ACCEPTS IN T1/	POSITION WITHIN WORD OF FIRST 0 (36=BIT 0, 1=BIT 35)
;	    T3/	COUNT OF THE NUMBER OF BITS TO BE CLEARED
;	    T4/	ADDRESS OF FIRST WORD CONTAINING THE BLOCK OF BITS
;	CALL CLRBTS
;RETURNS +1:	SOME OF THE BITS WERE ALREADY ZERO
;	 +2:	SUCCESSFUL

CLRBTS:	CALL BITMSK		;GENERATE A BIT MASK FOR THE FIRST WORD
CLRBT1:	PIOFF			;ENTER INTERLOCKED CODE
	MOVE T2,(T4)		;GET THE WORD TO BE CLEARED
	TDC T2,T1		;SEE IF ANY OF THE BITS ARE ALREADY 0
	TDNE T2,T1		;...
	JRST [	PION		;BITS ARE ALREADY 0
		RET]		;GIVE FAILURE RETURN WITHOUT DOING MORE
	ANDCAM T1,(T4)		;CLEAR THE BITS
	PION			;THROUGH INTERLOCKED CODE
	JUMPLE T3,RSKP		;ANY MORE TO BE CLEARED?
	CALL BITMS2		;YES, GET NEXT BIT MASK
	JRST CLRBT1		;LOOP BACK FOR REST OF BITS

;ROUTINE TO BUILD A BIT MASK FOR N BITS WITHIN A WORD

;ACCEPTS IN T1/	POSITION OF FIRST BIT (36=BIT 0, 1=BIT 35)
;	    T3/	COUNT OF BITS IN MASK
;	    T4/	POSITION IN BIT TABLE OF THIS WORD
;	CALL BITMSK
;RETURNS +1:	T1/	MASK
;		T3/	REMAINING COUNT (T3 .LE. 0 MEANS DONE)
;		T4/	UPDATED TO POINT TO NEXT WORD IN TABLE (BITMS2)

BITMSK:	PUSH P,T1		;SAVE POSITION
	MOVN T1,T3		;GET NEGATIVE COUNT
	CAILE T3,^D36		;MORE THAN 1 WORD?
	MOVNI T1,^D36		;YES, SETTLE FOR ONE WORD (OR LESS)
	MOVSI T2,400000		;SET UP TO PROPAGATE A MASK
	ASH T2,1(T1)		;GET THE RIGHT NUMBER OF BITS IN MASK
	SETZ T1,		;CLEAR ANSWER AC
	LSHC T1,@0(P)		;POSITION THE BITS PROPERLY IN T1
	SUB T3,0(P)		;REDUCE THE COUNT TO THE NEW VALUE
	POP P,(P)		;CLEAN UP THE STACK
	RET			;AND EXIT WITH MASK IN T1

;SECONDARY ROUTINE FOR BIT MASK GENERATION. START WITH BIT 0.
;SAME OPERATION AS BITMSK EXCEPT THAT T4 IS INCREMENTED ON EXIT

BITMS2:	SETO T1,		;MASK STARTS AT BIT 0
	MOVNI T2,-^D36(T3)	;SET UP SHIFT
	CAIGE T3,^D36		;DONT SHIFT IF MORE THAN ONE WORD
	LSH T1,(T2)		;POSITION THE MASK
	SUBI T3,^D36		;UPDATE THE COUNT
	AOJA T4,R		;UPDATE TABLE ADDRESS AND RETURN

;INITIALIZATION ROUTINE FOR THE RESIDENT FREE POOL

RESFPI::MOVEI T1,RESBTL		;GET LENGTH OF THE RESIDENT BIT TABLE
RESFP1:	SETOM RESBTB-1(T1)	;MARK ALL BITS AS "IN USE"
	SOJG T1,RESFP1		;LOOP FOR ALL WORDS IN THE BIT TABLE
	MOVE T1,[RESFRP]	;GET ADDRESS OF START OF FREE POOL
	ADDI T1,777
	ANDI T1,777000		;BUMP TO PAGE START
	MOVEM T1,RESBAS
	SETZM RESFFB		;FIRST FREE BLOCK IS BLOCK # 0
	SETZM RESFRE		;NO FREE SPACE YET
	MOVEI T1,RESFRM		;GET INITIAL VALUE OF MINIMUM
	MOVEM T1,RESMIN
	MOVEI T1,RESFRA		;SET UP THE AVERAGE LEVEL
	MOVEM T1,RESAVE		;THIS LEVEL IS MAINTAINED BY JOB 0
	MOVEI T1,RESFRB		;GET JOB 0 THRESHOLD VALUE
	MOVEM T1,UPRSAV		;ESTABLISH LIMIT
	MOVSI T1,-RESQTL	;NOW SET UP THE USAGE TABLE
RESFP2:	MOVE T2,RESQTB(T1)	;GET QUOTA
	MOVEM T2,RESUTB(T1)	;SAVE AS USAGE
	AOBJN T1,RESFP2		;LOOP TIL TABLE INITIALIZED
	RET			;ALL SET UP

RESQTB:	.RESGQ/4		;GENERAL POOL QUOTA
	.RESTQ/4		;TERMINAL POOL QUOTA
	.RESNQ/4		;NETWORK POOL QUOTA
	.RSTMQ/4		;TIMER POOL QUOTA
RESQTL==:.-RESQTB		;THIS VALUE MUST MATCH THE ONE IN STG

;ROUTINE CALLED BY JOB 0 TO LOCK AND UNLOCK FREE SPACE

;	CALL RESLCK
;RETURNS +1: ALWAYS

	SWAPCD

RESLCK::MOVE T1,UPRSAV		;SEE HOW CLOSE TO THE AVERAGE WE ARE
	CAMG T1,RESFRE		;DO WE HAVE ENOUGH LOCKED DOWN?
	JRST RESLK1		;YES, GO SEE IF SOME NEEDS UNLOCKING
	MOVEI T1,.RESP3		;NEED MORE, GO GET SOME
	CALL GRORES		;AT PROCESS LEVEL SO PAGE FAULTS ALLOWED
	 RET			;COULD NOT GET ANY, JUST RETURN
	JRST RESLCK		;GO SEE IF THIS WAS ENOUGH

RESLK1:	MOVE T1,RESFRE		;NOW CHECK IF SOME NEEDS UNLOCKING
	CAMG T1,UPRSAV		;ARE WE ABOVE THE AVERAGE?
	RET			;NO, THEN EXIT
	MOVE T3,RESFFB		;YES, TRY TO UNLOCK SOME
	MOVE T1,T3		;REMEMBER THE FIRST FREE BLOCK IN T3
	IDIVI T1,^D36		;BUILD A BYTE POINTER TO FIRST BIT
	MOVNS T2		;GET BIT NUMBER IN WORD
	SKIPN T2		;IS THIS THE FIRST BIT IN A WORD
	SOSA T1			;YES, BACK UP TO LAST BIT OF PREVIOUS WORD
	ADDI T2,^D36		;GET BIT POSITION WITHIN WORD
	ROT T2,-6		;USE THIS AS THE BIT POSITION
	TLO T2,0100+T1		;ONE BIT BYTE POINTER INDEXED BY T1
	ADDI T1,RESBTB		;GET OFFSET INTO BIT TABLE
	JRST RESLK3		;GO TO RESMON FOR CRITICAL CODE

;RESIDENT CODE TO DO NON-PI FUNCTIONS

	RESCD
RESLK3:	NOSKED
	PIOFF			;MUST BE DONE INTERLOCKED
	CAME T3,RESFFB		;STILL HAVE SAME FIRST FREE BLOCK?
	JRST [	PION		;NO, GO TRY AGAIN
		OKSKED
		JRST RESLK1]
	LDB T4,T2		;GET THE BIT
	JUMPN T4,[PION		;IF = 1, THEN IN USE SOMEWHERE
		OKSKED
		RET]		;SO RETURN
	MOVEI T4,1		;NOT IN USE, MARK IT TAKEN
	DPB T4,T2		;...
	SOS RESFRE		;COUNT DOWN THE FREE COUNT
	SOS T1,RESFFB		;AND REMOVE IT FROM FREE POOL
	PION			;THROUGH INTERLOCKED CODE
	JRST RESLK4		;NOW, BACK TO SWPMON

;RETURN TO SWAPPABLE CODE FOR PI FUNCTIONS

	SWAPCD
RESLK4:	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,RESBAS		;...
	TRNE T1,777		;IS THIS ON A PAGE BOUNDRY?
	JRST RESLK2		;NO, CANNOT UNLOCK THIS PAGE
	CALL FPTA##		;YES, THIS PAGE CAN NOW BE UNLOCKED
	CALL MULKPG##		;UNLOCK IT
RESLK2:	OKSKED
	JRST RESLK1		;GO SEE IF MORE WORK NEEDED

;ROUTINE TO ASSIGN SPACE FROM THE FREE POOL

SWFREL==:400
SWOPTL==:10
NR(SWPFRE,7)			;FREE SPACE HEADER BLOCK
NR(SWFREE,SWFREL)		;FREE STORAGE SPACE FOR MESSAGES
				;AND HEADERS

;INITIALIZE SWPFRE
SWPINI::MOVE T1,[SWFREE,,SWFREE+1]
	SETZM SWFREE		;ZERO THE FREE POOL
	BLT T1,SWFREE+SWFREL-1	;...
	MOVEI T1,SWFREE		;GET ADR OF FREE POOL
	HRLOM T1,SWPFRE		;INITIALIZE POINTER TO FREE BLOCK
	MOVEI T1,SWFREL		;GET LENGTH OF FREE AREA
	HRRZM T1,SWFREE		;MAKE IT ONE LARGE BLOCK
	MOVEM T1,SWPFRE+2	;STORE IN SPACE COUNTER
	SETOM SWPFRE+1		;INITIALIZE LOCK ON FREE STORE
	MOVE T1,[XWD SWFREE+SWFREL,SWFREE]
	MOVEM T1,SWPFRE+4	;SET UP TOP AND BOTTOM POINTERS
	MOVEI T1,SWOPTL		;GET OPTIMUM LENGTH OF MESSAGES
	MOVEM T1,SWPFRE+3	;SAVE IN HEADER BLOCK
	RET

;ACCEPTS IN T1:	DESIRED BLOCK SIZE
;	CALL ASGSWP
;RETURNS +1:	NOT ENOUGH ROOM, ERROR CODE IN T1
;	 +2:	BLOCK ASSIGNED
;		T1/	POINTER TO ASSIGNED BLOCK

ASGSWP::MOVE T2,T1		;GET SIZE IN T2 FOR CALL TO ASGFRE
	MOVEI T1,SWPFRE		;GET POINTER TO FREE SPACE HEADER
	CALL ASGFRE		;GET THE SPACE
	 RETBAD (IPCFX8)	;NOT ENOUGH ROOM
	HRRZS T2,0(T1)		;INITIALIZE SPACE TO 0'S
	CAIG T2,1		;MORE THAN 1 WORD?
	 JRST ASGSW0		;NO. DONE
	SETZM 1(T1)		;YES, CLEAR FIRST WORD AFTER LENGTH
	HRLI T3,1(T1)		;SET UP A BLT POINTER
	HRRI T3,2(T1)		;...
	MOVEI T4,0(T1)		;GET POINTER TO BLOCK
	ADDI T4,0(T2)		;GET POINTER TO END OF BLOCK + 1
	CAILE T2,2		;IS BLOCK LESS THAN 3 WORDS LONG?
	BLT T3,-1(T4)		;NO, ZERO BLOCK (BUT NOT LENGTH WORD)
ASGSW0:	RETSKP

;ROUTINE TO RELEASE A BLOCK TO THE FREE POOL

;ACCEPTS IN T1/	ADR OF BLOCK TO BE RELEASED
;	    T2/	LENGTH OF BLOCK
;	CALL RELSWP
;RETURNS +1:	ALWAYS - BLOCK RELEASED

;		OR

;ACCEPTS IN T1:	ADDRESS OF BLOCK TO BE RELEASED
;	CALL RELMES
;RETURNS +1:	ALWAYS - BLOCK RELEASED


RELSWP::HRRZM T2,0(T1)		;GLOBAL CALL WITH LENGTH IN T2
	JUMPLE T2,RELFRM
RELMES::MOVE T2,T1		;SET UP FOR CALL TO RELFRE
	MOVEI T1,SWPFRE		;GET ADR OF FREE LIST HEADER
	HRRZS 0(T2)		;CLEAR LEFT HALF OF BLOCK SIZE WORD
	CALLRET RELFRE		;RELEASE THE BLOCK AND RETURN

RELFRM:	BUG(CHK,<ILLEGAL TO DEASSIGN 0 FREE SPACE>)

	END
