.TITLE	POOL	buffer pool
	.IDENT	/02.04/
;
; This file implements routines for handling of buffer pools.
;
; A buffer pool is contigous memory block which is divided into a MAP part and
; a POOL part. The first two words of the MAP part contain the address of the
; first MAP entry and the address of the POOL part, the rest of the MAP part
; contains (address, size)-pairs describing free blocks of the POOL part.
;
; routines provided:
;	P$CALL	registers the POOL routines as system calls
;	P$INIT	initializes a memory block to be a POOL. Arguments are START off
;		the memory block, the SIZE of the memory block and size of the
;		map, NMAP. SIZE and NMAP are interpreted as bytes, all
;		arguments will be word-aligned. The address of the POOL will
;		be registered in J$POOL(CURJOB)
;	P$ALLO	allocates a buffer from a POOL. Argument is SIZE of the buffer
;		in bytes. Both Arguments will be rounded to the next full word.
;		On success, the carry flag is cleared and the address of the
;		buffer is returned in R0, otherwise the carry flag will be set.
;	P$FREE	returns a buffer back into a POOL. Arguments are ADDRess of the
;		buffer and SIZE of the buffer. If the MAP is full, it is
;		possible that the last free block will be lost.
;		In this case, a warning message is printed on the system
;		console.
;	P$INFO	prints out the sizes of free blocks in a POOL.
;	P$ERR	writes "POOL ALLOCATION FAILURE" on the system console.
;
; 03-MAY-2005	H. Rosenfeld	use system call priorities
; 22-APR-2005	H. Rosenfeld	there is now a pointer to the job POOL in the
;				job structure so that it is no longer necessary
;				to provide this pointer as argument to the POOL
;				system calls except for P$INIT, which will
;				register the initialized POOL within the job
;				structure.
; 11-APR-2005	H. Rosenfeld	block interrupts while manipulating a POOL,
;				add POOL system call macros and .P$CALL
; 10-APR-2005	H. Rosenfeld	rewrote POOL.MAC as the old one was unclean and
;				buggy
;
	.LIST	ME
	.NLIST	CND
	.ENABL	REG
	.LIBRARY	/CALL.SML/
	.LIBRARY	/UTIL.SML/
	.LIBRARY	/SYSCLL.SML/
	.LIBRARY	/JOBCTL.SML/
	.MCALL	$SYS,$REGSYS
	.MCALL	.CALL,.ENTRY,.RETRN
	.MCALL	.SYSPUT,.OCTAL
	.MCALL	.JOBCTL
	.GLOBL	CURJOB

	P$ADDR=0
	P$SIZE=2
	M$BEG=0
	M$END=2

	.MACRO	.P$CALL
		.GLOBL	P$CALL
		.CALL	P$CALL
	.ENDM

	.MACRO	.P$INIT	START,SIZE,NMAP
		.GLOBL	P$INIT
		.CALL	P$INIT,START,SIZE,NMAP
	.ENDM

	.MACRO	$P$INIT	START,SIZE,NMAP
		$SYS	#^RP$I,#^RNIT,START,SIZE,NMAP
	.ENDM

	.MACRO	.P$ALLO	SIZE
		.GLOBL	P$ALLO
		.CALL	P$ALLO,SIZE
	.ENDM

	.MACRO	$P$ALLO	SIZE
		$SYS	#^RP$A,#^RLLO,SIZE
	.ENDM

	.MACRO	.P$FREE	ADDR,SIZE
		.GLOBL	P$FREE
		.CALL	P$FREE,ADDR,SIZE
	.ENDM

	.MACRO	$P$FREE	ADDR,SIZE
		$SYS	#^RP$F,#^RREE,ADDR,SIZE
	.ENDM

	.MACRO	.P$INFO
		.GLOBL	P$INFO
		.CALL	P$INFO
	.ENDM

	.MACRO	.P$ERR
		.GLOBL	P$ERR
		.CALL	P$ERR
	.ENDM

	.MACRO	$P$ERR
		$SYS	#^RP$E,#^RRR
	.ENDM

	.JOBCTL

	.CSECT

; P$CALL, register pool system calls
P$CALL::.ENTRY
	$REGSYS	#^RP$E,#^RRR,#P$ERR,#0
	$REGSYS	#^RP$A,#^RLLO,#P$ALLO,#340
	$REGSYS	#^RP$F,#^RREE,#P$FREE,#340
	$REGSYS	#^RP$I,#^RNIT,#P$INIT,#340
	.RETRN

