Google
 

Trailing-Edge - PDP-10 Archives - BB-M080H-SM - monitor-sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
;Edit 3197 to FREE.MAC by GUNN on Thu 10-Jan-85
;		Make ARCF% .ARRFR function DISMS and wait if IPCF to 
;;		QUASAR fails
;**;[3197] Add 1 line at RELMES+1L	DCG	10-Jan-85
;Edit 3190 to FREE.MAC by GUNN on Fri 21-Dec-84 - Remove edit 3187
;Edit 3187 to FREE.MAC by GUNN on Thu 6-Dec-84, for SPR #18886
;		Make ARCMSG DISMS and retry if quota or free space exceeded
;**;[3187] Change 1 line at RELMES+1L	DCG	6-Dec-84
; UPD ID= 303, SNARK:<5.MONITOR>FREE.MAC.23,  29-Oct-81 14:25:04 by GRANT
;XXXMAX=1500.
; UPD ID= 205, SNARK:<5.MONITOR>FREE.MAC.22,  22-Sep-81 17:27:57 by MURPHY
;MORE TCO 5.1514 - FLUSH USELESS VARIABLE (UPRSAV)
; UPD ID= 189, SNARK:<5.MONITOR>FREE.MAC.21,  16-Sep-81 19:46:27 by PAETZOLD
;Change PAGSIZ to PGSIZ 
; UPD ID= 188, SNARK:<5.MONITOR>FREE.MAC.20,  16-Sep-81 17:52:12 by MURPHY
;TCO 5.1514 - PREVENT THRASHING ABOVE AND BELOW THRESHOLD IN RESLCK
; UPD ID= 130, SNARK:<5.MONITOR>FREE.MAC.19,  30-Aug-81 19:39:17 by PAETZOLD
;TCO 5.1462 - Check if PI was off before doing PION
; UPD ID= 2280, SNARK:<5.MONITOR>FREE.MAC.18,   1-Jul-81 15:37:17 by PAETZOLD
;TCO 5.1380 - Remove references to .RESEP and .RESEQ
; UPD ID= 1795, SNARK:<5.MONITOR>FREE.MAC.17,   6-Apr-81 18:02:50 by MURPHY
;BLSUB. ENTRY FOR ASGRES
;<5.MONITOR>FREE.MAC.16, 24-Jan-81 22:34:25, EDIT BY GRANT
;CONVERT RESFSW TO RESBSW OR RESHSW
; UPD ID= 1481, SNARK:<5.MONITOR>FREE.MAC.15,  22-Jan-81 16:40:10 by GRANT
;PUT THE FOLLOWING CODE UNDER THE RESFSW DEBUG SWITCH:
;  1) RING BUFFER USED BY ASGRES AND RELRES
;  2) THE SECOND HEADER WORD AND THE TRAILER WORD USED BY RESIDENT FREE SPACE
;  3) WRITE LOCKING THE RESIDENT FREE SPACE BIT TABLE
; UPD ID= 1250, SNARK:<5.MONITOR>FREE.MAC.14,   8-Nov-80 17:51:22 by GRANT
;TCO 5.1195 - Reorder the tests in RELRES
; UPD ID= 1249, SNARK:<5.MONITOR>FREE.MAC.13,   7-Nov-80 22:49:53 by GRANT
;TYPO IN PREVIOUS EDIT
; UPD ID= 1228, SNARK:<5.MONITOR>FREE.MAC.12,   4-Nov-80 11:27:34 by GRANT
;TCO 5.1188 - EXPAND RESIDENT FREE SPACE HEADER, CREATE TRAILER
; UPD ID= 973, SNARK:<5.MONITOR>FREE.MAC.11,  26-Aug-80 11:47:10 by GRANT
;Add time stamp to RELRES/ASGRES trace buffer info
; UPD ID= 905, SNARK:<5.MONITOR>FREE.MAC.10,  18-Aug-80 11:34:11 by GRANT
; UPD ID= 826, SNARK:<5.MONITOR>FREE.MAC.9,   4-Aug-80 10:19:41 by GRANT
;Add optional data to RESBAD, RESBAZ, and RESBND
; UPD ID= 776, SNARK:<5.MONITOR>FREE.MAC.8,  22-Jul-80 16:35:48 by HALL
;CHANGES TO RESIDENT FREE SPACE HANDLER:
; ALLOW HEADER OF ARBITRARY SIZE
; ALLOW POOL NUMBERS TO START AT 1
; UPD ID= 772, SNARK:<5.MONITOR>FREE.MAC.7,  22-Jul-80 14:15:31 by OSMAN
;Fix comment to advertize ASGPGS instead of ASGPG1
;TEMPORARY - MAKE RESIDENT BIT TABLE WRITE-LOCKED
;TEMPORARY - REMEMBER ALL CALLS TO ASGRES, ASGFRE
; UPD ID= 179, SNARK:<4.1.MONITOR>FREE.MAC.27,  28-Dec-79 14:23:32 by GRANT
;Change error code in ASGSWP from IPCFX8 to MONX06
;<4.MONITOR>FREE.MAC.26,  4-Oct-79 07:09:09, EDIT BY R.ACE
;ADD COMMENTS FOR JSB STACK
;<OSMAN.MON>FREE.MAC.1, 10-Sep-79 15:30:55, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FREE.MAC.24, 16-Jul-79 09:20:03, EDIT BY OSMAN
;tco 4.2330 - Make RELRNG be a BUGHLT
;<4.MONITOR>FREE.MAC.23,  8-Jun-79 11:22:24, EDIT BY HALL
;MAKE BUGCHKS ASGINT AND RELINT PRINT PC AT TIME OF CALL
;<4.MONITOR>FREE.MAC.22, 20-Mar-79 12:36:22, Edit by MCLEAN
;FIX RELFRE BUGCHK RELINT TO BE IN A BETTER PLACE
;<4.MONITOR>FREE.MAC.20, 18-Mar-79 14:51:05, EDIT BY BOSACK
;MAKE RELFRE BUGCHK IF OKINT
;<4.MONITOR>FREE.MAC.19, 14-Mar-79 21:03:14, EDIT BY BOSACK
;MAKE ASGFRE CHECK FOR NOINT, BUGCHK IF NOT
;<4.MONITOR>FREE.MAC.18, 10-Mar-79 14:12:35, EDIT BY MILLER
;FIX ASGJF1 SOMEMORE
;<4.MONITOR>FREE.MAC.17,  9-Mar-79 14:47:44, Edit by MCLEAN
;<4.MONITOR>FREE.MAC.16,  9-Mar-79 14:42:42, EDIT BY MILLER
;FIX ASGJFR TO ADD NEW STRING BLOCK RACE FREE.
;<4.MONITOR>FREE.MAC.15,  9-Mar-79 14:11:45, Edit by MCLEAN
;MAKE BUGHLTS FOR ATTEMPTS TO ASSIGN/DEASSIGN 0 OR - SPACE
;<4.MONITOR>FREE.MAC.14,  5-Mar-79 16:38:21, EDIT BY KIRSCHEN
;REMOVE UNUSED LOGICAL LINK POOL
;<4.MONITOR>FREE.MAC.13,  4-Mar-79 17:19:39, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FREE.MAC.12, 20-Feb-79 13:54:49, EDIT BY HALL
;BUGCHK RELRNG WAS MISSING A COMMA BEFORE OPTIONAL DATA
;<4.MONITOR>FREE.MAC.11,  9-Feb-79 16:27:19, EDIT BY DBELL
;TCO 4.2187 - FIX CONSISTANCY CHECK AT RELFR6
;<4.MONITOR>FREE.MAC.10, 31-Jan-79 12:11:51, EDIT BY KIRSCHEN
;REMOVE AC 'D' FROM ADDITIONAL DATA IN RELBAD (MAX FOUR ITEMS)
;<4.MONITOR>FREE.MAC.9,  8-Jan-79 06:44:59, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
;	Make JSBST4 work if the JSB is below 400000.
;<4.MONITOR>FREE.MAC.8,  3-Jan-79 19:47:48, EDIT BY DBELL
;TCO 4.2148 - MAKE JSFRMV IMMUNE TO JUNK IN LEFT HALF OF T1
;<4.MONITOR>FREE.MAC.7,  3-Jan-79 13:56:07, EDIT BY DBELL
;MOVE THE ECSKED AT RELFRB AFTER THE BUGCHK SO TYPEOUT OF CX IS USEFUL
;<4.MONITOR>FREE.MAC.6,  8-Nov-78 14:27:21, EDIT BY HALL
;ADD ERROR CODES TO RETURN FROM ASGRES AND RELATED ROUTINES
;<4.MONITOR>FREE.MAC.5, 23-Oct-78 17:55:24, Edit by MCLEAN
;ADD A FEW CSKEDS AND ECSKED TO ASGFRE
;<4.MONITOR>FREE.MAC.4, 11-Oct-78 16:41:55, EDIT BY MILLER
;ADD ASWSWS AND RELMSS TO GET AND STACK SWAP FREE SPACE
;<4.MONITOR>FREE.MAC.3, 15-Aug-78 10:21:16, Edit by HALL
;TCO 1985 - ADD OPTIONAL DATA TO BUGCHK'S IN RELFRE
;<4.MONITOR>FREE.MAC.2, 19-Jul-78 00:03:21, Edit by MCLEAN
;MOVE ASGSWP/RELSWP/RELMES INTO HERE FROM IPCF
;<4.MONITOR>FREE.MAC.1, 20-Jun-78 16:55:15, Edit by ENGEL
;CHANGE CAME TO CAMGE AT JSBSF7


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

	SEARCH PROLOG

   IFN RESBSW,<			;IF DEBUGGING
	SEARCH PROKL		;NEED WRITE-PROTECTING STUFF
   >
	TTITLE FREE		; Storage routines
	SWAPCD

