Google
 

Trailing-Edge - PDP-10 Archives - bb-x130a-sb - glxxxx.mac
There are 4 other files named glxxxx.mac in the archive. Click here to see a list.
TITLE	GLXMEM  --  Memory Manager for GALAXY Programs

	SEARCH	JOBDAT,MACTEN,UUOSYM
	TWOSEG	400000
	RELOC	0
	RELOC	400000

	TF==0			;TRUE/FALSE REGISTER, NEVER REFERENCED DIRECTLY
	S1==1			;S1 & S2 ARE ARGUMENTS TO ROUTINES
	S2==2			;AND ARE OTHERWISE SCRATCH

	T1==3			;T1 - T4 ARE TEMPORARY REGS
	T2==4
	T3==5
	T4==6

	P1==7			;P1 - P4 ARE PRESERVED REGS
	P2==10
	P3==11
	P4==12

	P==17			;PUSHDOWN POINTER

DEFINE FNCSKP(NEW,OLD),<
	ENTRY	NEW
NEW:	PUSH	P,TF
	PUSHJ	P,OLD
	SKIPF
	 AOS	-1(P)
	POP	P,TF
	POPJ	P,
>

DEFINE FNC(NEW,OLD),<
	ENTRY	NEW
NEW:	PUSH	P,TF
	PUSHJ	P,OLD
	SKIPT
	 PUSHJ	P,S..UFR
	POP	P,TF
	POPJ	P,
>


FNC	M$INIT,M%INIT
FNCSKP	M$ACQP,M%ACQP
FNCSKP	M$RELP,M%RELP
FNCSKP	M$GPAG,M%GPAG
FNCSKP	M$RPAG,M%RPAG
FNCSKP	M$IPSN,M%IPSN
FNCSKP	M$NXPG,M%NXPG
FNCSKP	M$IPRC,M%IPRC
FNCSKP	M$IPRM,M%IPRM
FNCSKP	M$AQNP,M%AQNP
FNCSKP	M$RLNP,M%RLNP
FNCSKP	M$CLNC,M%CLNC
FNCSKP	M$FPGS,M%FPGS
FNCSKP	M$GMEM,M%GMEM
FNCSKP	M$RMEM,M%RMEM

FNC	L$INIT,L%INIT
FNC	L$CLST,L%CLST
FNC	L$DLST,L%DLST
FNC	L$CENT,L%CENT
FNCSKP	L$CBFR,L%CBFR
FNCSKP	L$DENT,L%DENT
FNCSKP	L$NEXT,L%NEXT
FNC	L$FIRST,L%FIRST
FNC	L$LAST,L%LAST
FNC	L$APOS,L%APOS
FNCSKP	L$PREVIOUS,L%PREVIOUS
FNCSKP	L$PREM,L%PREM
FNCSKP	L$CURR,L%CURR
FNCSKP	L$SIZE,L%SIZE
FNCSKP	L$RENT,L%RENT
;               TABLE OF CONTENTS FOR GLXXXX
;
;
;                        SECTION                                   PAGE
;    1. .SAVEx routines
;         1.1   save permanent ACs................................   4
;    2. .POPJ, .POPJ1, .RETE,.RETT & .RETF
;         2.1   Common return routines............................   4
;    3. .ZPAGA - .ZPAGN - .ZCHNK
;         3.1   Zero out memory...................................   4
;    4. Table of contents.........................................   5
;    5. Revision History..........................................   6
;    6. Global Storage............................................   7
;    7. M%INIT - Initialize the memory system.....................   8
;    8. PAGFRE - Determine if a given page is free or not.........   9
;    9. M%GPAG - Acquire one free page full of zeros (address)....  10
;   10. M%ACQP - Acquire one free page full of zeros (page number)  10
;   11. M%AQNP - Acquire several free pages full of zeros.........  11
;   12. FNDPAG - Find first free page.............................  11
;   13. CREPAG - Routine to create a page.........................  12
;   14. M%NXPG - Acquire the number of a free page for IPCF reception  13
;   15. M%RLNP - Release contiguous free pages....................  14
;   16. M%RELP - Release a single page to the free pool (by page number)  14
;   17. M%RPAG - Release a single page to the free pool (by address)  14
;   18. M%FPGS - Return number of free pages......................  14
;   19. M%IPSN - Inform that page is about to be sent via IPCF....  15
;   20. M%IPRC - Inform that page has been created via IPCF.......  15
;   21. M%GMEM - Allocate a chunk of memory.......................  16
;   22. APMEM  - Routine to add one page to the chunk pool........  17
;   23. PGCOLL - Routine to remove whole pages from chunk free pool  18
;   24. M%RMEM - Routine to de-allocate a memory chunk............  19
;   25. Consistency checking routines.............................  20
;   26. M%CLNC - Routines for cleaning up core....................  21
;   27. M%IPRM -  Routine to find a free page for an IPCF receive.  22
;   28. End.......................................................  23
;   29. GLXLNK
;        29.1   GALAXY Linked List Facility.......................  24
;   30. Larry Samberg   1-Jan-82..................................  24
;   31. Table Of Contents.........................................  25
;   32. Revision History..........................................  26
;   33. Data Structures...........................................  27
;   34. Module Storage............................................  29
;   35. L%INIT
;        35.1   Initialize the GLXLNK Module......................  30
;   36. L%CLST
;        36.1   Create a list.....................................  31
;   37. MORLST
;        37.1   Make room for more lists..........................  32
;   38. L%DLST
;        38.1   Destroy a list....................................  33
;   39. L%CENT
;        39.1   Create a list entry...............................  34
;   40. L%CBFR
;        40.1   Create entry "before" CURRENT.....................  35
;   41. L%DENT
;        41.1   Delete list entry.................................  36
;   42. List Positioning Routines.................................  37
;   43. L%APOS - Position to the Entry whose address is in S1.....  38
;   44. Global Utilities..........................................  40
;   45. LINKIN
;        45.1   Link an entry into a list.........................  42
;   46. FNDLST
;        46.1   Find header of list...............................  43
	OPDEF	JUMPT [JUMPN]
	OPDEF	JUMPF [JUMPE]
	OPDEF	SKIPT [SKIPN]
	OPDEF 	SKIPF [SKIPE]

	OPDEF	$CALL	[PUSHJ P,]	;;CALL
	OPDEF	$RET	[POPJ	P,]	;;RETURN
	OPDEF	$RETT	[PJRST	.RETT]	;;RETURN TRUE
	OPDEF	$RETF	[PJRST	.RETF]	;;RETURN FALSE
	OPDEF	$RETIT	[JUMPT	.POPJ]	;;RETURN IF TRUE
	OPDEF	$RETIF	[JUMPF	.POPJ]	;;RETURN IF FALSE

	.NODDT	JUMPT,	JUMPF,	SKIPT,	SKIPF
	.NODDT	$CALL,	$RET
	.NODDT	$RETT,	$RETF,	$RETIT,	$RETIF

DEFINE $GDATA(NAM,SIZ<1>),<NAM: BLOCK SIZ>
DEFINE $DATA(NAM,SIZ<1>),<NAM: BLOCK SIZ>
DEFINE $STOP(PFX,TXT),<
S..'PFX:JRST	[OUTSTR [ASCIZ\?
?MEM'PFX TXT
\]
		 EXIT]
>
DEFINE TOPS10 <REPEAT 1,>
DEFINE TOPS20 <REPEAT 0,>
...COD==0
DEFINE $RETE(COD),<
	PUSHJ	P,.RETE
	IFNDEF ER'COD'$,<ER'COD'$=:<...COD==...COD+1>>
	JUMP	ER'COD'$
>
DEFINE ZERO(ADR,MSK),<
	IFNB <MSK>,PRINTX ?WRONG
	SETZM	ADR
>

DEFINE INCR(ADR,MSK),<
	IFNB <MSK>,PRINTX ?WRONG
	AOS	ADR
>

DEFINE LOAD(AC,ADR,MSK),<
	IFB <MSK>,<MOVE AC,ADR>
	IFNB <MSK>,<LDB AC,[POINTR ADR,MSK]>
>

DEFINE STORE(AC,ADR,MSK),<
	IFB <MSK>,<MOVEM AC,ADR>
	IFNB <MSK>,<DPB AC,[POINTR ADR,MSK]>
>

DEFINE	PG2ADR(AC),<LSH AC,^D9>

DEFINE	ADR2PG(AC),<LSH AC,-^D9>

	$STOP	(UFR,<Unexpected FALSE return from GLXLIB call>)
	PAGSIZ==^D512			;SIZE OF ONE PAGE
	MEMSIZ==^D512			;PAGES IN THE ADDRESS SPACE

	ND	DDCNT,5			;PAGES ADDED TO FREE POOL BEFORE
	ND	DCT.MN,1		;MINIMUM SIZE OF ENTRIES IN DICTIONARY
	ND	DCT.MX,^D50		;MAXIMUM SIZE OF ENTRY IN DICT

	PT.FLG==777		;FLAG FIELD OF PAGE TABLE ENTRY
	  PT.USE==1B35		;INDICATES PAGE IS IN USE
	  PT.ADR==1B34		;PAGE IS ADDRESSABLE (I.E. EXISTS)
	  PT.INI==1B33		;PART OF INITIAL IMAGE (I.E. CODE, ETC.)
	ND	IPCPAD,1		;MINIMUM NUMBER OF PAGES THAT MUST BE FREE
					;BEFORE M%NXPG WILL RETURN ONE
	ND	CNK.PM,^D24	;CHUNK MANAGERS PAGE COUNT BEFORE CLEANUP
	ND	PAGAVL,^D10	;MAX PAGES IN MEM MANAGER BEFORE CLEANUP
SUBTTL	.SAVEx routines -- save permanent ACs


; These routines act as co-routines with  the routines which call them.
; Therefore, no corresponding "restore" routines are needed. When the
; calling routine returns to its caller, it actually returns via the
; restore routines automatically. These unconventional looking routines
; actually run about 30% to 40% faster than those in SCAN or the TOPS-10
; monitor.

