PROCEDURE	<ALLOC -- ALLOCATE SPACE>,010100
;+
; abstract:	alloc
;
;	This module has generalised allocate/free support for
;	RUNOFF.
;
; calling sequence:
;
;	MOV	#LENGTH_IN_BYTES,R1
;	CALL	ALLOC	; allocate a block
;			; r1 -> allocated block
;
;	MOV	#BLOCK,R1
;	CALL	FREE	; free an allocated block.
;
;	CALL	INIFRE	; initialise free list.
;			; (effectively freeing everything)
;
; externals:
;
;	The free list head has the following format:
;
; FREHD::
;	.WORD	FIRST_FREE_BLOCK
;	.WORD	0	;!! for free subroutine
;
;	Free list elements in general have the format:
;
;	.WORD	NEXT_ENTRY_OR_0_IF_NONE
;	.WORD	LENGTH_OF_THIS_ENTRY
;
; written: 24-jan-80, -1.0.0-, Bruce C. Wright
; modified: 30-jan-80, -1.1.0-, Bruce C. Wright
;	Conditionalise for RSX-11M
; verified:
;-

	CODE	ALLOC
	.MCALL	GTSK$S
	.IF DF	R$$EXT
	.MCALL	EXTK$S
	.ENDC	;R$$EXT
ALLOC::
	MOV	R3,-(SP)	; Save R3
	MOV	R4,-(SP)	; Save R4
	MOV	R5,-(SP)	; Save R5
	ADD	#3,R1		; Increment up to a word boundary.
				; Also account for length word.
	BIC	#1,R1		; Round down to words.
	CMP	R1,#4		; Must allocate at least 4. at once.
	BHIS	5$		; enough, OK
	MOV	#4,R1		; Not enough, make it enough.
5$:	MOV	#FREHD,R5	; Get header for free list.
10$:	MOV	R5,R4		; Remember previous location.
	MOV	(R5),R5		; Get to next block in free list.
	BEQ	90$		; None there, error.
15$:	CMP	2(R5),R1	; Is there enough room here?
	BLO	10$		; No, keep looking.
	MOV	R5,R3		; Remember node address allocated.
	ADD	#4,R1		; Do we get the whole thing?
	CMP	R1,2(R5)	; Can't let < 4 bytes in free list.
	BLOS	20$		; There's enough room for a node.
	MOV	2(R5),R1	; Not enough, get all of it.
	MOV	(R5),(R4)	; Re-link previous into next node.
	BR	25$		; And skip node creation.
20$:	SUB	#4,R1		; Get amount to allocate.
	SUB	R1,2(R5)	; Compute new length of node.
	ADD	R1,R5		; Point to address of new node.
	MOV	R5,(R4)		; Point to this node from previous.
	MOV	(R3),(R5)+	; Point to next node from here.
	MOV	2(R3),(R5)	; Save length word in new node.
25$:	MOV	R1,(R3)+	; Save length allocated, point to returned
	MOV	R3,R1		; Remember address of allocated area.
	MOV	(SP)+,R5	; Recover registers.
	MOV	(SP)+,R4	; ...
	MOV	(SP)+,R3	; ...
	RETURN			; And return to the caller.
90$:
	.IF DF	R$$EXT		; If have EXTK$ ....
	MOV	R1,R5		; Get the size of the area desired.
	ADD	#77,R5		; Round it up to the next 32-word bound.
	BIC	#77,R5		; ...
	MOV	R5,R3		; Save this number.
	.IF DF	R$$EIS		; If EIS is available ...
	ASH	#-6,R5		; Compute number of 32-word blocks.
	.IFF			; Otherwise, ...
	.REPT	6.
	ASR	R5		; Compute number of 32-word blocsk.
	.ENDR
	.ENDC	;R$$EIS
	EXTK$S	R5		; Try to extend the task.
	BCS	99$		; Problems?
	MOV	LSTLOC,R5	; Get old last location.
	ADD	R3,LSTLOC	; Compute new last location.
	CLR	(R5)		; Show it's the end of the chain.
	MOV	R3,2(R5)	; Remember the size gotten.
	MOV	R4,R3		; Get the end of previous node
	ADD	2(R4),R3	; ...
	CMP	R3,R5		; Is it the beginning of this one?
	BEQ	95$		; Yes -- then merge the nodes.
	MOV	R5,(R4)		; Point to node from previous.
	BR	15$		; And allocate the stuff here!
