.NLIST	TOC,SYM
.TITLE	$RQCB
.SBTTL	ULBLIB 005	- Request Core Block
.IDENT	\V01.05\
.PSECT	.LIBC.
.ENABL	LC,GBL

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  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 except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
; Edits:
; 20-Dec-90 WFG	o Rearrange code for readability
;		o Try .SETTOP if not enough pool for request
;		o Ensure even addr gets passed to .SETTOP
;  4-Jan-91 WFG Add .MCALL for .SETTOP
; 15-Jan-91 WFG Round all lengths to dbl wrd, fix R4 -> prev blk 
;
;+
; $RQCB
; The Request Core Block routine determines whether there is enough space
; available in the free dynamic memory to satisfy an executing task's
; memory allocation request.  If memory is available, the $RQCB routine 
; allocates the requested memory block.  Request are always rounded up to 
; the next 4 byte boundary.
;
;	R0 -> free memory listhead
;	R1 =  the size (in bytes) of the request
;
;	CALL	$RQCB
;
;	R0 =  the address of the allocated block
;	R1 =  the actual size of the allocated block
;-
	.MCALL	.SETTOP
	S$HLMT	= 50		;User job high limit
 
$RQCB::	JSR	R5,$SAVRG	;Save R3-R5

; Try to get the memory from the free list
	MOV	@R0,R5		;R5 -> Set trial 'found' block in case
				; we scan free list for largest block
;	TST	@R0		;Are there any blocks in the free list ?
	BEQ	60$		;No, get the requested amnt from .SETTOP
	CMP	R1,#-2		;Asking for everything?
	BNE	30$		;Branch if not

; Scan free list for largest block
20$:	MOV	R0,R3		;R3 -> previous block
	MOV	@R0,R0		;R0 -> Get next block in list
	BEQ	25$		;Branch if at list's end
	CMP	2(R0),2(R5)	;Yes, is this block bigger than 'found' ?
	BLO	20$		;No, try the next block
	MOV	R3,R4		;R4 -> Block prior to largest
	MOV	R0,R5		;R5 -> Largest block yet found
	BR	20$		;Try the whole list
 
25$:	MOV	2(R5),R1	;Get the size of the largest block in list
	ADD	#3,R1		;Round the requested size up to 
	BIC	#3,R1		; next double-word boundary
	BR	40$		;Go allocate the block

; Scan the list for the smallest block that is greater than size requested
30$:	CLR	R5		;Clear found-block address
	ADD	#3,R1		;Round the requested size up to 
	BIC	#3,R1		; next double-word boundary
	BEQ	90$		;Request=zero, exit with error

32$:	MOV	R0,R4		;R4 -> previous block
	MOV	@R0,R0		;R0 -> First block
	BEQ	40$		;Leave at list's end
	CMP	2(R0),R1	;Is this block big enough?
	BEQ	45$		;Exact match, quit scan
	BLO	32$		;Too small, try the next one
	TST	R5		;Do we have a 'found' block ?
	BEQ	35$		;No, use this one
	CMP	2(R5),2(R0)	;Yes, is this a better fit?
	BLOS	32$		;No, continue scanning list

35$:	MOV	R0,R5		;Update 'best fit' found 
	BR	32$		; and try again
; R5 -> block that best meets our criteria
40$:	MOV	R5,R0		;Found a block?
	BEQ	60$		;No, try .SETTOP

; Adjust block at R0 by the amount of memory we're taking
45$:	SUB	R1,2(R0)	;Reduce size of block
	BNE	48$		;If equal, none left, so
	MOV	@R0,@R4		; remove block from list

48$:	ADD	2(R0),R0	;Reset addr to start of allocated memory
	BR	80$		;Exit with good status

; Couldn't satisfy request from free list, try .SETTOP
60$:	ADD	#3,R1		;Round the requested size up to 
	BIC	#3,R1		; next double-word boundary
	BEQ	90$		;Request=zero, exit with error
	MOV	@#S$HLMT,R0	;Get current memory top
	TST	(R0)+		;R0 -> 1st free word
	MOV	R0,R5		;Copy it for later
	BEQ	90$		;Branch if we wrapped -- error
	ADD	R1,R0		;R0 = desired high
	BCS	90$		;Branch if we wrapped -- error
	MOV	R0,R3		;Save what we want
	.SETTOP			;Try to get amount in R0
	CMP	R0,R3		;Did we?
	BLO	90$		;Branch if not.  Error
	MOV	R0,R1		;Copy new high address
	SUB	R5,R1		;Get size granted
	MOV	R5,R0		;Copy start address

80$:	TST	(PC)+		;Clear carry
90$:	SEC			;Error return

	RETURN

.END