.SAVE1:	PUSH	P,P1			;SAVE P1
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,P1			;RESTORE P1
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE2:	ADD	P,[2,,2]		;ADJUST STACK
	DMOVEM	P1,-1(P)		;SAVE P1 AND P2
	PUSHJ	P,@-2(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-3(P)			;ADJUST RETURN PC
	DMOVE	P1,-1(P)		;RESTORE P1 AND P2
	SUB	P,[3,,3]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE3:	ADD	P,[3,,3]		;ADJUST STACK
	DMOVEM	P1,-2(P)		;SAVE P1 AND P2
	MOVEM	P3,0(P)			;SAVE P3
	PUSHJ	P,@-3(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-4(P)			;ADJUST RETURN PC
	DMOVE	P1,-2(P)		;RESTORE P1 AND P2
	MOVE	P3,0(P)			;RESTORE P3
	SUB	P,[4,,4]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE4:	ADD	P,[4,,4]		;ADJUST STACK
	DMOVEM	P1,-3(P)		;SAVE P1 AND P2
	DMOVEM	P3,-1(P)		;SAVE P3 AND P4
	PUSHJ	P,@-4(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-5(P)			;ADJUST RETURN PC
	DMOVE	P1,-3(P)		;RESTORE P1 AND P2
	DMOVE	P3,-1(P)		;RESTORE P3 AND P4
	SUB	P,[5,,5]		;ADJUST STACK
	POPJ	P,			;RETURN

SUBTTL .POPJ, .POPJ1, .RETE,.RETT & .RETF -- Common return routines


; $RETE calls .RETE to set up the last GALAXY error and location
; then set TF = FALSE and return.

.RETE:	MOVEI	S1,@(P)		;GET RETURN PC
	HRRZ	S1,(S1)		;GET ERROR CODE
	POP	P,(P)		;TRIM STACK
				;FALL INTO .RETF (RETURN TO CALLER'S CALLER)

; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly.  They both set the value of TF, one to TRUE and the other
; to FALSE.  After doing this, they return via a POPJ P,
;
.RETF:	TDZA	TF,TF		;ZEROS MEAN FALSE
.RETT:	SETO	TF,		;ONES MEAN TRUE
	POPJ	P,		;RETURN


; The .POPJ and .POPJ1 routines can be jumped
; to get a return, without changing the value in the TF register
;
.POPJ1:	AOS	(P)		;SKIP
.POPJ:	POPJ	P,		;RETURN

SUBTTL	.ZPAGA - .ZPAGN - .ZCHNK  --  Zero out memory

;ROUTINES TO COMPLETELY ZERO A PAGE OF MEMORY.  .ZPAGA IS
;	CALLED WITH THE ADDRESS OF THE FIRST WORD OF THE PAGE
;	IN S1 AND .ZPAGN IS CALLED WITH THE PAGE NUMBER IN S1.
;	.ZCHNK IS USED TO ZERO A CHUNK OF MEMORY
;	  SIZE IN S1 AND LOCATION S2
;	ALL ACS ARE PRESERVED

.ZPAGN:	PUSH	P,S1			;SAVE PAGE NUMBER
	PG2ADR	S1			;CONVERT PAGE NUMBER TO ADR
	SKIPA				;DON'T SAVE S1 TWICE

.ZPAGA:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;AND S2
	MOVE	S2,S1			;GET ADDRESS INTO S2
	MOVX	S1,PAGSIZ		;AND ONE PAGE SIZE INTO S1
	PJRST	ZCHN.1			;JOIN COMMON CODE

.ZCHNK::TRNN	S1,-1			;Anything to do?
	$RETT				;No..just return
	PUSH	P,S1			;SAVE CALLER'S SIZE
	PUSH	P,S2			;AND ADDRESS
ZCHN.1:	ZERO	0(S2)			;CLEAR FIRST WORD
	SOJE	S1,ZCHN.2		;COUNT OF 1,,JUST RETURN
	ADDI	S1,0(S2)		;COMPUTE END ADDRESS
	CAIGE	S1,20			;OUT OF THE ACS?
	$STOP	(AZA,<Attempt to zero the ACs>) ;++LOSER
	HRLS	S2			;GET ADDR,,ADDR OF CHUNK
	AOS	S2			;AND NOW ADDR,,ADDR+1
	BLT	S2,0(S1)		;NOW CLEAR THE CHUNK
ZCHN.2:	POP	P,S2			;RESTORE CALLER'S CHUNK ADDR
	POP	P,S1			;AND HIS SIZE
	$RETT				;AND RETURN
SUBTTL Table of contents

;               TABLE OF CONTENTS FOR GLXMEM
;
;
;                        SECTION                                   PAGE
;    1. Entry Points found in GLXMEM..............................   2
;    2. Table of contents.........................................   3
;    3. Revision History..........................................   4
;    4. Global Storage............................................   5
;    5. M%INIT - Initialize the memory system.....................   6
;    6. PAGFRE - Determine if a given page is free or not.........   7
;    7. M%GPAG - Acquire one free page full of zeros (address)...   8
;    8. M%ACQP - Acquire one free page full of zeros (page number)   8
;    9. M%AQNP - Acquire several free pages full of zeros........   9
;   10. FNDPAG - Find first free page.............................   9
;   11. CREPAG - Routine to create a page.........................  10
;   12. M%NXPG - Acquire the number of a free page for IPCF reception  11
;   13. M%RLNP - Release contiguous free pages....................  12
;   14. M%RELP - Release a single page to the free pool (by page number)  12
;   15. M%RPAG - Release a single page to the free pool (by address)  12
;   16. M%FPGS - Return number of free pages......................  12
;   17. M%IPSN - Inform that page is about to be sent via IPCF....  13
;   18. M%IPRC - Inform that page has been created via IPCF.......  13
;   19. M%GMEM - Allocate a chunk of memory.......................  14
;   20. APMEM  - Routine to add one page to the chunk pool........  15
;   21. PGCOLL - Routine to remove whole pages from chunk free pool  16
;   22. M%RMEM - Routine to de-allocate a memory chunk............  17
;   23. Consistency checking routines.............................  18
;   24. M%CLNC - Routines for cleaning up core....................  19
;   25. M%IPRM - Routine to swap out anything possible............  20
;   27. TOPS-20 Dummy routines....................................  22
SUBTTL Revision History

COMMENT \

Edit	SPR/QAR			Explanation
----    -------	   -----------------------------------------------------
0001		   First pass at GLXMEM, remove AP usage, etc.
0002		   Remove TOPS-10 PFH and move it to the GLXINI module
0003		   Convert to new OTS format
0004		   Move creation of data area to INIT module
0005		   Add M%GPAG and M%RPAG
0006	G053	   Fix M%NXPG on the -20 to clear PT.USE and PT.WRK
0007	G054	   Fix GMEM and RMEM to Garbage Collected when asked for
		   more than CNK.PM pages and cleanup core when available
		   pages exceeds PAGAVL
0010		   Make BPN $STOP dump out offending page number
0011		   Remove usage of PJUMPE opdef
0012		   Arrange to zero our own $DATA space, but keep the stuff
		   we need for restart.  Also, comment out the zeroing of any
		   location that gets zeroed on initialization.
0013		   On TOPS20, make M%INIT start scanning for free pages
		   at c(.JBFF), not page zero.

0014		Restructure GLXLIB
		 1) Do PFH initialization here instead of in PFH. This includes
		    mapping core and marking all symbol table pages.
		 2) Create a non-sharable page and BLT the PFH into it.
		 3) As part of PFH setup, add new routine PFHADR to tell the
		    page fault handler where some of the memory manager data
		    base lives.
		 4) Add PFHRET kludge to allow the page fault handler to return
		    to the library when execute-only is in effect.
		 5) Copy NODDT routine here from PFH.

0015		Add new bit IB.NPF in the IB to disable GLXPFH.

0016		Shuffle some variables so GLXPFH can keep its data base in
		core. This is needed to avoid the possibility of getting a
		fault in the PFH itself. Also, force PFHRET whether or not
		GLXLIB is execute only.

0017		Shift some stuff around to preserve which locations get
		zeroed on a re-start. Broken by edit 16.

0020		Fix Stevens QAR on memory management loop. Allow calls to
		M%GMEM of greater then CNK.PM*PAGSIZ words.

0021		Synchronize with edit 15 to GLXPFH. Remove interface from
		GLXPFH to GLXMEM.

0022		Make creating PFH more robust. Don't call CREPAG to create
		page for PFH, do our own PAGE. uuo. If fails because of
		physical limit, swap out page 1, create ours, then swap 1
		back in.

0023		Remove GLXPFH. Set PHY core limit low and request a timer
		trap to invoke the system PFH.

0024		Clean and simplify M%IPRM. Allow it to give error returns.

0025		Remove reference to obsolete PFH symbols, and fix problem
		with M%CLNC not being called enough to kill pages.

0026		Don't set guidelines since PFH will work without doing that.

0027		Dont reset PT.ADR when restarting so GLXMEM doesnt stopcode.
\
SUBTTL	Global Storage

	RELOC	

	$GDATA	PAGTBL,MEMSIZ	;PAGE MAP OF ALL PAGES
	$DATA	PAGSTA		;STARTING POINT FOR PAGSRC PAGES

	$DATA	MEMBEG,0	;START OF ZEROABLE DATA FOR GLXMEM

	$DATA	AVBPGS		;COUNT OF RELP'D BUT IN CORE PAGES
	$DATA	FREPGS		;COUNT OF FREE PAGES IN ADR SPACE
	$DATA	FREWDS		;FREINI, EXPRESSED AS WORDS NOT PAGES
	$DATA	DICT,DCT.MX+1	;CHUNK DICTIONARY OF FREQUENTLY USED SIZES
	$DATA	PANFLG		;FLAG FOR CHUNK MANAGER
	$DATA	APCNT		;COUNTER FOR COLLECT OR ADD PAGE TEST
	$DATA	CNT.AP		;COUNTER: PAGES ADDED TO FREE CHUNK POOL
	$DATA	CNT.DD		;COUNTER: TIMES DICT HAD TO BE DUMPED
	$DATA	CNT.PC		;COUNTER: NUMBER OF PAGES GARBAGE COLLECTED
	$DATA	CNT.CL		;COUNTER: TIMES RECLAIMED MEMORY
	$DATA	MEMEND,0	;END OF ZEROABLE DATA FOR GLXMEM
				;HERE COMES NON-ZEROABLE $DATA SPACE
	$DATA	MEMFLG		;-1 WHEN M%INIT HAS BEEN CALLED
	$DATA	FREINI		;INITIAL VALUE OF FREPGS FOR CHECKING

	RELOC	
SUBTTL M%INIT - Initialize the memory system

; M%INIT HAS THE TASK OF PUTTING THE PAGE TABLE AND PAGE COUNTERS INTO
; A DETERMINED STATE.

; CALL IS:	NO ARGUMENTS
;
;TRUE RETURN:	ALWAYS