; P$INIT, initialize a pool
; input: start address of pool, size of pool, size of map part of pool
; output: beginning of map, end of map, beginning of first block, size of first
;	  block in map
; return: none
P$INIT::.ENTRY
	MOV	6(R5),R0	; first argument: start address
	INC	R0
	BIC	#1,R0		; make it word-aligned
	MOV	10(R5),R1	; second argument: partition size
	INC	R1
	BIC	#1,R1		; make it word-aligned
	MOV	12(R5),R2	; third argument: map size
	INC	R2
	BIC	#1,R2		; make it word-aligned
	MOV	R0,R3		; save start address
	SUB	R2,R1		; calculate size of pool
	ADD	R0,R2		; calculate start of pool
	CMP	(R0)+,(R0)+	; skip over 2 words to beginning of map
	MOV	R0,(R3)+	; beginning of map
	MOV	R2,(R3)+	; end of map
	MOV	R2,(R3)+	; start of first free block (whole pool)
	MOV	R1,(R3)+	; size of first free block (whole pool)
	CLR	(R3)+		; clear next entry
	CLR	(R3)+
	MOV	CURJOB,R0
	BEQ	1$		; if not in job context, skip
	MOV	6(R5),J$POOL(R0); register start of pool in job
1$:	.RETRN

; P$ALLO, allocate buffer from pool
; input: size of buffer
; output: map entry adjusted or removed
; return: carry set on error, clear otherwise
;         R0 address of buffer
P$ALLO::.ENTRY
	MOV	CURJOB,R0
	BEQ	2$		; error if not in job context
	MOV	J$POOL(R0),R0
	BEQ	2$		; error if job has no pool
	MOV	6(R5),R1	; argument: size of block
	INC	R1
	BIC	#1,R1		; make it word-aligned
	MOV	M$END(R0),R4	; get end of map
	CMP	(R0)+,(R0)+	; skip to first entry
1$:	TST	P$SIZE(R0)
	BEQ	2$		; stop on zero entry
	CMP	P$SIZE(R0),R1
	BHIS	3$		; size matches, allocate from this block
	CMP	(R0)+,(R0)+	; next entry
	CMP	R0,R4		; end of map?
	BNE	1$		; nay, try next
2$:	SEC			; indicate error
	.RETRN
3$:	MOV	P$ADDR(R0),R3	; get address of block
	ADD	R1,P$ADDR(R0)	; set new address of free block
	SUB	R1,P$SIZE(R0)	; decrement size of free block
	BNE	5$		; not exact fit, skip move
4$:	CMP	(R0)+,(R0)+	; skip to next entry
	CMP	R0,R4		; end of map?
	BEQ	5$		; yea, finish moving
	MOV	P$ADDR(R0),P$ADDR-4(R0)	; move entry up
	MOV	P$SIZE(R0),P$SIZE-4(R0)
	BNE	4$		; stop after moving last (zero) entry
5$:	MOV	R3,R0		; return address of block
	CLC			; no error
	.RETRN

; P$FREE, return buffer into pool
; input: address of buffer, size of buffer
; output: map entry created, adjacent entries concatenated
; return: none
P$FREE::.ENTRY
	MOV	CURJOB,R0
	BEQ	9$		; error if not in job context
	MOV	J$POOL(R0),R0
	BEQ	9$		; error if job has no pool
	MOV	6(R5),R1	; first argument: address of block
	INC	R1
	BIC	#1,R1		; make it word-aligned
	MOV	10(R5),R2	; second argument: size of block
	INC	R2
	BIC	#1,R2		; make it word-aligned
	MOV	R2,R3
	ADD	R1,R3		; calculate end of block
	MOV	R0,R4		; save pool address for reuse
7$:	CMP	(R0)+,(R0)+	; skip to next map entry
	TST	P$SIZE(R0)
	BNE	1$		; non-zero size, go on
	MOV	R1,P$ADDR(R0)	; zero block, just fill in values
	MOV	R2,P$SIZE(R0)
	.RETRN
1$:	CMP	P$ADDR(R0),R3	; exact fit at the end of block?
	BNE	2$		; nay, go on
	MOV	R1,P$ADDR(R0)	; set new address of free block
	ADD	R2,P$SIZE(R0)	; increment size of free block
	CMP	R0,M$BEG(R4)	; first entry?
	BEQ	6$		; yea, go on
	MOV	P$ADDR-4(R0),R3	; get end of previous block
	ADD	P$SIZE-4(R0),R3
	CMP	R3,R1		; can we append to the previous block?
	BNE	6$		; nay, we can't, go on
	ADD	P$SIZE(R0),P$SIZE-4(R0)	; append to previous
	CLR	P$SIZE(R0)