;NO SPECIAL AC DEFINITIONS HEREIN

;LOCAL DEFINITIONS FOR JSBSTK

DEFSTR (JSCOD,,17,18)		;THE CODE
DEFSTR (JSFRK,1,17,18)	;THE FORK HANDLE
DEFSTR (JSLVL,1,35,18)		;THE INTERRUPT LEVEL

; Assign space in free storage region
; Call:	RH(A)		; Location of free storage header
;	B		; Size of block needed
;	CALL 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::SKIPG B			;CHECK FOR LEGAL REQUEST
	BUG(ASGFR0)
	SKIPGE INTDF		;IS THE PROCESS NOINT?
	JRST [	MOVE C,0(P)	;GET PC OF THE CALL
		BUG(ASGINT,<<C,D>>)
		JRST .+1]
	CAMLE B,2(A)		; Any possibility of success?
	RET			; No. return immediately
	CSKED			;DON'T RE-SCHEDULE
	LOCK 1(A)		; 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(A)		; Initial best block size
	SETZM 6(A)		; Initial location of best block
	MOVE B,A		; Start with the header word
ASGFR1:	HLRZ C,0(B)		; Get pointer to next block
	JUMPE C,ASGFR2		; No more free blocks to examine
	HRRZ D,0(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
		ECSKED		;ALLOW RESKED
		POP P,B		; FLUSH TEMP
		POP P,B		; Make transparent to b on error
		RET]
	MOVE D,-1(P)		; Get desired size
	HLRZ C,0(B)		; Get pointer to block to be used
	HRRM D,0(C)		; Convert to desired size
	ADD D,C			; Pointer remainder of block
	HRLM D,0(B)		; Point prev to remainder
	HLLZ B,0(C)		; Get next
	HLLM B,0(D)		; Point remainder to it
	MOVE B,5(A)
	SUB B,-1(P)		; Size of remainder
	HRRM B,0(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)
	ECSKED
	MOVEI A,0(C)		; Get origin of block
	HRROS (A)		; Set lh to ones
	CAMN B,[-1]		;IS THIS A BLOCK OF 1 WORD?
	JRST ASGFR6		;YES. DON'T ZERO ANYTHING THEN
	HRRZ B,(A)		; Get rh
	HRRZI C,2(A)
	SETZM -1(C)		;ZERO FIRST WORD BEFORE SETTING LEFT HALF INDEX
	HRLI C,1(A)
	ADD B,A
	HRRZS B
	CAILE B,(C)
	BLT C,-1(B)		; Zero the block
ASGFR6:	POP P,B
	AOS (P)
	RET

ASGFR3:	HLL D,0(C)
	HLLM D,0(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
;	CALL RELFRE
; Clobbers b,c,d

;RELFRS IS CALLED TO REMOVE ENTRY FROM JSFSTK

;RIGHT HALF OF FIRST WORD OF BLOCK BEING RETURNED MUST CONTAIN
;NUMBER OF WORDS IN THE BLOCK (INCLUDING THE FIRST WORD)

;NOTE: BUGCHK RELINT PRINTS 0(P) AS IT WAS WHEN THIS ROUTINE
;WAS ENTERED. MUST BE CHANGED IF ANY MORE PUSHES ARE DONE.

RELFRS::PUSH P,A		;SAVE HEADER
	PUSH P,B		;AND ADDRESS
	MOVE A,B		;THE ADDRESS
	MOVEI B,STKCD1		;THE CODE
	CALL JSFRMV		;REMOVE IT
	POP P,B
	SKIPA A,0(P)		;RESTORE A BUT DO NOT POP IT

RELFRE::PUSH P,A		;SAVE ADDRESS OF HEADER WORD FOR POOL
	SKIPGE INTDF		;CHECK FOR NOINT
	JRST [	MOVE A,-1(P)	;GET ADDRESS OF CALL
		BUG(RELINT,<<A,D>>)
		MOVE A,0(P)	;GET BACK ADDRESS OF HEADER
		JRST .+1]
	CSKED			;DON'T STOP SCHEDULING
	LOCK 1(A)		;LOCK THIS FREE SPACE POOL
	HRRZ D,0(A)		;GET RH OF HEADER WORD FOR POOL
	JUMPE D,RELFR0		; Jump if old style free block

;SEE IF THE BLOCK BEING RETURNED BEGINS OUTSIDE OF THE RANGE OF
;THE SPECIFIED POOL.

	HLRZ D,4(A)		;GET UPPER LIMIT ON THIS POOL
	HRRZ A,4(A)		;GET LOWER LIMIT ON THIS POOL
	CAILE D,0(B)		;IS USER RETURNING BLOCK BEYOND THE END?
	CAILE A,0(B)		;NO. BEFORE THE START?
	 JRST RELFRA		;LOSSAGE - OUT OF RANGE

;BLOCK STARTS WITHIN RANGE OF THE SPECIFIED POOL OF FREE SPACE. STEP
;THROUGH THE CHAIN OF FREE BLOCKS. STOP WHEN A BLOCK IS BEYOND THE
;ONE BEING RETURNED OR THE CHAIN ENDS

	MOVE A,0(P)		;GET BACK ADDRESS OF POOL HEADER
RELFR0:	PUSH P,B		;SAVE ADDRESS OF BLOCK BEING RETURNED
	HRLI B,0		;SOME FIX NEEDED HERE TO KEEP OUT OF SEC 0 ***!!
	HLLM B,0(P)		;FORCE 0 INTO LEFT HALF OF ADDRESS
	MOVE B,-1(P)		;GET ADDRESS OF POOL HEADER
RELFR1:	HLRZ C,0(B)		;GET ADDRESS OF NEXT BLOCK ON CHAIN
	JUMPE C,RELFR2		;AT END OF THE CHAIN?
	CAML C,0(P)		;NO. PAST THE BLOCK BEING RETURNED?
	JRST RELFR2		;YES.
	MOVE B,C		;NO. STEP TO THE NEXT BLOCK
	JRST RELFR1		;GO CONTINUE THE SEARCH

;HERE WHEN CALLER IS TRYING TO RETURN A BLOCK THAT STARTS AFTER THE
;END OF THE SPECIFIED POOL OR BEFORE THE BEGINNING. BUGCHK PRINTS
;ADDRESS OF BLOCK, LOWER LIMIT ON POOL, UPPER LIMIT ON POOL

RELFRA:	BUG(RELRNG,<<B,D>,<A,D>,<D,D>>)
				; This has been made a HLT instead of a CHK
				; so that any reasons for lost free space
				; can hopefully be found.
	POP P,A			;GET THE ADDRESS OF THE POOL
	UNLOCK 1(A)		;UNLOCK THE POOL LOCK
	ECSKED
	RET
;HERE WHEN SEARCH THROUGH FREE SPACE CHAIN IS COMPLETE. EITHER
; 1) THE LAST BLOCK IN THE CHAIN WAS BEFORE (LOWER ADDRESS) THAN 
;THE BLOCK BEING RETURNED (C CONTAINS 0) 
;OR
; 2) A BLOCK HAS BEEN REACHED THAT IS AFTER (HIGHER ADDRESS)
;THE ONE BEING RELEASED (C CONTAINS THE ADDRESS OF THIS BLOCK)
;IF C CONTAINS THE ADDRESS OF THE BLOCK BEING RETURNED, BLOCK
;IS ALREADY IN THE CHAIN