M%INIT:	MOVE	S1,[MEMBEG,,MEMBEG+1]	;SETUP BLT PTR TO ZERO $DATA SPACE
	SETZM	MEMBEG			;ZERO OUT FIRST LOCATION
	BLT	S1,MEMEND-1		;AND DO THE REST
	SKIPGE	MEMFLG			;HAVE WE BEEN HERE BEFORE (RESTART)?
	JRST	INIT.3			;YES, RESTORE INITIAL STATE
	SETOM	MEMFLG			;NO, DETERMINE INITIAL STATE

	MOVEI	S1,0			;START AT PAGE 0

	ADR2PG	S1			;CONVERT TO PAGE NUMBER
	SETOM	PAGSTA			;NO PAGE MARKED AS FIRST FREE YET

INIT.1:	PUSHJ	P,PAGXXX		;IS THIS PAGE FREE?
	JUMPN	S2,INIT.2		;IF ITS IN USE, MARK IT AS SUCH
	AOS	FREINI			;INCREMENT COUNT OF FREE PAGES
	SKIPGE	PAGSTA			;HAVE WE ALREADY FOUND ONE FREE PAGE?
	MOVEM	S1,PAGSTA		;NO, SO SET IT UP NOW

INIT.2:	STORE	S2,PAGTBL(S1),PT.INI	;SAVE INITIAL BIT (1=PART OF ORIGINAL)
	STORE	S2,PAGTBL(S1),PT.USE	;SET THE PAGE STATUS UP TOO
	STORE	S2,PAGTBL(S1),PT.ADR	;AND ADDRESSABLE
	CAIE	S1,MEMSIZ-1		;LOOP FOR ALL PAGES
	AOJA	S1,INIT.1		;MARKING FREE AND INUSE
	JRST	INIT.6			;THEN DO COMMON SET UP

INIT.3:	MOVEI	S1,0			;START AT PAGE 0

INIT.4:	LOAD	S2,PAGTBL(S1),PT.INI	;GET INITIAL IN-USE BIT
	STORE	S2,PAGTBL(S1),PT.USE	;RESET 'IN USE' BIT FOR THIS PAGE
	CAIE	S1,MEMSIZ-1		;ARE WE DONE?
	AOJA	S1,INIT.4		;NO, SO DO NEXT PAGE

INIT.6:	MOVE	S1,FREINI		;GET NUMBER OF FREE PAGES
	MOVEM	S1,FREPGS		;STORE CURRENT NUMBER OF FREE PAGES
	PG2ADR	S1			;CONVERT TO WORDS
	MOVEM	S1,FREWDS		;AND STORE THAT TOO
	MOVX	S1,DDCNT		;RE-SET THE DICT DUMP COUNT
	MOVEM	S1,APCNT		;FOR M%GMEM AND M%RMEM
	PUSHJ	P,M%CLNC		;CLEAN UP CORE
	ZERO	AVBPGS			;CLEAR COUNT OF AVAILABLE PAGES
	$RETT				;ALL DONE, RETURN NOW

PAGXXX:	LDB	S2,[POINT 9,.JBREL,26]	;GET UPPER BOUND ON LOW SEG
	CAMG	S1,S2			;WITHIN LOWER?
	 JRST	PAGX1			;YES--EXISTS
	LDB	S2,[POINT 9,.JBHRL,26]	;GET UPPER BOUND ON HIGH SEG
	CAIL	S1,400			;HIGH SEG?
	 CAMLE	S1,S2			;..
	  TDZA	S2,S2			;NO--DOESNT EXIST
PAGX1:	   MOVEI S2,1			;YES--EXISTS
	$RETT				;AND RETURN
SUBTTL PAGFRE - Determine if a given page is free or not

;CALL		S1/PAGE NUMBER OF PAGE IN QUESTION
;
;TRUE RETURN:	S2/0			;IF PAGE IS FREE
;  OR
;		S2/1			;IF PAGE IS IN USE


PAGFRE:	MOVE	S2,S1			;GET ARGUMENT (PAGE NR.)
	HRLI	S2,.PAGCA		;GET PAGE ACCESS
	PAGE.	S2,			;LOOK UP PAGE ACESS CODE
	  $STOP(PEF,Page existence check failed)
	TXNE	S2,PA.GNE		;DOES PAGE EXIST?
	TDZA	S2,S2			;NO, RETURN 0, I.E. PAGE IS FREE
	MOVX	S2,1			;YES, MARK IT AS IN USE
	$RETT				;IN EITHER CASE, RETURN
SUBTTL	M%GPAG - Acquire one free page full of zeros (address)

;This routine is called to acquire one free page (zeroed).
;
;Call:	no arguments
;
;T Ret:	S1/  address of first word of page acquired

M%GPAG:	PUSHJ	P,M%ACQP		;GET A PAGE
	PG2ADR	S1			;CONVERT PAGE NUMBER TO ADDRESS
	$RETT				;AND RETURN


SUBTTL M%ACQP - Acquire one free page full of zeros (page number)

;THIS ROUTINE IS CALLED TO ACQUIRE A SINGLE FREE PAGE
;
;TRUE RETURN:	S1/PAGE NUMBER OF ACQUIRED PAGE
;
;FALSE RETURN:	NEVER, STOP CODE "ASE" INSTEAD
;

M%ACQP:	MOVEI	S1,1			;WILL ASK FOR 1 PAGE
	SKIPG	AVBPGS			;ANY "GOOD" PAGES AVAILABLE?
	JRST	M%AQNP			;NO, TAKE ANY AVAILABLE PAGE
	MOVE	S1,PAGSTA		;GET STARTING POINT FOR SEARCH
ACQP.1:	CAIL	S1,MEMSIZ		;OFF THE TOP OF MEMORY
	$STOP(CAC,Count of Available Pages Confused)
	MOVE	S2,PAGTBL(S1)		;GET PAGE FLAGS
	TXC	S2,PT.ADR		;WANT TO TEST FOR ON
	TXNE	S2,PT.USE!PT.ADR	;IS IT FREE AND IN-CORE NOW
	AOJA	S1,ACQP.1		;NOT THE BEST, TRY THE NEXT
	PJRST	CREPAG			;EXIT, CREATING AND ZEROING PAGE "S1"
SUBTTL M%AQNP - Acquire several free pages full of zeros

;CALL IS:	S1/NUMBER OF PAGES DESIRED (MAYBE 1 TO MEMSIZ, BUT NOT 0)
;
;TRUE RETURN:	S1/PAGE NUMBER OF FIRST PAGE ACQUIRED
;
;FALSE RETURN:	NEVER, STOP CODE "ASE" INSTEAD


M%AQNP:	SKIPG	S1			;WANTS 1 OR MORE PAGES, RIGHT?
	$STOP(RZP,Request for zero pages) ; NO, SO STOP NOW
	PUSHJ	P,.SAVE3		;SAVE A COUPLE FIRST
	MOVE	P1,S1			;GET THE NUMBER REQUESTED
AQNP.0:	MOVE	S1,PAGSTA		;FIRST PAGE TO TRY FOR
	MOVEI	P2,-1(P1)		;COPY THE COUNT FOR THE LOOP BELOW
	PUSHJ	P,FNDPAG		;GET A PAGE
	JUMPF	AQNP.3			;IF NO PAGES, TRY TO ROB CHUNK POOL
	JUMPE	P2,AQNP.2		;DONE IF ONLY WANTS ONE
AQNP.1:	MOVE	P3,S1			;SAVE THAT NUMBER
	PUSHJ	P,[ AOJA S1,FNDPAG]	;TRY NEXT PAGE NOW
	JUMPF	AQNP.3			;IF FAILS, TRY COLLECTING
	CAIE	S1,1(P3)		;ARE THEY CONTIGUOUS?
	  MOVEI	P2,(P1)			;NO, RESET LOOP COUNT
	SOJG	P2,AQNP.1		;GET MORE IF REQUIRED
AQNP.2:	PUSHJ	P,CREPAG		;CREATE PAGE "S1"
	SOJLE	P1,.RETT		;RETURN IF ALL DONE
	SOJA	S1,AQNP.2		;ELSE BACK DOWN TO THE NEXT ONE

AQNP.3:	SKIPE	PANFLG			;CALL FROM M%GMEM?
	JRST	S..ASE			;YES, ITS ALL OVER
	PUSHJ	P,PGCOLL		;COLLECT PAGES FROM CHUNK ODD SIZE POOL
	JUMPT	AQNP.0			;IF WE GOT A PAGE, TRY ALL OVER
	$STOP(ASE,Addressing space exhausted) ;ELSE, REALLY NO CORE LEFT




SUBTTL FNDPAG - Find first free page

;CALL IS:	S1/ STARTING POINT FOR THE SEARCH
;TRUE RETURN:	S1/ FIRST FREE PAGE
;FALSE RETURN:	COULD NOT FIND A FREE PAGE

FNDPAG:	CAIL	S1,MEMSIZ		;ONLY WANT PAGES THAT ARE UNUSED
	  $RETF				;IF CAN'T FIND ONE, FAIL RETURN
	LOAD	S2,PAGTBL(S1),PT.USE	;THIS ONE USED
	JUMPE	S2,.RETT		;NO, TAKE THIS ONE
	AOJA	S1,FNDPAG		;TRY ANOTHER
SUBTTL CREPAG - Routine to create a page

CREPAG:	PUSHJ	P,REDUCE		;REDUCE COUNT OF FREE PAGES
	MOVX	S2,PT.USE		;GET THE INUSE BIT
	IORB	S2,PAGTBL(S1)		;SET IN USE, GET THE OTHERS
	TXNE	S2,PT.ADR		;IS IT ADDRESSABLE
	 JRST	[SOS	AVBPGS		;YES--DECREMENT "GOOD" PAGES
		 PJRST	.ZPAGN]		;AND RETURN ZEROING PAGE

	PUSHJ	P,.SAVE4		;SAVE P1-P4
CREP.1:	MOVE	P3,S1			;ARGUMENT FOR CREATE A PAGE
	MOVEI	P2,1			;ONLY 1 ARGUMENT
	MOVE	P1,[.PAGCD,,P2]		;FUNCTION CREATE/DESTROY,,ARGUMENTS
	PAGE.	P1,			;TRY THE CREATE
	  JRST	CREP.2			;ANALYZE THE ERROR
	MOVX	S2,PT.ADR		;ADDRESSABLE
	IORM	S2,PAGTBL(S1)		;INCLUDE THE FLAG
	PJRST	.ZPAGN			;RETURN, ZEROING THE PAGE

