;
; suballoc.s
;
; Handling of requests for small link blocks (MDW)
;
;  1994-1998 Straylight
;

;----- Licensing note -------------------------------------------------------
;
; This file is part of Straylight's Sapphire library.
;
; Sapphire is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2, or (at your option)
; any later version.
;
; Sapphire is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with Sapphire.  If not, write to the Free Software Foundation,
; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

;----- Standard header ------------------------------------------------------

		GET	libs:swis
		GET	libs:header

;----- External dependencies ------------------------------------------------

		GET	sapphire:alloc
		GET	sapphire:mem
		GET	sapphire:sapphire

;----- Word to the wise -----------------------------------------------------
;
; Various bits of Sapphire require lots of small blocks for linked lists and
; things.  To avoid mangling the heap, we allocate very big blocks and then
; split them up into littler ones.  These big blocks just contain lots of
; little ones.
;
; The data blocks are allocated such that they are just big enough for the
; data -- the caller must specify the actual size of the block when freeing.
; Completely free big blocks just stay in the heap ready to be allocated
; again by this system.  They are not returned to the heap.
;
; We keep a table of pointers to the big block lists for each supported
; block size.  This is rather like the `bins' idea in the C library malloc
; algorithms.

;----- Main code ------------------------------------------------------------

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- sub_alloc ---
;
; On entry:	R0 == size of block to allocate
;
; On exit:	R0 == pointer to block allocated
;		May return an error
;
; Use:		Allocates a block of the size specified, typically very
;		quickly indeed.
;
;		If the size is not one of those supported (currently
;		supported sizes are 8-40 inclusive in 4 byte increments),
;		the behaviour is undefined (but very predictable).

		EXPORT	sub_alloc
sub_alloc	ROUT

		STMFD	R13!,{R1-R3,R12,R14}

		; --- Find the correct table entry ---

		WSPACE	sub__wSpace		;Find my workspace
		ADD	R1,R12,R0		;Find the entry in the table

		; --- Are there any free blocks? ---

		LDR	R2,[R1]			;Get the free list offset
		CMP	R2,#0			;Are there any free blocks?
		BEQ	%20sub_alloc		;No -- better allocate some

		; --- Mess about with the free list and return ---

10sub_alloc	LDR	R0,[R2]			;Get next pointer from block
		STR	R0,[R1]			;This is now first free block
		MOV	R0,R2			;Return the old free block
		LDMFD	R13!,{R1-R3,R12,R14}	;Restore registers and return
		BICS	PC,R14,#V_flag		;Clear error as we leave

		; --- Create a big block ---
		;
		; We're now using alloc for this.  To avoid extra memory
		; usage, we nobble alloc's `extra' word which allows it
		; to find the free routine, because we'll never free it
		; anyway!

20sub_alloc	MOV	R2,R0			;Keep the size safe
		MOV	R0,R0,LSL #3		;Find the chunk size
		SUB	R0,R0,#4		;This is evil.  I don't care
		BL	alloc			;Allocate some memory
		BCS	%90sub_alloc		;If failed, report error
		SUB	R0,R0,#4		;Gobble alloc's overhead

		; --- Now set up the links for the free list ---

		MOV	R14,#0			;Next free pointer start at 0
		MOV	R3,#8			;We have 8 blocks to do
00		STR	R14,[R0],R2		;Store in next field
		SUB	R14,R0,R2		;Remember old block pointer
		SUBS	R3,R3,#1		;Point to previous block
		BGT	%b00			;If more to do, continue...

		; --- The links are set up -- now take off a block ---

		MOV	R2,R14			;Use last block allocated
		B	%10sub_alloc		;Then allocate as normal

		; --- Handle an error ---

90		BL	alloc_error		;Find the error message
		LDMFD	R13!,{R1-R3,R12,R14}	;Restore registers
		ORRS	PC,R14,#V_flag		;And return the error

		LTORG

; --- sub_free ---
;
; On entry:	R0 == pointer to block
;		R1 == size of the block
;
; On exit:	--
;
; Use:		Frees a block allocated using sub_alloc.

		EXPORT	sub_free
sub_free	ROUT

		STMFD	R13!,{R0,R1,R12,R14}	;Preserve registers

		; --- Find the correct table entry ---

		WSPACE	sub__wSpace		;Find my workspace
		ADD	R1,R12,R1		;Find the entry in the table

		; --- Mess about with the list ---

		LDR	R14,[R1]		;Get current first block
		STR	R14,[R0]		;Store in newly freed block
		STR	R0,[R1]			;And insert new block in list
		LDMFD	R13!,{R0,R1,R12,PC}^	;Oh, and return to caller

		LTORG

; --- sub_init ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Initialises the suballocation system for use.

		EXPORT	sub_init
sub_init	ROUT

		STMFD	R13!,{R0-R2,R12,R14}	;Save some registers
		WSPACE	sub__wSpace		;Find my workspace

		; --- Am I initialised? ---

		LDR	R14,sub__flags		;Get my flags word
		TST	R14,#sub__INITED	;Test the flag
		LDMNEFD	R13!,{R0-R2,R12,PC}^	;Yes -- return to caller

		; --- Set up the workspace properly ---

		ORR	R14,R14,#sub__INITED	;We are now initialised
		STR	R14,sub__flags		;Store it in the flags
		ADD	R0,R12,#4		;Point to the table
		MOV	R1,#10*4		;Number of entries supported
		MOV	R2,#0			;Zero them all
		BL	mem_set			;Zero-initialise my workspace
		BL	alloc_init		;Make sure alloc is awake
		LDMFD	R13!,{R0-R2,R12,PC}^	;Return to caller

		LTORG

sub__wSpace	DCD	0

;----- Workspace ------------------------------------------------------------

		^	0,R12
sub__wStart	#	0

sub__flags	#	0			;Various interesting flags

sub__INITED	EQU	(1<<0)			;Am I initialised?

sub__table	#	4*10			;The suballoc root table

sub__wSize	EQU	{VAR}-sub__wStart

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	sub__wSize
		DCD	sub__wSpace
		DCD	0
		DCD	sub_init

;----- That's all folks -----------------------------------------------------

		END
