Google
 

Trailing-Edge - PDP-10 Archives - BB-M081Q-SM - monitor-sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
; Edit= 8833 to FREE.MAC on 20-Apr-88 by RASPUZZI (TCO 7.1278)
;Install TCO 7.1278 - supress ONSTR/OFFSTR and make RELRNG a BUGCHK again.
;TCO 7.1278 - Make RELRNG a BUGCHK for the release.
; Edit= 8803 to FREE.MAC on 18-Mar-88 by RASPUZZI
;Prevent ILMNRF BUGHLTs in the RESBSW code that sets the free space bit table
;writeable. It is only setting the first page of the bit table and we could be
;using the second page.
; UPD ID= 8686, RIP:<7.MONITOR>FREE.MAC.7,  17-Mar-88 19:22:38 by RASPUZZI
;TCO 7.1258 - Have FSPREM scan the linked free space blocks and return
;	      the largest block size.
; UPD ID= 8677, RIP:<7.MONITOR>FREE.MAC.6,   3-Mar-88 14:55:03 by RASPUZZI
;TCO 7.1252 - Change RELRNG to a BUGHLT again.
; UPD ID= 8520, RIP:<7.MONITOR>FREE.MAC.5,   9-Feb-88 15:36:24 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8337, RIP:<7.MONITOR>FREE.MAC.4,  14-Jan-88 14:37:56 by MCCOLLUM
;TCO 7.1175 - Add FSPREM to check remaining swappable pool space.
; UPD ID= 100, RIP:<7.MONITOR>FREE.MAC.3,   4-Sep-87 10:53:55 by MCCOLLUM
;TCO 7.1050 - Rewrite RESLCK so it can lock down more pages
; *** Edit 7395 to FREE.MAC by MCCOLLUM on 18-Nov-86, for SPR #21426
; Don't call MLKPG in GRORE1 unless crossing a page boundry. 
; *** Edit 7384 to FREE.MAC by MCCOLLUM on 15-Oct-86, for SPR #21288
; Add ASGF2 to FILST1. This bit should ALWAYS shadow the state of ASGF in
; FILSTS 
; *** Edit 7320 to FREE.MAC by MCCOLLUM on 12-Jun-86
; Change references of FBSIZ to FBKSIZ and define FBKSIZ in TRVAR at SETVAR 
; *** Edit 7207 to FREE.MAC by WAGNER on 9-Dec-85
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs. 
; Edit 7140 to FREE.MAC by WAGNER on 27-Aug-85, for SPR #838626 (TCO 6-1-1530)
; Modify text for RELBAD, RESBAZ, FSPARB, FSPPRE, FSPSCC, RELINC, FSPPTR and
; FSPASN BUGHLTS to reflect their being BUGHLTS instead of BUGCHKS. 
;TCO 6.1.1530 - Change text for BUGHLTS to reflect their being HLTS.
; UPD ID= 2215, SNARK:<6.1.MONITOR>FREE.MAC.74,  12-Jun-85 08:40:04 by PAETZOLD
;TCO 6.1.1443 - Fix smashed AC causing ILMNRFs in RESLK3.
; UPD ID= 2077, SNARK:<6.1.MONITOR>FREE.MAC.73,   3-Jun-85 14:36:54 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 2018, SNARK:<6.1.MONITOR>FREE.MAC.72,  28-May-85 12:08:03 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 2002, SNARK:<6.1.MONITOR>FREE.MAC.71,  24-May-85 12:00:35 by MCCOLLUM
;Change RESBAZ to a BUGHLT.
; UPD ID= 1898, SNARK:<6.1.MONITOR>FREE.MAC.70,   4-May-85 16:03:19 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1879, SNARK:<6.1.MONITOR>FREE.MAC.69,   4-May-85 12:50:19 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1848, SNARK:<6.1.MONITOR>FREE.MAC.68,  30-Apr-85 12:31:59 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1804, SNARK:<6.1.MONITOR>FREE.MAC.67,  24-Apr-85 10:17:59 by PALMIERI
;TCO 6.1.1339 Put ASGDCN and RELDCN under FTNSPSRV
; UPD ID= 1749, SNARK:<6.1.MONITOR>FREE.MAC.66,  12-Apr-85 13:41:24 by MCCOLLUM
;Change RELRNG to a HLT
; UPD ID= 1642, SNARK:<6.1.MONITOR>FREE.MAC.65,  15-Mar-85 11:50:21 by MCCOLLUM
;Change RELBAD to a HLT.
; UPD ID= 1176, SNARK:<6.1.MONITOR>FREE.MAC.64,  11-Dec-84 09:30:49 by LEACHE
;Change FSPOUT to BUGINF
; UPD ID= 1104, SNARK:<6.1.MONITOR>FREE.MAC.63,  19-Nov-84 16:08:52 by LEACHE
;Change JSB-stack  routines to use 30-bit addressing
; UPD ID= 5039, SNARK:<6.MONITOR>FREE.MAC.62,  30-Oct-84 14:18:47 by LEACHE
;Fix off-by-1 bug at LIMCHK
; UPD ID= 5034, SNARK:<6.MONITOR>FREE.MAC.61,  29-Oct-84 14:50:38 by LEACHE
;TCO 6.2265 Fix minimum block size logic
; UPD ID= 4995, SNARK:<6.MONITOR>FREE.MAC.60,  24-Oct-84 19:15:50 by LEACHE
;Fix typo in previous
; UPD ID= 4993, SNARK:<6.MONITOR>FREE.MAC.59,  24-Oct-84 19:02:45 by LEACHE
;TCO 6.2259 - Add protection against bad block lengths
; UPD ID= 4982, SNARK:<6.MONITOR>FREE.MAC.58,  23-Oct-84 15:34:11 by LEACHE
;Temporarily change FSPOUT to BUGHLT
; UPD ID= 4966, SNARK:<6.MONITOR>FREE.MAC.57,  19-Oct-84 15:22:59 by LEACHE
;More of previous
; UPD ID= 4958, SNARK:<6.MONITOR>FREE.MAC.56,  18-Oct-84 15:45:32 by LEACHE
;TCO 6.2254 Add history buffers to swappable freespace
; UPD ID= 4757, SNARK:<6.MONITOR>FREE.MAC.55,  27-Aug-84 10:41:39 by LEACHE
;TCO 6.2203 Fix bug at ASGSW1; Call FSPCK after pool is locked
; UPD ID= 4542, SNARK:<6.MONITOR>FREE.MAC.54,  15-Jul-84 10:55:52 by PURRETTA
;Update copyright notice
; UPD ID= 4182, SNARK:<6.MONITOR>FREE.MAC.53,   8-May-84 14:11:56 by LEACHE
;TCO 6.2052  Protect against allocating not-yet deallocated block at RELRE1
;Make FSPCK handle the case of totally exhausted pool
; UPD ID= 4058, SNARK:<6.MONITOR>FREE.MAC.52,  11-Apr-84 04:49:56 by LEACHE
; Fix arguments to 2 BUGCHKs
; UPD ID= 4016, SNARK:<6.MONITOR>FREE.MAC.51,  31-Mar-84 16:15:04 by PAETZOLD
;TCO 6.2019 - Replace a SUB P,BHC with an ADJSP.
; UPD ID= 3400, SNARK:<6.MONITOR>FREE.MAC.50,   3-Jan-84 13:47:01 by LEACHE
;Remove 2 routines from DEBUG conditional
; UPD ID= 3347, SNARK:<6.MONITOR>FREE.MAC.49,  19-Dec-83 15:39:39 by LEACHE
;More of previous
; UPD ID= 3217, SNARK:<6.MONITOR>FREE.MAC.48,  28-Nov-83 09:44:59 by LEACHE
;Add more sanity checking to freespace manager
; UPD ID= 3083, SNARK:<6.MONITOR>FREE.MAC.47,  26-Oct-83 12:20:50 by HALL
;Fix ASGRSB to be resident. Bug introduced by UPD ID 1795
; UPD ID= 2919, SNARK:<6.MONITOR>FREE.MAC.46,  21-Sep-83 12:01:53 by LEACHE
;Place call to FILHDR under FSPDBG conditional
; UPD ID= 2849, SNARK:<6.MONITOR>FREE.MAC.45,  19-Aug-83 14:29:41 by MURPHY
;Fix ref to section 0 at FILHDR+3.
; UPD ID= 2837, SNARK:<6.MONITOR>FREE.MAC.44,  17-Aug-83 11:31:59 by HALL
;TCO 6.1502 - Treat (1,,n) as (0,,n) in RELRES
; UPD ID= 2794, SNARK:<6.MONITOR>FREE.MAC.43,   4-Aug-83 00:29:25 by LEACHE
;TCO 6.1641 Move swappable freespace out of section zero
; UPD ID= 2642, SNARK:<6.MONITOR>FREE.MAC.42,  28-Jun-83 08:09:27 by GRANT
;TCO 6.1502 - fix bug in CHKRFS, it always checks section 0 quota
; UPD ID= 2599, SNARK:<6.MONITOR>FREE.MAC.41,  20-Jun-83 14:39:28 by HALL
;TCO 6.1689 - Move fork tables to extended section
;	Reference FKJOB via DEFSTR
;	Move EA.ENT from ASGREX to ASGRB0
; UPD ID= 2545, SNARK:<6.MONITOR>FREE.MAC.40,  31-May-83 16:44:36 by MURPHY
;TCO 6.1525 - Move RESBTB to extended section.
; UPD ID= 2444, SNARK:<6.MONITOR>FREE.MAC.39,   8-May-83 11:02:41 by HALL
;TCO 6.1641 - Move swappable and JSB free space to extended section
;	Add temporary entry points to ASGSWP and RELSWP for hiding the header
; UPD ID= 2278, SNARK:<6.MONITOR>FREE.MAC.38,  14-Apr-83 15:35:38 by HAUDEL
;More TCO 6.1502 - reference memory and not the old immediate value
; UPD ID= 2041, SNARK:<6.MONITOR>FREE.MAC.37,  20-Mar-83 13:30:18 by HALL
;Still trying
; UPD ID= 2040, SNARK:<6.MONITOR>FREE.MAC.36,  20-Mar-83 13:27:22 by HALL
;Typo in previous edit
; UPD ID= 2037, SNARK:<6.MONITOR>FREE.MAC.35,  20-Mar-83 12:42:07 by HALL
;TCO 6.1502 - allow free space in extended section
;	Make ASGRSB use full word in AC 2
;	In ASGREX, check PC of caller if requesting extended section
;	In ASGREX, force section 0/1 free space if free space not created yet
;	In RELRES, check for PC in section 0 if returning extended free space
;	In RELRES, don't lose section number when pointing to trailer word
;	Remove temporary code limiting all actions to section 0 free space
; UPD ID= 1800, SNARK:<6.MONITOR>FREE.MAC.34,  14-Feb-83 15:03:20 by HALL
;TCO 6.1502 - allow free space in extended section
;	Add CHKRFS
;	Allow multiple kinds of free space
; UPD ID= 1755, SNARK:<6.MONITOR>FREE.MAC.33,   3-Feb-83 13:53:50 by GRANT
;TCO 6.1493 - add new UNITS pool to resident free space
;Clean up the comments, page boundaries
; UPD ID= 1535, SNARK:<6.MONITOR>FREE.MAC.31,  16-Dec-82 12:43:27 by HAUDEL
;Add more code to RESBSW conditional assembly
; UPD ID= 1530, SNARK:<6.MONITOR>FREE.MAC.30,  11-Dec-82 09:52:10 by HAUDEL
;Change RESBSW conditional assembly code
; UPD ID= 1529, SNARK:<6.MONITOR>FREE.MAC.29,  11-Dec-82 09:39:14 by HAUDEL
;No change with the edit, do to user error with ALU
; UPD ID= 1373, SNARK:<6.MONITOR>FREE.MAC.28,  25-Oct-82 11:39:00 by GRANT
;TCO 6.1326 - add header word to swappable free space blocks
; UPD ID= 844, SNARK:<6.MONITOR>FREE.MAC.27,   6-Jun-82 12:54:47 by CDUNN
;Fix RELFRM BUGHLT after move from BUGS.MAC. Also fix half removed
;BUGHLTs...
; UPD ID= 841, SNARK:<6.MONITOR>FREE.MAC.26,   4-Jun-82 22:03:08 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 812, SNARK:<6.MONITOR>FREE.MAC.25,   2-Jun-82 11:40:31 by GRANT
;TCO 6.1150 - Don't update block count until address has been verified
; UPD ID= 519, SNARK:<6.MONITOR>FREE.MAC.24,  17-Mar-82 13:58:06 by GRANT
;TCO 6.1071 - Clear left half of returned header word in RELFR6
; UPD ID= 411, SNARK:<6.MONITOR>FREE.MAC.23,  19-Feb-82 18:07:09 by WALLACE
;TCO 6.1062 - Add routine RELJFR, to Release JSB Free Space
; 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

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH PROLOG

	TTITLE FREE		; Storage routines
	SWAPCD

;NO SPECIAL AC DEFINITIONS HEREIN

;LOCAL DEFINITIONS FOR JSBSTK

;Definitions for stack record
DEFSTR (JSCOD,JSSTCD,17,18)		;THE CODE
DEFSTR (JSFRK,JSSTFK,17,18)		;THE FORK HANDLE
DEFSTR (JSLVL,JSSTFK,35,18)		;THE INTERRUPT LEVEL
	SUBTTL Swappable and JSB Free Space Manager (old)

;These routines assign and release free space from two pools: swappable
;free space and JSB free space. Each area is identified by a block of
;words at the beginning of the area. The caller specifies which
;area is to be used by passing the address of the header. The format
;of the header is as follows:

;	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
;ASGSWP - ROUTINE TO ASSIGN SPACE FROM THE SWAPPABLE 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
   IFN SWPHSW,<
	MOVE T4,(P)		;GET CALLER
   >
	STKVAR <FLAG,CALLR>	;FLAG:  PLACE TO HOLD ENTRY TYPE
				;CALLR:  CALLER'S PC
	MOVEM T3,FLAG		;SAVE ENTRY TYPE
   IFN SWPHSW,<
	MOVEM T4,CALLR		;SAVE CALLER
	AOS T1			;MAKE ROOM FOR HEADER WORD
   >
	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
   IFN SWPHSW,<
	SOS (T1)		;ADJUST COUNT FOR CALLER
   >
	HRRZS T2,0(T1)		;INITIALIZE SPACE TO 0'S
   IFN SWPHSW,<
	MOVEM T2,1(T1)		;PUT IN COUNT
	MOVE T3,CALLR		;RETRIEVE CALLER
	MOVEM T3,(T1)		;PUT IT IN 
	AOS T1			;ADJUST ADDRESS FOR CALLER
   >
	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

	ENDSV.