CREP.2:	PUSH	P,S1			;SAVE THE PAGE WE'RE TRYING TO CREATE
	CAIE	P1,PAGNS%		;OUT OF SWAPPING SPACE
	  JRST	CREP.3			;NO, LOOK AGAIN
	MOVEI	S1,5			;TAKE A QUICK NAP FIRST
	SLEEP	S1,			;IN CASE SOME FREES UP
	PUSHJ	P,M%CLNC		;FREE SOME SWAPPING SPACE
	POP	P,S1			;RESTORE PAGE NUMBER
	JRST	CREP.1			;AND RETRY THE CREATE

CREP.3:	CAIE	P1,PAGLE%		;MY LIMIT EXCEEDED
	  $STOP(CCP,Cannot create page)	;
	PUSHJ	P,M%IPRM		;SWAP OUT ANYTHING
	SKIPT				;CHECK FOR ERRORS
	  $STOP	(NFP,<No free pages>)
	POP	P,S1			;RESTORE PAGE NUMBER
	JRST	CREP.1			;RETRY THE CREATE
SUBTTL M%NXPG - Acquire the number of a free page for IPCF reception

;CALL		NO ARGUMENTS
;
;TRUE RETURN:	S1/THE PAGE NUMBER AVAILABLE FOR IPCF RECEIVE
;FALSE RETURN:	S1/?, NO PAGES AVAILABLE AT THIS TIME, TRY LATER
;
;		AFTER THE RECEIVE, A CALL TO M%IPRC IS REQUIRED.

M%NXPG:
NXPG.0:	MOVE	S1,FREPGS		;GET COUNT OF FREE PAGES
	CAILE	S1,IPCPAD		;ENOUGH TO HANDLE AN INCOMING MESSAGE
	  JRST	NXPG.1			;YES, GO TAKE ONE
	PUSHJ	P,PGCOLL		;NO, TAKE ONE FROM THE FREE SPACE
	JUMPF	.RETF			;CAN'T GET ONE, RETURN FALSE
	JRST	NXPG.0			;TRY UNTIL ENOUGH FREE

NXPG.1:	PUSHJ	P,NXPG.3		;FIND A COMPLETELY MISSING PAGE
	JUMPT	NXPG.2			;TAKE THIS ONE IF WE CAN
	PUSHJ	P,M%CLNC		;DESTROY ANY PAGES I CAN
	PUSHJ	P,NXPG.3		;NOW TRY TO FIND ONE
	SKIPT				;GREAT IF WE GOT ONE
	  $STOP(CFC,Count of Free Pages Confused)
NXPG.2:	MOVX	S2,PT.USE!PT.ADR		;SET THE TEMP STATE
	IORM	S2,PAGTBL(S1)		;OF INUSE BUT NOT ADDRESSABLE
	$RETT				;RETURN OUR SUCCESS

NXPG.3:	MOVE	S1,PAGSTA		;START AT THE FIRST AVAILABLE PAGE
NXPG.4:	CAIL	S1,MEMSIZ		;END OF THE ADDRESSING SPACE
	  $RETF				;YES, RETURN A FAILURE
	MOVE	S2,PAGTBL(S1)		;GET THE TABLE ENTRY
	TXNN	S2,PT.USE!PT.ADR	;IS THIS PAGE THERE
	  $RETT				;NO BITS MEANS OK TO USE IT
	AOJA	S1,NXPG.4		;WELL, TRY THE NEXT
SUBTTL M%RLNP - Release contiguous free pages

;CALL IS:	S1 / NUMBER TO RELEASE
;		S2 / THE FIRST PAGE
;
;TRUE RETURN:	ALWAYS

M%RLNP:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;COPY THE ARGS OVER
RLNP.1:	SOJL	P1,.RETT		;DECR THE COUNT AND RTN ON 0
	MOVE	S1,P2			;GET THE PAGE NUMBER
	PUSHJ	P,M%RELP		;RELEASE IT
	AOJA	P2,RLNP.1		;AND LOOP



SUBTTL M%RELP - Release a single page to the free pool (by page number)
SUBTTL M%RPAG - Release a single page to the free pool (by address)

;CALL IS:	S1/ PAGE NUMBER TO RELEASE
;
;TRUE RETURN:	ALWAYS


M%RPAG:	ADR2PG	S1			;CONVERT ADR TO PAGE
					;  AND FALL INTO M%RELP

M%RELP:	PUSHJ	P,VALPAG		;CONSISTENCY CHECK PAGE NUMBER
	MOVE	S2,PAGTBL(S1)		;GET THE FLAGS
	TXNE	S2,PT.ADR		;IS THIS THE ONE IPCF'ED AWAY
	  JRST	RELP.1			;NO, GO FIX THE COUNTS
	ZERO	PAGTBL(S1)		;CLEAR THE ENTRY
	$RETT				;AND RETURN

RELP.1:	PUSHJ	P,.SAVE1		;SAVE AN AC
	MOVEI	P1,PAGTBL(S1)		;SAVE ADDRESS OF PAGTBL ENTRY
	PUSHJ	P,INCLUD		;BUMP FREE PAGE COUNT
	AOS	S1,AVBPGS		;BUMP COUNT OF AVAILABLE PAGES
	CAILE	S1,PAGAVL		;EXCEED WORKING SET SIZE
	PUSHJ	P,M%CLNC		;YES..CLEANUP MEMORY
RELP.2:	TXZ	S2,PT.USE		;CLEAR IN USE
	MOVEM	S2,(P1)			;SAVE THE ENTRY IN PAGE TABLE
	$RETT				;NOW RETURN..
					;THIS WILL ALWAYS LEAVE ONE PAGE
					;FOR AVBPGS



SUBTTL M%FPGS - Return number of free pages

;CALL		NO ARGUMENTS
;
;TRUE RETURN:	ALWAYS, S1/THE NUMBER OF PAGES FREE

M%FPGS:	MOVE	S1,FREPGS		;PICK UP THE NUMBER
	$RETT				;AND RETURN
SUBTTL M%IPSN - Inform that page is about to be sent via IPCF

; CALL IS:	S1/ PAGE NUMBER OF IPCF'ED PAGE
;
;TRUE RETURN:	ALWAYS

M%IPSN:	PUSHJ	P,VALPAG		;CONSISTENCY CHECK PAGE NUMBER
	MOVX	S2,PT.ADR		;CLEAR ADDRESSABLE
	ANDCAM	S2,PAGTBL(S1)		;SO THAT WE DON'T GET CONFUSED
	PJRST	INCLUD			;BUMP FREE PAGE COUNT AND RETURN



SUBTTL M%IPRC - Inform that page has been created via IPCF

;CALL IS:	S1/PAGE NUMBER THAT RECEIVE CREATED
;
;TRUE RETURN:	ALWAYS

M%IPRC:	PUSHJ	P,VALPAG		;CONSISTENCY CHECK PAGE NUMBER
	PUSH	P,S1			;SAVE THE PAGE NUMBER
	HRLI	S1,.PAGCA		;CHECK ITS ACCESS BITS
	PAGE.	S1,			;SEE IF THE PAGE IS SWAPPED OUT
	  $STOP(PAF,Page access check failed)
	MOVX	S2,PT.ADR		;ADDRESSABLE
	TXNE	S1,PA.GNE		;PAGE DOESN'T EXIST
	  $STOP(RNF,Received non-existent page)
	POP	P,S1			;RESTORE PAGE NUMBER
	IORM	S2,PAGTBL(S1)		;INCLUDE THE FLAG(S)
	PJRST	REDUCE			;REDUCE COUNT OF FREE PAGES AND RETURN
SUBTTL M%GMEM - Allocate a chunk of memory

;CALL IS:	S1/ NUMBER OF WORDS WANTED
;
;TRUE RETURN:	S1/ NUMBER OF WORDS OBTAINED
;		S2/ ADDRESS OF FIRST WORD


M%GMEM:	PUSHJ	P,.SAVE2		;GET TWO WORK REGISTERS
	CAMG	S1,FREWDS		;IN RANGE OF AVAILABLE SPACE?
	SKIPG	S1			;OR SILLY NUMBER?
	$STOP(RNW,Ridiculous number of words requested)
	CAIG	S1,DCT.MX		;IF REQUIRED SIZE .GT. DICTIONARY
	SKIPN	S2,DICT(S1)		;OR IF DICTIONARY ENTRY IS 0
	JRST	GMEM.0			;GO TRY THE ODD SIZE POOL
	MOVE	P1,0(S2)		;GET FORWARD LINK OF CHOSEN BLOCK
	MOVEM	P1,DICT(S1)		;STORE INTO HEAD AS NEXT TO CHOSE
	PJRST	.ZCHNK			;RETURN ZEROING CHUNK

GMEM.0:	MOVE	P1,S1			;SAVE THE REQUIRED BLOCK LENGTH
	MOVE	S1,CNT.AP		;GET FREE POOL ALLOCATED PAGE COUNT
	CAIL	S1,CNK.PM		;WITHIN BOUNDS OF PAGES
	PUSHJ	P,[PUSHJ P,PGCOLL	;NO,,GARBAGE COLLECT
		   SETZM CNT.AP		;CLEAR ADDED PAGE COUNT
		   POPJ  P,   ]		;RETURN
	MOVE	S1,P1			;RESTORE REQUIRED BLOCK LENGTH

GMEM.1:	MOVEI	S2,DICT			;START WITH HEADER OF ODD LIST
GMEM.2:	MOVE	P1,S2			;REMEMBER WHO POINTS TO CURRENT
	HRRZ	S2,0(P1)		;S2 IS NOW CURRENT BLOCK
	JUMPE	S2,GMEM.4		;IF 0, WE HAVE REACHED END OF THE ROAD
	HLRZ	P2,0(S2)		;GET SIZE OF CURRENT BLOCK
	CAMGE	P2,S1			;IS IT SUFFICIENT FOR REQUEST?
	JRST	GMEM.2			;NO, SO TRY NEXT BLOCK
GMEM.3:	HRL	S2,0(S2)		;GET LINK OF CURRENT BLOCK
	HLRM	S2,0(P1)		;MAKE PREV LINK BE WHAT WAS OUR LINK
	HRRZS	S2			;ISOLATE CURRENT BLOCKS ADDRESS
	CAMN	P2,S1			;IS THIS AN EXACT MATCH ON SIZE?
	PJRST	.ZCHNK			;YES, RETURN, ZEROING CHUNK
	PUSH	P,S1			;SAVE NUMBER OF WORDS
	PUSH	P,S2			;SAVE ADDRESS
	ADD	S2,S1			;GET FIRST WORD TO RETURN
	SUBM	P2,S1			;NUMBER OF WORDS TO RETURN
	PUSHJ	P,M%RMEM		;RETURN THE EXTRA WORDS
	POP	P,S2			;RESTORE ADDRESS OF BLOCK
	POP	P,S1			;RESTORE NUMBER OF WORDS
	PJRST	.ZCHNK			;YES, RETURN, ZEROING CHUNK

