;_Header
;*******************************************************************
;    NOVA CONTROL SYSTEM  ---  Lawrence Livermore Laboratory
;
;    Copyright 1984 by The Regents of the University of California
;*******************************************************************
;
;_Module_Name:  RSXHEAP
;
;_Description:
;	Dynamic memory allocation routines for Praxis RSX-11 Run-Time Library.
;_Call:
;_Remarks:
;_Identifier: { none }
;*******************************************************************
;_Author:  T. A. SHERMAN		_Creation_Date:  10-OCT-1984
;_Revisions:
.IDENT  /7.200/  ;10-OCT-1984  TAS	Initial Key-in.
;*******************************************************************
;_End
	.TITLE	RSXHEAP

	.MCALL	CODESECT,DATASECT,VARSSECT
	.MCALL	RAISE,INITENTRY

	INITENTRY HEAPINIT

	VARSSECT

M$HEAD:: .word	0		; list head of memory pool
	 .word	0		; two word header needed

	CODESECT

HEAPINIT::
	jsr	pc,$saval	; save all registers
	mov	#M$head,r0	; set up list head
	call	$inidm		; extend task and initialize the pool
	ccc			; set c=0
	return			; exit and restore


	.PAGE
	CODESECT

p$ainit::
PRX$AINIT::
p$aflex::			; Allocate and initialize
PRX$AFLEX::
	MOV	R3,-(SP)	; Save R3
	MOV	R2,-(SP)	; Save R2
	MOV	R1,-(SP)	; Save R1
	MOV	10(SP),-(SP)	; Push num. bytes to allocate
	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
	CODESECT

p$alloc::
prx$alloc::

	mov	2(sp),r0	; get # of bytes desired
	mov	(sp),2(sp)	; clean stack
	mov	r1,(sp)		; save r1
	mov	r0,r1		; set # bytes in r1
	MOV	#M$HEAD,R0	; set up list head address
	add	#2,r1		; add 2 bytes for address storage
	call	$RQCB		; request core block ( best fit )
	bcc	1$		; none, so give out error
	RAISE	x$heap$empty
1$:	mov	r1,(r0)+	; store size as first word
				; giving back adr+2 in R0
	mov	(sp)+,r1	; restore r1
	return			; back to caller

	CODESECT

p$free::
prx$free::			; 
	mov	r2,-(sp)	; save r2
	mov	4(sp),r2	; get block address
	bne	10$		; if nil raise fault
	RAISE	x$nil$pointer
10$:	bit	#1,r2		; check if address even
	beq	20$		; no, then bad pointer
	RAISE	x$bad$pointer
20$:	mov	r1,-(sp)	; save r1 and r0
	mov	r0,-(sp)	;
	mov	-(r2),r1	; get size of block
	bne	30$		; if zero then bad news
	RAISE	x$bad$pointer
30$:	mov	#m$head,r0	; set up list head
	call 	$RLCB		; release the core block
	mov	(sp)+,r0	; restore regs
	mov	(sp)+,r1	;
	mov	(sp)+,r2	;
	mov	(sp)+,(sp)	; delete arg
	return			; back to caller

	.END