;
; alloc.s
;
; Redirectable memory allocation (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:header
		GET	libs:swis

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

		GET	sapphire:msgs
		GET	sapphire:sapphire
		GET	sapphire:subAlloc

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

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- alloc__halloc ---
;
; On entry:	R0 == size of block to find
;
; On exit:	CC and R0 == pointer to block, if possible
;		CS if not enough memory
;
; Use:		Allocates memory from the OS_Heap area.  This is mainly
;		useful for registering the OS_Heap heap as the current
;		allocator.

alloc__halloc	ROUT

		STMFD	R13!,{R1-R3,R14}	;Save some registers away
		MOV	R3,R0			;Move the size away
		MOV	R1,R12			;Locate the heap address
		MOV	R0,#2			;Allocate memory
		SWI	XOS_Heap		;Call the OS to allocate
		BVS	%99alloc__halloc	;If it failed, skip ahead
		MOV	R0,R2			;Point at block it returned
		LDMFD	R13!,{R1-R3,R14}	;Find all the registers again
		BICS	PC,R14,#C_flag		;If successful, return CC

99alloc__halloc	LDR	R1,[R0,#0]		;Get the error number out
		MOV	R2,#&084		;&184 is `Not enough memory'
		ORR	R2,R2,#&100		;Complete the error number
		CMP	R1,R2			;Is this right?
		SWINE	OS_GenerateError	;No -- something's screwed
		LDMFD	R13!,{R1-R3,R14}	;Find all the registers again
		ORRS	PC,R14,#C_flag		;No memory -- return CS

		LTORG

; --- alloc__hfree ---
;
; On entry:	R0 == pointer to a block allocated by alloc_halloc
;
; On exit:	--
;
; Use:		Frees a block allocated by alloc_halloc, or indeed by
;		OS_Heap in the Sapphire fixed-size area.  If anything goes
;		badly amiss, an error is generated.

alloc__hfree	ROUT

		STMFD	R13!,{R0-R2,R14}	;Save some registers
		MOV	R2,R0			;Move the pointer away
		MOV	R1,R12			;Locate the heap address
		MOV	R0,#3			;Free memory
		SWI	OS_Heap			;Free it, generating errors
		LDMFD	R13!,{R0-R2,PC}^	;Return to caller

		LTORG

; --- alloc_register ---
;
; On entry:	R0 == pointer to allocator function
;		R1 == pointer to free function
;		R2 == workspace pointer to pass to them in R12
;
; On exit:	--
;
; Use:		Registers two functions to be used as a heap manager by
;		alloc and free.
;
;		The allocator is entered with R0 as the	size of block
;		required, and should exit with CC and R0 == pointer to the
;		block allocated if successful, CS if there wasn't enough
;		memory and generate any other errors that occur.  Registers
;		other than R0 must be preserved.
;
;		The freer is entered with R0 == pointer to block to free.
;		It should exit with all registers preserved.  If anything
;		goes wrong, it should generate an error.

		EXPORT	alloc_register
alloc_register	ROUT

		STMFD	R13!,{R0-R5,R12,R14}	;Save some registers away
		WSPACE	alloc__wSpace		;Find my workspace

		; --- Search the list first ---

10		LDMIA	R12,{R3-R5,R14}		;Load the values out
		CMP	R0,R4			;Do they match up nicely?
		CMPEQ	R1,R5
		CMPEQ	R2,R14
		LDMEQFD	R13!,{R0-R5,R12,PC}^	;Yes -- then return now
		CMP	R3,#0			;End of the list?
		MOVNE	R12,R3			;Yes -- get a copy the
		BNE	%10alloc_register	;And go back round again

20		MOV	R4,R2			;Keep the R12 value safe
		MOV	R3,R1			;And the free routine ptr
		MOV	R2,R0			;And the alloc routine ptr
		MOV	R1,#0

		MOV	R0,#alloc__nodeSize	;Find size of a node block
		BL	sub_alloc		;Try to allocate memory
		SWIVS	OS_GenerateError	;This is a major problem

		STMIA	R0,{R1-R4}		;Save values into block
		STR	R0,[R12,#0]		;And link this block in

		LDMFD	R13!,{R0-R5,R12,PC}^	;Return to caller

; --- alloc_useOSHeap ---
;
; On entry:	R1 == pointer to OS_Heap-managed heap to use
;
; On exit:	--
;
; Use:		Registers an OS_Heap heap to use to allocate memory when
;		alloc is called.

		EXPORT	alloc_useOSHeap
alloc_useOSHeap	ROUT

		STMFD	R13!,{R0-R2,R14}	;Save some registers
		MOV	R2,R1			;Move into workspace pointer
		ADR	R0,alloc__halloc	;Point to OS_Heap allocator
		ADR	R1,alloc__hfree		;Point to OS_Heap freer
		BL	alloc_register		;Register them nicely
		LDMFD	R13!,{R0-R2,PC}^	;Return to caller

; --- alloc ---
;
; On entry:	R0 == size of block to allocate from current heap
;
; On exit:	R0 == pointer to block and CC if it all worked
;		CS if there wasn't enough memory (R0 corrupted)
;
; Use:		Allocates R0 bytes from a heap manager.  This routine will
;		attempt to allocate memory from the current heaps in order
;		of registration (i.e. the Sapphire OS_Heap first etc.) until
;		either one which can service the request is found, or all
;		the heaps have been tried.

		EXPORT	alloc
alloc		ROUT

		STMFD	R13!,{R1-R5,R12,R14}	;Save some registers
		WSPACE	alloc__wSpace		;Find my workspace
		ADD	R5,R0,#4		;Add in the overhead

		ADR	R1,alloc__list		;Find the list head item
10alloc		CMP	R1,#0			;Have we reached the end?
		BEQ	%20alloc		;Yes -- couldn't do it then
		LDMIA	R1,{R2-R4,R12}		;Load values from block
		MOV	R0,R5			;Get block size wanted
		MOV	R14,PC			;Set up return address
		MOV	PC,R3			;Call the allocator
		MOVCS	R1,R2			;If it failed, move on
		BCS	%10alloc		;And try the next heap

		STR	R1,[R0],#4		;Save the node pointer
		LDMFD	R13!,{R1-R5,R12,R14}	;Return to caller with ptr
		BICS	PC,R14,#C_flag		;With C flag clear

20alloc		LDMFD	R13!,{R1-R5,R12,R14}	;Return to caller
		ORRS	PC,R14,#C_flag		;With no memory warning

		LTORG

; --- free ---
;
; On entry:	R0 == pointer to block allocated by alloc
;
; On exit:	--
;
; Use:		Frees a block allocated by alloc, regardless of which heap
;		it came from.

		EXPORT	free
free		ROUT

		STMFD	R13!,{R0,R1,R12,R14}	;Save some registers
		LDR	R1,[R0,#-4]!		;Load node pointer from block
		ADD	R1,R1,#alloc__free	;Find free and workspace ptr
		LDMIA	R1,{R1,R12}		;Load them out
		MOV	R14,PC			;Set up return address
		MOV	PC,R1			;And call the routine
		LDMFD	R13!,{R0,R1,R12,PC}^	;Return to caller done

		LTORG

; --- alloc_init ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Initialises the alloc system, and sets it up to use the
;		kernel-provided OS_Heap area.

		EXPORT	alloc_init
alloc_init	ROUT

		STMFD	R13!,{R0-R3,R12,R14}	;Save some registers
		WSPACE	alloc__wSpace		;Find the workspace
		LDR	R14,alloc__list		;Find the list head pointer
		CMP	R14,#0			;Is it null?
		LDMNEFD	R13!,{R0-R3,R12,PC}^	;Yes -- return then

		; --- Initialise allocator list ---
		;
		; This is essential -- both msgs and suballoc need to be
		; able to allocate memory immediately.  We have to build the
		; whole link here, because we normally use suballoc to create
		; the link blocks!

		MOV	R0,#0			;No next pointer yet
		ADR	R1,alloc__halloc	;Point to allocator
		ADR	R2,alloc__hfree		;And freer
		LDR	R3,sapph_heapBase	;Find the heap address
		STMIA	R12,{R0-R3}		;Save them all away

		; --- Set up other required things ---

		BL	sub_init		;Initialise suballocator
		LDMFD	R13!,{R0-R3,R12,PC}^	;Return to caller

		LTORG

alloc__wSpace	DCD	0

; --- alloc_error ---
;
; On entry:	--
;
; On exit:	V set and R0 == pointer to an error about not having enough
;		memory.
;
; Use:		Returns an error suitable for displaying to a user if there
;		isn't enough memory left.

		EXPORT	alloc_error
alloc_error	ROUT

		STMFD	R13!,{R1,R14}		;Save some registers
		ADR	R0,alloc__noMem		;Point to the error block
		BL	msgs_error		;Translate the error message
		LDMFD	R13!,{R1,R14}		;Unstack the registers
		ORRS	PC,R14,#V_flag		;Return with the error nicely

		; --- The message ---
		;
		; Note that we supply a default, since it may be msgs which
		; is saying that it's out of memory!

alloc__noMem	DCD	1
		DCB	"allocNOMEM:Not enough memory",0

		LTORG

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

; --- Allocator list ---

		^	0
alloc__next	#	4			;Address of next node
alloc__alloc	#	4			;The allocator for blocks
alloc__free	#	4			;The freer for blocks
alloc__R12	#	4			;Workspace for allocator
alloc__nodeSize	#	0			;Size of this block

; --- Workspace ---

		^	0,R12
alloc__wStart	#	0

alloc__list	#	alloc__nodeSize		;List of current allocators

alloc__wSize	EQU	{VAR}-alloc__wStart

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	alloc__wSize
		DCD	alloc__wSpace
		DCD	0
		DCD	alloc_init

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

		END