GMEM.4:	MOVEI	P2,1(S1)		;START WITH NEXT DICT SLOT
GMEM.5:	CAILE	P2,DCT.MX		;IS THIS STILL INSIDE DICTIONARY?
	JRST	GMEM.6			;TIME FOR MORE MEMORY
	SKIPN	S2,DICT(P2)		;ANYTHING IN THIS DICTIONARY SLOT ???
	AOJA	P2,GMEM.5		;NO, TRY NEXT LARGEST
	MOVEI	P1,DICT(P2)		;P1 IS CELL POINTING TO CHOSEN
	JRST	GMEM.3			;EXIT RETURNING EXTRA MEMORY

GMEM.6:	PUSH	P,S1			;SAVE SIZE WANTED
	PUSHJ	P,APMEM			;TRY TO FIX UP FREE CHUNK POOL
	POP	P,S1			;RESTORE THE SIZE
	JRST	GMEM.1			;AND TRY AGAIN
SUBTTL APMEM  - Routine to add one page to the chunk pool

;CALL IS:	No arguments
;TRUE RETURN:	Always


APMEM:	PUSHJ	P,.SAVE2		;GET SOME INDICES
	SETOM	PANFLG			;DON'T WANT ANYTHING TO GO TO DICT
	SOSL	APCNT			;TIME TO DUMP THE DICTIONARY?
	JRST	APME.4			;NO, JUST GET A PAGE
	MOVEI	P1,DCT.MX		;GET MAXIMUM DICTIONARY ENTRY
APME.1:	MOVE	P2,DICT(P1)		;GET START OF LINKED LIST FOR SIZE
	SETZM	DICT(P1)		;CLEAR IT OUT
APME.2:	SKIPN	S2,P2			;DO WE HAVE A VALID ADDRESS?
	JRST	APME.3			;NO, PROCESS NEXT SIZE
	MOVE	S1,P1			;SET SIZE OF CHUNK UP
	MOVE	P2,0(P2)		;GET LINK TO NEXT BLOCK
	PUSHJ	P,M%RMEM		;AND RETURN IT
	JRST	APME.2			;REPEAT FOR POSSIBLE NEXT BLOCK

APME.3:	SOJG	P1,APME.1		;DO FOR ENTIRE DICTIONARY
	MOVEI	P1,DDCNT		;SET COUNTER AGAIN
	MOVEM	P1,APCNT		;RESET IT
	SETZM	PANFLG			;CLEAR PANIC LEVEL FLAG
	INCR	CNT.DD			;DUMPED DICTIONARY AGAIN
	$RETT				;AND RETURN

APME.4:	AOS	CNT.AP			;BUMP THE ADDED PAGE COUNT
	PUSHJ	P,M%ACQP		;ACQUIRE A PAGE
	SETZM	PANFLG			;CLEAR PANIC LEVEL FLAG
	MOVE	S2,S1			;GET PAGE NUMBER
	PG2ADR	S2			;CONVERT TO AN ADDRESS
	MOVEI	S1,PAGSIZ		;AND THE SIZE
	PJRST	M%RMEM			;RETURN, RETURNING TO FREE POOL

SUBTTL PGCOLL - Routine to remove whole pages from chunk free pool

;This routine is called to remove, from the odd-size pool of the chunk
;manager, whole pages so that they are available to routines needing
;whole, page-aligned areas of memory.

;CALL IS:	No arguments
;TRUE RETURN:	A page has been freed
;FALSE RETURN:	No page could be removed

PGCOLL:	AOS	CNT.CL			;BUMP NUMBER OF TIMES COLLECTED
	SETZM	APCNT			;FORCE DICTIONARY DUMP
	PUSHJ	P,APMEM			;TO INSURE FREE POOL IS ALL IN ODD SIZE
	PUSHJ	P,.SAVE4		;NEED LOTS OF SCRATCH SPACE
	SETZM	CNT.PC			;CLEAR COUNT OF PAGES GOTTEN
	MOVEI	P1,DICT			;SEED HEAD OF LIST AS PREVIOUS
PGCO.1:	HRRZ	P2,0(P1)		;GET ADDR OF NEXT CHUNK
	JUMPE	P2,PGCO.2		;IF 0 LINK, WE ARE AT END
	HLRZ	P3,0(P2)		;GET LENGTH OF THIS CHUNK
	MOVE	S1,P2			;GET ADDRESS OF CHUNK
	ADDI	S1,PAGSIZ-1		;AND ROUND UP TO
	TRZ	S1,PAGSIZ-1		; PAGE BOUNDARY
	MOVE	P4,P2			;COPY ADDRESS OF THIS CHUNK
	ADD	P4,P3			;COMPUTE FIRST ADDR NOT IN THIS CHUNK
	MOVE	S2,S1			;GET START OF CHUNK
	ADDI	S2,PAGSIZ		;ADDR OF PAGE STARTING HERE
	CAMGE	P4,S2			;IS SIZE OF PAGE WITH BOUNDS OF CHUNK?
	  JRST	[ MOVE P1,P2		;NO, SO STEP TO NEXT CHUNK
		  JRST PGCO.1 ]		;AND TRY AGAIN
	MOVE	P4,S2			;REMEMBER END ADDRESS OF PAGE SIZE CHUNK
	HRRZ	S2,0(P2)		;GET ADDR OF NEXT CHUNK IN CHAIN
	HRRM	S2,0(P1)		;DE-LINK THIS CHUNK
	SUB	S1,P2			;COMPUTE LN. OF LEFT HAND OVERFLOW
	MOVE	S2,P2			;AND ADDRESS LH OVERFLOW STARTS AT
	SUBI	P3,PAGSIZ(S1)		;ADJUST COUNT TO REFLECT 1 PAGE+LH
	SKIPE	S1			;IF THERE IS ANY LEFT HAND TO RETURN
	PUSHJ	P,M%RMEM		;DO SO NOW
	DMOVE	S1,P3			;GET SIZE, ADDR OF RH OVERFLOW
	SKIPE	S1			;IF THERE IS ANY RH OVERFLOW,
	PUSHJ	P,M%RMEM		;RETURN IT NOW
	INCR	CNT.PC			;COUNT PAGES COLLECTED IN THIS MANNER
	MOVE	S1,P4			;GET END ADDRESS OF PAGE SIZE CHUNK
	SUBI	S1,PAGSIZ		;IT STARTS HERE
	PUSHJ	P,M%RPAG		;RETURN THE PAGE
	JRST	PGCO.1			;TRY TO GET SOME MORE
PGCO.2:	SKIPG	CNT.PC			;DID WE GET ANY
	$RETF				;NO..RETURN FALSE
	$RETT				;YES..RETURN TRUE
SUBTTL M%RMEM - Routine to de-allocate a memory chunk
;CALL IS:	S1/ SIZE OF CHUNK BEING RETURNED
;		S2/ ADDRESS OF CHUNK BEING RETURNED
;
;TRUE RETURN:	ALWAYS

M%RMEM:	PUSHJ	P,.SAVE2		;GET SOME WORK SPACE
	PUSHJ	P,VALADR		;VALIDATE THE ADDRESS
	SKIPG	S1			;REASONABLE AMOUNT BEING RETURNED?
	$STOP(ZWR,Zero words of memory returned)
	SKIPE	PANFLG			;ARE WE IN PANIC MODE?
	JRST	RMEM.1			;YES, DON'T RETURN TO DICTIONARY
	CAIL	S1,DCT.MN		;LESS THAN SMALLEST OR
	CAILE	S1,DCT.MX		;GREATER THAN MAXIMUM IN DICT?
	JRST	RMEM.1			;YES, RETURN TO ODD-SIZE POOL
	MOVE	P1,DICT(S1)		;GET LINK OF HEADER
	HRRZM	P1,0(S2)		;MAKE IT CURRENT BLOCK'S HEADER
	HRRZM	S2,DICT(S1)		;AND MAKE HEADER POINT TO CURRENT
	$RETT				;RETURN NOW

RMEM.1:	MOVEI	P1,DICT			;GET PREV SET UP
RMEM.2:	HRRZ	P2,0(P1)		;GET PREV'S LINK
	SKIPE	P2			;IF CURRENT IS 0 OR
	CAIL	P2,0(S2)		;  ITS ADDRESS IS PAST ADDR OF RETURN BLK
	JRST	RMEM.3			; THEN RETURN BLOCK HERE
	MOVE	P1,P2			;MAKE PREV=CURRENT
	JRST	RMEM.2			;CONTINUE

RMEM.3:	HLRZ	P2,0(P1)		;GET SIZE OF PREVIOUS
	ADD	P2,P1			;ADD SIZE PLUS ADDRESS
	CAIE	P2,0(S2)		;DOES THIS PUT IT AT CURRENT BLOCK?
	JRST	RMEM.4			;NO, CANNOT COMBINE
	MOVE	S2,P1			;CONCATENATE PREV AND CURRENT
	HLRZ	P2,0(P1)		;GET SIZE OF PREVIOUS AGAIN
	ADD	S1,P2			;MAKE A COMBINED SIZE
RMEM.4:	HRLM	S1,0(S2)		;STORE SIZE OF CURRENT BLOCK
	HRRZ	P2,0(P1)		;GET PREV'S FORWARD LINK
	HRRM	P2,0(S2)		;MAKE IT CURRENT'S FORWARD LINK
	CAME	S2,P1			;UNLESS PREV=CURRENT (FROM CONCATENATION)
	HRRM	S2,0(P1)		;MAKE PREV'S FORWARD LINK POINT TO CURR.
	MOVE	P1,S2			;GET ADDRESS OF CURRENT BLOCK
	ADD	P1,S1			;ADD SIZE TO THAT
	CAIE	P1,0(P2)		;DO WE BUTT UP AGAINST NEXT?
	$RETT				;NO, CANNOT COMBINE, RETURN NOW
	HRLZS	S1			;YES, POSITION SIZE OF CURRENT
	ADD	S1,0(P2)		;MAKE COMBINED SIZE,,LINK TO NEW NEXT
	MOVEM	S1,0(S2)		;STORE NEW SIZE AND LINK
	$RETT				;RETURN
