;_Header
;*******************************************************************
;    NOVA CONTROL SYSTEM  ---  Lawrence Livermore Laboratory
;
;    Copyright 1984 by The Regents of the University of California
;*******************************************************************
;
;_Module_Name:  PRXHEAP		_File:  [VCDEV.PRXRTS]PRXHEAP.MAC
;
;_Description:
;	Praxis heap management routines for Stand-alone LSI-11
;_Call:
;	JSR	PC,PRX$AINIT
;	JSR	PC,PRX$AFLEX
;	JSR	PC,PRX$FREE
;_Remarks:
;_Identifier: { none }
;*******************************************************************
;_Author:  T. A. SHERMAN		_Creation_Date:  14-APR-1984
;_Revisions:
;  1.000  14-APR-1984  TAS	Initial Key-in.
;  1.001  19-Sep-1984	FWH	Put Macros inside so self-contained
;  1.002  27-Sep-1984	FWH	Optimized, added comments
;*******************************************************************
;_End
	.TITLE	PRXHEAP
	.LIST MEB
;------------------------------------------------------------------
; Macros used inside this module
	.MACRO	RAISE	ID
	MOV	#ID,-(SP)
	JSR	PC,PRX$RAISE
	.ENDM
;;-----------------------------------------------------------------
	.MACRO	PRINT	TEXT,VAL,?LABEL,?LSIZE
	.ENABL	LSB
	.PSECT	$PDATA,REL,CON,LCL,D,RO
	.EVEN
LSIZE:
	.NCHR	N,<TEXT>
	.WORD	N
LABEL:
	.ASCII	/TEXT/
	.EVEN
	.WORD	0
	.PSECT	$CODE1
	MOV	LSIZE,-(SP)
	MOV	#LABEL,-(SP)
	JSR	PC,PUTSTR
	.IF	B,VAL
	TST	(SP)+
	.IFF
	CLR	(SP)
	CLR	-(SP)
	MOV	VAL,-(SP)
	JSR	PC,PUTOCT
	ADD	#6,SP
	.ENDC
	.DSABL	LSB
	.ENDM
;----------------------------


	.PAGE
; This is the heap.  Its size can be extended by use of the
; EXTSCT=$HEAP:n option in the link command file, where 
; n = number of bytes to extend the heap by.

	.PSECT	$HEAP,REL,CON,LCL,D,RW
LOHEAP::.BLKB	256.
	.PSECT	$HEAPA,REL,CON,LCL,D,RW
HIHEAP::.WORD	0

; The heap is organized as as a double threaded list requiring
; 3 words of overhead per allocated element, as follows.
;
;---------------------------------------------------------
; LOHEAP	ADC	Pointer to successor element
;		ADC	Pointer to predecessor element
;		NUM	Size this element, bytes (<0 of not used)
; Praxis Pointer --->		Space for allocated element
; -----------------------------------------------------
;		ADC	Pointer to successor
;		ADC	Pointer to LOHEAP
;		ADC	N
; Praxis Pointer --->		Space for allocated element
;------------------------------------------------------
;		etc.
	.PAGE
	.PSECT	$CODE1,REL,CON,LCL,I,RO

; Initialize the heap

HEAPINIT::
;;	PRINT	<Initialize the  Heap>
	MOV	R0,-(SP)	; Save R0
	MOV	#LOHEAP,R0	; Get pointer to heap
	CLR	(R0)+		; Point to no successor
	CLR	(R0)+		; Point to no predecessor
	MOV	#-1,(R0)+	; Set stat to free
	MOV	#LOHEAP-HIHEAP+8.,(R0)	; single element, 
	MOV	(SP)+,R0	; Restore R0
;	PRINT	<Heap address limits>
;	PRINT	<Lo Limit: >,#LOHEAP
;	PRINT	<Hi Limit: >,#HIHEAP
	RTS	PC		; Return

PRX$AINIT::			; Allocate and initialize
PRX$AFLEX::
	PRINT	<AINIT or AFLEX entry>
	MOV	R3,-(SP)	; Save R3
	MOV	R2,-(SP)	; Save R2
	MOV	R1,-(SP)	; Save R1
	MOV	10(SP),-(SP)	; Push num. bytes to allocate
	PRINT	<Number to allocate => (SP)
	JSR	PC,PRX$ALLOC	; Call allocate routine
	MOV	10(SP),R1	; Get num. bytes to initialize
	INC	R1		; Round up ( INC followed by ASR )
	ASR	R1		; Halve for word count
	MOV	12(SP),R2	; Get pointer to constructor
	MOV	R0,R3		; Get pointer to block
10$:
	MOV	(R2)+,(R3)+	; Copy constructor
	SOB	R1,10$		; Until word count is zero
	MOV	(SP)+,R1	; Restore R1
	MOV	(SP)+,R2	; Restore R2
	MOV	(SP)+,R3	; Restore R3
	MOV	(SP)+,(SP)	; Pop parameter
	MOV	(SP)+,(SP)	; Ditto
	RTS	PC		; Return

	.PAGE
PRX$ALLOC::			; Allocate
	MOV	R5,-(SP)	; Save R5
	MOV	R4,-(SP)	; Save R4
	MOV	R3,-(SP)	; Save R3
	MOV	#LOHEAP,-(SP)	; Get pointer to heap
	BIT	#1,12(SP)	; Allocation size odd
	BNE	5$		; If NE yes
	BR	7$