95$:	ADD	2(R5),2(R4)	; Compute new free length.
	BR	5$		; And go allocate all over.
99$:				; Here on extend failure
	.ENDC	;R$$EXT
	DIAG	CORERR		; Tell user no memory left.
	JMP	ENDFIL		; And go finish up what we've got.

FREE::
	MOV	R3,-(SP)	; save R3
	MOV	R4,-(SP)	; save registers.
	MOV	R5,-(SP)	; ...
	SUB	#2,R1		; create a dummy free list entry.
	MOV	(R1),2(R1)	; Move over the length word.
	MOV	#FREHD,R5	; point to free list header.
10$:	MOV	R5,R4		; remember previous free list pointer.
	MOV	(R5),R5		; Get to next address in free list.
	BEQ	80$		; to end of list, link in at end.
	CMP	R1,R5		; freed area > free list entry?
	BHI	10$		; Yes, loop until found good entry.
	MOV	R5,(R1)		; link the new node into list.
	MOV	R1,(R4)		; point to it from previous node.
	MOV	R1,R3		; Get freed area into R3.
	ADD	2(R1),R3	; Get to the end of the freed area.
	CMP	R3,R5		; is it equal?
	BHI	99$		; corrupt free list!
	BNE	30$		; no, skip merging of nodes.
	ADD	2(R5),2(R1)	; Add in the length of the node.
	MOV	(R5),(R1)	; point to the next node from here.
30$:	MOV	R4,R3		; Does R4 pointer match?
	ADD	2(R4),R3	; point to end of R4 area.
	CMP	R3,R1		; is it the same?
	BHI	99$		; corrupt free list!
	BNE	40$		; no, skip merging of nodes.
	ADD	2(R1),2(R4)	; Arrange amount of free space.
	MOV	(R1),(R4)	; fixup the next pointer.
40$:	MOV	(SP)+,R5	; recover registers
	MOV	(SP)+,R4	; ...
	MOV	(SP)+,R3	; ...
	RETURN			; And return to the caller.
80$:	MOV	R1,(R4)		; link into the chain.
	CLR	(R1)		; show that we're at end of line.
	BR	30$		; And try to merge with previous node.
99$:	FATAL	BADFRE		; something horrible happened.

INIFRE::
	MOV	R4,-(SP)	; save R4
	MOV	R5,-(SP)	; save R5
	SUB	#16.*2,SP	; Get space for GTSK$S
	MOV	SP,R4		; Get space.
	GTSK$S	R4		; Get the task size.
	MOV	G.TSTS(R4),R4	; Get size of task.
	ADD	#$DSW,R4	; Compute last address in task.
	.IF DF	R$$EXT		; Need to keep track of
				; the amount of space currently
				; allocated for expand.
	MOV	R4,LSTLOC	; Remember last location.
	.ENDC	;R$$EXT
	ADD	#16.*2,SP	; pop space for GTSK$S
	CLR	FREHD+2		; init free head.
	MOV	LIMIT+2,R5	; point to first free area.
	MOV	R5,FREHD	; point to it.
	SUB	R5,R4		; Compute length of free area.
	CMP	R4,#4		; Is there any room in free area?
	BHIS	10$		; Yes -- take it
	CLR	FREHD		; No -- clear out buffer area.
	BR	20$		; And return without any area.
10$:	CLR	(R5)+		; Show end of free area.
	MOV	R4,(R5)+	; Indicate size of free area.
20$:	MOV	(SP)+,R5	; recover R5
	MOV	(SP)+,R4	; recover R4
	RETURN			; and return to the caller.
;
	DATA	ALLOCD
LIMIT:	.LIMIT			; Get limits
FREHD:	.WORD	0,0		; free listhead
	.IF DF	R$$EXT
LSTLOC:	.WORD	0		; Next location to be allocated.
				; (last location in task + 1, for
				; dynamic task extension support)
	.ENDC	;R$$EXT
	.END