;NOTE: This entire page is temporary. Don't call these routines without
;talking to people about it first.

;ASGSWH - Temporary version of ASGSWP that hides the header from the
;caller. Will not do stacking.

;Caller should not expect to find count in first word of free space

ASGSWH:	STKVAR <ASGSIZ,ASGADR>
	MOVEM T1,ASGSIZ		;SAVE COUNT USER REQUESTED
	AOS T1			;MAKE ROOM FOR HIDDEN HEADER
	MOVE T2,T1		;SET UP FOR ASGFRE
	MOVEI T1,SWPFRE
	CALL ASGFRE
	 RETBAD (MONX06)
	AOS T1			;POINT PAST THE HEADER
	MOVEM T1,ASGADR		;SAVE ADDRESS TO RETURN TO CALLER
	SETZM (T1)		;ZERO THE FIRST WORD AFTER HEADER
	MOVE T2,T1		;SOURCE
	MOVE T3,T2
	ADDI T3,1		;DESTINATION
	MOVE T1,ASGSIZ		;SIZE
	SUBI T1,1
	CALL XBLTA
	MOVE T1,ASGADR		;RETURN ADDRESS OF FIRST DATA WORD
	RETSKP

	ENDSV.

;RELSWH - Releasing version of ASGSWH. Assumes caller never touched the
;header

RELSWH:
	MOVE T2,T1		;SET UP FOR RELFRE
	SOS T2			;POINT TO THE HEADER THAT WAS HIDDEN
	MOVEI T1,SWPFRE
	CALL RELFRE
	RET
;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.(HLT,RELFRM,FREE,SOFT,<Illegal to deassign 0 free space>,,<

Cause:	This is a free space problem.  The calling routine is trying to release
	a block of storage of zero length.  It is illegal to free a block of
	zero length.

Action:	Look at the dump.  Backing up the stack will show which routine made
	the call to release the storage.
>)]
RELMES::
   IFN SWPHSW,<
	MOVE T2,(T1)		;GET "USER'S HEADER" WORD
	AOS T2			;ADJUST THE COUNT
	MOVEM T2,-1(T1)		;PUT IT IN "REAL HEADER"
	SOS T1			;GET "REAL HEADER" ADDRESS
   >
	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
;ASGFRE - 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