5$:	CMP	(R0)+,(R0)+	; skip to next map entry
	CMP	R0,M$END(R4)	; end of map?
	BEQ	6$		; yea, stop moving
	MOV	P$ADDR(R0),P$ADDR-4(R0)	; move entry up
	MOV	P$SIZE(R0),P$SIZE-4(R0)
	BNE	5$		; stop after moving last (zero) entry
6$:	.RETRN
9$:	MOV	10(R5),-(SP)	; save block size for error message
	MOV	6(R5),-(SP)	; save block address for error message
	BR	10$		; print error message
2$:	CMP	P$ADDR(R0),R3
	BLO	7$		; block is below this entry, try next
	CMP	R0,M$BEG(R4)	; end of map?
	BEQ	3$		; yea, try insert
	MOV	P$ADDR-4(R0),R3
	ADD	P$SIZE-4(R0),R3	; calculate end of previous entry
	CMP	R3,R1		; does it fit?
	BNE	3$		; nay, try insert
	ADD	R2,P$SIZE(R0)	; append block to previous entry
	.RETRN
3$:	MOV	R2,-(SP)	; save block size for insert loop
	MOV	R1,-(SP)	; save block address for insert loop
4$:	MOV	P$ADDR(R0),R1	; get address of free block
	MOV	P$SIZE(R0),R2	; get size of free block
	MOV	(SP)+,P$ADDR(R0); store address from stack
	MOV	(SP)+,P$SIZE(R0);store size from stack
	BEQ	8$		; stop on last (zero) entry
	MOV	R2,-(SP)	; save size of replaced entry
	MOV	R1,-(SP)	; save address of replaced entry
	CMP	(R0)+,(R0)+	; skip to next entry
	CMP	R0,M$END(R4)	; end of map?
	BNE	4$		; no, continue
10$:	.SYSPUT	#LOST		; argh, we lost a free block!
	MOV	(SP)+,R0	; print address of lost block
	.OCTAL	R0,#OCTBUF
	MOVB	#11,(R0)+
	CLRB	(R0)+
	.SYSPUT	#OCTBUF
	MOV	(SP)+,R0	; print size of lost block
	.OCTAL	R0,#OCTBUF
	.SYSPUT	#OCTBUF
	.SYSPUT	#CRLF
8$:	.RETRN

; P$INFO, print free block sizes of pool
P$INFO::.ENTRY
	MOV	CURJOB,R0
	BEQ	4$		; error if not in job context
	MOV	J$POOL(R0),R3
	BEQ	4$		; error if job has no pool
	MOV	M$END(R3),R4	; get end of map
	CMP	(R3)+,(R3)+	; get first map entry
	TST	P$SIZE(R3)	; are there any free blocks?
	BNE	1$		; yea, print sizes
	.SYSPUT	#NOBLKS		; nay, print message
	.RETRN
1$:	.SYSPUT	#FRBLKS
2$:	.OCTAL	P$SIZE(R3),#OCTBUF	; print size of block
	MOVB	#11,(R0)+
	CLRB	(R0)+
	.SYSPUT	#OCTBUF
	CMP	(R3)+,(R3)+	; skip to next entry
	CMP	R3,R4		; end of map?
	BEQ	3$		; yea, stop
	TST	P$SIZE(R3)	; last (zero) entry?
	BNE	2$		; nay, continue
3$:	.SYSPUT	#CRLF
4$:	.RETRN

; P$ERR, print error message
P$ERR::	.ENTRY
	.SYSPUT	#ERROR
	.RETRN

	.PSECT	DATA
OCTBUF:	.BLKW	4

	.PSECT	CONST
ERROR:	.ASCIZ	/POOL ALLOCATION FAILURE/<15><12>
NOBLKS:	.ASCIZ	/NO FREE BLOCKS IN POOL/<15><12>
FRBLKS:	.ASCIZ	/SIZES OF FREE BLOCKS IN POOL:/<11>
LOST:	.ASCIZ	/POOL MAP FULL, FREE BLOCK LOST:/<11>
CRLF:	.ASCIZ	<15><12>
	.END