5$:	INC	12(SP)		; Round up
7$:	MOV	12(SP),R0
;	PRINT	<Allocation size = >,R0
	JMP	L50$
L10$:
	MOV	@SP,R5		; Point to this block
;	PRINT	<Succ frame = >,(R5)
;	PRINT	<Pred frame = >,2(R5)
	TSTB	4(R5)		; Is it free
	BNE	L12$		; If NE yes
;	PRINT	<Status = allocated>
	JMP	L40$
L12$:
;	PRINT	<Status = free>
	MOV	6(R5),R4	; Get size of block
;	PRINT	<Size = >,R4
	CMP	R4,12(SP)	; Is block an exact fit
	BNE	L13$		; If NE no
;	PRINT	<Exact fit>
	JMP	L20$
L13$:	SUB	#8.,R4		; Add size of a header
	CMP	R4,12(SP)	; Is block large enough to split
	BGE	L14$		; If GE yes
;	PRINT	<Too small>
	JMP	L40$
L14$:	
;	PRINT	<Too large, Split in two>
	MOV	R5,R4		; Make pointer to new block for excess
	ADD	12(SP),R4	; Add size of allocation
	ADD	#8.,R4		; Plus size of header
;	PRINT	<Second frame = >,R4
	MOV	(R5),(R4)	; Point him at our succ
;	PRINT	<Succ frame = >,(R4)
	MOV	(R4),R3		; Did we have a succ
	BEQ	15$		; If EQ no
	MOV	R4,2(R3)	; Point our succ at him
15$:
	MOV	R4,(R5)		; Point us at him
	MOV	R5,2(R4)	; Point him at us
;	PRINT	<Pred frame = >,2(R4)
	MOV	#-1,4(R4)	; Set his stat to free
;	PRINT	<Status = free>
	MOV	6(R5),6(R4)	; Get his size
	SUB	12(SP),6(R4)	; Sub size of allocation
	SUB	#8.,6(R4)	; Plus size of header
;	PRINT	<Size = >,6(R4)
	MOV	12(SP),6(R5)	; Get our size
L20$:
	CLRB	4(R5)		; Set our stat to allocated
	MOV	R5,R0		; Get pointer to block
	ADD	#8.,R0		; Add size of header
;	PRINT	<Allocate block>
;	PRINT	<Succ frame = >,0(R5)
;	PRINT	<Pred frame = >,2(R5)
;	PRINT	<Status = >,4(R5)
;	PRINT	<Size = >,6(R5)
30$:
	TST	(SP)+		; Clean up stack
	MOV	(SP)+,R3	; Restore R3
	MOV	(SP)+,R2	; Restore R2
	MOV	(SP)+,R1	; Restore R1
	MOV	(SP)+,(SP)	; Pop parameter off stack
	RTS	PC		; Return
L40$:
	MOV	@0(SP),@SP	; Get pointer to next block
L50$:
	MOV	@SP,R0
;	PRINT	<This frame = >,R0
	TST	@SP		; Is this a nil pointer
	BEQ	60$		; If EQ yes
	JMP	L10$
60$:
	RAISE	x$heap$empty	; Raise exception

	.PAGE
PRX$FREE::
	MOV	R5,-(SP)	; Save R5
	MOV	R4,-(SP)	; Save R4
	MOV	R3,-(SP)	; Save R3
	MOV	#LOHEAP,-(SP)	; Get pointer to heap
	SUB	#8.,12(SP)	; Sub header size
	BR	60$
10$:
	CMP	@SP,12(SP)	; Is this the block to free
	BNE	50$		; If NE no
	MOV	@SP,R5		; Point to this block
	MOVB	#-1,4(R5)	; Set stat to free
20$:
	MOV	(R5),R4		; Is there a block below us
	BEQ	30$		; If EQ no
	TSTB	4(R4)		; Is it free also
	BEQ	30$		; If EQ no
	ADD	6(R4),6(R5)	; Add his size to us
	ADD	#8.,6(R5)	; Plus his header size
	MOV	(R4),(R5)	; Point to his succ
	MOV	(R5),R3		; Did he have a succ
	BEQ	30$		; If EQ no
	MOV	R5,2(R3)	; Point his succ at us
30$:
	MOV	2(R5),R4	; Is there a block above us
	BEQ	40$		; If EQ no
	TSTB	4(R4)		; Is it free also
	BEQ	40$		; If EQ no
	ADD	6(R5),6(R4)	; Add our size to him
	ADD	#8.,6(R4)	; Plus our header size
	MOV	(R5),(R4)	; Point him at our succ
	MOV	(R4),R3		; Did we have a succ
	BEQ	40$		; If EQ no
	MOV	R4,2(R3)	; Point our succ at him
40$:
	TST	(SP)+		; Clean up stack
	MOV	(SP)+,R3	; Restore R3
	MOV	(SP)+,R4	; Restore R4
	MOV	(SP)+,R5	; Restore R5
	MOV	(SP)+,(SP)	; Pop parameter off stack
	RTS	PC		; Return
50$:
	MOV	@0(SP),@SP	; Get pointer to next block
60$:
	TST	@SP		; Is this a nil pointer
	BNE	10$		; If NE no
70$:
	RAISE	x$failed$free	; Raise exception

	.END