ASGFRE::SKIPG B			;CHECK FOR LEGAL REQUEST
	BUG.(HLT,ASGFR0,FREE,SOFT,<ASGFRE - Illegal to assign 0 free space>,,<

Cause:	An illegal request for free space is being made.  The calling routine
	is asking for zero words of free space.

Action:	Look at the dump.  By backing up the stack you
	should be able to tell what routine called for the illegal
	free space.


>)
	SKIPGE INTDF		;IS THE PROCESS NOINT?
	JRST [	MOVE C,0(P)	;GET PC OF THE CALL
		BUG.(CHK,ASGINT,FREE,SOFT,<ASGFRE called OKINT>,<<C,CALLER>>,<

Cause:	This is a free space problem.  Calls to swapable free space
	routines should be made only while the calling process is NOINT.  The
	calling routine is not protecting itself from losing free space.  It is
	OKINT.  Since it is OKINT it could get interupted and never return,
	thus losing the free block assigned.

Action:	Make the routine be NOINT until it has ensured that the block will
	be freed when it is interrupted (e.g. JSB stack).

Data:	CALLER -  The address of the calling routine

>)
		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:
	ADJSP P,-1		; Clean up one stack location
	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.(CHK,RELINT,FREE,SOFT,<RELFRE called OKINT>,<<A,CALLER>>,<

Cause:	This is a free space problem.  The calling routine is trying to release
	a swapable free space block while it is OKINT.  This is dangerous since
	it could get interrupted and loose the block.  All
	free space actions should occur while NOINT.

Action:	Make the calling routine become NOINT when it removes the address
	of the block about to be released from the database.  The routine
	can be made OKINT when control is returned to it.

Data:	CALLER - The address of the calling routine.
>)
		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:	MOVE C,(P)		;GET ADDRESS OF FREE STORAGE HEADER
	BUG.(CHK,RELRNG,FREE,SOFT,<RELFRE - Block out of range>,<<B,BLOCK>,<C,POLHDR>,<A,POLLOW>,<D,POLHGH>>,<

Cause:	This is a free space problem.  The caller to the free space
	routines is trying to return a block that was not given
	out by the free space manager.  The block is outside the
	range of free space management.

Action:	If the problem persists, change the CHK to a HLT and
	look through the dump.  By looking at the stack you
	should be able to determine who called for the releasing
	of the block.

Data:	BLOCK - Address of block being released
	POLHDR - Address of free storage header (e.g. ASGRES)
	POLHGH - High address of free space pool
	POLLOW - Low address of free space pool
>)				;[7.1278] Make a CHK for official release
	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
	TLZ T4,-1		;CLEAR OUT LH - JUST IN CASE USER DIDN'T
	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.(HLT,RELBAD,FREE,SOFT,<RELFRE - Bad block being released>,<<CX,CALLER>,<A,POLHDR>,<B,LSTBLK>,<C,NXTBLK>>,<

Cause:	This is a free space problem.  The block being returned does not fit
	into the free space.  When blocks are returned to the free space pool,
	there is a consistency check performed.  The block is merged into
	existing blocks that follow it in free space.  This block overlaps
	into existing free blocks.  It cannot be merged.

Action:	Looking at the stack will show the caller.  It is possible that the
	length of the current block is incorrect.  It is equally likely that
	the block(s) before this block (in free space) have had incorrect
	lengths on return.  Thus, the caller may not be the culprit.

Data:	CALLER - Caller to this BUGHLT
	POLHDR - Address of header of this pool
	LSTBLK - Address of last block before this one
	NXTBLK - Address of first block after this one
>)
	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


;RELJFR - Release JSB Free Space
;T2/ Location of Block to Be Returned
;	CALL RELJFR
; Returns +1: Always

RELJFR::MOVEI T1,JSBFRE		;Get address of JSB Free Space Header
	CALLRET RELFRE		;  and call routine to release the space
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
COMMENT \

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

Note - although labeled a "stack", the data-structure functions as
a simple table.

For 6.1, the JSB-stack routines have been changed to store a 36-bit
datum.  Comments in the code about "old-style freespace manager"
and "change for 30-bit addressing" indicate instructions that should
be changed if the JSB stack itself is ever moved to an extended section.

	JSB stack descriptor (in JSB)


				JSFSTK:
         !=======================================================!
JSSTCN   !                Size of stack in words                 !
         !=======================================================!
JSSTCC   !           Current number of records in use            !
         !=======================================================!
JSSTMR   !          Maximum number of available records          !
         !=======================================================!
JSSTAD   !                  Pointer to stack                     !
         !=======================================================!




Format of single stack record:

	!-------------------------------------------------------!
JSSTCD	!  ENTRY TYPE CODE (JSCOD)  !          Unused           !
	!-------------------------------------------------------!
JSSTFK	!   SYSTEM FORK # (JSFRK)   !    PSI LEVEL # (JSLVL)    !
	!-------------------------------------------------------!
JSSTDT  !                          DATA                         !
	!-------------------------------------------------------!

	Record size = JSRSZ

	\		;End comment
;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,SKDATM,SKCODE>	;WORK STORAGE
	HRRZM A,SKDATM		;SAVE ARGUMENTS
	CAILE B,STKHWD		;Halfword datum?
	MOVEM A,SKDATM		;No, fullword
	MOVEM B,SKCODE		;""
	NOINT			;PREVENT INTS
	LOCK JSFLCK		;LOCK THE STACK
	SKIPN JSFSTK+JSSTAD	;HAVE A STACK YET?
	JRST ASGSTK		;No, go get one
	MOVE D,JSFSTK+JSSTCC	;Get current record count
	CAMGE D,JSFSTK+JSSTMR	;Room for more?
	JRST JSBST1		;Yes, go use it

	;Stack is full
	MOVE B,JSFSTK+JSSTCN	;Get size of existing stack
	ADDI B,JSSTSZ		;GET MORE SPACE THIS TIME
	CALL JSBST4		;GO GET SOME
	 JRST JSBSF5		;FAILED. GIVE IT UP
	MOVEM A,SVA		;Save address of new block
	MOVE A,JSFSTK+JSSTCN	;Get current stack size
	SOS A			;Discount the header word - only needed
				; for old-style freespace manager

	MOVE B,JSFSTK+JSSTAD	;Get address of current stack
	MOVE C,SVA		;Get address of new stack
	XBLT. A			;Move the stack
	MOVEI A,JSBFRE		;Release to this pool
	MOVE B,JSFSTK+JSSTAD	;Get address of old stack

	SOS B			;Reveal the header - only needed for old-style
				; freespace manager
	CALL RELFRE		;Release the space
	MOVEI A,JSSTSZ		;Get size-increment
	ADDM A,JSFSTK+JSSTCN	;Record the size of new stack
	MOVE C,SVA		;Get pointer to new stack
	;Change to MOVEM for 30-bit addressing
	HRRZM C,JSFSTK+JSSTAD	;Save it

JSBST0:	MOVE A,JSFSTK+JSSTCN	;Get size of stack
	IDIVI A,JSRSZ		;Divide by words per record
	MOVEM A,JSFSTK+JSSTMR	;Save maximum # of records

JSBST1:	MOVE D,JSFSTK+JSSTMR	;Fetch maximum # records	
	MOVE C,JSFSTK+JSSTAD	;Get stack address
JSBST2:	SKIPN JSSTCD(C)		;THIS ONE FREE?
	JRST JSBST3		;YES
	ADDI C,JSRSZ		;Step to next record
	SOJG D,JSBST2		;NO KEEP LOOKING

	BUG.(HLT,JSTERR,FREE,SOFT,<JSB stack error>,,<

Cause:	This is a problem with the JSB-stack logic; the count for the stack
	indicated that free cells were available, however none could be
	found.

Action: Analyze the dump.

>)


;INSERT ENTRY AT CURRENT STACK CELL		

JSBST3:	MOVE A,SKDATM		;THE DATUM
	MOVEM A,JSSTDT(C)	;STASH IT
	MOVE A,PSIBIP		;RECORD CURRENT BREAK LEVEL
	JFFO A,.+1
	STOR B,JSLVL,(C)
	MOVE B,SKCODE		;THE CODE
	STOR B,JSCOD,(C)	;STORE THE CODE
	MOVE A,FORKX		;CURRENT FORK
	STOR A,JSFRK,(C)	;SAVE THIS
	AOS JSFSTK+JSSTCC	;Increment current record count
	JRST JSBSF5		;GO FINISH UP

	;Get initial stack
ASGSTK:	MOVEI B,JSSTSZ+1	;Get this much space
				; +1 to hide the header - only needed for
				; old style freespace manager
	MOVEM B,JSFSTK+JSSTCN	;Save it
	CALL JSBST4		;GO ASSIGN SOME FREE SPACE
	 JRST JSBSF5		;FAILED. GIVE IT UP
	SETZM JSFSTK+JSSTCC	;Reset current count
	MOVEM A,JSFSTK+JSSTAD	;Save pointer
	JRST JSBST0		;Return with stack available

;GET SOME SPACE FOR LARGER STACK

JSBST4:	CALL ASGJFR		;GET IT
	 RETBAD			;NONE THERE
	AOS A			;Hide the header - only needed for old style
				; freespace manager
	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 PSIPIB
JSBSF6:	SKIPG JSFSTK+JSSTCC	;HAVE ANY ENTRIES IN THE STACK?
	JRST JSBSF5		;NO, GO FINISH UP
	MOVE D,JSFSTK+JSSTMR	;Get max # records
	MOVE C,JSFSTK+JSSTAD	;Get stack pointer
JSBSF1:	SKIPN JSSTCD(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:	ADDI C,JSRSZ		;Step to next record
	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
	MOVE A,JSSTDT(C)	;THE DATUM
	SETZM JSSTCD(C)		;FREE ENTRY
	MOVE B,CODTBL-1(B)	;FETCH ROUTINE ADDRESS
	CALL 0(B)		;CALL IT
	SOS JSFSTK+JSSTCC	;Decrement current count
	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
	SKIPG JSFSTK+JSSTCC	;HAVE ANY ENTRIES IN THE STACK?
	JRST JSBSF5		;NO, GO WRAP UP
	STKVAR <SAVDTM,SAVCOD>	;WORK CELLS
	HRRZM A,SAVDTM		;SAVE ARGUMENTS
	CAILE B,STKHWD		;Halfword datum?
	MOVEM A,SAVDTM		;No, fullword
	MOVEM B,SAVCOD

	MOVE C,JSFSTK+JSSTAD	;Get pointer
	MOVE D,JSFSTK+JSSTMR	;Get max record count
JSFRM1:	SKIPE JSSTCD(C)		;ONE HERE?
	JRST JSFRM2		;YES
JSFRM3:	ADDI C,JSRSZ		;Increment to next record
	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
	MOVE A,JSSTDT(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 JSSTCD(C)		;CLEAR IT
	SOS JSFSTK+JSSTCC	;Decrement current record count
	JRST JSBSF5		;GO WRAP UP
	SUBTTL Resident Free Space Manager

COMMENT *

;For each type of resident free space, there is a descriptor block
;containing information that previously was stored in resident locations
;The following list contains the offset, the name that was used before
;Release 6, and the meaning of the offset.

Offset	Old	Meaning
	Name

.REBAS	RESBAS	Starting address of free space
.REEND	RESFRZ	Address of last word of free space
.RETOT	NRESFB	Total size of free space in blocks
.REPR1	RESMIN	If remaining space less than this, allocate only priority 1
.REGRO	RESAVE	If remaining space less than this, grow free space (larger than .REPR1)
.REBTB	RESBTB	Address of start of bit table
.REBTL	RESBTL	Length of bit table (words)
.RETFR	RESFRE	Total remaining unallocated blocks
.REFFB	RESFFB	Number of block just past end of free space
.REPMX	RESQTL	Number of pools
.REQTA	RESQTB	Address of block containing quota for each pool
.REPFR	RESUTB	Address of block containing count of unallocated blocks per pool
*

.REBAS==0	;RESBAS	Starting address of free space
.REEND==1	;RESFRZ Address of last word of free space
.RETOT==2	;NRESFB	Total size of free space in blocks
.REPR1==3	;RESMIN	If remaining space less than this, allocate only priority 1
.REGRO==4	;RESAVE	If remaining space less than this, grow free space (larger than .REPR1)
.REBTB==5	;RESBTB	Address of start of bit table
.REBTL==6	;RESBTL	Length of bit table (words)
.RETFR==7	;RESFRE	Total remaining unallocated blocks
.REFFB==10	;RESFFB	Number of block just past end of free space
.REPMX==11	;RESQTL	Number of pools
.REQTA==12	;RESQTB	Address of block containing quota for each pool
.REPFR==13	;RESUTB	Address of block containing count of unallocated blocks per pool
;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
;	.RESUP		UNITS POOL - USED BY PHYSIO AND DSKALC
;Areas of free space are preceded by a header. If debugging is turned on,
;they are also followed by a trailer. The format is as follows:

COMMENT [

	 +-------------------------------------------------------+
	 !          Pool #           !        # of blocks        !
	 !-------------------------------------------------------!
*	 ! Flags  !                 PC of caller                 !
	 !-------------------------------------------------------!
	 !                  Body of free block                   !
	 !-------------------------------------------------------!
	 !                           .                           !
	 !-------------------------------------------------------!
	 !                           .                           !
	 !-------------------------------------------------------!
	 !                           .                           !
	 !-------------------------------------------------------!
	 !                  Body of free space                   !
	 !-------------------------------------------------------!
*	 !          101010           !     Address of header     !
	 +-------------------------------------------------------+
[

;* These words appear only if RESHSW is nonzero

;Flags:

;	Bit 0 - ON if block is in use, OFF if it is not

;If debugging is on, a trace is made of the events, and stored in locations
;starting at XXXBUF. At any time, XXXPTR points to the word most recently
;written.

;The format is as follows:

COMMENT [

	 +-------------------------------------------------------+
	 !             0             !          010101           !
	 !-------------------------------------------------------!
	 !           Flags           ! Address of start of block !
	 !-------------------------------------------------------!
	 !          Pool #           !    # of 4-word blocks     !
	 !-------------------------------------------------------!
	 !                      Caller's PC                      !
	 !-------------------------------------------------------!
	 !           Job #           !        Fork handle        !
	 !-------------------------------------------------------!
	 !                        TODCLK                         !
	 !-------------------------------------------------------!
	 !       GETZ counter        !       GETZ2 counter       !
	 +-------------------------------------------------------+
[

;Flags:

;	Left half is 0 if assigning, -1 if deassigning
;ASGRES - Assign resident free space

;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 following flag is defined and should be used by callers whose free
;space must be in section 0. It is not yet supported but will be some day

;	RS%SE0==:1B0		;SPACE MUST BE IN SECTION 0 



;ENTRY FOR BLCAL. CALLS

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

	RESCD

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

	ENDBS.

ASGRES::MOVE T4,(P)		;GET PC OF CALLER
ASGRB0:	EA.ENT			;NEED THIS FOR FORK TABLES IN DEBUG CODE
   IFN RESBSW,<			;USE RING BUFFER TO RECORD ASSIGNMENTS
	CALL ASGREX		;DO THE WORK
	 RET			;FAILED
	HRRZI T2,010101		;SET UP FRAME MARK
	CALL XXXPUT		;STORE IT
	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
	CAIL T2,0		;IS IT SCHEDULER
	JRST [ LOAD T3,FKJO%,(T2) ;NO. GET JOB NUMBER
	       HRL T2,T3	;COMBINE JOB AND FORK NUMBERS
	       JRST .+1]
	CALL XXXPUT		;STORE IT
	MOVE T2,TODCLK		;GET TIME
	CALL XXXPUT		;STORE IT
	MOVE T2,XXXCT2		;GET COUNTER
	HRL T2,XXXCT1		;GET THE OTHER COUNTER
	CALL XXXPUT
	SETZM XXXCT2		;ZERO THE COUNTER
	MOVEI 2,1
	MOVEM 2,XXXCT1		;RESET XXXCT1
	RETSKP			;SKIP


	XXXMAX==^D3000		;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(XXXCT1,1)			;COUNTER FOR GETZ LOOP
RS(XXXCT2,1)			;COUNTER FOR GETZ2

RS(XXXPTR,1)			;INDEX INTO BUFFER
RS(XXXBUF,XXXMAX)		;BUFFER
;ASGREX - Worker routine for ASGRES
;ACCEPTS IN T1/	PRI ,, LEN
;	    T2/	FLAGS ,, POOL #
;	    T4/ PC OF CALLER 
;	CALL ASGREX
;RETURNS +1:	FAILED TO GET THE REQUESTED SPACE
;		T1/ ERROR CODE
;	 +2:	ADDRESS OF BLOCK IN T1

ASGREX:	
   >				;END OF IFN RESBSW
	ASUBR <ASGREA,ASGREF,ASGREC,ASGCAL>
	ACVAR <W1>
	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
	XMOVEI W1,RESNTB	;ASSUME NON-ZERO SECTION NUMBER
	TXNE T2,RS%SE0		;DID USER REQUEST SECTION 0?
	XMOVEI W1,RES0TB	;YES. RESTRICT USE TO SECTION 0

;IF THE CALLER OF THIS ROUTINE IS RUNNING IN SECTION 0 ON AN EXTENDED
;ADDRESSING MACHINE, THERE MAY BE TROUBLE LATER WHEN THE CALLER USES
;THE ADDRESS RETURNED BY THIS ROUTINE. THIS ROUTINE RETURNS AN ADDRESS
;IN A NON-ZERO SECTION, AND THE CALLER PROBABLY DOES AN INDEXED REFERENCE
;TO THAT ADDRESS. IN SECTION 0, THE LEFT HALF OF THE AC WILL BE IGNORED.
;THE CODE UNDER THE CONDTIONAL TESTS FOR THIS CASE AND BUGHLT'S, THUS
;AVERTING LATER DISASTER.

IFN SEC0SW,<			;IF TESTING FOR RUNNING IN SECTION 0
	TXNE T2,RS%SE0		;REQUESTED SECTION 0?
	JRST ASGRE2		;YES. DON'T CHECK PC OF CALLER
	TXNN T4,VSECNO		;REQUESTED EXTENDED. RUNNING IN SECTION 0?
	BUG.(HLT,SEC0FS,FREE,SOFT,<ASGRES called from section 0>,<<T4,PC>>,<

Cause:	A routine in FREE that provides free space in a non-zero section
	was called from section 0. This is dangerous because the routine
	returns a 30-bit address, and the caller will probably use the
	address in an index register, thus losing the section number.

Action:	It is essential that any code that references a non-zero section
	run in a non-zero section. The long-term solution is to study the
	entire stack and make all the code run in section 1. For the short
	term, it may be possible to insert an EA.ENT at the beginning of
	the routine that called ASGRES. Note that this may lead to other
	problems, including slower performance and ILMNRF BUGHLT's.

Data:	PC - the PC from which ASGRES was called

>)
>				;END SECTION 0 CHECK

	;..
	;..

ASGRE2:	SKIPE XRESFL		;IF WE'RE NOT READY YET (MAP NOT SET UP)
	XMOVEI W1,RES0TB	; THEN GIVE SECTION 0 REGARDLESS
	HRRZ T2,ASGREF		;GET POOL NUMBER
	SKIPE T2		;0 ISN'T A LEGAL POOL NUMBER
	CAML T2,.REPMX(W1)	;IS POOL NUMBER TOO LARGE?
	JRST [	BUG.(CHK,ASGREQ,FREE,SOFT,<Illegal pool number given to ASGRES>,,<

Cause:	This is a free space problem.  The caller is requesting resident
	free space.  In T2 the caller is providing a pool number for where
	the free space should come from.  This pool number is incorrect.

Action:	If the problem persists change the BUGCHK to a BUGHLT to find the
	culprit. The caller putting a bad value into T2.


>)
		RETBAD (MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
	ADD T2,.REPFR(W1)	;POINT TO TABLE OF FREE BLOCKS PER POOL
	CAML T1,(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 MINIMUM, WE MAY WANT TO EXPAND THE POOL.

	;..
ASGRE0:	MOVE T2,.RETFR(W1)	;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.(CHK,ASGREP,FREE,SOFT,<Illegal priority given to ASGRES>,,<

Cause:	This is a free space problem.  The caller is asking for resident
	free space.  In T3 the caller gives a priority for this request.
	The priority determines how ASGRES is going to handle this request
	when free space is low.  This priority is out of range.

Action:	If the problem persists change the BUGCHK to a BUGHLT and look
	through the dump to find the caller.


>)
		RETBAD(MONX03)]	;RETURN 'MONITOR INTERNAL ERROR'
	CAMGE T2,.REPR1(W1)	;WOULD THIS PUT US UNDER THE MINIMUM?
	JRST [	CAIE T3,.RESP1	;YES. 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
	MOVE T2,.REBTB(W1)	;GET START OF BITTABLE
	MOVE T3,.REBTL(W1)	;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
	ADD T3,.REPFR(W1)	;POINT TO TABLE OF FREE BLOCKS PER POOL
	ADDM T2,(T3)		;DECREMENT THE POOL COUNT OF FREE BLOCKS
	ADDB T2,.RETFR(W1)	;DECREMENT THE TOTAL COUNT OF FREE BLOCKS
	;..
;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,.REFFB(W1)	;GET FIRST FREE BLOCK
	CAMGE T2,.REGRO(W1)	;BELOW THE AVERAGE DESIRED?
	CAML T3,.RETOT(W1)	;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,.REBAS(W1)	;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
	MOVE T4,W1		;T4/ ADDRESS OF DESCRIPTOR BLOCK
	CALL GRORES		;TRY TO EXPAND THE FREE POOL
	 RETBAD ()		;COULDNT GET ANY MORE
	JRST ASGRE0		;GOT SOME, GO SEE IF THIS WAS ENOUGH
	ENDAV.			;END ACVAR
;ROUTINE TO EXPAND THE RESIDENT FREE POOL
;ACCEPTS IN T1/	PRIORITY NUMBER (.RESP1, .RESP2, OR .RESP3)
;	    T4/ ADDRESS OF DESCRIPTOR BLOCK
;	CALL GRORES
;RETURNS +1:	COULD NOT GET ANY
;		T1/ ERROR CODE
;	 +2:	FOUND SOME

GRORES:	STKVAR <<GRORET,2>,GROADR>
	MOVEM T4,GROADR		;SAVE ADDRESS OF DESCRIPTOR BLOCK
	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. .REFFB 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,.REFFB(T4)	;GET FIRST FREE BLOCK
	TRNE T1,177		;IS THERE ANY LEFT ON THIS PAGE?
	CAML T1,.RETOT(T4)	;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,.REFFB(T4)	;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.

	;..
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,.REFFB(T4)	;GET FIRST FREE BLOCK
	CAML T1,.RETOT(T4)	;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,.REFFB(T4)	;STORE NEW POINTER
	SKIPE T3		;WAS PION?
	PION			;YES
	POP P,T3		;RESTORE T3
	DMOVEM T1,GRORET	;STORE THE BLOCK NUMBER
	TRNE T1,177		;[7395]DID WE JUMP A PAGE BOUNDRY?
	JRST GROR1A		;[7395]NO
	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,.REBAS(T4)
	CALL FPTA		;LOCK IT DOWN
	CALL MLKPG		;...
	DMOVE T1,GRORET		;GET BLOCK NUMBER BACK AGAIN
GROR1A:	MOVE T4,GROADR		;[7395]RESTORE ADDRESS OF DESCRIPTOR BLOCK
	;..
;AT THIS POINT THE PAGE TO WHICH .REFFB PREVIOUSLY POINTED IS LOCKED
;DOWN. .REFFB HAS BEEN MOVED TO THE BEGINNING OF THE NEXT PAGE.

;	T1/ .REFFB BEFORE THE EXPANSION
;	T2/ .REFFB AFTER THE EXPANSION
;	T4/ ADDRESS OF DESCRIPTOR BLOCK FOR FREE SPACE

;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,.REBAS(T4)	;...
	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
	ADD T3,.REPFR(T4)	;POINT TO TABLE OF FREE BLOCKS PER POOL
	MOVNS T2		;FUDGE THE USE COUNT
	ADDM T2,(T3)		;DECREASE COUNT OF FREE BLOCKS FOR 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
	MOVE 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:	
IFN RESBSW,<
	AOS XXXCT2		;INCREMENT THE COUNTER
	>
	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

IFN RESBSW,<
	AOS XXXCT1		;INCREMENT THE COUNTER
>
	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
IFN RESBSW,<
	AOS XXXCT1		;INCREMENT THE COUNTER
>
	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
; * * * *
;NOTE: This works only as long as the bit tables are in sections 0/1
; * * * *
   IFN RESBSW,<
SETOS1:	PUSH P,T2		;SAVE SOME ACS
	PUSH P,T3		;THAT WE NEED
	HRRZ T2,T4		;COPY ADDRESS WITHIN SECTION
	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,@[EP. RSECMP(T2)] ;SET WRITE BIT IN MMAP
	CLRPT (T4)		;MAKE IT SEEN BY HARDWARE
	IORM T1,(T4)		;NOW MARK THESE AS IN USE
	ANDCAM T3,@[EP. RSECMP(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
	HRRZ 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,@[EP. RSECMP(T2)] ;WRITE-ENABLE BITTABLE
	CLRPT (T4)		;LET HARDWARE KNOW
	ANDCAM T1,(T4)		;CLEAR THESE BITS
	ANDCAM T3,@[EP. RSECMP(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:
;	T1/ ADDRESS OF THE BLOCK   (RS%GRO INDICATES "GROWING")

;	CALL RELRES

;RETURNS +1:	ALWAYS

RELRES::MOVE T4,(P)		;GET PC OF CALLER
	EA.ENT
	COMMENT %
	STKVAR LEGEND
		RELGRO		;Flag indicating block release is really part
				;of pool-growth mechanism
				;0 = not growing; -1 = growing
		RELRAD		;Address of block being released
		RELCAL		;PC of caller
		RELADR		;Address of pool descriptor block
		RELSIZ		;# of 4-word blocks in returned block
		RELPLN		;Pool number
		%		;End comment

	STKVAR <RELGRO,RELRAD,RELCAL,RELADR,RELSIZ,RELPLN>

	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 T4,RELCAL		;SAVE PC OF CALLER
	XMOVEI T3,RES0TB	;ASSUME SECTION 0

;MONUMENT: When ASGRES assigns free space from section 0/1, it returns an
;address of the form (0,,n). However, because sections 0 and 1 are mapped
;together, (1,,n) is also a valid address.  This could be generated if a
;user of free space did XMOVEI AC,(T1) while running in section 1, and then
;saved (AC) as the address of free space. The kludge below recognizes that;possibility by treating the two addresses as equivalent, and then forcing
;the section 0 address before checking the bounds.

	HLRZ T2,T1		;GET SECTION NUMBER OF BLOCK
	CAIG T2,1		;0 OR 1?
	IFNSK.
	  HRRZS T1		;YES. FORCE SECTION 0 ADDRESS
	  HRRZS RELRAD
	ELSE.
IFN SEC0SW,<			;IF TESTING FOR RUNNING IN SECTION 0
	  TXNN T4,VSECNO	;RUNNING IN SECTION 0?
	  BUG.(HLT,SEC0RL,FREE,SOFT,<RELRES called from section 0>,<<T4,PC>>,<

Cause:	A routine in FREE that releases free space was called from section
	0 with an address of free space in a non-zero section. This probably
	means that the caller should be running in a non-zero section, since
	any attempt to reference the free space would fail.

Action:	It is essential that any code that references a non-zero section
	run in a non-zero section. The long-term solution is to study the
	entire stack and make all the code run in section 1. For the short
	term, it may be possible to insert an EA.ENT at the beginning of
	the routine that called RELRES. Note that this may lead to other
	problems, including slower performance and ILMNRF BUGHLT's.

Data:	PC - the PC from which RELRES was called

>)
>				;END SECTION 0 CHECK
	  XMOVEI T3,RESNTB	;EXTENDED SECTION FREE POOL
	ENDIF.
RELRE3:	MOVEM T3,RELADR		;SAVE ADDRESS OF DESCRIPTOR BLOCK
	MOVE T2,T1		;Get block address in T2
	SUBI T2,RSHLEN		;Point to header word
	LOAD T4,RSPOO,(T2)	;Get pool number
	MOVEM T4,RELPLN		;Save it
	LOAD T4,RSSIZ,(T2)	;GET NUMBER OF 4-WORD BLOCKS
	MOVEM T4,RELSIZ		;Save it
   IFN RESBSW,<			;USE RING BUFFER TO RECORD RELEASING
	HRRZI T2,010101		;SET UP FRAME MARK
	CALL XXXPUT		;STORE IT
	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
	CAIL T2,0		;IS IT SCHEDULER
	JRST [ LOAD T3,FKJO%,(T2) ;NO. GET JOB NUMBER
	       HRL T2,T3	;COMBINE WITH FORK NUMBER
	       JRST .+1]
	CALL XXXPUT		;STORE IT
	MOVE T2,TODCLK		;GET TIME
	CALL XXXPUT		;STORE IT
	MOVEI 2,0
	CALL XXXPUT		;DUMMY ENTRY FOR SYMMETRY

   >				;END OF IFN RESBSW

;CHECK FOR "ADDRESS WITHIN RESIDENT FREE SPACE"

	MOVE T3,RELADR		;RESTORE ADDRESS OF DESCRIPTOR BLOCK
	CAML T1,.REBAS(T3)	;ADDRESS PRECEDES START OF FREE SPACE?
	CAML T1,.REEND(T3)	;NO. FOLLOWS END OF FREE SPACE?
	JRST RESOUT		;ADDRESS IS 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.(CHK,RESBAD,FREE,SOFT,<RELRES - Illegal address passed to RELRES>,<<T1,BADADR>,<T2,CALLER>>,<

Cause:	This is a free space problem.  The caller is trying to release some
	resident free space.  The address being specified is not a legal
	resident free space address.

Action:	If the problem persists change the BUGCHK to a BUGHLT and find the
	caller.  The caller is providing an illegal address.
	Find where the caller get the address and how that location gets
	modified.

Data:	BADADR - the address given to the free space manager
	CALLER - the PC when the free space manager was called
>)
		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
	CAML T4,.REPMX(T3)	; 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
	ADD T4,T1		;POINT TO TRAILER WORD
	SOS T4
	LOAD T2,RSFLG,(T4)	;GET THE FLAG
	CAIE T2,RESFLG		;OK?
	JRST RESINC		;NO

;Note that this is an 18-bit comparison. The trailer contains the offset
;within the section for the header, not the full 30-bit address.

	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"

;	T1/ Address of header of free space as passed by caller
;	T3/ Address of descriptor block for free space

	;..
RELRE1:	MOVE T4,.REBTB(T3)	;POINT TO BIT TABLE
	MOVE T2,T1		;SAVE THE HEADER ADDRESS
	SUB T2,.REBAS(T3)	;GET OFFSET INTO FREE SPACE
	LSH T2,-2		;GET 4-WORD BLOCK NUMBER
	IDIVI T2,^D36		;GET POSITION OF BLOCK IN BIT TABLE
	ADD T4,T2		;POINT TO WORD IN BIT TABLE
   IFN RESHSW,<			;IF DEBUGGING
	SETZRO RSINU,(T1)	;TURN OFF "IN USE" BIT
   >				;END OF IFN RESHSW
	LOAD T1,RSSIZ,(T1)	;GET NUMBER OF 4-WORD BLOCKS
	MOVEI T2,^D36		;GET BIT POSITION IN CORRECT FORMAT
	SUBM T2,T3		;  FOR CLRBTS
	EXCH T3,T1		;SET UP FOR CALL TO CLRBTS

	CALL CLRBTS		;FREE UP THIS SPACE
	 JRST [MOVE T1,RELRAD	;ALREADY FREE.  GET THE BAD ADDRESS
	       MOVE T2,RELCAL	; AND THE CALLER
	       BUG.(HLT,RESBAZ,FREE,SOFT,<RELRES - Free block returned more than once>,<<T1,BADADR>,<T2,CALLER>>,<

Cause:	This is a free space problem.  The caller is returning a block to
	resident free space.  The block being returned is already a released
	block in the resident free space pool.  Thus, the caller is either
	returning the same block twice or has a completely random address which
	is incorrect.

Action:	The caller may or may not be the culprit.  It is possible that some
	other routine  is picking up the wrong address and releasing it.

Data:	BADADR - the address given to the free space manager
	CALLER - the PC when the free space manager was called
>)
	       RET]
	;Note:  as we are now PION, we are in a window such that an interrupt
	;routine may have just acquired the very block we are still releasing;
	;this is why pool number and block size were saved previous to call to
	;CLRBTS.  If we are in the window, the pool count is deficient by the
	;value stored in RELSIZ (We are going to rectify that with the next
	;few inststructions...).

	MOVE T4,RELPLN		;Get pool number
	MOVE T2,RELSIZ		;Get number of 4-word blocks
	MOVE T3,RELADR		;POINT TO DESCRIPTOR BLOCK
	ADD T4,.REPFR(T3)	;POINT TO FREE ENTRY FOR POOL
	ADDM T2,(T4)		;ADD BACK THE SPACE TO USAGE TABLE
	ADDM T2,.RETFR(T3)	;UPDATE THE OVERALL FREE COUNT
	RET
RESOUT:	MOVE T1,RELRAD		;GET BAD ADDRESS
	MOVE T2,RELCAL		;GET CALLER
	BUG.(CHK,RESBND,FREE,SOFT,<RELRES - Releasing space beyond end of resident free pool>,<<T1,BADADR>,<T2,CALLER>>,<

Cause:	This is a free space problem.  The caller is trying to release resident
	free space.  The address passed to RELRES is outside the range of the
	resident free space pool.

Action:	If the problem persists change the BUGCHK to a BUGHLT.

Data:	BADADR - the address given to the free space manager
	CALLER - the PC when the free space manager was called
>)
	RET

RESINC:	MOVE T1,RELRAD		;GET BADADR
	MOVE T2,RELCAL		;GET CALLER
	BUG.(HLT,RESCHK,FREE,SOFT,<RELRES - Resident free space was overwritten>,<<T1,BADADR>,<T2,CALLER>>,<

Cause:	Resident free space has been overwritten.

Action: Look at the header of the free space segment; it contains the PC of the
	assigner of the space.  Try to figure out why more space was used
	than was requested.

Data:	BADDAR - Address passed to RELRES
	CALLER - PC when RELRES was called
>)
	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
	HRRZ 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,@[EP. RSECMP(T3)] ;MAKE PAGE WRITABLE
	CLRPT (T4)		;TELL HARDWARE
	ANDCAM T1,(T4)		;CLEAR THE BITS
	ANDCAM T2,@[EP. RSECMP(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
;CHKRFS - Check to see if there's enough resident free space

;ACCEPTS: 
;	T1/ Number of words required
;	T2/ Flags,,pool number

;	CALL CHKRFS

;RETURNS +1: Not enough space
;	 +2: There was enough when you asked

;Flags:

;	RS%SE0==:1B0		;SPACE MUST BE IN SECTION 0 

CHKRFS::	
	XMOVEI T3,RESNTB	;ASSUME NON-ZERO SECTION NUMBER
	TXZN T2,RS%SE0		;DID USER REQUEST SECTION 0?
	IFSKP.
	  HRRZS T2		;YES, GET RID OF FLAGS
	  XMOVEI T3,RES0TB	;RESTRICT USE TO SECTION 0
	ENDIF.
	ADD T2,.REPFR(T3)	;POINT TO TABLE OF FREE BLOCKS BY POOL NO.
	ASH T1,-2		;COMPUTE NUMBER OF 4-WORD BLOCKS REQUIRED
	CAMLE T1,(T2)		;USER NEEDS FEWER THAN WE HAVE FREE?
	RETBAD			;NO. RETURN ERROR
	RETSKP			;YES. RETURN SUCCESS

;RESFPI - INITIALIZATION ROUTINE FOR THE RESIDENT FREE POOL

RESFPI::
	XMOVEI T3,RES0TB
	CALL RESFPX
	XMOVEI T3,RESNTB
	CALL RESFPX
	RET

RESFPX:
	MOVE T1,.REBTL(T3)	;GET LENGTH OF BIT TABLE
	SOS T1
	MOVE T2,.REBTB(T3)	;SOURCE
   IFN RESBSW,<
	HLRZ T3,T2		;SEE WHAT SECTION HAS BIT TABLE
	CAIE T3,RESSEC		;THIS ONE?
	BUG.(HLT,RBTSEC,FREE,SOFT,<RESBTB in wrong section>,,<

Cause:	Debugging code attempts to write-protect the allocation
	table by changing the map directly.  It assumes that
	the bit table is in the section used by NRPE, but
	the address is not in that section.
>)
   >				;END REWBSW
	SETOM (T2)		;INITIALIZE FIRST WORD
	XMOVEI T3,1(T2)		;DESTINATION
	XBLT. T1
	RET

REPEAT 0,<
	MOVE T1,.REBTL(T3)	;GET LENGTH OF BIT TABLE
	MOVE T4,.REBTB(T3)	;GET START OF BIT TABLE
RESFP1:	SETOM (T4)		;MARK ALL BITS AS "IN USE"
	AOS T4
	SOJG T1,RESFP1		;LOOP FOR ALL WORDS IN THE BIT TABLE
	RET			;ALL SET UP
>
;[7.1050]
;Routine called by job 0 to lock and unlock resident free space. The RESLCI
;entry point is called by RUNDD in MEXEC to reset the number of section 0
;free blocks. This value may be doubled at startup to accomodate large
;section 0 requests at PI level that can't "grow" the free space.
;Call:
;	CALL RESLCK or
;	CALL RESLCI
;
;Returns +1: Always
;
	SWAPCD

RESLCK::TDZA T4,T4		;Not initting free space
RESLCI::SETOM T4		;-1 implies initting free space
	STKVAR <INIFLG>		;Someplace to store the init flag
	MOVEM T4,INIFLG		;Save the init flag
	XMOVEI T4,RES0TB	;Section 0 free space
	CALL RESLCX		;()Lock down section 0 free space
	SKIPN INIFLG		;Are we initing section 0?
	IFSKP.			;If yes...
	  MOVEI T1,RESFRA	;Free space init is complete. CHKR
	  MOVEM T1,RES0TB+.REGRO ;will now keep RESFRA blocks locked
	ENDIF.			;
	XMOVEI T4,RESNTB	;Non-zero free space
	CALL RESLCX		;()Lock down enough non-0 space
	RET

;Accepts:
;	T4/ Address of descriptor block

;	CALL RESLCX

;Returns +1: always

RESLCX::STKVAR <LCKADR,LCKPIF>
	MOVEM T4,LCKADR		;SAVE ADDRESS OF DESCRIPTOR BLOCK
RESLK5:	MOVE T1,.REGRO(T4)	;SEE HOW CLOSE TO THE AVERAGE WE ARE
	CAMG T1,.RETFR(T4)	;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
	MOVE T4,LCKADR		;RESTORE ADDRESS OF DESCRIPTOR BLOCK
	JRST RESLK5		;GO SEE IF THIS WAS ENOUGH

;Current remaining space is sufficient. See if we need to unlock any
;(that is, we have more than a page to spare)

RESLK1:	MOVE T1,.RETFR(T4)	;NOW CHECK IF SOME NEEDS UNLOCKING
	SUBI T1,PGSIZ/4		;NUMBER BLOCKS ON A PAGE
	CAMG T1,.REGRO(T4)	;ARE WE WELL ABOVE THE AVERAGE?
	RET			;NO, THEN EXIT
	MOVE T3,.REFFB(T4)	;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
	ADD T1,.REBTB(T4)	;GET OFFSET INTO BIT TABLE
	JRST RESLK3		;GO TO RESMON FOR CRITICAL CODE

;Resident code to do non-PI functions

;	T1/ Address of bit table word
;	T2/ Byte pointer to bit
;	T3/ Number of first free block
;	T4/ Address of descriptor block

	RESCD
RESLK3:	NOSKED
	MOVEM T1,LCKPIF		;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,LCKPIF		;SAVE PI STATE FLAG RESTORE T1
	CAME T3,.REFFB(T4)	;STILL HAVE SAME FIRST FREE BLOCK?
	IFNSK.
	   MOVE T1,LCKPIF	;NO. GET PI STATE FLAG
	   SKIPE T1		;WAS PI ON?
	   PION			;YES. TURN IT BACK ON
	   OKSKED
	   JRST RESLK1		;GO TRY AGAIN
	ENDIF.

	;..
	;..
	LDB T4,T2		;GET THE BIT (NOTE: USES T1 IN BYTE POINTER!)
	SKIPN T4		;BLOCK IN USE? 
	IFSKP.
	   EXCH T1,LCKPIF	;YES. SAVE T1. RESTORE PI STATE FLAG
	   SKIPE T1		;WAS PI ON?
	   PION			;YES. TURN IT BACK ON
	   OKSKED
	   RET			;AND RETURN
	ENDIF.

;Here when block is not in use. Decrement free block count and pointer
;to first free block, and clear the bit in the bit table

   IFN RESBSW,<
	HRRZ T3,T1		;[8803] Get bit table address
	LSH T3,-PGSFT		;[8803] Get page number only
	MOVX T4,PTWR		;GET WRITE FLAG
	IORM T4,@[EP. RSECMP(T3)] ;SET WRITE ACCESS IN MONITOR MAP
	MOVE T3,T1		;[8803] Get address again
	CLRPT (T3)		;LET HARDWARE KNOW
   >				;END OF IFN RESBSW
	MOVEI T4,1		;NOT IN USE, MARK IT TAKEN
	DPB T4,T2		;NOTE: USES AC 1 IN BYTE POINTER!
	MOVE T4,LCKADR		;GET BACK THE FREE SPACE DESCRIPTOR
   IFN RESBSW,<
	HRRZ T3,T3
	LSH T3,-PGSFT		;[8803] Want page number of bit table
	MOVX T1,PTWR		;GET WRITE FLAG
	ANDCAM T1,@[EP. RSECMP(T3)] ;CLEAR WRITE-ENABLE
	MOVE T2,T1		;[8803] Get address of bit table
	CLRPT (T2)		;LET HARDWARE KNOW
   >				;END OF IFN RESBSW
	SOS .RETFR(T4)		;COUNT DOWN THE FREE COUNT
	SOS T1,.REFFB(T4)	;AND REMOVE IT FROM FREE POOL
	EXCH T1,LCKPIF		;SAVE T1 RESTORE PI STATE FLAG
	SKIPE T1		;WAS PI ON?
	 PION			;THROUGH INTERLOCKED CODE
	MOVE T1,LCKPIF		;RESTORE T1 CLEAN UP STACK
	JRST RESLK4		;NOW, BACK TO SWPMON

;RETURN TO SWAPPABLE CODE FOR PI FUNCTIONS

;	T1/ Number of block to be released
;	T4/ Address of descriptor block

	SWAPCD
RESLK4:	LSH T1,2		;GET THE ADDRESS OF THIS BLOCK
	ADD T1,.REBAS(T4)	;...
	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
	MOVE T4,LCKADR		;GET ADDRESS OF DESCRIPTOR BLOCK
RESLK2:	OKSKED
	JRST RESLK1		;GO SEE IF MORE WORK NEEDED
	SUBTTL  Routines for new swappable freespace manager

;	EXTERN FSPTAB,FSPTBL,ENQFSX,IPCFSX,GENFSX,JSBFSX,DCNFSX
	EXTERN FSPTAB,FSPTBL,ENQFSX,IPCFSX
IFN FTNSPSRV,<
	EXTERN DCNFSX
>  ;End IFN FTNSPSRV

;************************************************************************
	COMMENT %

	Conditional assembly features

	FSPDBG  allows headers greater than length 3 and the existence of
		trailers.  Headers and trailers may be any size as long as
		the trailer is no larger than the header.

	FSPACC	allows accounting of requested and granted block sizes and
		traversal length required to find desired size.
		Requests larger than constant FSPBSC-1 are counted in a single
		category.

	%	;End comment
	COMMENT %
	Swappable and JSB freespace structures


				Freespace-descriptor index table

FSPTAB:         *-------------------------------------------------------------*
		*		Pointer to freespace descriptor		      *
	        *-------------------------------------------------------------*
		*		Pointer to freespace descriptor		      *
	        *-------------------------------------------------------------*
						.
						.
						.
	        *-------------------------------------------------------------*
		*		Pointer to freespace descriptor		      *
	        *-------------------------------------------------------------*

	FSPTBL = Freespace-descriptor index-table size in words
				      Freespace descriptor

	        *-------------------------------------------------------------*
FSPPFL:     0   *			      Flags			      *
	        *-------------------------------------------------------------*
FSPLOK:     1   *			    Pool lock			      *
	        *-------------------------------------------------------------*
FSPORG:     2   *		Origin address of freespace pool              *
	        *-------------------------------------------------------------*
FSPEND:     3   *		Ending address of freespace pool              *
	        *-------------------------------------------------------------*
FSPCNT:     4   *	        Count of space remaining in pool	      *
	        *-------------------------------------------------------------*
FSPSML:     5   *          Smallest balance of free space achieved            *
	        *-------------------------------------------------------------*
FSPBAP:     6   *		Pointer to block-accounting area              *
	        *-------------------------------------------------------------*
FSPMTB:     7   *		    Minimum total block size                  *
	        *-------------------------------------------------------------*
FSPFFB:    10   *  		    Pointer to first free block		      *
	        *-------------------------------------------------------------*
FSPRFB:    11   *	    Randomized pointer to first free block  	      *
	        *-------------------------------------------------------------*
FSPHDS:    12   *			Block header size		      *
	        *-------------------------------------------------------------*
FSPTRS:    13   *		        Block trailer size		      *
	        *-------------------------------------------------------------*
FSPHTS:    14   *	         Combined header and trailer size	      *
	        *-------------------------------------------------------------*
FSPBCS:    15   *	         Smaller of header or trailer size	      *
	        *-------------------------------------------------------------*
FSPHBO:    16   *                     History buffer address                  *
	        *-------------------------------------------------------------*
FSPHBX:    17   *    Max History transactions    *  Index to current hist rec *
	        *-------------------------------------------------------------*


	FSPDSS = descriptor size in words

	;Offsets for history records
	FSPHST==0		;Transaction type:
				;-1 = assign
				; 0 = deassign
	FSPHPC==1		;PC of caller
	FSPHJF==2		;Job,,fork of caller
	FSPHBA==3		;Block address
	FSPHBS==4		;Block size

	FSPHRS==5		;History record size
	FSPHRC==^D200		;# of history records per pool

	        *-------------------------------------------------------------*
	n+0	*							      *
	        *-------------------------------------------------------------*
	n+1     *		    Count for blocksize 1		      *
	        *-------------------------------------------------------------*
	n+2     *		    Count for blocksize 2		      *
	        *-------------------------------------------------------------*
						.
						.
						.
	        *-------------------------------------------------------------*
	n+end-1 *		 Count for blocksize "end"-1 		      *
	        *-------------------------------------------------------------*
	n+end   *  	   Count for all blocks of size "end" or greater      *
	        *-------------------------------------------------------------*

		Where "end" is the last offset in the accounting block.

	FSPBSC = accounting-block size in words

		There are actually 3 of the previously described blocks
		in the accounting area:

		(1) a count of requests for each blocksize
		(2) a count of filled requests for each blocksize
		(3) a count of the list traversal-lengths for each blocksize
				Freespace block header/trailer

	        *-------------------------------------------------------------*
FSPDPC:     -7  *		      PC of block assigner		      *
	        *-------------------------------------------------------------*
FSPDJF:     -6  *               Job #,,fork # of block assigner               *
	        *-------------------------------------------------------------*
FSPDPC:     -5  *		      PC of block deassigner		      *
	        *-------------------------------------------------------------*
FSPDJF:     -4  *               Job #,,fork # of block deassigner             *
	        *-------------------------------------------------------------*
FSPFLG:     -3  *		       Flags,,unique code		      *
	        *-------------------------------------------------------------*
FSPSIZ:     -2  *            Size of block (including header/trailer)         *
	        *-------------------------------------------------------------*
FSPNXT:     -1  *		    Pointer to  next block		      *
	        *-------------------------------------------------------------*


		At a minimum, a header of length 3 is required (no trailer
		is ever required).  The header is infinitely expandable, as
		is any trailer.

		While in the pool, blocks are manipulated by pointers that
		address the first word past the header (thus the negative
		offsets for the header definitions).  Before a block is
		assigned to the user, the pointer is SOS'd and the user area
		of the block overlays the header by 1 word.  (Specifically,
		the user area of the block begins with header word FSPNXT.)


	%	;End comment

 

	
	COMMENT %
Routine to set up global variables
CALL:		JSP T4,SETVAR
RETURNS +1:	ALWAYS

	TRVAR LEGEND:

	FLAGS	Entry flags
	CALRPC	PC of caller
	DATUM	Datum identifier code for use when stacking entries
	BLKSIZ	Desired block size (Requested + Block header and trailer size)
	BADDR	Address of "first block"
	PADDR	Address of predecessor of user block
	FRAGSZ  Size of block fragment
	PASS	-1 = First pass, 0 = second pass through assignment algorithm
	ENDPL	Ending address of freespace pool
	TRAVRS	When block accounting is in effect, counts length of traverse
		for this size block
	BLOCKX  When block accounting is in effect, contains the descriptor 
		address plus the appropriate index for this block size
	DESNDX	Descriptor index for the pool
	%	;End comment

SETVAR:	TRVAR <FLAGS,CALRPC,DATUM,BLKSIZ,BADDR,PADDR,FRAGSZ,PASS,TRAVRS,BLOCKX,DESNDX,FBKSIZ> ;[7320]
	CALLRET 0(T4)

	;Miscellaneous flags used by swappable freespace routines
	;These flags are kept in TRVAR FLAGS for ASGFSP and RELFSP

	;Flags for entry type:
	FSP.SK==1B0		;We want this entry stacked
				;(RH)F contains datum code
	;Flags for returned block merge-states
	FSP.MS==1B1		;Merged with successor
	FSP.MP==1B2		;Merged with predecessor
	COMMENT *

	Routine to initialize swappable free space.  Zeroes the entire pool,
	turns it into one block, and initializes the free pool lock.

	Note:  Free PIDs occur in the interval [1...MAXPID]
	Used PIDs are identified by their swappable free space
	pointer and occur in the interval of the swappable free space
	addresses.  The 2 intervals must not overlap, so MAXPID
	should always be less than the first free space address.
	This is guaranteed as long as swappable free space is in a
	non-zero section.

		*	;End comment


	;RETURNS:	+1 Always

FSPINI::SAVEAC<T1,T2,T3,T4,P1,P2,P3> ;Save our AC's
	JSP T4,SETVAR		;Setup global variables
;	SETZM FSPTAB+JSBFSX	;Make sure that this slot is zero
				;So that JSB space is initialized only on
				; job start-up
	MOVSI P3,-FSPTBL	;Get AOBJN pointer
FSPIN:	MOVE P1,FSPTAB(P3)	;Get address of pool descriptor
	JUMPE P1,ININXT		;No descriptor, skip this slot
	CALL POOLIN		;Do the work
ININXT:	AOBJN P3,FSPIN		;Do entire table

	;(Not for V6)
	;Having skipped the initialization of JSB freespace,
	;simply set up a pointer to the job area where the template descriptor
	;(JSBDES) will be moved.
;	MOVEI T1,JSBFRE		;Get address of JSB descriptor
;	MOVEM T1,FSPTAB+JSBFSX	;Store it

	RET

	COMMENT %

	Not for V6

	;Routine to initialize JSB freespace
	;Called on job-startup
JSBFIN::HRLI T1,JSBDES		;Get origin of JSB descriptor template
	HRRI T1,JSBFRE		;Get JSB address to move it to
	BLT T1,JSBFRE+FSPDSS-1	;Move it
	;Initialize bittable for JSB freespace pages
	MOVE T1,[XWD JBCOR,JBCOR+1]
	SETZM JBCOR
	BLT T1,JBCOR+3
	UNLOCK JBCLCK		;Unlock the ASGPAG lock
	UNLOCK JSFLCK		;Unlock the resource-stack lock

	;Initialize the JSB pool itself
	MOVE P1,FSPTAB+JSBFSX	;Get address of descriptor
	CALLRET POOLIN		;Go do the work

	%	;End comment
	;Subroutine to initialize a freespace pool
	;Args:	P1/  Address of pool descriptor

	;Zero the free pool
POOLIN:
   COMMENT %
	MOVE T1,FSPCNT(P1)	;Get pool length
	SOS T1			;Less 1
	MOVE T2,FSPORG(P1)	;Get origin of free pool
	SETZM (T2)		;Zero first cell
	MOVE T3,T2		;Get free pool origin in T3
	AOS T3			;Increment it
	XBLT. T1		;Zero the pool
   %				;End comment

	;Initialize the dummy header
	MOVE T1,FSPFFB(P1)	;Get address of dummy header
	MOVE T2,FSPHDS(P1)	;Get blocksize
	MOVEM T2,FSPSIZ(T1)	;Store that as size of dummy header
	MOVE T3,T1		;Get dummy-header address in T3
	ADD T3,T2		;Add header size to calc start of next block
	MOVEM T3,FSPNXT(T1)	;Use that as next pointer of dummy header

	;Turn entire pool into 1 block
	MOVE T1,FSPCNT(P1)	;Get length of free pool
	MOVE T2,FSPORG(P1)	;Get origin of freespace pool
	MOVE T3,FSPHDS(P1)	;Get header size
	ADD T2,T3		;Adjust pointer for header length
	MOVEM T1,FSPSIZ(T2)	;Store the block size (all of free pool)
	SETZM FSPNXT(T2)	;Make sure next-pointer is zero
	MOVE T1,T2		;Get block address in T1
	MOVEI T2,FSPUCD		;Get the unique code
	HRRZM T2,FSPFLG(T1)	;Store in header
   IFN FSPDBG,<
	MOVE P2,T1		;Get block address in P2
	CALL FILHDR		;Complete header and trailer
   >
	SETOM FSPLOK(P1)	;Initialize free pool lock
	RET

	;The following are entry points to the central swappable-
	;free space allocator (ASGFSP)

	;ARGS:	T1/  Desired block size

;ASGGEN::MOVEI T2,GENFSX		;Get free-pool descriptor index
;	JRST ASGCOM		;Join common code
IFN FTNSPSRV,<
ASGDCN::MOVEI T2,DCNFSX		;Get free-pool descriptor index
	JRST ASGCOM		;Join common code
>  ;End IFN FTNSPSRV
ASGIPC::MOVEI T2,IPCFSX		;Get free-pool descriptor index
	JRST ASGCOM		;Join common code
ASGENQ::MOVEI T2,ENQFSX		;Get free-pool descriptor index

ASGCOM:
   IFN FSPDBG,<
	MOVE T3,(P)		;Get PC of caller
   >
	JSP T4,SETVAR		;Set up global variables
   IFN FSPDBG,<
	MOVEM T3,CALRPC	;Save PC
   >
	SETZM FLAGS		;Zero flags word
	JRST ASGFSP		;Enter main routine




	;The following are entry points to the central swappable-
	;free space deallocator (RELFSP)

	;ARGS:	T1/  Block address

;RELJSB::MOVEI T2,JSBFSX		;Get free-pool descriptor index
;	JRST RELCOM		;Join common code
;RELGEN::MOVEI T2,GENFSX		;Get free-pool descriptor index
;	JRST RELCOM		;Join common code
IFN FTNSPSRV,<
RELDCN::MOVEI T2,DCNFSX		;Get free-pool descriptor index
	JRST RELCOM		;Join common code
>  ;End IFN FTNSPSRV
RELIPC::MOVEI T2,IPCFSX		;Get free-pool descriptor index
	JRST RELCOM		;Join common code
RELENQ::MOVEI T2,ENQFSX		;Get free-pool descriptor index

RELCOM:
   IFN FSPDBG,<
	MOVE T3,(P)		;Get PC of caller
   >
	JSP T4,SETVAR		;Set up global variables
   IFN FSPDBG,<
	MOVEM T3,CALRPC	;Save PC
   >
	SETZM FLAGS		;Zero flags word
	JRST RELFSP		;Enter main routine
	COMMENT %
	Central routine for allocating swappable free space

	ARGS:	T1/  Desired block size
		T2/  Free pool descriptor index
	RETURNS:	+1  Failure, error code in T1
			+2  success, block address in T1

	%  ;End comment


ASGFSP:	SAVEAC <P1>
	MOVEM T2,DESNDX		;Save pool descriptor index
	MOVE P1,FSPTAB(T2)	;Get address of pool descriptor
	SKIPLE T2,T1		;Is this request legal?
	JRST ASGFS1		;Yes
	MOVE T1,DESNDX		;Get pool number
	MOVE T3,CALRPC		;Get caller's PC
	BUG.(HLT,FSPZER,FREE,SOFT,<ASGFSP - Illegal to assign 0 FREE space>,<<T1,POOLN>,<T3,CALRPC>>,<

Cause:	An illegal request for free space is being made.  The calling routine
	is asking for zero words of free space.

Action:	Look at the dump.  By backing up the stack you
	should be able to tell what routine called for the illegal
	free space.

Data:	POOLN		Pool number
	CALRPC		PC of caller of ASGFSP
>)

ASGFS1:	SKIPL INTDF		;Is the process NOINT?
	JRST ASGFS2		;Yes
	MOVE T4,DESNDX		;Get pool number
	MOVE T3,CALRPC		;Get caller's PC

	BUG.(HLT,FSPANN,FREE,SOFT,<ASGFRE called OKINT>,<<T4,POOLN>,<T3,CALRPC>>,<

Cause:	This is a free space problem.  Calls to swapable free space
	routines should be made only while the calling process is NOINT.  The
	calling routine is not protecting itself from losing free space.  It is
	OKINT.  Since it is OKINT it could get interrupted and never return,
	thus losing the free block assigned.

Action:	The data supplied gives the address of the calling routine.  Make
	the routine NOINT until it has insured that the block will be
	freed when it is interrupted (e.g. JSB stack).

Data:	POOLN - Pool number
	CALRPC - Caller of RELFSP
>)
ASGFS2:

   IFN FSPACC,<
	CALL BLKACC		;Account for this block request
   >
	ADD T2,FSPHTS(P1)	;Add header+trailer length to desired block size
	SOS T2			;Less 1 as we will give the next-pointer word
				; in the header to the user
	CAMGE T2,FSPMTB(P1)	;Is this request below minimum size?
	MOVE T2,FSPMTB(P1)	;Yes, allocate the minimum size block
	CAMLE T2,FSPCNT(P1)	;Is requested block size .LEQ. remaining space?
	JRST ASGRT3		;No, return
	CSKED			;Don't reschedule
	LOCK FSPLOK(P1)		;Lock this free storage list

   IFN FSPDBG,<
	MOVE T1,FSPPFL(P1)	;Get flags
	TXNE T1,FS.CHK		;Should we check this pool?
	CALL FSPCK		;Yes, check integrity of pool
	  JFCL			;We will try even though pool may be damaged
   >
	MOVEM T2,BLKSIZ		;Save desired block size
	MOVEI T2,377777		;Get initial best block size
	MOVEM T2,FBKSIZ		;[7320]SAVE IT FOR LATER
	SETZM PADDR		;Initial location of predecessor
	SETOM PASS		;This is pass 1
	SKIPN T2,FSPRFB(P1)	;Get address of randomized first block
	MOVE T2,FSPFFB(P1)	;There was none, use first free block
	CAMN T2,FSPFFB(P1)	;Is it really the head of list?
	SETZM PASS		;Yes, don't allow a second pass

   IFN FSPACC,<
	SETZM TRAVRS		;Zero traverse length
   >
	;...
	;...
	;Perform free-pool traversal
ASGSW1:
   IFN FSPACC,<
	AOS TRAVRS		;Count length of this traverse
   >
	MOVE T3,FSPNXT(T2)	;Get pointer to next block
	JUMPE T3,ASGRT1		;No more free blocks, so fail
	MOVE T4,FSPSIZ(T3)	;Get size of block
	MOVEM T2,PADDR		;Save address of predecessor
	MOVEM T4,FBKSIZ		;[7320]This is a better "first block", save its size.

	CAMN T4,BLKSIZ		;Is it exactly the desired block size?
	JRST ASGSW9		;Yes, go use it
	CAML T4,BLKSIZ		;Is it greater than the desired block size?
	JRST ASGSW6		;Yes, go fragment it


ASGSW4:	MOVE T2,T3		;Step to next free block
	JRST ASGSW1		;And repeat

	;Here with PADDR pointing to predecessor of "first block".  If we can
	;we will split "first block" and return fragment to free pool.
ASGSW6:	MOVE T2,PADDR		;Get address of predecessor
	JUMPE T2,ASGRT1		;There is none, exit (no "first block")
	MOVE T3,FSPNXT(T2)	;Get address of best block
	MOVE T4,FBKSIZ		;[7320]Get size of "first block"
	SUB T4,BLKSIZ		;Subtract the desired block size
	MOVEM T4,FRAGSZ		;And keep fragment size here
	MOVE T4,FSPMTB(P1)	;Get minimum block size
	CAMLE T4,FRAGSZ		;Would a fragment be above minimum size?
	JRST ASGSW8		;No, return entire block to user
	MOVE T1,BLKSIZ		;Get desired block size
	MOVEM T1,FSPSIZ(T3)	;Reduce "first block" to desired block size
	ADD T1,T3		;Calculate address of block fragment
	MOVE T2,FSPNXT(T3)	;Get "first block's" next-pointer
	MOVEM T2,FSPNXT(T1)	;Point fragment at that block
	MOVE T2,PADDR		;Get address of predecessor
	MOVEM T1,FSPNXT(T2)	;Point predecessor to fragment

   IFN FSPDBG,<
	SKIPN FSPTRS(P1)	;Is there a trailer?
	JRST ASGSW7		;No
	ADD T2,FSPSIZ(T2)	;Step to trailer of predecessor
	SUB T2,FSPTRS(P1)	;...
	MOVEM T1,FSPNXT(T2)	;Update pointer in trailer
   >
ASGSW7:	MOVE T2,FRAGSZ		;Get fragment size
	MOVEM T2,FSPSIZ(T1)	;Store in header of block fragment
	;...
	;...

	MOVEI T4,FSPUCD		;Get unique code
	MOVEM T4,FSPFLG(T1)	;Store in header of block fragment
   IFN FSPDBG,<
	CALL FILTRL		;Update the trailer of fragment
   >
	JRST ASGRET		;Go finish up and return successfully

	;Here if a fragment would be below minimum block size.
ASGSW8:	MOVE T4,FBKSIZ		;[7320]Get size of "first block"
	MOVEM T4,BLKSIZ		;Make it the desired block size
	;Here if "first block" size is exactly right.
ASGSW9:	MOVE T4,FSPNXT(T3)	;Get next pointer out of newly assigned block
	MOVEM T4,FSPNXT(T2)	;Point previous block to succeeding block
	;Make sure predecessor trailer contains same pointer as header
   IFN FSPDBG,<
	SKIPN FSPTRS(P1)	;Is there a trailer?
	JRST ASGRET		;No
	ADD T2,FSPSIZ(T2)	;Step to trailer of predecessor
	SUB T2,FSPTRS(P1)	;...
	MOVEM T4,FSPNXT(T2)	;Point previous block to succeeding block
   >
	;...
	;...
	;Exit code for successful attempt
ASGRET:	MOVE T2,FSPNXT(T3)	;Get next pointer from newly-allocated block
	MOVEM T2,FSPRFB(P1)	;Start next traverse here


	MOVE T2,FSPCNT(P1)	;Get current free space balance
	SUB T2,BLKSIZ		;Subtract size of block just allocated
	MOVEM T2,FSPCNT(P1)	;Save adjusted balance
	CAMGE T2,FSPSML(P1)	;Is this the smallest balance seen so far?
	MOVEM T2,FSPSML(P1)	;Yes, remember it

	UNLOCK FSPLOK(P1)	;Unlock the freespace pool
	ECSKED			;Allow reschedule
	MOVX T2,FSP.AS!FSPUCD	;Get block-assigned bit + unique code
	MOVEM T2,FSPFLG(T3)	;Store in header
	MOVE T1,T3		;Get pointer to newly allocated block
   IFN FSPDBG,<
	CALL FILHDR		;Fill in the remainder of the header + trailer
   >
	CALL ZERBLK		;Zero the block
   IFN FSPACC,<
	SKIPN T2,BLOCKX		;Can we do block accounting?
	JRST ASGRTG		;No
	AOS FSPFIL(T2)		;Account for filled block-request
	MOVE T3,TRAVRS		;Get length of traverse
	ADDM T3,FSPTRV(T2)	;Add it to current total
   >

ASGRTG:
   IFN FSPDBG,<
	CALL HISTRY		;Generate a history record
   >
	SOS T1			;Include next-pointer word in user area
	MOVE T2,FSPPFL(P1)	;Get flags
	TXNN T2,FS.CNT		;User want to see count word?
	RETSKP			;No, return with block address in T1
	SOS T1			;Point to count word of header
	MOVN T2,FSPHTS(P1)	;Get -(combined header and trailer size)
	ADDM T2,(T1)		;Leave just the user block size
	AOS (T1)		;Allow for header overlay
	RETSKP

	;Exit code for unsuccessful attempt
ASGRT1:	AOSLE PASS		;Can we do a second pass?
	JRST ASGRT2		;No
	MOVE T2,FSPFFB(P1)	;Yes, start list traverse with first free block
	JRST ASGSW1		;Do a second pass

ASGRT2:	UNLOCK FSPLOK(P1)	;Unlock the freespace pool
	ECSKED			;Allow reschedule
   IFN FSPACC,<
	SKIPN T2,BLOCKX		;Can we do block accounting?
	JRST ASGRT3		;No
	MOVE T3,TRAVRS		;Get length of traverse
	ADDM T3,FSPTRV(T2)	;Add it to current total
   >
ASGRT3:	MOVE T2,DESNDX		;Get pool number
	BUG.(INF,FSPOUT,FREE,SOFT,<Freespace pool exhausted>,<<T2,POOLN>>,<

Cause:	This is a free space problem.  There is no more space available
	in the freespace pool.

Action:	The data supplied gives the pool number (pool descriptor index) of
	the pool in question.  If the pool repeatedly runs out of space,
	the pool size must be increased and the monitor rebuilt.

Data:	POOLN - Freespace pool number
>)

	MOVEI T1,MONX06		;Tell him no free space
	RET
	COMMENT *
	Central routine for deassigning swappable free space
	ARGS:	T1/  Block Address
		T2/  Pool descriptor index

	AC usage:
		F/   Internal flags
		P1/  Pool descriptor address
		P2/  User block address

	Returns:  +1 Always
		*	;End comment

RELFSP::SAVEAC <F,P1,P2,P3,Q1>		;Save AC's
	MOVEM T2,DESNDX		;Save pool descriptor index
	MOVE P1,FSPTAB(T2)	;Get address of descriptor
	SKIPL INTDF		;Are we NOINT?
	JRST RLF1		;Yes
	MOVE T4,DESNDX		;Get pool number
	MOVE T3,CALRPC		;Get caller's PC

	BUG.(HLT,FSPDNN,FREE,SOFT,<RELFSP called OKINT>,<<T4,POOLN>,<T3,CALRPC>>,<

Cause:	This is a free space problem.  The calling routine is trying to release
	a swapable free space block while it is OKINT.  This is dangerous since
	it could get interrupted and loose the block.  All
	free space actions should occur while NOINT.

Action:	The data supplied gives the address of the calling routine.  Make
	the routine become NOINT when it removes the address of the block
	about to be released from the database.  The routine
	can be made OKINT when control is returned to it.

Data:	POOLN - Pool number
	CALRPC - PC of caller of RELFSP
>)
RLF1:	CSKED			;Don't allow reschedule
	LOCK FSPLOK(P1)		;Lock free space pool

	;See if the returned block falls correctly within the address
	;range for this pool.
	MOVE F,FLAGS		;Keep flags here
	MOVE P2,T1		;Keep user block address here
	MOVE T2,FSPPFL(P1)	;Get pool flags
	TXNN T2,FS.CNT		;Does user see count word?
	JRST LIMCHK		;No
	MOVE T2,(P2)		;Get the block length
	ADD T2,FSPHTS(P1)	;Add combined header/trailer size
	HRRZM T2,(P2)		;Set block size in RH only
	SOS (P2)		;Allow for header overlay
	AOS P2			;Step the pointer to first header word

LIMCHK:	AOS T1,P2		;Exclude next-pointer word from user area
				; and get it in T1 for HISTRY
   IFN FSPDBG,<
	CALL HISTRD		;Generate a history record
   >
	MOVE T4,FSPEND(P1)	;Get ending pool address
	MOVE T1,FSPORG(P1)	;Get origin pool address
	CAMLE T4,P2		;Is the user block beyond the end?
	CAMLE T1,P2		;Is the user block before the start?
	JRST RELBBA		;No, bad address
	MOVE T2,FSPSIZ(P2)	;Get the blocksize
	ADD T2,FSPCNT(P1)	;Calculate augmented poolsize
	SOS T2			;Adjust by 1 for correct compare
	ADD T2,T1		;Add pool origin address
	CAMG T2,T4		;If poolcount pushes last pool addr beyond 
				; FSPEND, we have a problem.
	CAMGE T2,T1		;If poolcount pushes first pool addr below
				; FSPORG, we have a problem
	JRST RELBBS		;We have a problem, go complain
	CALL BLKCKP		;Check the block and complain if bad
	  SKIPA			;Block is bad
	JRST BLKOK
	MOVE T4,FSPFLG(P2)	;Get flags word
	TXZ T4,FSP.AS		;Turn off block-assigned bit
	MOVEM T4,FSPFLG(P2)	;Replace flags
	MOVE P3,P2		;Get block address in P3
   IFN FSPDBG,<
	CALL UPDHDR		;Update header
   >
	JRST RLFRR		;Return, leaving block in limbo
BLKOK:	MOVE T3,FSPSIZ(P2)	;Get user block length
	MOVEM T3,BLKSIZ		;Save it

	;The block starts within the address interval for this pool.  Traverse
	;the pool until we find either the end of the chain, or a block beyond
	;the one we wish to return.
RLFR0:	MOVE T2,FSPFFB(P1)	;Get address of first free block
	MOVEM T2,PADDR		;Save as predecessor of predecessor
RLFR1:	MOVE T3,FSPNXT(T2)	;Get address of next block on chain
	JUMPE T3,RLFR2		;At end of chain?
	CAML T3,P2		;No, past the user block?
	JRST RLFR2		;Yes
	MOVEM T2,PADDR		;No, save as predecessor of predecessor
	MOVE T2,T3		;Step to the next block
	JRST RLFR1		;Continue search
	COMMENT *
	Here when the traverse through the chain is complete.
	Either:

	1.  The last block in the chain precedes (lower address)
	    the block we wish to return.

	2.  A block has been found that succedes (higher address)
	    the block we wish to return.  We also check to see
	    if we are attempting to return a block that is already
	    on the list.

	Block being returned will go between address in T2 and address in
	T3.

	T2/  Address of block preceding user block
	T3/  Address of block succeding user block or zero

	*	;End comment

RLFR2:	CAME T3,T2		;Releasing already-released block?
	JRST CHKPRE		;No
	MOVE T4,CALRPC		;Get caller's PC
	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPARB,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<

Cause: The caller is attempting to release a block that has already been
	released.

Action:	Looking at the stack will show the caller.  It is possible that the
	length of the current block is incorrect.  It is equally likely that
	the block(s) before this block (in free space) have had incorrect
	lengths on return.  Thus, the caller may not be the culprit.

Data:	POOLN - Pool number
	CALRPC - PC of caller of RELFSP
	BLKADR - Address of user block
>)

	;See if preceding block will overlap user block.  If so, BUGCHK.
CHKPRE:	MOVE T4,FSPSIZ(T2)	;Get size of preceding block
	ADD T4,T2		;Compute start of next block
	CAMG T4,P2		;Does previous block overlap user's block?
	JRST CHKSUC		;No

	MOVE Q1,DESNDX		;Get pool number
	MOVE T4,CALRPC		;Get caller's PC
	BUG.(HLT,FSPPRE,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<

Cause:	This is a free space problem.  The block being returned does not fit
	into the free pool.  The block would overlap the preceding block
	in the pool.

Action:	Looking at the stack will show the caller.  It is possible that the
	length of the current block is incorrect.  It is equally likely that
	the block(s) before this block (in free space) have had incorrect
	lengths on return.  Thus, the caller may not be the culprit.

Data:	POOLN - Pool number
	CALRPC - PC of caller of RELFSP
	BLKADR - Address of user block
>)
	;See if the user block would overlap the one after it
CHKSUC:	JUMPE T3,RLFR5		;If end of list, skip overlap checking
	MOVE T4,P2		;Get address of user block
	ADD T4,BLKSIZ		;Compute address of next block
	CAMG T4,T3		;Does that block overlap succeding block?
	JRST RLFR4		;No
	MOVE T1,CALRPC		;Get caller's PC
	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPSCC,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T1,CALRPC>,<P2,BLKADR>>,<

Cause:	This is a free space problem.  The block being returned does not fit
	into the free pool.  The block would overlap the succeeding block
	in the pool.

Action:	Looking at the stack will show the caller.  It is possible that the
	length of the current block is incorrect.  It is equally likely that
	the block(s) before this block (in free space) have had incorrect
	lengths on return.  Thus, the caller may not be the culprit.

Data:	POOLN		Pool number
	CALRPC		PC of caller of RELFSP
	BLKADR		Address of user block


>)
	;See if the user block can me Merged with its successor.
RLFR4:	CAME T4,T3		;Same as succeeding block address?
	JRST RLFR5		;No, we can't do the merge
	;...
	;..

	;Merge user block and successor
	MOVE T4,FSPSIZ(T3)	;Get length of succeeding block
	ADDM T4,FSPSIZ(P2)	;Augment length of user block
	MOVE T4,FSPNXT(T3)	;Get addr of successor's successor
	MOVEM T4,FSPNXT(P2)	;Make user block point to it
   IFN FSPDBG,<
	TXO F,FSP.MS		;Indicate merge state
   >
	JRST RLFR6		;Go attend to predecessor

	;Here when user block cannot be merged with its successor
RLFR5:	MOVEM T3,FSPNXT(P2)	;Point user block to successor
	;Make the predecessor point to the user block.  Also see if they
	;can be merged.
RLFR6:	MOVEM T2,FSPRFB(P1)	;Assume we can't merge - make predecessor the
				; randomized first block
	MOVEM P2,FSPNXT(T2)	;Make predecessor point to user block
	MOVE T4,FSPSIZ(T2)	;Get length of predecessor
	ADD T4,T2		;Compute first address after predecessor
	CAME T2,FSPFFB(P1)	;Is the predecessor the dummy header?
	CAME T4,P2		;Does predecessor extend to user block?
	JRST RLFRG		;Yes, No, can't do merge

	;Merge predecessor and user block
	MOVE T4,FSPNXT(P2)	;Get user block's successor
	MOVEM T4,FSPNXT(T2)	;Make predecessor point to it
	MOVE T4,FSPSIZ(P2)	;Get size of user block
	ADDM T4,FSPSIZ(T2)	;Augment length of predecessor
   IFN FSPDBG,<
	TXO F,FSP.MP		;Indicate merge state
   >
	MOVE T4,PADDR		;Get predecessor of predecessor
	MOVEM T4,FSPRFB(P1)	;Make that our random first block

	;User block successfully returned to free pool
RLFRG:	MOVE T4,FSPFLG(P2)	;Get flags word
	TXZ T4,FSP.AS		;Turn off block-assigned bit
	MOVEM T4,FSPFLG(P2)	;Replace flags
   IFN FSPDBG,<
	CALL MOVHDR		;Update header and trailer
   >
	MOVE T4,BLKSIZ		;Get size of user block
	ADDM T4,FSPCNT(P1)	;Increment pool word count

RLFRR:	UNLOCK FSPLOK(P1)	;Unlock the pool
	SETZM IPPKFR		;[7207] CLEAR FLAG TO ALLOW IPCF RETRYS
	ECSKED			;Allow reschedule
	RET			;Return

RLFRB:	UNLOCK FSPLOK(P1)	;Unlock the pool
	ECSKED			;Allow reschedule
	MOVE T4,CALRPC		;Get caller's PC
	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,RELINC,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<

Cause:	This is a free space problem.  The block being returned does not fit
	into the free space.  When blocks are returned to the free space pool,
	there is a consistency check performed.  The block is merged into
	existing blocks that follow it in free space.  This block overlaps
	into existing free blocks.  It cannot be merged.

Action:	Looking at the stack will show the caller.  It is possible that the
	length of the current block is incorrect.  It is equally likely that
	the block(s) before this block in free space have had incorrect
	lengths on return.  Thus, the caller may not be the culprit.

Data:	POOLN - Pool number
	CALRPC - PC of caller of RELFSP
	BLKADR - Address of user block
>)
	RET			;Return



	;Here when caller is trying to return a block that will
	;cause an invalid pool word-count to be calculated.

RELBBS:	UNLOCK FSPLOK(P1)	;Unlock the pool
	ECSKED			;Allow reschedule
	MOVE T3,CALRPC		;Get the caller of RELFSP
	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPBPC,FREE,SOFT,<RELFSP - Bad pool count>,<<Q1,POOLN>,<T3,CALRPC>,<P2,BLKADR>>,<

Cause:	This is a free space problem.  The caller to the free space
	routines is trying to return a block so that when the pool count
	is augmented by the blocksize, an invalid number results.  The
	blocksize may be in error, or the pool count may already be in
	error.

Action:	Look through the dump.  If the blocksize is wrong, then study the
        code at the calling PC for possible errors.  If the pool count is
	wrong, then more investigation is required.  The history buffer for the
	pool may contain helpful data.

Data:	POOLN - Pool number
	CALRPC - PC of caller to RELFSP
	BLKADR - Address of block being returned
>)
	RET			;Exit RELFSP


	;Here when caller is trying to return a block whose address
	;does not fall within the legal free-space address interval.
RELBBA:	UNLOCK FSPLOK(P1)	;Unlock the pool
	ECSKED			;Allow reschedule
	MOVE T3,CALRPC		;Get the caller of RELFSP
	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPBND,FREE,SOFT,<RELFSP - Block out of range>,<<Q1,POOLN>,<T3,CALRPC>,<P2,BLKADR>>,<

Cause:	This is a free space problem.  The caller to the free space
	routines is trying to return a block that was not given
	out by the free space manager.  The block is outside the
	range of free space management.

Action:	Look through the dump.  By looking at the stack you
	should be able to determine who called for the releasing
	of the block.

Data:	POOLN - Pool number
	CALRPC - PC of caller to RELFSP
	BLKADR - Address of block being returned
>)
	RET			;Exit RELFSP
	;****************** SWAPPABLE FREESPACE SUBROUTINES ****************


	;Routine to complete a history record
	;ARGS:
	;		T1/  Block pointer
	;		P1/  Pool descriptor
	;RETURNS:	+1 always

   IFN FSPDBG,<
HISTRD: SETZM T2		;Indicate deassign
	SKIPA
HISTRY:	SETOM T2		;Indicate assign
	SKIPN FSPHBP(P1)	;Is there a history buffer?
	RET			;No
	AOS T3,FSPHBX(P1)	;Increment history buffer index
	HLRZ T4,T3		;Get max # history records
	HRRZS T3		;Keep left half zero
	CAMGE T3,T4		;In range?
	JRST RANGOK		;Yes
	SETZM T3		;Wrap-around the index
	HRRM T3,FSPHBX(P1)	;...
RANGOK:	IMULI T3,FSPHRS		;Multiply index by record size
	ADD T3,FSPHBP(P1)	;Add the origin of the history buffer
				; T3 now points to origin of current record
	MOVEM T2,FSPHST(T3)	;Store transaction type
	MOVE T4,CALRPC		;Get the caller's PC
	MOVEM T4,FSPHPC(T3)	;Store in record
	HRLZ T2,JOBNO		;Get the job number
	HRR T2,FORKX		;Get the fork number
	MOVEM T2,FSPHJF(T3)	;Store in record
	MOVEM T1,FSPHBA(T3)	;Store block address
	MOVE T2,FSPSIZ(T1)	;Fetch the block size
	MOVEM T2,FSPHBS(T3)	;Store in record
	RET

   >	;End IFN FSPSBG


	COMMENT *
	Routine to complete filling in of block header in newly-allocated block.
	(Flags, block-length and next-pointer are already filled in.)
	Also moves the contents of the header to the trailer.
	ARGS:	T1/	Block pointer
		P1/	Pool descriptor address	
	RETURNS:	+1 always


	Entry FILHDR is called to finish header and generate trailer for a
	soon-to-be-allocated user block.

	Entry FILTRL is called to update the trailer of that portion of a
	fragmented block that will remain in the pool.
		*	;End comment

   IFN FSPDBG,<
HDRTAB:  BLOCK FSPBHS
	RELOC HDRTAB
	[RET]			;Zero length header
	RELOC HDRTAB-FSPNXT
	HTDONE			;Pointer to next block (already filled in)
	RELOC HDRTAB-FSPSIZ
	HTDONE			;Size of block (already filled in)
	RELOC HDRTAB-FSPFLG
	HTDONE			;flags (already filled in)
	RELOC HDRTAB-FSPDJF
	HTDONE			;Deassigning fork and job
	RELOC HDRTAB-FSPDPC
	HTDONE			;Deassigning PC
	RELOC HDRTAB-FSPAJF
	HT6			;Assigning fork and job
	RELOC HDRTAB-FSPAPC
	HT7			;Assigning PC

	RELOC HDRTAB+FSPBHS+1
	;...
	;...
FILHDR: SAVET			;Save our AC's
	;Complete the header
	HRRZ T2,FSPHDS(P1)	;Get header size
	MOVE T3,HDRTAB(T2)	;Get dispatch address
	CAIG T2,FSPBHS		;Reasonable index?
	JUMPGE T2,(T3)		;Dispatch and fill in as much as there is
	RET			;Bad index

HT7:	MOVE T2,CALRPC		;Get caller's PC
	MOVEM T2,FSPAPC(T1)	;Store in header
HT6:	MOVE T2,JOBNO		;Get job number of requestor
	HRLM T2,FSPAJF(T1)	;Store in header
	MOVE T2,FORKX		;Get fork number of requestor
	HRRM T2,FSPAJF(T1)	;Store in header
	;Move header to trailer
HTDONE:	SKIPA
FILTRL:	SAVET
	SKIPG FSPTRS(P1)	;Is there a trailer?
	RET			;No, so return now
	MOVE T2,T1		;Get block address in T2
	SUB T2,FSPHDS(P1)	;Make T2 point to top of header
	MOVE T3,FSPSIZ(T1)	;Get block size
	ADD T3,T2		;Make T3 point to end of trailer+1
	SUB T3,FSPTRS(P1)	;Make T3 point to start of trailer
	MOVE T1,FSPTRS(P1)	;Get trailer size
	XBLT. T1		;Move as much of header as will fit in trailer
	RET			;Return

  >	;End FSPDBG conditional
	;Routine to zero a block

	;ARGS:	T1/  Block address
	;	P1/  Pool descriptor address
	;RETURNS +1 always

ZERBLK:	SAVET			;Save our AC's
	MOVE T2,T1		;Get block address in T2
	SOS T2			;Allow for header overlay
	SETZM (T2)		;Zero the first word
	MOVE T1,FSPSIZ(T1)	;Get the length of the block
	SUB T1,FSPHTS(P1)	;Subtract size of the header
;	CAIG T1,1		;Is our block size greater than 1?
	SKIPG T1		;Is our user block size greater than 1?
				; Header overlay means 0 = 1-word user size
	RET			;No, so we have zeroed the whole block
	MOVE T3,T2		;Get the block address again
	AOS T3			;Get addr +1
	XBLT. T1		;Zero the block
	RET			;Return	


	;Routine to account for block request
	;ARGS:     T2/  Block size
	;RETURNS:  BLOCKX/  Index into request accounting-area for this blocksize
   IFN FSPACC,<

BLKACC:	SKIPE T3,FSPBAP(P1)	;Can we do block accounting for this pool?
	JRST BLKAC1		;Yes
	SETZM BLOCKX		;No
	RET
BLKAC1:
	CAILE T2,FSPBSC-2	;Can we actually account for this size block?
	ADDI T3,FSPBSC-1	;No, use this as a catch-all
	CAIG T2,FSPBSC-2	;...
	ADD T3,T2		;Yes, use the offset for that block size
	MOVEM T3,BLOCKX		;Save this index
	AOS FSPREQ(T3)		;Increment count of requests for that size
	RET
   >	;End FSPACC conditional
	COMMENT %
	Routine to move header to trailer after block is released
	ARGS:	P1/  Pool descriptor address
		P2/  User block address
		T2/  Predecessor address
		T3/  Successor address
		F /  Merge flags

	AC USAGE:

		P3/  Address of header to be updated
		P4/  Address of trailer to be updated
	%


   IFN FSPDBG,<
MOVHDR:	SAVEAC <P3,P4>
	;Point P4 at user trailer
	MOVE P4,P2		;Point to user block
	TXNE F,FSP.MS		;Successor merge?
	MOVE P4,T3		;Yes, point to successor
	ADD P4,FSPSIZ(P4)	;Point to block trailer
	SUB P4,FSPHTS(P1)	;...
	;Point P3 at predecessor header
	MOVE P3,T2		;Get predecessor block address
	TXNN F,FSP.MP		;Did a predecessor merge occur?
	MOVE P3,P2		;No, move to user block
	CALL UPDHDR		;Update the header
	SUB P3,FSPHDS(P1)	;Get physical start of block
	EXCH P2,T1		;Save P2
	MOVE P2,FSPTRS(P1)	;Get trailer size
	XBLT. P2		;Move header to trailer
	EXCH P2,T1		;Recover P2
	TXNE F,FSP.MP		;Predecessor merge?
	JRST MOVHD1		;Yes
	;No predecessor merge -
	;Make sure predecessor trailer contains same pointer as header
	SKIPN FSPTRS(P1)	;Is there a trailer?
	JRST MOVHD2		;No
	ADD T2,FSPSIZ(T2)	;Step to trailer of predecessor
	SUB T2,FSPTRS(P1)	;...
	MOVEM P2,FSPNXT(T2)	;Point previous block to user block
	JRST MOVHD2
	;Here if predecessor merge
MOVHD1:	MOVE T1,P2		;Get address of user block
	CALL ZERHDR		;Zero predecessor trailer and user header
MOVHD2:	TXNN F,FSP.MS		;Successor merge?
	RET			;No
	MOVE T1,T3		;Get address of successor
	CALLRET ZERHDR		;Zero user trailer and successor header

   >	;End FSPDBG conditional
	COMMENT %
	Routine to update header data after block is released
	ARGS:	P1/  Pool descriptor address
		P3/  Block address
	%

   IFN FSPDBG,<

UPDHDR:	SAVEAC<T1,T2>		;Save our AC's
	MOVE T1,FSPHDS(P1)	;Get header size
	CAIGE T1,<-FSPDJF>+1	;Enough room to even try?
	RET			;No
	MOVE T2,FORKX		;Get our fork number
	HRRM T2,FSPDJF(P3)	;Save it
	MOVE T2,JOBNO		;Get our job number
	HRLM T2,FSPDJF(P3)	;Save it
	CAIGE T1,<-FSPDPC>+1	;Room for PC?
	RET			;No
	MOVE T2,CALRPC		;Get the PC
	MOVEM T2,FSPDPC(P3)	;Save it
	RET

   >	;End FSPDBG conditional


	;Routine to zero a block header/trailer after the block has been merged
	;with another.

	;ARGS:	T1/	 Block pointer
	;	P1/      Pool descriptor address
	;RETURNS +1 always

   IFN FSPDBG,<

ZERHDR: SAVET
	MOVE T2,T1		;Get address of block
	SUB T2,FSPHTS(P1)	;Point to start of previous block's trailer
	SETZM (T2)		;Zero first word
	MOVE T3,T2		;Get block address again
	AOS T3			;Get address +1
	MOVE T1,FSPHTS(P1)	;Get combined header/trailer size
	SOS T1			;Adjust block length
	XBLT. T1		;Zero the header and trailer
	RET			;Return
   >	;End FSPDBG conditional
	;Routine to compare block header against block trailer
	;ARGS:
	;	P1/	Address of pool descriptor
	;	P2/	Address of block
	;Destroys T1-T4
	;Returns:	+1	Block header/trailer do not match
	;		+2	Block OK

BLKCKP:	SAVET			;Enter here to avoid comparison of pointers
	SETZM T3
	JRST BLKCOM
BLKCHK:	SAVET			;Enter here to compare entire header and trailer
	SETOM T3

BLKCOM:	MOVN T4,FSPBCS(P1)	;Get block-check size (as AOBJN pointer)
	SKIPN T4		;Is there a trailer?
	RETSKP			;No
	MOVE T1,FSPFLG(P2)	;Get the flags word from block header
	;Calculated risk here, somebody might have trashed the flags
	TXNE T1,FSP.BD		;Have we already complained about this block?
	RET			;Yes

	MOVE T1,P2		;Get user block address in T1 
	MOVE T2,P2		;And T2
	ADD T2,FSPSIZ(T1)	;Add block size
	SUB T2,FSPTRS(P1)	;Make T2 point to trailer
	JUMPN T3,CHKALL		;Comparing entire header?
	AOS T4			;No, "decrement" count to avoid comparison of
				;pointers
	SOS T1			;Additional SOS prevents comparison of pointers
	SOS T2			;...
CHKALL:	HRLZS T4		;Complete the AOBJN pointer
CHKLP:	SOS T1			;Pointers are at ends of header/trailer;
	SOS T2			;  Step them back
	MOVE T3,(T1)		;Get word of header
	CAME T3,(T2)		;Compare against trailer
	JRST BADBLK		;They don't match, complain
	AOBJN T4,CHKLP		;Keep checking

	;Now see if the length is reasonable
	CAMN P2,FSPFFB(P1)	;Is this the dummy header?
	RETSKP			;Yes, just return success
	MOVE T2,FSPEND(P1)	;Get highest address in freepool
	SUB T2,FSPORG(P1)	;Get size of pool (-1)
	AOS T2			;Get true size
	MOVE T3,FSPSIZ(P2)	;Get blocksize
	CAML T2,T3		;Is poolsize .LSS. blocksize?
	CAMGE T3,FSPMTB(P1)	;Is blocksize .GE. minimum size?
	SKIPA			;Bad blocksize
	RETSKP			;Everything OK

BADSZ:	BUG.(HLT,FSPBBS,FREE,SOFT,<Bad blocksize>,<<P1,POOLN>,<P2,BLKADR>>,<


Cause:	This is a free space problem; 	The block size is either smaller
	than the minimum block size for this pool, or larger than the entire
	amount of space allocated to the pool.

Action: If the condition is noticed when a block is being returned to the list,
	it is simply marked deassigned (and bad) but not returned to the list.
	If the list header is large enough to include it, the PC, job 
	number and fork number of the assigner and deassigner are stored in  
	the header/trailer.  These may give a clue as to what code caused the  
	problem.

	If the problem persists, change the BUGCHK to a BUGHLT and analyze the 
	dump.


Data:	POOLN - Pool number
	BLKADR - Address of the block. Zero indicates it is the pool
		 descriptor itself that contains the bad pointer.
>)
	RET		;Return +1


	;Here when header and trailer don't match
BADBLK:	MOVX T3,FSP.BD		;Get the bad-block flag
	IORM T3,FSPFLG(P2)	;Turn it on in header
	MOVE T1,DESNDX		;Get pool number
	BUG.(HLT,FSPBLK,FREE,SOFT,<Block damaged>,<<T1,POOLN>,<P2,BLKADR>>,<

Cause:	This is a free space problem. The header of the block does not match
	its trailer.

Action: If the condition is noticed when a block is being returned to the list,
	it is simply marked deassigned (and bad) but not returned to the list.
	If the list header is large enough to include it, the PC, job 
	number and fork number of the assigner and deassigner are stored in 
	the header/trailer.  These may give a clue as to what code caused the  
	damage.

	If the problem persists, change the BUGCHK to a BUGHLT and analyze the 
	dump.


Data:	POOLN - Pool number
	BLKADR - Address of the block. Zero indicates it is the pool
		 descriptor itself that contains the bad pointer.
>)
	RET		;Return +1
   IFN FSPDBG,<
	;External routine to check integrity of freespace pool
	;Args:  T1/     Pool descriptor index
	;Returns +1	Problem with pool
	;	 +2	Pool Ok

FSPCHK:	SKIPL T1		;Range check the index
	CAILE T1,FSPTBL		;...
	RET			;Bad index
	SKIPN P1,FSPTAB(T1)	;Get pool # in P1
	RET			;No pool descriptor for that index

	SETZM T1		;Use T1 as return flag
	LOCK FSPLOK(P1)		;Lock the pool
	CSKED			;Defer reschedule
	CALL FSPCK		;Check the pool
	  SETOM T1		;Indicate +1 return
	UNLOCK FSPLOK(P1)	;Unlock the pool
	ECSKED			;Allow reschedule
	SKIPE T1		;+1/+2 return?
        RET
	RETSKP


	;Internal routine to check integrity of freespace pool

	;Args:	P1/	Address of pool descriptor
	;	Called with pool locked and CSKED

	;Returns +1	Problem with pool
	;	 +2	Pool Ok

FSPCK:	SAVEAC <T1,T2,T3,T4,Q1,Q2,P2>
	MOVE T4,FSPEND(P1)	;Get ending pool address
	MOVE T3,FSPORG(P1)	;Get starting pool address
	MOVE T2,FSPFFB(P1)	;Get address of first free block
	MOVE T2,FSPNXT(T2)	;Get first real block
	JUMPE T2,RSKP		;Zero indicates totally exhausted pool
FSPCLP:	MOVE T1,T2		;Keep current block address here
	MOVE T2,FSPNXT(T1)	;Get next-pointer
	SKIPN T2		;End of list?
	RETSKP			;Yes
	CAML T2,T3		;In range?
	CAML T2,T4		;...
	JRST BADPTR		;No, bad pointer
	MOVE Q2,FSPFLG(T2)	;Get flags from that block
	TXNE Q2,FSP.AS		;Is the block assigned?
	CALL BLKASN		;Yes - it shouldn't be
	MOVE Q1,FSPSIZ(T1)	;Get block size
	ADD Q1,T1		;Add address of block to find succeeding block
	HRRZ Q2,FSPFLG(Q1)	;Get unique code
	CAIE Q2,FSPUCD		;Is this a real block?
	JRST BADSIZ		;No, bad block size or succeeding block damaged
	MOVE P2,T1		;Yes, get block address in P2
	CALL BLKCHK		;Compare header and trailer and complain if bad
	  JFCL			;Ignore +1 return
	JRST FSPCLP		;Keep going through list
BADPTR:	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPPTR,FREE,SOFT,<Block contains bad pointer>,<<Q1,POOLN>,<T1,BLKADR>,<T2,NXTPTR>>,<

Cause:	This is a free space problem.  A free block in the freespace pool
	was found to contain a pointer that did not fall within the legal
	address interval for that pool.


Action:	Analyze the Dump.


Data:	POOLN		Pool number
	BLKADR		Address of the block containing the bad pointer.
	NXTPTR		The bad pointer
>)
	RET


BADSIZ:	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPBSZ,FREE,SOFT,<Block contains bad blocksize>,<<Q1,POOLN>,<T1,BLKADR>>,<

Cause:	This is a free space problem. When the address of the current block
	is incremented by its blocksize, the result should be the address of  
	the next block in the chain.  This is not the case. It indicates that  
	the blocksize of the current block is incorrect, or that the successor  
	of the current block has suffered header damage.




Action:	If the problem persists, change the BUGCHK to a BUGHLT and analyze the 
	dump.


Data:	POOLN		Pool number
	BLKADR		Address of the current block.
>)
	RET


BLKASN:	MOVE Q1,DESNDX		;Get pool number
	BUG.(HLT,FSPASN,FREE,SOFT,<Assigned-block in free-list>,<<Q1,POOLN>,<T1,BLKADR>>,<

Cause:	This is a free space problem.  A block in the freespace pool was
	found to have the "block-assigned" bit set.


Action:	Analyze the Dump.


Data:	POOLN		Pool number
	BLKADR		Address of the block.
>)
	RET

   >		;End FSPDBG conditional
		SUBTTL FSPREM
;[7.1175][7.1258]
;FSPREM - This routine returns the amount of free space (in words) remaining
;in a given pool from the free space descriptor. It also returns the
;biggest block size in the requested pool. If the pool number
;passed is out of range or does not exist, an FSPBPN BUGCHK is issued
;and the value returned is zero. This routine can be used for any
;pool that is built with the FSPPL. macro.
;
; Call with:
;	T1/   Pool Number
;	CALL FSPREM		;(T1/T2,T3)
;
; Returns:
;	+1:   Always with free space remaining in T2 and
;	      with max size block in T3
;
FSPREM::STKVAR <COUNT,MAX,FSPIDX> ;[7.1258] Place holder for count in free space
	JUMPL T1,FSPREB		;Negative index is illegal
	CAIGE T1,FSPTBL		;Must be less then FSPTBL
	SKIPN T2,FSPTAB(T1)	;Is there a pool here?
	JRST FSPREB		;Index out of range or no such pool
	MOVEM T2,FSPIDX		;[7.1258] Save pool descriptor
	MOVE T3,FSPCNT(T2)	;[7.1258] Get remaining words
	MOVEM T3,COUNT		;[7.1258] Save for now
	SETZM MAX		;[7.1258] Say biggest block is initially 0
	SKIPN T2,FSPFFB(T2)	;[7.1258] Get address of first free block
	JRST FSPRM1		;[7.1258] No free blocks, outta here
	DO.			;[7.1258] Loop over all free blocks
	  MOVE T3,FSPSIZ(T2)	;[7.1258] Get block size
	  CAMLE T3,MAX		;[7.1258] Smaller than our current biggest?
	  MOVEM T3,MAX		;[7.1258] No, have our newest big block
	  SKIPE T2,FSPNXT(T2)	;[7.1258] Scan next block
	  JRST TOP.		;[7.1258] And check it
	OD.			;[7.1258]
	MOVE T3,MAX		;[7.1258] Return biggest block size
	MOVE T2,FSPIDX		;[7.1258] Get back pool descriptor
	SUB T3,FSPHTS(T2)	;[7.1258] Now account for header and trailer
FSPRM1:	MOVE T2,COUNT		;[7.1258] Get count
	RET			;[7.1258] And return to caller

	ENDSV.			;[7.1258]

; Here when the pool number is out of range or the pool does not exist in
; FSPTAB.

FSPREB: MOVE T2,0(P)		;Get address of caller
	BUG.(CHK,FSPBPN,FREE,SOFT,<FSPREM - Bad pool number>,<<T1,POOLN>,<T2,CALLER>>,<

Cause:	This BUGCHK occurs when a routine calls routine FSPREM in FREE
	to determine how much free space is left in a given pool and
	the pool number supplied is either out of range (greater or
	equal to FSPTBL) or does not exit (FSPTAB entry equals zero).

Action:	Examine the calling routine and fix it to supply a valid pool
	number.

Data:	POOLN - Pool number
	CALLER - Address of calling routine
>)
	SETZ T2,		;Return zero to caller
	RET			;Done
	;****************************************
	ENDTV.			;End SETVAR TRVAR
	;****************************************

	TNXEND
	END