SUBTTL Consistency checking routines

;"REDUCE" DECREMENTS THE FREE PAGE COUNT , "INCLUD" ADDS A FREE PAGE
;


REDUCE:	SOSGE	FREPGS			;DECREMENT COUNT OF FREE PAGES
	  $STOP(FCN,Free count negative)
	$RETT				;RETURN IF OK

INCLUD:	AOS	S1,FREPGS		;ADD A FREE PAGE
	CAMLE	S1,FREINI		;MORE THAN WE STARTED OUT WITH
	  $STOP(FCE,Free count exceeds FREINI)
	$RETT				;RETURN IF OK

;VALADR VALIDATES THE RANGE OF MEMORY THAT STARTS AT ADDR IN S2
;	AND CONTINUES FOR THE NUMBER OF WORDS IN S1

VALADR:	PUSH	P,S1			;SAVE INPUT ARGUMENTS
	PUSH	P,S2			;FROM M%RMEM
	EXCH	S1,S2			;GET ADDRESS IN S1, SIZE IN S2
	ADR2PG	S1			;CONVERT TO A PAGE NUMBER
VALA.1:	PUSHJ	P,VALPAG		;VALIDATE IT
	SUBI	S2,PAGSIZ		;HAVE ACCOUNTED FOR ONE PAGE
	SKIPLE	S2			;DONE ENTIRE CHUNK?
	AOJA	S1,VALA.1		;NO, DO THE NEXT PAGE
	POP	P,S2			;RESTORE S2 (ADDRESS)
	POP	P,S1			;RESTORE S1 (SIZE)
	$RETT				;AND RETURN

;VALPAG VALIDATES THE PAGE NUMBER IN AC S1

VALPAG:	CAIL	S1,MEMSIZ		;RANGE CHECK THE PAGE NUMBER
	  JRST	S..BPN			;OUT OF RANGE OF PAGE TABLE
	PUSH	P,S2			;SAVE CALLER'S AC
	MOVE	S2,PAGTBL(S1)		;GET THE PAGE TABLE ENTRY FOR PAGE
	TXNN	S2,PT.INI		;PART OF INITIAL CORE IMAGE?
	TXNN	S2,PT.USE		;OR NOT IN USE?
	$STOP(BPN,Bad page number ^O/S1/)	;YES, STOP NOW
	POP	P,S2			;RESTORE CALLER'S S2
	$RETT				;RETURN IF OK
SUBTTL M%CLNC - Routines for cleaning up core

;CALL IS:	NO ARGUMENTS
;
;TRUE RETURN:	ALWAYS

M%CLNC:
	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVE	P4,PAGSTA		;THE FIRST AVAILABLE PAGE
CLNC.1:	CAIL	P4,MEMSIZ		;OFF THE END OF THE WORLD
	  $RETT				;YES, RETURN
	MOVE	P1,PAGTBL(P4)		;GET THE TABLE ENTRY
	TXC	P1,PT.ADR		;NEED CHECK FOR BOTH SO FLIP
	TXNN	P1,PT.USE!PT.ADR	;USED OR NOT ADDRESSABEL
	  PUSHJ	P,KILPAG		;DESTROY THE PAGE (COULD BE PAGED OUT)
	AOJA	P4,CLNC.1		;AND CONTINUE LOOPING

KILPAG:	MOVEI	P3,(P4)			;WANT IT IN P3
	TXO	P3,1B0			;SET TO DESTROY
	MOVEI	P2,1			;1 ARGUMENT
	MOVE	P1,[.PAGCD,,P2]		;CREATE/DESTROY,,ARGUMENT
	PAGE.	P1,			;TRY TO DESTROY IT
	  $STOP(PKF,Page kill failed)
	ZERO	P1			;CLEAR A REG
	EXCH	P1,PAGTBL(P4)		;CLEAR PAGE TABLE ENTRY, GET OLD FLAGS
	SOS	AVBPGS			;ONE LESS "GOOD" PAGE
	$RETT				;RETURN
SUBTTL M%IPRM -  Routine to find a free page for an IPCF receive


; M%IPRM will find a free page for an IPCF receive. To do this
; correctly in all cases, we create a page on disk, fault it into
; core, and destroy it. This leaves us a slot in our working set
; to receive an IPCF packet.
; Call:	$CALL	M%IPRM
;
; TRUE return:	a page free in the working set
; FALSE return:	can't find a free page
;
M%IPRM:
	PUSHJ	P,.SAVE3		;SAVE SOME ACS
	PUSHJ	P,M%NXPG		;GET A NON-EXISTANT PAGE NUMBER
	  JUMPF	IPRM.E			;CAN'T
	MOVE	P1,[.PAGCD,,P2]		;SET UP UUO
	MOVEI	P2,1			;ONE WORD ARGUMENT
	MOVE	P3,S1			;GET THE PAGE NUMBER
	TXO	P3,PA.GCD		;CREATE THE PAGE ON DISK
	PAGE.	P1,			;CREATE THE PAGE
	  JRST	IPRM.E			;CAN'T
	MOVE	P1,S1			;GET THE PAGE NUMBER
	PG2ADR	P1			;CONVERT TO AN ADDRESS
	MOVE	S2,(P1)			;PAGE FAULT IT INTO CORE
	MOVE	P1,[.PAGCD,,P2]		;SET UP UUO
	MOVEI	P2,1			;ONE WORD ARGUMENT
	MOVE	P3,S1			;GET THE PAGE NUMBER
	TXO	P3,PA.GAF		;LITE THE DESTROY BIT
	PAGE.	P1,			;DESTROY THE PAGE
	  SKIPA				;CAN'T
	$RETT				;RETURN

IPRM.E:	$RETE	(NFP)			;?NO FREE PAGES
SUBTTL	End


MEM%L:

	SUBTTL	GLXLNK  --  GALAXY Linked List Facility
	SUBTTL	Larry Samberg	1-Jan-82

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


	LNKEDT==11			;MODULE EDIT LEVEL

;THE GLXLNK MODULE PROVIDES A LINKED-LIST MANIPULATION FACILITY
;	FOR THE GALAXY COMPONENTS.  THE FACILITIES INCLUDE
;	CREATING AND DESTROYING LISTS, CREATING AND DESTROYING
;	ENTRIES WITHIN A LIST, SCANNING AND REARRANGING LISTS.
SUBTTL	Table Of Contents

;               TABLE OF CONTENTS FOR GLXLNK
;
;
;                        SECTION                                   PAGE
;    1. Larry Samberg   7 Oct 77..................................   1
;    2. Table Of Contents.........................................   2
;    3. Revision History..........................................   3
;    4. Data Structures...........................................   4
;    5. Module Storage............................................   6
;    6. L%INIT  --  Initialize the GLXLNK Module..................   7
;    7. L%CLST  --  Create a list.................................   8
;    8. MORLST  --  Make room for more lists......................   9
;    9. L%DLST  --  Destroy a list................................  10
;   10. L%CENT  --  Create a list entry...........................  11
;   11. L%CBFR  --  Create entry "before" CURRENT.................  12
;   12. L%DENT  --  Delete list entry.............................  13
;   13. List Positioning Routines.................................  14
;   14. L%APOS - Position to the Entry whose address is in S1.....  15
;   15. Global Utilities..........................................  17
;   16. LINKIN  --  Link an entry into a list.....................  19
;   17. FNDLST  --  Find header of list...........................  20
SUBTTL	Revision History


COMMENT	\

0001	Create GLXLNK module.

0002	L%DENT Did no clear "current" when deleting the only entry
	1. Make L%DENT not return address of "current"
	2. Make L%DENT not return ERBOL$ after deleting the first entry
	3. Remove L%CFEN and add a new routine, L%CBFR

0003	Fix bugs introduce in previous edit.