;BLOCK BEING RETURNED WILL GO BETWEEN ADDRESS IN B AND ADDRESS IN C

; A/ ADDRESS OF HEADER FOR THE POOL
; B/ ADDRESS OF BLOCK PRECEDING BLOCK POINTED TO BY C
; C/ 0 OR ADDRESS OF FIRST BLOCK AFTER ONE BEING RETURNED
; 0(P)/ 0,,ADDRESS OF BLOCK BEING RETURNED
; -1(P)/ ADDRESS OF FREE SPACE POOL TO WHICH BLOCK IS BEING RETURNED

RELFR2:	CAMN C,0(P)		; Releasing a block already released?
	JSP CX,RELFRB		;YES, LOSSAGE

;SEE IF BLOCK THAT PRECEDES THIS BLOCK WILL OVERLAP IT. IF SO,
;GO BUGCHK.

	CAIN A,0(B)		;THIS FIRST BLOCK ON FREE LIST?
	JRST RELFR6		;YES. SKIP OVERLAP CHECKING
	HRRZ D,0(B)		;GET LENGTH OF PRECEDING BLOCK
	ADD D,B			;COMPUTE ITS ENDING ADDRESS
	CAMLE D,0(P)		;PREVIOUS BLOCK OVERLAPS ONE BEING RELEASED?
	JSP CX,RELFRB		;YES, LOSSAGE

;SEE IF THIS BLOCK WOULD OVERLAP THE ONE AFTER IT

RELFR6:	JUMPE C,RELFR7		;IF END OF LIST, SKIP OVERLAP CHECKING
	HRRZ D,@(P)		;GET SIZE OF BLOCK
	ADD D,0(P)		;ADD ADDRESS TO GET ENDING ADDRESS
	CAMLE D,C		;OVERLAPS NEXT BLOCK ON FREE LIST?
	JSP CX,RELFRB		;YES, LOSSAGE

;NO ERRORS DETECTED. INCREMENT THE COUNT OF FREE SPACE FOR THE
;POOL

RELFR7:	HRRZ D,@0(P)		;GET LENGTH OF BLOCK BEING RETURNED
	ADDM D,2(A)		; Augment count of remaining storage
	;..
;SEE IF THIS BLOCK CAN BE ADDED TO ITS SUCCESSOR.
;IT CAN BE IF ITS ENDING ADDRESS IS THE SAME AS THE ADDRESS OF THE
;NEXT BLOCK. IF SO, ADD LENGTH OF FOLLOWING BLOCK TO LENGTH OF
;BLOCK BEING RETURNED. MAKE BLOCK BEING RETURNED POINT TO THE
;SUCCESSOR OF THE ONE BEING MERGED.

	;..
	ADD D,0(P)		; Get end of block being returned
	CAIE D,0(C)		; Same as following block location?
	JRST RELFR3		; No
	HRRZ D,0(C)		; Get length of following block
	ADDM D,@0(P)		; Augment length of block being returned
	HLLZ D,0(C)		; Get loc of successor of successor
	HLLM D,@0(P)		;MAKE BLOCK BEING RETURNED POINT TO IT

;MAKE THE PREDECESSOR POINT TO THE BLOCK BEING RETURNED. IF PREDECESSOR
;EXTENDS TO START OF BLOCK BEING RETURNED, MERGE THEM AND MAKE THE
;PREDECESSOR POINT TO THE SUCCESSOR OF THE BLOCK BEING RETURNED.

RELFR5:	MOVE C,0(P)		;GET ADDRESS OF BLOCK BEING RETURNED
	HRLM C,0(B)		;MAKE PREDECESSOR POINT TO IT
	HRRZ D,0(B)		;GET LENGTH OF PREDECESSOR
	ADD D,B			;COMPUTE ENDING ADDRESS OF PREDECESSOR
	CAME D,C		;DOES PREDECESSOR EXTEND TO THIS BLOCK?
	JRST RELFR4		; No, done
	MOVE C,0(C)		;GET (SUCCESSOR,,COUNT) FOR BLOCK BEING RETURNED
	HLLM C,0(B)		;MAKE PREDECESSOR POINT TO IT
	HRRZS C			;GET COUNT OF BLOCK BEING RETURNED
	ADDM C,0(B)		;ADD TO PREDECESSOR'S COUNT

;HERE WHEN DONE. UNLOCK THE FREE SPACE POOL AND CLEAN THE STACK

RELFR4:	UNLOCK 1(A)		;UNLOCK THE POOL LOCK
	ECSKED
	POP P,B
	POP P,A
	RET

;HERE WHEN RETURNING BLOCK CANNOT BE MERGED WITH THE ONE THAT
;FOLLOWS IT.

RELFR3:	HRLM C,@0(P)		; Point returned block to successor
	JRST RELFR5

RELFRB:	UNLOCK (<1(A)>)
	BUG(RELBAD,<<CX,D>,<A,D>,<B,D>,<C,D>>)
	ECSKED
	POP P,B
	POP P,A
	RET
; Assign a page in job area
; Call:	CALL ASGPAG
; Return
;	+1	; None available
;	+2	; Success
;	A	; Address of origin of page

;ASGPGS IS CALLED IN ORDER TO PUT THE PAGE ON THE JSB STACK
;SO IT CAN BE RELEASED IN CASE OF FORK RESET

ASGPGS::TDZA A,A		;ENTRY TO SAVE ASSIGNMENT
ASGPAG::SETO A,			;DON'T SAVE INFO
	STKVAR <FLAG>
	MOVEM A,FLAG		;SAVE TYPE OF ENTRY
	CSKED			;DON'T STOP SCHEDULER
	LOCK JBCLCK
	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
	ECSKED
	RET			; No words left

ASGPG2:	MOVN B,B
	MOVSI A,400000
	ROT A,(B)
	ANDCAM A,JBCOR(C)	; Mark as used
	UNLOCK JBCLCK
	ECSKED
	MOVEI A,(C)
	IMULI A,^D36
	SUB A,B
	LSH A,9
	ADDI A,JSBPGA		; Origin of job mapped area
	SKIPE FLAG		; WANT THE ADDRESS STACKED?
	RETSKP
	MOVEM A,FLAG		; YES. SAVE IT
	MOVEI B,STKCD2		; SAY IS FROM ASGPAG
	CALL JSBSTK		; GO STACK IT ON THE JSB STACK
	MOVE A,FLAG		; THE PAGE ADDRESS
	RETSKP			; AND DONE

; Return page
; Call:	A	; Location of page
;	CALL RELPAG

;RELPGS IS CALLED TO REMOVE THE ENTRY FROM THE JSFSTK

RELPGS::PUSH P,A		;SAVE PAGE
	MOVEI B,STKCD2		;THE PROPER CODE
	CALL JSFRMV		;GO REMOVE IT
	SKIPA A,0(P)		;RESTORE A
RELPAG::PUSH P,A		;SAVE ADDRESS
	MOVE B,A		;ADDRESS TO B
	SETZ A,			;UNMAP REQUEST
	CALL SETMPG		;MAKE SURE ALL SPACE RELEASED
	POP P,A			;AND PROCEED
	SUBI A,JSBPGA
	LSH A,-9
	IDIVI A,^D36
	MOVSI C,400000
	MOVNS B
	ROT C,(B)
	IORM C,JBCOR(A)		; Clear the bit
	RET
; Assign job storage
; Call:	B	; Size of block needed
;	CALL ASGJFR
; Return
;	+1	; Not enough room
;	+2	; Success. location of block in A

ASGJFS::TDZA A,A		;STACK FLAG
ASGJFR::SETO A,			;DON'T STACK
	STKVAR <FLAG>
	MOVEM A,FLAG		;SAVE FLAG
