;_Header
;*******************************************************************
;    NOVA CONTROL SYSTEM  ---  Lawrence Livermore Laboratory
;
;    Copyright 1984 by The Regents of the University of California
;*******************************************************************
;
;_Module_Name:  SAHEAP
;
;_Description:
;	Praxis heap management routines for Stand-alone LSI-11
;_Call:
;	JSR	PC,P$ALLOC
;	JSR	PC,P$FREE
;_Remarks:
;_Identifier: { none }
;*******************************************************************
;_Author:  T. A. SHERMAN		_Creation_Date:  14-APR-1984
;_Revisions:
; 07-Dec-1984	F. Holloway	To test in compatibility mode on VAX
.IDENT  /7.201/  ;14-APR-1984  TAS	Initial Key-in.
;*******************************************************************
;_End
	.TITLE	SAHEAP
;--------------------------------------------------------
Message = 0	; turn debug messages (0=off, 1=on)
;---------------------------------------------------------
	.MCALL	CODESECT,DATASECT,VARSSECT,PRINT,RAISE,INITENTRY

	INITENTRY HEAPINIT

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

	.PAGE
	CODESECT
HEAPINIT::
	.IF NE  Messages
	PRINT	<INITIALIZE HEAP>
	.ENDC
	MOV	#LOHEAP,R0	; Get pointer to heap
	CLR	(R0)		; Point to no succ
	CLR	2(R0)		; Point to no pred
	MOV	#-1,4(R0)	; Set stat to free
	MOV	#HIHEAP,6(R0)	; Get hi heap limit
	SUB	#LOHEAP,6(R0)	; Minus lo heap limit
	SUB	#8.,6(R0)	; Minus size of header
	CLR	R0

	.IF NE  Messages
	PRINT	<Heap address limits>
	PRINT	<Lo Limit: >,#LOHEAP
	PRINT	<Hi Limit: >,#HIHEAP
	.ENDC

	RTS	PC		; Return


	.PAGE	;
;----------------------------------------------------------
;	Allocate a flexible array and initialize it
;
p$aiflex::
;	0(SP)	Return Address
;	2(SP)	Addr of Initial Condition Constructor
;	4(SP)	High of flexible array
;	6(SP)	Size of block needed

	MOV	R3,-(SP)	; Save R3
	MOV	R2,-(SP)	; Save R2
	MOV	R1,-(SP)	; Save R1
	.IF NE  Messages
	MOV	14(SP),R1	; size, for debug
	MOV	12(SP),R2	; high, for debug
	MOV	10(SP),R3	; Addr of initial cond, for debug
	PRINT	<P$AIFLEX SIZE= >,R1
	PRINT	<High = >,R2
	PRINT	<Init cond addr = >,R3
	.ENDC
	MOV	12(SP),-(SP)	; Push High of flex
	MOV	14(SP),-(SP)	; Push num. bytes to allocate
	JSR	PC,P$AFLEX	; Call flex allocate routine
	.IF NE  Messages
	PRINT	<BACK FROM P$AFLEX>
	.ENDC
	MOV	14(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 Initial conditions constructor
	.IF NE  Messages
	PRINT	<Initialize Addr =>,R2
	PRINT	<Numb Words =>,R1
	.ENDC
	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)	; Pop parameter
	MOV	(SP)+,(SP)	; Pop parameter
	RTS	PC		; Return
;----------------------------------------------------------
;	Allocate a flexible array
;
p$aflex::
PRX$AFLEX::
;	0(SP)	Return Address
;	2(SP)	Size of block needed
;	4(SP)	High of flexible array

	MOV	R3,-(SP)	; Save R3
	MOV	R2,-(SP)	; Save R2
	MOV	R1,-(SP)	; Save R1
	.IF NE  Messages
	MOV	10(SP),R1	; for debug
	MOV	12(SP),R2	; high, for debug
	PRINT	<P$AFLEX SIZE= >,R1
	PRINT	<High = >,R2
	.ENDC
	MOV	10(SP),-(SP)	; Push num. bytes to allocate
	JSR	PC,P$ALLOC	; Call allocate routine
	.IF NE  Messages
	PRINT	<BACK FROM P$ALLOC>
	.ENDC
	MOV	(SP)+,R1	; Restore R1
	MOV	(SP)+,R2	; Restore R2
	MOV	(SP)+,R3	; Restore R3
	MOV	4(SP),(R0)	; Save High of array at word 0

	MOV	(SP)+,(SP)	; Pop parameter
	MOV	(SP)+,(SP)	; Pop parameter
	RTS	PC		; Return

	.PAGE
;-----------------------------------------------------------------
;	Allocate and Initialize
;
	CODESECT
p$ainit::
PRX$AINIT::
;	0(SP)	-- Return Addr
;	2(SP)	-- Size of block needed
;	4(SP)	-- Addr of Initial Condition Constructor

	MOV	R3,-(SP)	; Save R3
	MOV	R2,-(SP)	; Save R2
	MOV	R1,-(SP)	; Save R1
	.IF NE  Messages
	MOV	10(SP),R1	; for debug
	PRINT	<P$AINIT SIZE= >,R1
	.ENDC
	MOV	10(SP),-(SP)	; Push num. bytes to allocate
	JSR	PC,P$ALLOC	; Call allocate routine
	.IF NE  Messages
	PRINT	<BACK FROM P$ALLOC>
	.ENDC
	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 Initial conditions constructor
	.IF NE  Messages
	PRINT	<Initialize Addr =>,R2
	PRINT	<Numb Words =>,R1
	.ENDC
	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	;
;------------------------------------------------------------------
;			ALLOCATE SPACE FROM HEAP
;-----------------------------------------------------------------
	CODESECT
p$alloc::
PRX$ALLOC::
	MOV	R5,-(SP)	; Save R5
	MOV	R4,-(SP)	; Save R4
	MOV	R3,-(SP)	; Save R3
	MOV	#LOHEAP,-(SP)	; Get pointer to heap

;	0(SP)	-- #LOHEAP
;	2(SP)	-- save R3
;	4(SP)	-- save R4
;	6(SP)	-- save R5
;	10(SP)	-- Return Addr
;	12(SP)	-- Parameter #1 :Number of bytes to allocate

	.IF NE  Messages
    	MOV 	12(SP),R3
	PRINT	<P$ALLOC, Size_bytes = >,R3
	.ENDC	

	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

	.IF NE  Messages
	PRINT	<Allocation size = >,R0
	.ENDC

	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
	.IF NE  Messages
	PRINT	<Status = allocated>
	.ENDC
	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
	.IF NE  Messages
	PRINT	<Allocated block, pointer = >,R0
;	PRINT	<Succ frame = >,0(R5)
;	PRINT	<Pred frame = >,2(R5)
;	PRINT	<Status = >,4(R5)
	PRINT	<Size = >,6(R5)
	.ENDC
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
;-------------------------------------------------------------------------
;		FREE
p$free::
PRX$FREE::
	MOV	R5,-(SP)	; Save R5
	MOV	R4,-(SP)	; Save R4
	MOV	R3,-(SP)	; Save R3
	MOV	#LOHEAP,-(SP)	; Get pointer to heap

	.IF NE  Messages
        MOV	12(SP),R5
	PRINT	<P$FREE, pointer =>,R5
        .ENDC

	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