0004	Make L%PREM return error code ERNRE$ instead of stopcode NRE
	for No remembered entry.  (GCF #2).

0005	Add routine L%APOS for positioning to an entry by address.

0006	Zero out $DATA space like all the other modules do.

0007	Restructure GLXLIB
	The PHASE/DEPHASE stuff around the linked list offset definitions
	confused MACRO (and me) when the library was TWOSEG'ed. Remove the
	PHASE/DEPHASE and redefine the symbols another way.

0010	Remove stopcodes ENF (entry not found) and NSL (no such list).
	Replace them with error returns.

0011	Add a check following each call to FNDLST to make sure that
	the link'ed list exists...

\ ;End of revision history
SUBTTL	Data Structures

;EACH ENTRY IN A LIST IS FORMATTED AS SHOWN BELOW.  WHEN A USER
;	IS RETURNED THE ADDRESS OF AN ENTRY, IT IS ACTUALLY
;	THE ADDRESS OF THE FIRST "USER DATA WORD" WHICH IS
;	RETURNED.

;	!=======================================================!
;	!                           !        CHUNK SIZE         !
;	!-------------------------------------------------------!
;	! POINTER TO PREVIOUS ENTRY !   POINTER TO NEXT ENTRY   !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                    USER DATA AREA                     \
;	\                                                       \
;	\                                                       \
;	!                                                       !
;	!=======================================================!

LEN.SZ==-2				;SIZE OF THE CHUNK
	LE.SIZ==0,,-1			;THE SIZE FIELD
LEN.LK==-1				;LINK WORD
	LE.PTP==-1,,0			;POINTER TO PREVIOUS
	LE.PTN==0,,-1			;POINTER TO NEXT
LEN.DT==0				;FIRST USER DATA WORD
	LENOVH==LEN.DT-LEN.SZ		;OVERHEAD PER ENTRY
;EACH LIST HAS AN INTERNAL LIST HEADER. THIS IS FORMATTED AS FOLLOWS:

;	!=======================================================!
;	!   POINTER TO LAST ENTRY   !  POINTER TO FIRST ENTRY   !
;	!-------------------------------------------------------!
;	!               ADDRESS OF CURRENT ENTRY                !
;	!-------------------------------------------------------!
;	!              ADDRESS OF REMEMBERED ENTRY              !
;	!=======================================================!

HDR.LK==0				;THE LINK WORD
	HD.PTL==-1,,0			;POINTER TO LAST ITEM
	HD.PTF==0,,-1			;POINTER TO FIRST ITEM
HDR.CU==1				;ADDRESS OF CURRENT ENTRY
HDR.RM==2				;ADDRESS OF REMEMBERED ENTRY
HDR.SZ==3				;SIZE OF THE HEADER
SUBTTL Module Storage

	RELOC	

	$DATA	LNKBEG,0		;START OF ZEROABLE $DATA SPACE
	$DATA	LSTNUM			;NUMBER OF LIST SLOTS
	$DATA	LSTADR			;ADDRESS OF LIST SLOTS
	$DATA	LSTFRE			;NUMBER OF FREE LIST SLOTS
	$DATA	LNKEND,0		;END OF ZEROABLE $DATA SPACE

	RELOC	
SUBTTL	L%INIT  --  Initialize the GLXLNK Module


L%INIT:	MOVE	S1,[LNKBEG,,LNKBEG+1]	;SETUP BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	LNKBEG			;DO THE FIRST LOC
	BLT	S1,LNKEND-1		;AND BLT THE REST TO ZERO
	$RETT				;AND RETURN
SUBTTL	L%CLST  --  Create a list

;L%CLST IS CALLED TO CREATE A LINKED-LIST.  THE ROUTINE CREATES
;	THE LIST AND RETURNS A LIST-NAME.  THE LIST IS POSITIONED
;	AT THE BEGINNING.

;CALL:			NO ARGUMENTS
;
;TRUE RETURN:		S1/ LIST NAME


L%CLST:	SKIPN	LSTFRE			;ANY FREE SLOTS?
	PUSHJ	P,MORLST		;NO, MAKE SOME
	MOVE	S1,LSTADR		;GET ADDRESS OF THE SLOTS
	PUSHJ	P,.SAVE1		;SAVE P1

CLST.1:	SKIPE	0(S1)			;IS THIS SLOT FREE?
	AOJA	S1,CLST.1		;NO, LOOP FOR A FREE ONE
	MOVE	P1,S1			;YES, SAVE ITS ADDRESS
	MOVEI	S1,HDR.SZ		;GET HEADER SIZE
	PUSHJ	P,M%GMEM		;GET SOME CORE
	MOVEM	S2,0(P1)		;SAVE THE ADDRESS
	SUB	P1,LSTADR		;MAKE A LIST NAME
	SOS	LSTFRE			;DECREMENT FREE LIST SLOTS
	MOVE	S1,P1			;PUT IT IN THE CORRECT AC
	JUMPE	S1,L%CLST		;NEVER RETURN LIST 0
	$RETT				;AND RETURN
SUBTTL	MORLST  --  Make room for more lists

;MORLST IS CALLED WHEN WE RUN OUT OF FREE SLOTS WHILE TRYING TO
;	CREATE A NEW LIST.

MORLST:	MOVE	S1,LSTNUM		;GET CURRENT NUMBER OF SLOTS
	ADDI	S1,^D20			;ADD THE INCREMENT
	PUSHJ	P,M%GMEM		;AND GET THE SPACE
	EXCH	S2,LSTADR		;SAVE THE NEW ADDRESS
	JUMPE	S2,MORL.1		;IF FIRST CALL, NO OLD LIST ADDR
	PUSH	P,S2			;SAVE THE OLD ADDRESS
	HRL	S2,S2			;START BUILDING A BLT PTR
	HRR	S2,LSTADR		;FINISH BUILDING A BLT POINTER
	MOVE	S1,LSTADR		;GET START OF NEW TABLE
	ADD	S1,LSTNUM		;ADD LENGTH OF OLD TABLE
	BLT	S2,-1(S1)		;AND BLT OLD TO NEW
	POP	P,S2			;GET ADDRESS OF OLD TABLE BACK
	MOVE	S1,LSTNUM		;GET ITS LENGTH
	PUSHJ	P,M%RMEM		;RETURN THE MEMORY
MORL.1:	MOVEI	S1,^D20			;GET INCREMENT SIZE
	ADDM	S1,LSTNUM		;INCREMENT THE TOTAL
	ADDM	S1,LSTFRE		;AND THE FREE CELL COUNT
	$RETT				;AND RETURN
SUBTTL	L%DLST  --  Destroy a list

;L%DLST IS CALLED WITH A LIST NAME TO DESTROY THE LIST.  ALL
;	ENTRIES IN THE LIST ARE RETURNED TO THE FREE SPACE POOL
;	AND THE LIST IS DESTROYED.

;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		ALWAYS


L%DLST:	PUSH	P,S1			;SAVE LIST ID
	PUSHJ	P,L%LAST		;POSITION TO THE LAST
	JUMPF	DLST.2			;DONE ALREADY!

DLST.1:	PUSHJ	P,L%DENT		;DELETE THE ENTRY
	JUMPT	DLST.1			;AND LOOP

DLST.2:	POP	P,S1			;RESTORE LIST NAME
	ADD	S1,LSTADR		;GET ADDRESS OF LIST SLOT
	MOVEI	S2,0			;LOAD A ZERO
	EXCH	S2,0(S1)		;CLEAR LST SLOT AND LD ADDRESS
	MOVEI	S1,HDR.SZ		;GET HEADER SIZE
	PUSHJ	P,M%RMEM		;RETURN THE MEMORY
	AOS	LSTFRE			;INCREMENT FREE SLOT COUNT
	$RETT				;AND RETURN
SUBTTL	L%CENT  --  Create a list entry

;L%CENT IS CALLED TO CREATE AN ENTRY AND LINK IT IN "AFTER" THE
;	CURRENT ENTRY IN A LIST.  IF THERE IS "NO" CURRENT ENTRY,
;	THE ENTRY IS LINKED AS THE FIRST ENTRY.
;
;THE NEWLY CREATED ENTRY BECOMES CURRENT.
;
;CALL:			S1/  LIST NAME
;			S2/  ENTRY SIZE (IN WORDS)
;
;TRUE RETURN:		S1/  LIST NAME
;			S2/  ADDRESS OF CURRENT ("NEW") ENTRY


L%CENT:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;SAVE LIST NAME AND SIZE
	PUSHJ	P,FNDLST		;FIND THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	EXCH	P2,S2			;SAVE HEADER ADR GET SIZE
	MOVEI	S1,LENOVH(S2)		;GET SIZE+OVERHEAD IN S1
	PUSHJ	P,M%GMEM		;GET THE SPACE
	ADDI	S2,LENOVH		;POINT TO USER DATA
	STORE	S1,LEN.SZ(S2),LE.SIZ	;STORE CHUNK SIZE
	EXCH	S2,P2			;GET HEADER ADDRESS
	MOVE	S1,S2			;PUT HEADER ADDRESS IN S1
	MOVE	S2,P2			;PUT ENTRY ADDRESS IN S2
	PUSHJ	P,LINKIN		;GO LINK IT IN
	DMOVE	S1,P1			;GET LIST NAME AND ENTRY ADR
	$RETT				;AND RETURN SUCCESS
SUBTTL 	L%CBFR  --  Create entry "before" CURRENT


; L%CBFR IS CALLED TO CREATE AN ENTRY IMMEDIATELY BEFORE THE CURRENT ONE

L%CBFR:	PUSHJ	P,.SAVE2		;SAFE STOREAGE
	DMOVE	P1,S1			;SAVE INPUT ARGS
	PUSHJ	P,L%PREV		;GET PREVIOUS
	JUMPF	CBFR.1			;CHECK THE ERROR
	DMOVE	S1,P1			;RESTORE ARGUMENTS
	PJRST	L%CENT			;CREATE ENTRY HERE

CBFR.1:	MOVE	S1,P1			;GET LIST NAME
	PUSHJ	P,FNDLST		;FIND IT
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SETZM	HDR.CU(S2)		;CLEAR CURRENT ENTRY
	MOVE	S2,P2			;GET THE SIZE BACK
	PJRST	L%CENT			;GO CREATE THE ENTRY
SUBTTL	L%DENT  --  Delete list entry

;L%DENT IS CALLED TO DELETE THE CURRENT ENTRY IN A LIST.  AFTER THE
;	ENTRY IS DELETED, THE LIST IS POSITIONED TO THE IMMEDIATELY
;	PREVIOUS ENTRY.  IF THE ENTRY DELETED WAS THE FIRST ENTRY,
;	CURRENT IS CLEARED.

;CALL:			S1/  LIST NAME
;
;TRUE RETURN:		S1/  LIST NAME

;FALSE RETURN:	S1/ ERNCE$


L%DENT:	PUSHJ	P,.SAVE3		;SAVE P1, P2, P3
	PUSHJ	P,FNDLST		;FIND THE LST HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	DMOVE	P1,S1			;SAVE THE RETURNED INFO
	SKIPN	P3,HDR.CU(S2)		;GET THE ADDRESS OF CURRENT
	$RETE(NCE)			;LOSE
	CAMN	P3,HDR.RM(S2)		;IS THIS THE "REMEMBERED" ENTRY?
	ZERO	HDR.RM(S2)		;YES, CLEAR "REMEMBERED"
	LOAD	S1,LEN.LK(P3),LE.PTP	;GET POINTER TO PREVIOUS
	LOAD	S2,LEN.LK(P3),LE.PTN	;GET POINTER TO NEXT
	JUMPE	S1,DENT.1		;JUMP IF IT IS THE FIRST
	JUMPE	S2,DENT.2		;JUMP IF IT IS THE LAST
	STORE	S1,LEN.LK(S2),LE.PTP	;STORE NEXT'S PREVIOUS
	STORE	S2,LEN.LK(S1),LE.PTN	;STORE PREVIOUS' NEXT
	MOVEM	S1,HDR.CU(P2)		;STORE AS "CURRENT"
	JRST	DENT.4			;AND FINISH UP

;HERE IF DESTROYING THE FIRST
DENT.1:	JUMPE	S2,DENT.3		;JUMP IF THIS IS THE "ONLY"
	STORE	S2,HDR.LK(P2),HD.PTF	;SET NEXT TO BE FIRST
	STORE	S1,LEN.LK(S2),LE.PTP	;CLEAR OUT THE "PREVIOUS
	PUSHJ	P,DENT.4		;DO COMMON CODE FOR DELETE
	ZERO	HDR.CU(P2)		;CLEAR "CURRENT"
	$RETT				;AND RETURN

;HERE IF DESTROYING THE LAST
DENT.2:	STORE	S1,HDR.LK(P2),HD.PTL	;SET PREVIOUS TO BE LAST
	STORE	S2,LEN.LK(S1),LE.PTN	;CLEAR OUT THE "NEXT"
	MOVEM	S1,HDR.CU(P2)		;STORE NEW "CURRENT"
	JRST	DENT.4			;AND FINISH UP

;HERE IF DESTROYING THE ONLY
DENT.3:	SETZM	HDR.LK(P2)		;CLEAR THE LINK WORDS
	SETZM	HDR.CU(P2)		;CLEAR THE "CURRENT" WORD

DENT.4:	LOAD	S1,LEN.SZ(P3),LE.SIZ	;GET ENTRY SIZE
	SUBI	P3,LENOVH		;POINT TO BEGINNING OF CHUNK
	MOVE	S2,P3			;PUT IN IN S2
	PUSHJ	P,M%RMEM		;RETURN THE MEMORY
	MOVE	S1,P1			;GET LIST NAME BACK
	$RETT				;AND RETURN
SUBTTL	List Positioning Routines

;ROUTINES TO POSITION TO VARIOUS PLACES IN A LIST


;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		S1/ LIST NAME
;			S2/ ADDRESS OF CURRENT ENTRY
;
;FALSE RETURN:		S1/ ERBOL$   EREOL$   ERNCE$


L%NEXT:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE LIST NAME IN P1
	PUSHJ	P,FNDLST		;GET THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SKIPN	HDR.CU(S2)		;GET THE CURRENT
	JRST	L%FIRST			;NO CURRENT, USE FIRST
	MOVE	S1,HDR.CU(S2)		;GET "CURRENT" ENTRY
	LOAD	S1,LEN.LK(S1),LE.PTN	;GET POINTER TO NEXT
	SKIPN	S1			;IS THERE A NEXT ONE?
	$RETE(EOL)			;NO, RETURN END-OF-LIST
	JRST	POSRET			;FINISH UP AND RETURN


L%FIRST:
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE LIST NAME IN P1
	PUSHJ	P,FNDLST		;GET THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	LOAD	S1,HDR.LK(S2),HD.PTF	;GET POINTER TO FIRST
	SKIPN	S1			;IS THERE ONE?
	$RETE(EOL)			;NO, EOL
	JRST	POSRET			;FINISH UP AND RETURN


L%LAST:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE LIST NAME IN P1
	PUSHJ	P,FNDLST		;GET THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	LOAD	S1,HDR.LK(S2),HD.PTL	;GET POINTER TO LAST
	SKIPN	S1			;IS THERE ONE?
	$RETE(EOL)			;NO, RETURN EOL
	JRST	POSRET			;CLEAN-UP AND RETURN

	SUBTTL	L%APOS - Position to the Entry whose address is in S1

; Call:	S1/ The List Id
;	S2/ The Address of the Entry to be positioned to
;
; TRUE return:	S1/ The List Id
;		S2/ The Address of the Current Entry
; FALSE return:	S1/ ERENF$

L%APOS:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	DMOVE	P1,S1			;SAVE THE INPUT ARGS
	PUSHJ	P,FNDLST		;GO FIND THE LIST WE WANT
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	MOVE	S1,S2			;SAVE THE LIST HEADER ADDRESS
	LOAD	S2,HDR.LK(S2),HD.PTF	;GET THE ADDRESS OF THE FIRST ENTRY
	SKIPA				;SKIP THE FIRST TIME THROUGH
APOS.1:	LOAD	S2,LEN.LK(S2),LE.PTN	;GET THE ADDRESS OF THE NEXT ENTRY
	SKIPN	S2			;CAN'T BE 'END OF LIST' !!!
	  $RETE	(ENF)			;?ENTRY NOT FOUND
	CAME	S2,P2			;DO THE ADDRESSES MATCH ???
	JRST	APOS.1			;NO,,TRY THE NEXT ENTRY
	MOVEM	S2,HDR.CU(S1)		;MAKE THIS THE CURRENT ENTRY
	DMOVE	S1,P1			;RESTORE THE INPUT ARGS
	$RETT				;AND RETURN
L%PREVIOUS:
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE LIST NAME IN P1
	PUSHJ	P,FNDLST		;GET THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SKIPN	S1,HDR.CU(S2)		;GET THE CURRENT ENTRY
	$RETE(NCE)			;NO CURRENT ENTRY
	LOAD	S1,LEN.LK(S1),LE.PTP	;GET POINTER TO PREVIOUS
	SKIPN	S1			;DID WE HIT BOL?
	$RETE(BOL)			;YES, GIVE THE ERROR
	JRST	POSRET			;AND FINISH UP

L%PREM:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE LIST NAME IN P1
	PUSHJ	P,FNDLST		;GET THE HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SKIPN	S1,HDR.RM(S2)		;GET "REMEMBERED"
	$RETE(NRE)			;RETURN NO REMEMBERED ENTRY
	JRST	POSRET			;AND FINISH UP




;HERE TO FINISH UP AND RETURN AFTER POSITIONING OPERATIONS
;CALL WITH:	S1/  ADDRESS OF NEW CURRENT ENTRY
;		S2/  ADDRESS OF LIST HEADER
;		P1/  LIST NAME
;
;RETURN WITH:	S1/  LIST NAME
;		S2/  ADDRESS OF CURRENT ENTRY
;
;STORES THE NEW CURRENT ENTRY IN THE HEADER ALSO.
POSRET:	MOVEM	S1,HDR.CU(S2)		;STORE THE NEW CURRENT
	MOVE	S2,S1			;GET THE NEW CURRENT
	MOVE	S1,P1			;GET THE LIST NAME
	$RETT				;AND RETURN
SUBTTL	Global Utilities

;L%CURR  -  IS CALLED TO RETURN THE ADDRESS OF THE "CURRENT" ITEM
;	IN A LIST.
;
;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		S1/ LIST NAME
;			S2/ ADDRESS OF "CURRENT" ENTRY
;
;FALSE RETURN:		S1/ ERNCE$


L%CURR:	PUSHJ	P,FNDLST		;FIND THE LIST HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SKIPN	S2,HDR.CU(S2)		;GET THE CURRENT ENTRY
	$RETE(NCE)			;THERE IS NONE
	$RETT				;RETURN TRUE


;L%SIZE  -  IS CALLED TO RETURN THE SIZE OF THE CURRENT ENTRY IN A
;	LIST.

;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		S1/ LIST NAME
;			S2/ SIZE OF "CURRENT ENTRY"
;
;FALSE RETURN:		S1/ ERNCE$


L%SIZE:	PUSHJ	P,FNDLST		;FIND THE LIST
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	SKIPN	S2,HDR.CU(S2)		;GET ADDRESS OF CURRENT ENTRY
	$RETE(NCE)			;THERE IS NONE
	LOAD	S2,LEN.SZ(S2),LE.SIZ	 ;GET THE CHUNK SIZE
	SUBI	S2,LENOVH		;SUBTRACT OFFSET TO DATA-AREA
	$RETT				;AND RETURN
;L%RENT  --  CALLED TO "REMEMBER" THE ADDRESS OF THE CURRENT ENTRY
;	IN A LIST.

;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		S1/ LIST NAME
;			S2/ ADDRESS OF CURRENT ENTRY
;
;FALSE RETURN:		S1/ ERNCE$


L%RENT:	PUSHJ	P,FNDLST		;GET THE LIST HEADER
	JUMPF	[$RET]			;NO SUCH LIST,,RETURN ERROR
	PUSHJ	P,.SAVE1		;SAVE P1
	SKIPN	P1,HDR.CU(S2)		;GET ADDRESS OF CURRENT
	$RETE(NCE)			;NONE!
	MOVEM	P1,HDR.RM(S2)		;REMEMBER IT
	MOVE	S2,P1			;COPY ADDRESS OVER
	$RETT				;AND RETURN SUCCESS
SUBTTL	LINKIN  --  Link an entry into a list

;CALLED TO LINK AN ENTRY INTO A LIST "AFTER" THE CURRENT ENTRY.
;	IF THERE IS NO CURRENT ENTRY, THE NEW ENTRY IS LINKED
;	IN AT THE BEGINNING OF THE LIST.

;CALL:			S1/  HEADER ADDRESS
;			S2/  ENTRY ADDRESS
;
;MAKES THE NEW ENTRY THE "CURRENT" ENTRY IN THE LIST

LINKIN:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;AND SAVE THE CALL ARGS
	SKIPN	S1,HDR.CU(P1)		;IS THERE A CURRENT ENTRY?
	JRST	LINK.1			;NO, LINK AT THE TOP
	LOAD	S2,LEN.LK(S1),LE.PTN	;GET ADDRESS OF NEXT
	STORE	S2,LEN.LK(P2),LE.PTN	;MAKE IT NEW PTN
	STORE	P2,LEN.LK(S1),LE.PTN	;MAKE THIS ITS PRED.
	STORE	S1,LEN.LK(P2),LE.PTP	;MAKE CURR NEW PRED.
	JUMPE	S2,LINK.2		;JUMP IF THIS IS THE LAST
	STORE	P2,LEN.LK(S2),LE.PTP	;MAKE PRED. OF SUCC.
	MOVEM	P2,HDR.CU(P1)		;STORE NEW CURRENT
	$RETT				;AND RETURN

LINK.1:	LOAD	S1,HDR.LK(P1),HD.PTF	;GET POINTER TO FIRST
	STORE	P2,HDR.LK(P1),HD.PTF	;MAKE THIS THE FIRST
	STORE	S1,LEN.LK(P2),LE.PTN	;MAKE IT 2ND
	JUMPE	S1,LINK.2		;JUMP IF ALSO LAST ELEMENT
	STORE	P2,LEN.LK(S1),LE.PTP	;STORE OLD FIRST'S PREV POINTER
	SKIPA				;AND DONT STORE AS LAST
LINK.2:	STORE	P2,HDR.LK(P1),HD.PTL	;ELSE STORE AS LAST
	MOVEM	P2,HDR.CU(P1)		;STORE NEW CURRENT
	$RETT				;AND RETURN
SUBTTL	FNDLST  --  Find header of list

;FNDLST IS CALLED WITH A LIST NAME.  IT SEARCHES FOR THE LIST
;	HEADER AND RETURNS IT'S ADDRESS.

;CALL:			S1/ LIST NAME
;
;TRUE RETURN:		S1/ LIST NAME
;			S2/ ADDRESS OF LIST HEADER
;FALSE RETURN:		s1/ ERNSL$


FNDLST:	SKIPL	S1			;NEGATIVE OR
	CAML	S1,LSTNUM		;GREATER THAN ALLOWABLE?
	  $RETE	(NSL)			;?NO SUCH LIST
	MOVE	S2,LSTADR		;GET ADDRESS OF LIST SLOTS
	ADD	S2,S1			;ADD IN THE OFFSET
	SKIPN	S2,0(S2)		;GET THE HEADER ADDRESS
	  $RETE	(NSL)			;?NO SUCH LIST
	$RETT





LNK%L:
	END