ASGJF0:	MOVEI A,JSBFRE
	CALL ASGFRE		; Attempt to assign
	 JRST ASGJF1		; Not enough
	AOS (P)			; Success
	SKIPE FLAG		; WANT STACKING?
	RET
	MOVEM A,FLAG		; YES.
	MOVEI B,STKCD1		; SAY IS FROM ASGJFR
	CALL JSBSTK		; GO STACK IT
	MOVE A,FLAG		; THE ADDRESS
	RET			; AND DONE

ASGJF1:	PUSH P,B
	PUSH P,C
	PUSH P,JSBFRE+4		;SAVE CURRENT VALUES
	CALL ASGPAG		; Get another page of job storage
	 JRST ASGJF2		; No pages left
	POP P,B			;GET BACK RANGE VALUES
	CAME B,JSBFRE+4		;DID FREE SPACE CHANGE SIZE?
	JRST [	CALL RELPAG	;RELEASE THE PAGE
		JRST ASGJF3]	;AND TRY AGAIN
	CSKED			;SET UP TO OWN LOCK
	LOCK JSBFRE+1		;LOCK STRING DATA BASE
	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
	UNLOCK JSBFRE+1		;DONE UPDATING THE BLOCK
	ECSKED			;AND DONE WITH CRITICAL REGION
	MOVE B,A
	MOVEI A,JSBFRE
	CALL RELFRE		; Release the new block
ASGJF3:	POP P,C
	POP P,B
	JRST ASGJF0		; Try again

ASGJF2:	POP P,0(P)		;GET RID OF SAVED RANGE WORD
	POP P,C
	POP P,B
	RET			; Fail
IFN 0,<
; Put item onto deallocation list
; Call:	LH(A)	; Routine to call to deallocate the item
;	RH(A)	; Item identifier (address usually)
;	CALL 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
	CALL 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
	CALL 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
	RET
; Release all items on interrupt level specified in a
; Call:	A	; Interrupt level
;	CALL RELITM

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

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
	CALL (B)
	POP P,A
RELIT2:	AOBJN A,RELIT1
	MOVE B,-1(P)
	MOVEI A,PSBFRE
	CALL RELFRE
	POP P,B
	POP P,A
	RET
>
SUBTTL JSB STACK ROUTINES

;FOLLOWING IS A COLLECTION OF ROUTINES WHICH ARE USED TO QUEUE
;UP FREE SPACE DEALLOCATION. ENTRIES DESCRIBE FREE SPACE STRINGS
;OR PAGES WHICH THE JSYS WANTS TO RELEASE WHEN IT IS FINISHED. SHOULD
;IT BE INTERRUPTED AND NOT ALLOWED TO FINISH (I.E. VIA DEBRK, OR
;KFORK) THIS LIST WILL BE USED TO RELEASE THE FREE SPACE ACQUIRED
;BY THE PROCESS WHILE IN MONITOR CONTEXT. THIS MECHANISM ALLOWS
;MANY JSYS'S TO RUN OKINT WHICH ORDINARILY WOULD BE OBLIGED TO
;RUN NOINT


;JSB STACK POINTER (IN JSB)

;	!=======================================================!
;JSFSTK	!      - # OF ENTRIES       !ADDR OF BLOCK IN FREESPACE !
;	!=======================================================!

;JSB STACK (IN JSB FREESPACE)

;	!=======================================================!
;	!            -1             !WORD COUNT (INCL THIS WORD)!
;	!-------------------------------------------------------!
;	!  ENTRY TYPE CODE (JSCOD)  !           DATA            !
;	!-------------------------------------------------------!
;	!   SYSTEM FORK # (JSFRK)   !    PSI LEVEL # (JSLVL)    !
;	!-------------------------------------------------------!
;	!        REPEAT PREVIOUS 2 WORDS FOR EACH ENTRY         !
;	!                           .                           !
;	!                           .                           !
;	!                           .                           !
;	!=======================================================!
;ROUTINE TO PUT THE ASSIGNED SPACE ON THE JSB STACK. THIS STACK IS
;USED TO RELEASE ANY FREE SPACE ACCUMULATED BY A PROCESS WHICH
;IT COULD NOT RELEASE BECAUSE IT WAS INTERRUPTED.
;ACCEPTS:
;	1/ DATUM TO BE STACKED
;	2/ CODE IDENTIFYING TYPE OF DATUM

JSBSTK::STKVAR <SVA,SVB>	;WORK STORAGE
	MOVEM A,SVA		;SAVE ARGS
	MOVEM B,SVB		;""
	NOINT			;PREVENT INTS
	LOCK JSFLCK		;LOCK THE STACK
	SKIPE C,JSFSTK		;HAVE A STACK YET?
	JRST JSBST1		;YES. GO TRY AND USE IT
	MOVEI B,21
	CALL JSBST4		;GO ASSIGN SOME FREE SPACE
	 JRST JSBSF5		;FAILED. GIVE IT UP
	MOVEM A,JSFSTK		;SAVE IT
	MOVE C,A		;MOVE POINTER
JSBST1:	HRRZ D,0(C)		;GET COUNT
	SOS D			;NUMBER OF ENTRIES
	LSH D,-1		;NUMBER OF FULL ENTRIES
JSBST2:	AOS C			;NEXT CELL
	SKIPN 0(C)		;THIS ONE FREE?
	JRST JSBST3		;YES
	AOS C			;STP
	SOJG D,JSBST2		;NO KEEP LOOKING
	MOVE A,JSFSTK		;GET CURRENT ASSIGNMENT
	HRRZ B,0(A)		;THE COUNT
	ADDI B,20		;GET MORE SPACE THIS TIME
	CALL JSBST4		;GO GET SOME
	 JRST JSBSF5		;FAILED. GIVE IT UP
	MOVE B,JSFSTK		;OLD STACK
	HLL A,B			;PRESERVE COUNT OF ENTRIES
	PUSH P,A		;SAVE BLOCK
	MOVEI A,1(A)		;INCREMENT ADDRESS
	HRLI A,1(B)		;TO MOVE
	HRRZ B,0(B)		;COUNT OF THIS ONE
	ADDI B,-2(A)		;NUMBER TO MOVE
	BLT A,0(B)		;MOVE IT
	POP P,B			;BLOCK
	EXCH B,JSFSTK		;MAKE IT CURRENT. GET OLD
	MOVEI A,JSBFRE
	HRRZS B			;GET ADDRESS ONLY
	CALL RELFRE		;RELEASE FREE SPACE
	MOVE C,JSFSTK		;GET IT AGAIN
	JRST JSBST1		;GO TRY INSERT NOW

;INSERT ENTRY AT 0(C)

JSBST3:	MOVE A,SVA		;THE DATUM
	MOVEM A,0(C)		;STASH IT
	MOVE A,PSIBIP		;RECORD CURRENT BREAK LEVEL
	JFFO A,.+1
	STOR B,JSLVL,(C)
	MOVE B,SVB		;THE CODE
	STOR B,JSCOD,(C)	;STORE THE CODE
	MOVE A,FORKX		;CURRENT FORK
	STOR A,JSFRK,(C)	;SAVE THIS
	MOVSI A,-1		;INCREMENTER
	ADDM A,JSFSTK		;ANOTHER ENTRY IN THE STACK
	JRST JSBSF5		;GO FINISH UP

;GET SOME SPACE

JSBST4:	CALL ASGJFR		;GET IT
	 RETBAD			;NONE THERE
	PUSH P,A		;SAVE ADDRESS
	HRRZ B,0(A)		;END
	SOS B
	ADD B,0(P)		;THE LAST WORD TO ZERO
	ADDI A,2
	SETZM -1(A)		;GET A ZERO
	HRLI A,-1(A)		;FORM BLT
	BLT A,0(B)		;ZERO THE AREA
	POP P,A			;THE AREA
	RETSKP			;AND DONE
;ROUTINE TO PROCESS THE JSFSTK ENTRY FOR A GIVEN PROCESS.
;ACCEPTS:
;	1/ SYSTEM-WIDE FORK #
;	2/ PSIBIP TO INDICATE WHAT STACK LEVEL ENTRIES TO CLEAR (0=ALL)

;RETURNS +1 WITH ALL ENTRIES FOR THIS PROCESS HANDLED
;AND REMOVED FROM THE STACK

;DISPATCH TABLE FOR CODES

CODTBL:	RELSTR			;FREE A STRING
	RELPGA			;FREE A PAGE
	DECRTT			;DECREMENT TTY LOCK COUNT
	RELMES			;RELEASE A SWAPPABLE STRING

JSBSTF::NOINT			;PREVENT INTS
	LOCK JSFLCK		;LOCK THE STACK
	SAVET			;SAVE ACS
	STKVAR <HLDBIP,HLDHND>	;HOLD THE PSIPIB FOR STACK CLEARING
	MOVEM B,HLDBIP		;SAVE THE SPIPIB
JSBSF6:	SKIPL C,JSFSTK		;HAVE ANY ENTRIES IN THE STACK?
	JRST JSBSF5		;GO FINISH UP
	HRRZ D,0(C)		;THE COUNT
	SOS D			;NUMBER OF ENTRIES IN TABLE
	LSH D,-1		;NUMBER OF FULL ENTRIES
JSBSF1:	AOS C			;NEXT ONE
	SKIPN 0(C)		;ANYTHING HERE?
	JRST JSBSF4		;NO
	LOAD B,JSFRK,(C)	;GET FORK HANDLE
	CAIN A,0(B)		;THIS IT?
	JRST JSBSF2		;YES. GO DO IT
JSBSF4:	AOS C			;NEXT CELL
	SOJG D,JSBSF1		;MORE?
JSBSF5:	UNLOCK JSFLCK		;FREE THE LOCK
	OKINT			;ALLOW INTS
	RET			;ALL DONE

JSBSF2:	MOVEM A,HLDHND		;SAVE FORK HANDLE
	MOVE A,HLDBIP		;RELEASE ENTIES FOR CURRENT OR
	JFFO A,JSBSF7		; HIGHER LEVELS ONLY.
	JRST JSBSF3		;NO HIGHER LEVELS - GO RELEASE SPACE
JSBSF7:	LOAD A,JSLVL,(C)	;GET THIS ENTRIES STACK LEVEL
	CAMGE A,B		;SKIP IF ENTRY IS OF HIGHER LEVEL THAN CURRENT
	JRST [	MOVE A,HLDHND		;RESTOR A
		JRST JSBSF4]		;NO - THEN DON'T RELEASE THIS LEVEL
JSBSF3:	LOAD B,JSCOD,(C)	;GET CODE
	HRRZ A,0(C)		;THE DATUM
	SETZM 0(C)		;FREE ENTRY
	MOVE B,CODTBL-1(B)
	CALL 0(B)
	MOVSI A,1		;A DECREMENTER
	ADDM A,JSFSTK		;ONE LESS ENTRY
	MOVE A,HLDHND		;THE FORK HANDLE
	JRST JSBSF6		;CONTINUE
;ROUTINES TO PROCESS INDIVIDUAL STACK ENTRIES

;ROUTINE TO RELEASE A JSB STRING. A/STRING ADDRESS

RELSTR:	MOVE B,A		;THE STRING
	MOVEI A,JSBFRE		;THE HEADER
	CALLRET RELFRE		;DO IT

;ROUTINE TO RELEASE A JSB PAGE . A/ PAGE

RELPGA:	CALLRET RELPAG		;FREE IT

;ROUTINE TO DECREMENT A TTY LOCK. A/ TTY NUMBER

DECRTT:	MOVE B,A		;MOVE TTY NUMBER
	CALL STADYN		;GO FIND DATA BASE
	 RET			;ALREADY RELEASED.
	CALLRET ULKTT		;GO UNLOCK THE DATA BASE
;ROUTINE TO REMOVE A CERTAIN ENTRY FROM THE TABLE
;ACCEPTS:
;	1/ DATUM
;	2/CODE

JSFRMV::NOINT			;PREVENT INTS
	LOCK JSFLCK		;LOCK THE STACK
	SKIPL C,JSFSTK		;HAVE ANY ENTRIES IN THE STACK?
	JRST JSBSF5		;GO WRAP UP
	STKVAR <SAVDTM,SAVCOD>	;WORK CELLS
	HRRZM A,SAVDTM		;SAVE ARGUMENTS
	MOVEM B,SAVCOD
	HRRZ D,0(C)		;COUNT
	SOS D			;NUMBER OF ENTRIES
	LSH D,-1		;# OF FULL ENTRIES
JSFRM1:	AOS C			;NEXT ONE
	SKIPE 0(C)		;ONE HERE?
	JRST JSFRM2		;YES
JSFRM3:	AOS C			;NEXT CELL
	SOJG D,JSFRM1		;NO. LOOP
	JRST JSBSF5		;GO WRAP UP

JSFRM2:	LOAD A,JSFRK,(C)	;SEE IF CORRECT FORK
	CAME A,FORKX		;IS IT?
	JRST JSFRM3		;NO
	LOAD A,JSCOD,(C)	;PROPER CODE?
	CAME A,SAVCOD
	JRST JSFRM3		;NO
	HRRZ A,0(C)		;GET DATUM
	CAME A,SAVDTM		;CORRECT?
	JRST JSFRM3		;NO
	PUSH P,B		;SAVE. TAKE ENTRIES FROM PROPER PSI LEVEL ONLY
	MOVE A,PSIBIP		;COMPUTE THE PSI LEVEL NUMBER
	JFFO A,JSFRM4		;JUMP WHEN NOT AT LEVEL ZERO.
	JRST JSFRM5		;LEVEL ZERO - CLEAN OFF ENTRIES
JSFRM4:	LOAD A,JSLVL,(C)	;GET THE LEVEL NUMBER FROM STACK
	CAME A,B		;ARE WE AT THAT LEVEL
	JRST [	POP P,B		;NO - THEN CONTINUE LOOKING
		JRST JSFRM3]
JSFRM5:	POP P,B
	SETZM 0(C)		;CLEAR IT
	MOVSI A,1		;A DECREMENTER
	ADDM A,JSFSTK		;ONE LESS ENTRY
	JRST JSBSF5		;GO WRAP UP
SUBTTL
;ROUTINE TO ASSIGN RESIDENT FREE SPACE

;ENTRY FOR BLCAL. CALLS
;	BLCAL ASGRSB,<LENGTH,PRIORITY,POOL>
; RETURNS SAME AS FOR ASGRES

ASGRSB::BLSUB. <LEN,PRI,POO>
	SAVEAC <T2,T4>
	HRRZ T1,LEN
	HRL T1,PRI
	HRRZ T2,POO
	CALLRET ASGRES		;DO THE WORK

	ENDBS.

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

;THE PRIORITIES ARE:
;	.RESP1		HIGHEST PRIORITY - CALLER IS AT SCHED OR INTERRUPT
;			LEVEL, NO PAGE FAULTS ARE ALLOWED. THIS
;			REQUEST WILL BE SERVICED IF AT ALL POSSIBLE.

;	.RESP2		CALLER IS AT INTERRUPT LEVEL OR SCHEDULER
;			LEVEL BUT IT IS NOT CRITICAL THAT THE SPACE
;			REQUEST BE GRANTED.  SPACE WILL NOT BE GIVEN
;			OUT IF DOING SO CAUSES THE AMOUNT OF FREE 
;			SPACE TO DROP BELOW THE MINIMUM GUARANTEED
;			FOR THE HIGHEST PRIORITY CALLS.

;	.RESP3		CALLER IS IN PROCESS CONTEXT.  IT IS LEGAL TO
;			CAUSE PAGE FAULTS.  THE SPACE WILL BE GRANTED
;			UNLESS THE TOTAL FREE POOL IS EXHAUSTED.  IF 
;			NECESSARY, THIS ROUTINE WILL CAUSE ANOTHER 
;			PAGE TO BE LOCKED DOWN AND ASSIGN THE SPACE
;			FROM THAT PAGE.  CALLS AT THIS LEVEL WILL NOT
;			CAUSE THE FREE SPACE COUNT TO DROP BELOW THE
;			MINIMUM AMOUNT RESERVED FOR THE HIGHEST 
;			PRIORITY LEVEL.

;THE RESIDENT POOLS ARE:
;	.RESGP		GENERAL POOL - USED BY ALL CALLERS EXCEPT THE
;					ROUTINES THAT HAVE THEIR OWN POOL
;					SYSERR BLOCKS USE THIS POOL
;	.RESTP		TERMINAL POOL - USED FOR ALL TERMINAL RELATED 
;					STORAGE
;	.RESNP		NETWORK POOL - USED BY DECNET MODULES
;	.RSTMP		TIMER POOL - USED BY TIMER JSYS
	RESCD

ASGRES::MOVE T4,(P)		;GET PC OF CALLER
ASGRB0:
   IFN RESBSW,<			;USE RING BUFFER TO RECORD ASSIGNMENTS
	CALL ASGREX		;DO THE WORK
	 RET			;FAILED
	MOVEI T2,-RSHLEN(T1)	;GET ADDRESS OF BLOCK, AND ZERO AS FLAG
	CALL XXXPUT		;STORE IT
	MOVE T2,-RSHLEN(T1)	;GET HEADER OF BLOCK
	CALL XXXPUT		;STORE IT
	MOVE T2,(P)		;GET CALLER PC
	CALL XXXPUT		;STORE IT
	MOVE T2,FORKX		;GET FORK NUMBER
	CALL XXXPUT		;STORE IT
	MOVE T2,TODCLK		;GET TIME
	CALL XXXPUT		;STORE IT
	RETSKP			;SKIP


	XXXMAX==^D1500		;SIZE OF BUFFER

XXXPUT:	AOS T3,XXXPTR		;ADVANCE COUNTER
	CAIL T3,XXXMAX		;TOO HIGH?
	SETZB T3,XXXPTR		;YES, RESET IT
	MOVEM T2,XXXBUF(T3)	;STORE DATA ITEM
	RET			;DONE

RS(XXXPTR,1)			;INDEX INTO BUFFER
RS(XXXBUF,XXXMAX)		;BUFFER


ASGREX:	
   >				;END OF IFN RESBSW
	ASUBR <ASGREA,ASGREF,ASGREC,ASGCAL>
	HRRZI T1,RSHLEN+RSTLEN+3(T1)	;CONVERT TO THE # OF
	ASH T1,-2		; 4-WORD BLOCKS NEEDED
	MOVEM T1,ASGREC		;SAVE THE COUNT OF BLOCKS NEEDED
	HRRZ T2,ASGREF		;GET POOL NUMBER
	SKIPE T2		;0 ISN'T A LEGAL POOL NUMBER
	CAIL T2,RESQTL		;IS POOL NUMBER TOO LARGE?
	JRST [	BUG(ASGREQ)
		RETBAD (MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
	CAML T1,RESUTB(T2)	;IS THERE ENOUGH IN THE POOL?
	RETBAD (MONX05)		;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 [	BUG(ASGREP)
		RETBAD(MONX03)]	;RETURN 'MONITOR INTERNAL ERROR'
	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
	;..
;IF THE FIRST FREE BLOCK (THE ONE AFTER THE LAST USED BLOCK) IS BELOW
;THE DESIRED LEVEL, WAKE UP JOB 0 TO LOCK DOWN ANOTHER PAGE.

	;..
	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

;SET UP THE HEADER AND TRAILER WORDS.  ZERO THE BLOCK OF FREE SPACE

	LSH T1,2		;GET THE OFFSET IN THE FREE SPACE
	ADD T1,RESBAS		;ADD IN THE BASE ADDRESS OF FREE SPACE
	MOVE T2,ASGREC		;GET THE NUMBER OF BLOCKS ASSIGNED
	STOR T2,RSSIZ,(T1)	;STORE IT IN THE HEADER
   IFN RESHSW,<			;IF DEBUGGING
   	MOVE T3,ASGCAL		;GET CALLER'S PC
	STOR T3,RSCAL,(T1)	;PUT IT IN HEADER
	SETONE RSINU,(T1)	;SET THE "IN USE" BIT
   >				;END OF IFN RESHSW
	HRRZ T3,ASGREF		;GET POOL # OF ASSIGNMENT
	STOR T3,RSPOO,(T1)	;STORE IT IN THE HEADER
	ADDI T1,RSHLEN		;RETURN POINTER TO FIRST FREE WORD
	SETZM 0(T1)		;ZERO THE FIRST WORD OF THE BLOCK
	LSH T2,2		;NOW ZERO THE BLOCK
	SUBI T2,RSHLEN		;GET NUMBER OF WORDS TO ZERO
	HRL T3,T1		;START AT FIRST WORD
	HRRI T3,1(T1)		;WORD +1
	SOS T2			;GO TO
	ADD T2,T1		; END OF THE BLOCK
	BLT T3,(T2)		;ZERO THE BLOCK
   IFN RESHSW,<			;IF DEBUGGING
	MOVEI T3,RESFLG		;GET THE "TRAILER FLAG"
	STOR T3,RSFLG,(T2)	;PUT FLAG IN TRAILER WORD
	MOVEI T3,-RSHLEN(T1)	;GET ADDR OF HEADER
	STOR T3,RSHED,(T2)	;PUT IT IN TRAILER WORD
   >				;END OF IFN RESHSW
	RETSKP

;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
;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

;HERE WHEN WE CAN'T TAKE A PAGE FAULT. THE ONLY WAY WE CAN GROW
;FREE SPACE IS TO EXPAND TO THE END OF THE LAST PAGE THAT IS LOCKED
;DOWN. RESFFB POINTS TO THE BEGINNING OF THE LAST FREE BLOCK. IT
;ALWAYS IS ON THE LAST LOCKED-DOWN PAGE. IF IT IS A MULTIPLE OF 200,
;THEN IT POINTS TO THE BEGINNING OF A PAGE, AND THE PREVIOUS ONE
;HAS ALREADY BEEN LOCKED DOWN. IN THAT CASE, FREE SPACE CAN'T BE
;EXPANDED WITHOUT RISKING A PAGE FAULT.

	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PION
	CONSO PI,PIPION		;IS PION?
	 TDZA T3,T3		;NO PIOFF
	  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 [	SKIPE T3	;NO GIVE ERROR...WAS PION?
		 PION		;YES SO TURN IT BACK ON
		POP P,T3	;RESTORE T3
		RETBAD (MONX05)] ;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
	SKIPE T3		;WAS PION?
	 PION
	POP P,T3		;RESTORE T3
	JRST GRORE2		;GO RETURN THIS BLOCK

;HERE WHEN PRIORITY IS SUCH THAT PAGE FAULTS ARE ALLOWED.
; * * BUG: NEED TO LOCK DOWN ONLY WHEN CROSS PAGE BOUNDARY.
; * * PAGES NEVER GET PROPERLY UNLOCKED.

GRORE1:
	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PION
	CONSO PI,PIPION		;IS PI ON?
	 TDZA T3,T3		;NO SO SET FLAG
	  PIOFF			;GET A FULL PAGE (IF NECESSARY)
	MOVE T1,RESFFB		;GET FIRST FREE BLOCK
	CAIL T1,NRESFB		;ANY LEFT?
	JRST [	SKIPE T3	;NO...WAS PION?
		 PION		;YES
		POP P,T3	;RESTORE T3
		RETBAD(MONX05)]	;RETURN 'NO FREE SPACE'
	MOVEI T2,200(T1)	;GET THIS PAGE (OR PARTIAL BLOCK)
	TRZ T2,177
	MOVEM T2,RESFFB		;STORE NEW POINTER
	SKIPE T3		;WAS PION?
	 PION			;YES
	POP P,T3		;RESTORE T3
	DMOVEM T1,GRORET	;STORE THE BLOCK NUMBER
	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,RESBAS
	CALL FPTA		;LOCK IT DOWN
	CALL MLKPG		;...
	DMOVE T1,GRORET		;GET BLOCK NUMBER BACK AGAIN
	;..
;AT THIS POINT THE PAGE TO WHICH RESFFB PREVIOUSLY POINTED IS LOCKED
;DOWN. RESFFB HAS BEEN MOVED TO THE BEGINNING OF THE NEXT PAGE.

;	T1/ RESFFB BEFORE THE EXPANSION
;	T2/ RESFFB AFTER THE EXPANSION

;MAKE THE NEW BLOCK LOOK LIKE A BLOCK OF FREE SPACE. STORE THE POOL
;NUMBER AND BLOCK COUNT IN THE HEADER AND CALL RELRES.. THIS BLOCK
;IS ALWAYS RETURNED TO THE GENERAL POOL.

GRORE2:	SUB T2,T1		;GET THE SIZE OF THIS BLOCK
	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,RESBAS		;...
	STOR T2,RSSIZ,(T1)	;STORE SIZE IN THE HEADER
	MOVEI T3,.RESGP		;GET NUMBER OF THE GENERAL POOL
	STOR T3,RSPOO,(T1)	;STORE POOL NUMBER IN THE HEADER
	MOVNS T2		;FUDGE THE USE COUNT
	ADDM T2,RESUTB+.RESGP	;FOR THE GENERAL POOL
	ADDI T1,RSHLEN		;GET POINTER TO BLOCK FOR RELRES
	TXO T1,RS%GRO		;SAY WE ARE GROWING
	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 (MONX05)	;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


;USE OF AC'S:
;	P1 IS UPDATED AS CODE STEPS THROUGH TABLE
;	T3 IS RUNNING COUNT OF 0'S

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 (MONX05)		;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
   IFE RESBSW,<
SETOS1:
	PUSH P,T2		;SAVE T2
	SETO T2,		;ASSUME PION
	CONSO PI,PIPION		;IS PI ON?
	 TDZA T2,T2		;NO SO SET FLAG
	  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
	SKIPE T2		;WAS PI ON?
	 PION			;THROUGH THE TOUCHY PART FOR NOW
	POP P,T2		;RESTORE T2
	JUMPLE T3,RSKP		;ALL DONE?
	CALL BITMS2		;NO, CONTINUE WITH NEXT WORD IN BLOCK
	JRST SETOS1		;BIT MASK OBTAINED, GO MARK THE BITS

SETOS2:
	SKIPE T2		;WAS PI ON?
	 PION			;BIT ALREADY IN USE, MUST UNDO OTHERS
	POP P,T2		;RESTORE T2
	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
   >				;END OF IFE RESBSW
   IFN RESBSW,<
SETOS1:	PUSH P,T2		;SAVE SOME ACS
	PUSH P,T3		;THAT WE NEED
	MOVE T2,T4		;COPY ADDRESS
	LSH T2,-PGSFT		;GET PAGE NUMBER OF ADDRESS
	MOVX T3,PTWR		;AND GET WRITE-FLAG
	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PION
	CONSO PI,PIPION		;PI ON?
	 TDZA T3,T3		;NO
	  PIOFF			;PREVENT INTERRUPTIONS FROM ABOVE
	EXCH T3,0(P)		;SAVE FLAG RESTORE T3
	TDNE T1,(T4)		;BIT ALREADY ON?
	JRST SETOS2		;YES, GO CLEAN UP AND EXIT
	IORM T3,MMAP(T2)	;SET WRITE BIT IN MMAP
	CLRPT (T4)		;MAKE IT SEEN BY HARDWARE
	IORM T1,(T4)		;NOW MARK THESE AS IN USE
	ANDCAM T3,MMAP(T2)	;CLEAR WRITE-ENABLE AGAIN
	CLRPT (T4)		;MAKE THAT SEEN AGAIN
	POP P,T3		;GET PI STATUS FLAG
	SKIPE T3		;WAS PION?
	 PION			;YES...THROUGH THE TOUCHY PART FOR NOW
	POP P,T3		;RESTORE ACS
	POP P,T2		;THAT WE USED
	JUMPLE T3,RSKP		;ALL DONE?
	CALL BITMS2		;NO, CONTINUE WITH NEXT WORD IN BLOCK
	JRST SETOS1		;BIT MASK OBTAINED, GO MARK THE BITS

SETOS2:
	POP P,T3		;GET PI STATUS FLAG
	SKIPE T3		;WAS PION?
	 PION			;YES...BIT ALREADY IN USE, MUST UNDO OTHERS
	POP P,T3		;RESTORE ACS
	POP P,T2		;THAT WE USED
	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
	PUSH P,T2		;SAVE ACS AGAIN
	PUSH P,T3		;THAT WE USE
	MOVE T2,T4		;GET ADDRESS
	LSH T2,-PGSFT		;CONVERT TO PAGE NUMBER
	MOVX T3,PTWR		;GET WRITE BIT
	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PION
	CONSO PI,PIPION		;IS PI PN?
	 TDZA T3,T3		;NO
	  PIOFF			;NO PI'S NOW
	EXCH T3,0(P)		;RESTORE T3..SAVE PI STATE FLAG
	IORM T3,MMAP(T2)	;WRITE-ENABLE BITTABLE
	CLRPT (T4)		;LET HARDWARE KNOW
	ANDCAM T1,(T4)		;CLEAR THESE BITS
	ANDCAM T3,MMAP(T2)	;WRITE-PROTECT AGAIN
	CLRPT (T4)		;LET IT BE KNOWN
	POP P,T3		;GET PI STATE FLAG
	SKIPE T3		;WAS PI ON?
	 PION			;YES...PI'S OK AGAIN
	POP P,T3		;RESTORE ACS
	POP P,T2		;THAT WE SAVED
	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
   >				;END OF IFN RESBSW
;ROUTINE TO RETURN RESIDENT FREE SPACE TO THE FREE POOL

;ACCEPTS IN T1/	ADDRESS OF THE BLOCK   (RS%GRO INDICATES "GROWING")
;	CALL RELRES
;RETURNS +1:	ALWAYS

RELRES::MOVE T2,(P)		;GET PC OF CALLER
	STKVAR <RELGRO,RELRAD,RELCAL>
	SETZM RELGRO		;ASSUME "NOT GROWING"
	TXZE T1,RS%GRO		;ARE WE REALLY GROWING?
	SETOM RELGRO		;YES, SET THE "GROWING" FLAG
	MOVEM T1,RELRAD		;SAVE ADDR PROVIDED BY USER
	MOVEM T2,RELCAL		;SAVE PC OF CALLER
   IFN RESBSW,<			;USE RING BUFFER TO RECORD RELEASING
	HRROI T2,-RSHLEN(T1)	;GET ADDRESS OF BLOCK, AND -1 AS FLAG
	CALL XXXPUT		;STORE IT
	MOVE T2,-RSHLEN(T1)	;GET HEADER OF BLOCK
	CALL XXXPUT		;STORE IT
	MOVE T2,RELCAL		;GET CALLER PC
	CALL XXXPUT		;STORE IT
	MOVE T2,FORKX		;GET FORK NUMBER
	CALL XXXPUT		;STORE IT
	MOVE T2,TODCLK		;GET TIME
	CALL XXXPUT		;STORE IT

   >				;END OF IFN RESBSW

;CHECK FOR "ADDRESS WITHIN RESIDENT FREE SPACE"

	MOVE T2,RESBAS		;GET THE BEGINNING
	CAMGE T1,T2		;BEYOND IT?
	JRST RESOUT		;NO, OUT OF BOUNDS
	MOVEI T2,RESFRZ		;GET THE END
	CAML T1,T2		;BEFORE IT?
	JRST RESOUT		;NO, OUT OF BOUNDS

;CHECK FOR "LEGAL BLOCK ADDRESS"

	SUBI T1,RSHLEN		;POINT TO HEADER
	TRNE T1,3		;ON A 4-WORD BOUNDARY?
	JRST [	MOVE T1,RELRAD	;NO.  GET THE BAD ADDRESS
		MOVE T2,RELCAL	; AND THE CALLER
		BUG(RESBAD,<<T1,BADADR>,<T2,CALLER>>)
		RET]
;CHECK FOR "CONSISTENT BLOCK" - HEADER AND TRAILER ARE VERIFIED

	MOVE T4,RELGRO		;GET THE "GROWING FLAG
	JUMPN T4,RELRE1		;IF GROWING, MOVE ON
	LOAD T4,RSPOO,(T1)	;GET THE POOL NUMBER
	CAILE T4,0		;IS IT
	CAIL T4,RESQTL		; VALID?
	JRST RESINC		;NO
	LOAD T4,RSSIZ,(T1)	;GET THE NUMBER OF BLOCKS
	SKIPG T4		;IS IT POSSIBLE?
	JRST RESINC		;NO
   IFN RESHSW,<			;IF DEBUGGING
	LSH T4,2		;CONVERT TO WORDS
	ADDI T4,-1(T1)		;POINT TO TRAILER WORD
	LOAD T2,RSFLG,(T4)	;GET THE FLAG
	CAIE T2,RESFLG		;OK?
	JRST RESINC		;NO
	LOAD T2,RSHED,(T4)	;GET THE ADDR OF THE HEADER
	HRRZ T4,T1		;SAME SECTION
	CAME T2,T4		;OK?
	JRST RESINC		;NO
   >				;END OF IFN RESHSW

;UPDATE COUNTS AND FREE THE BLOCK - CHECKS FOR "BLOCK ALREADY FREE"

RELRE1:	MOVE T2,T1		;SAVE THE HEADER ADDRESS
	SUB T2,RESBAS		;GET OFFSET INTO FREE SPACE
	LSH T2,-2		;GET 4-WORD BLOCK NUMBER
	IDIVI T2,^D36		;GET POSITION OF BLOCK IN BIT TABLE
	LOAD T4,RSPOO,(T1)	;GET POOL NUMBER
	LOAD T1,RSSIZ,(T1)	;GET NUMBER OF 4-WORD BLOCKS
	ADDM T1,RESUTB(T4)	;ADD BACK THE SPACE FREED TO USAGE TABLE
	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 [MOVE T1,RELRAD	;ALREADY FREE.  GET THE BAD ADDRESS
	       MOVE T2,RELCAL	; AND THE CALLER
	       BUG(RESBAZ,<<T1,BADADR>,<T2,CALLER>>)
	       RET]
	MOVE T1,RELRAD		;GET ADDRESS PASSED BY CALLER
	SUBI T1,RSHLEN		;POINT TO HEADER WORD
   IFN RESHSW,<			;IF DEBUGGING
	SETZRO RSINU,(T1)	;TURN OFF "IN USE" BIT
   >				;END OF IFN RESHSW
	RET

RESOUT:	MOVE T1,RELRAD		;GET BAD ADDRESS
	MOVE T2,RELCAL		;GET CALLER
	BUG (RESBND,<<T1,BADADR>,<T2,CALLER>>)
	RET

RESINC:	MOVE T1,RELRAD		;GET BADADR
	MOVE T2,RELCAL		;GET CALLER
	BUG (RESCHK,<<T1,BADADR>,<T2,CALLER>>)
	RET
;CLRBTS - 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
   IFE RESBSW,<
CLRBT1:
	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PI ON
	CONSO PI,PIPION		;IS PI ON
	 TDZA T3,T3		;NO
	  PIOFF			;YES...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 [	SKIPE T3	;WAS PI ON?
		 PION		;BITS ARE ALREADY 0
		POP P,T3	;RESTORE T3
		RET]		;GIVE FAILURE RETURN WITHOUT DOING MORE
	ANDCAM T1,(T4)		;CLEAR THE BITS
	SKIPE T3		;WAS PI ON?
	 PION			;THROUGH INTERLOCKED CODE
	POP P,T3		;RESTORE T3
	JUMPLE T3,RSKP		;ANY MORE TO BE CLEARED?
	CALL BITMS2		;YES, GET NEXT BIT MASK
	JRST CLRBT1		;LOOP BACK FOR REST OF BITS
   >				;END OF IFE RESBSW

   IFN RESBSW,<
CLRBT1:	PUSH P,T3		;SAVE AN AC
	MOVE T3,T4		;COPY ADDRESS
	LSH T3,-PGSFT		;CONVERT TO PAGE NUMBER
	PUSH P,T3		;SAVE T3
	SETO T3,		;ASSUME PI ON
	CONSO PI,PIPION		;IS PI ON?
	 TDZA T3,T3		;NO
	  PIOFF			;YES...ENTER INTERLOCKED CODE
	EXCH T3,0(P)		;SAVE PI STATE...RESTORE T3
	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 [	POP P,T3	;GET PI STATE FLAG
		SKIPE T3	;WAS PI ON?
		 PION		;YES...BITS ARE ALREADY 0
		POP P,T3	;RESTORE AC
		RET]		;GIVE FAILURE RETURN WITHOUT DOING MORE
	MOVX T2,PTWR		;GET WRITE FLAG
	IORM T2,MMAP(T3)	;MAKE PAGE WRITABLE
	CLRPT (T4)		;TELL HARDWARE
	ANDCAM T1,(T4)		;CLEAR THE BITS
	ANDCAM T2,MMAP(T3)	;WRITE-PROTECT AGAIN
	CLRPT (T4)		;LET HARDWARE KNOW
	POP P,T3		;GET PI STATE FLAG
	SKIPE T3		;WAS PI ON?
	 PION			;YES...THROUGH INTERLOCKED CODE
	POP P,T3		;RESTORE AC
	JUMPLE T3,RSKP		;ANY MORE TO BE CLEARED?
	CALL BITMS2		;YES, GET NEXT BIT MASK
	JRST CLRBT1		;LOOP BACK FOR REST OF BITS
   >				;END OF IFN RESBSW
;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
	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
	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:	0			;THIS POOL NOT USED
	.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,RESAVE		;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
	SUBI T1,PGSIZ/4		;NUMBER BLOCKS ON A PAGE
	CAMG T1,RESAVE		;ARE WE WELL 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
	PUSH P,T1		;SAVE T1
	SETO T1,		;ASSUME PI ON
	CONSO PI,PIPION		;IS PI ON?
	 TDZA T1,T1		;NO
	  PIOFF			;YES...MUST BE DONE INTERLOCKED
	EXCH T1,0(P)		;SAVE PI STATE FLAG RESTORE T1
	CAME T3,RESFFB		;STILL HAVE SAME FIRST FREE BLOCK?
	JRST [	EXCH T1,0(P)	;SAVE T1 GET PI STATE FLAG
		SKIPE T1	;WAS PI ON?
		 PION		;YES...GO TRY AGAIN
		POP P,T1	;RESTORE T1 CLEAN UP STACK
		OKSKED
		JRST RESLK1]
	LDB T4,T2		;GET THE BIT
	JUMPN T4,[EXCH T1,0(P)	;SAVE T1 RESTORE PI STATE FLAG
		  SKIPE T1	;WAS PI ON?
		   PION		;YES...IF = 1, THEN IN USE SOMEWHERE
		  POP P,T1	;RESTORE T1 CLEAN UP STACK
		OKSKED
		RET]		;SO RETURN
	MOVEI T4,1		;NOT IN USE, MARK IT TAKEN
   IFN RESBSW,<
	PUSH P,T3		;SAVE AC
	MOVX T3,PTWR		;GET WRITE FLAG
	IORM T3,MMAP+<RESBTB/PGSIZ>	;SET IT
	CLRPT RESBTB		;LET HARDWARE KNOW
   >				;END OF IFN RESBSW
	DPB T4,T2		;...
   IFN RESBSW,<
	ANDCAM T3,MMAP+<RESBTB/PGSIZ>	;CLEAR WRITE-ENABLE
	CLRPT RESBTB		;LET HARDWARE KNOW
	POP P,T3		;RESTORE AC
   >				;END OF IFN RESBSW
	SOS RESFRE		;COUNT DOWN THE FREE COUNT
	SOS T1,RESFFB		;AND REMOVE IT FROM FREE POOL
	EXCH T1,0(P)		;SAVE T1 RESTORE PI STATE FLAG
	SKIPE T1		;WAS PI ON?
	 PION			;THROUGH INTERLOCKED CODE
	POP P,T1		;RESTORE T1 CLEAN UP STACK
	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

;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

ASGSWS::TDZA T3,T3		;REMEMBER THIS ENTRY
ASGSWP::SETOM T3			;REMEMBER THIS ENTRY
	STKVAR <FLAG>		;PLACE TO HOLD ENTRY TYPE
	MOVEM T3,FLAG		;SAVE IT
	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 (MONX06)	;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:	SKIPE FLAG		;WANT TO STACK IT?
	RETSKP			;NO
	MOVEM T1,FLAG		;SAVE ADDRESS
	MOVEI T2,STKCD4		;ENTRY TYPE
	CALL JSBSTK		;STACK IT
	MOVE T1,FLAG		;GET BACK BLOCK ADDRESS
	RETSKP			;RETURN WITH POINTER IN T1

;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


;FIRST, ROUTINE TO UNSTACK ENTRY

RELMSS::PUSH P,T1		;SAVE DATUM
	MOVEI T2,STKCD4		;TYPE
	CALL JSFRMV		;REMOVE ENTRY
	POP P,T1		;RESTORE DATUM
	JRST RELMES		;AND PROCEED
RELSWP::HRRZM T2,0(T1)		;GLOBAL CALL WITH LENGTH IN T2
	JUMPLE T2,[	BUG(RELFRM)]
;**;[3197] Add 1 line at RELMES+1L	DCG	10-Jan-85
RELMES::MOVE T2,T1		;SET UP FOR CALL TO RELFRE
	SETZM IPPKFR		;CLEAR FLAG TO ALLOW IPCF TO RETRY
	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

	TNXEND
	END