;
; dynHeap.s
;
; New heap management for Dynamite
;
;  1994-1998 Straylight
;
;----- Licensing note -------------------------------------------------------
;
; This file is part of Straylight's Dynamite
;
; Dynamite 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.
;
; Dynamite 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 Dynamite.  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

		GET	libs:stream

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

		GET	libs:sh.fastMove

		GET	sh.dynArea
		GET	sh.dynTask
		GET	sh.wSpace

		GET	sh.messages

;----- Macros ---------------------------------------------------------------

		MACRO
$label		DIR	$reg
$label		LDR	$reg,dyn_machine	;Get the machine type
		CMP	$reg,#&A5		;Is it a RISC PC?
		MEND

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

		AREA	|Dynamite$$Code|,CODE,READONLY

; --- dh_alloc ---
;
; On entry:	R0 == pointer to anchor
;		R1 == size to allocate in bytes
;		R2 == ID value to store
;
; On exit:	R0 and R1 preserved
;		R2 == address of block allocated
;
; Use:		Allocates a block from the Dynamite heap.

		EXPORT	dh_alloc
dh_alloc	ROUT

		STMFD	R13!,{R0,R1,R3,R14}	;Save some registers
		MOV	R3,R0			;Keep anchor pointer
		ADD	R0,R1,#blk__oHead+15	;Put size in R0...
		BIC	R0,R0,#15		;...after mangling suitably
		BL	dh__ensure		;Ensure the memory's there
		BVS	%90dh_alloc		;If not there, return error
		STR	R1,[R0,#blk__size]	;Save the size in there
		STR	R3,[R0,#blk__anchor]	;And the anchor address
		STR	R2,[R0,#blk__id]	;Oh, and the ID value
		ADD	R2,R0,#blk__oHead	;Return correct address
		STR	R2,[R3,#0]		;And save address in anchor
		LDMFD	R13!,{R0,R1,R3,PC}^	;And return to caller

90dh_alloc	ADD	R13,R13,#4		;Don't restore R0 on exit
		LDMFD	R13!,{R1,R3,R14}	;Unstack some registers
		ORRS	PC,R14,#V_flag		;And return the error

		LTORG

; --- dh_free ---
;
; On entry:	R0 == pointer to anchor of block to free
;
; On exit:	--
;
; Use:		Frees a Dynamite block.

		EXPORT	dh_free
dh_free		ROUT

		STMFD 	R13!,{R1,R14}		;Save some registers
		BL	dh__checkAnchor		;Make sure the anchor's OK
		MOVVC	R14,#0			;If so, clear block's anchor
		STRVC	R14,[R1,#blk__anchor]	;Zero the anchor (R14==0 !!)
		BLVC	dh__unCompact		;Say the heap is uncompact
		LDMFD	R13!,{R1,PC}		;Return to caller

		LTORG

; --- dh_freeWithID ---
;
; On entry:	R0 == ID of all blocks to free
;
; On exit:	--
;
; Use:		Frees all allocated blocks with a given ID number.

		EXPORT	dh_freeWithID
dh_freeWithID	ROUT

		CMP	R0,#0			;Is he trying to free ID 0?
		ADREQL	R0,msg_errBadFreeAll	;Yes -- that's an error
		ORREQS	PC,R14,#V_flag		;So return it to him

		; --- Do the freeing job ---
		;
		; We just tonk a 0 anchor over all blocks with a matching ID.

		STMFD	R13!,{R0-R4,R14}	;Save some registers
		LDR	R2,dyn_heapSize		;Load the current heap size
		DIR	R14			;Is it RISC PC?
		LDRGE	R1,dyn_areaBase		;Yes -- load the area base
		RSBLT	R1,R2,#&01800000	;No -- find the base anyway
		ADD	R2,R2,R1		;Find the heap end address
		MOV	R3,#0			;Haven't freed anything yet

00dh_freeWithID	CMP	R1,R2			;Have we reached the end?
		BGE	%10dh_freeWithID	;Yes -- return then
		LDR	R14,[R1,#blk__id]	;Get the block's ID
		SUBS	R14,R14,R0		;Is it a match? (=> R14==0)
		STREQ	R14,[R1,#blk__anchor]	;Yes -- blank out the anchor
		MOVEQ	R3,#1			;And remember we done this
		LDR	R14,[R1,#blk__size]	;Load this block's size
		ADD	R14,R14,#blk__oHead+15	;Add on the overhead size
		BIC	R14,R14,#15		;And align to granularity
		ADD	R1,R1,R14		;Move on to next block
		B	%00dh_freeWithID	;And go round again

		; --- We finished -- tidy up and return ---

10dh_freeWithID	CMP	R3,#0			;Did we free anything?
		BLNE	dh__unCompact		;Yes -- then heap isn't tidy
		LDMFD	R13!,{R0-R4,PC}^	;And return to caller

		LTORG

; --- dh_blockInfo ---
;
; On entry:	R0 == address of block anchor
;
; On exit:	R0 preserved
;		R1 == address of block
;		R2 == size of block
;		R3 == block ID
;
; Use:		Returns information about a Dynamite block

		EXPORT	dh_blockInfo
dh_blockInfo	ROUT

		STMFD	R13!,{R14}		;Save the link register
		BL	dh__checkAnchor		;Make sure anchor is kosher
		LDMVCIB	R1,{R2,R3}		;Yes -- load size and ID
		ADDVC	R1,R1,#blk__oHead	;Point to the block
		LDMFD	R13!,{PC}		;And return to caller

		LTORG

; --- dh_changeID ---
;
; On entry:	R0 == address of anchor block, or 0 for all
;		R1 == new ID
;		R2 == old ID (if R0 == 0)
;
; On exit:	--
;
; Use:		This call is use to change the ID of either an individual
;		block (R0 == address of anchor), or the ID of all the
;		blocks with the ID passed in R2 (if R0 == 0).

		EXPORT	dh_changeID
dh_changeID	ROUT

		STMFD	R13!,{R0-R3,R14}	;Stack some registers
		CMP	R0,#0			;Just one block to change?
		BEQ	%50dh_changeID		;No -- jump ahead

		; --- Change the ID of a specific block ---

		MOV	R2,R1			;Preserve the new ID
		BL	dh__checkAnchor		;Check the anchor
		BVS	%99dh_changeID		;It's garbish -- return error
		STR	R2,[R1,#blk__id]	;Store the new id
		B	%98dh_changeID		;And return to caller

		; --- Change the ID of all blocks with ID R2 ---

50dh_changeID	LDR	R3,dyn_heapSize		;Load the current heap size
		DIR	R14			;Is it RISC PC?
		LDRGE	R0,dyn_areaBase		;Yes -- load the area base
		RSBLT	R0,R3,#&01800000	;No -- find the base anyway
		ADD	R3,R3,R0		;Find the heap end address

60dh_changeID	CMP	R0,R3			;Have we reached the end?
		BGE	%98dh_changeID		;Yes -- return then
		LDR	R14,[R0,#blk__id]	;Get the id of this block
		CMP	R14,R2			;Do we want to change it?
		STREQ	R1,[R0,#blk__id]	;Yes -- make it so then
		LDR	R14,[R0,#blk__size]	;Get the block size
		ADD	R14,R14,#blk__oHead+15	;Add on the block size
		BIC	R14,R14,#15		;And word align
		ADD	R0,R0,R14		;Point to the next block
		B	%60dh_changeID		;Keep on looking for blocks

98dh_changeID	LDMFD	R13!,{R0-R3,PC}^	;Return to caller

99dh_changeID	ADD	R13,R13,#4		;Don't unstack R0
		LDMFD	R13!,{R1-R3,R14}	;Get back registers
		ORRS	PC,R14,#V_flag		;Return with error

		LTORG

; --- dh__checkAnchor ---
;
; On entry:	R0 == address of anchor to check
;
; On exit:	R1 == address of block descriptor
;
; Use:		Ensures that a given anchor is valid.

dh__checkAnchor	ROUT

		STMFD	R13!,{R14}		;Save some registers
		LDR	R1,[R0,#0]		;Load the block address
		SUB	R1,R1,#blk__oHead	;Point to our information
		LDR	R14,[R1,#blk__anchor]	;Load the block's anchor
		CMP	R0,R14			;Do they match up?
		ADRNEL	R0,msg_errBadAnchor	;No -- point to error message
		LDMFD	R13!,{R14}		;Restore registers
		BICEQS	PC,R14,#V_flag		;Anchor OK -- clear V on exit
		ORRNES	PC,R14,#V_flag		;Anchor duff -- return error

		LTORG

; --- dh__ensure ---
;
; On entry:	R0 == number of bytes required (multiple of 16)
;
; On exit:	R0 == pointer to base of area allocated
;
; Use:		Ensures that there are R0 bytes available in the heap.  If
;		there aren't R0 bytes available, it goes out of its way to
;		ensure that there *are* by getting more.  If there still
;		isn't enough, it compacts the heap and tries some more.

dh__ensure	ROUT

		STMFD	R13!,{R1-R5,R14}	;Save some registers
		MOV	R1,R0			;Keep the size I want

		; --- Try to find some space among the free blocks ---

		LDR	R3,dyn_heapSize		;Load the current heap size
		DIR	R14			;Is it RISC PC?
		LDRGE	R2,dyn_areaBase		;Yes -- load the area base
		RSBLT	R2,R3,#&01800000	;No -- find the base anyway
		ADD	R3,R3,R2		;Find the heap end address
		MOV	R5,#0			;No bytes found yet

00dh__ensure	CMP	R2,R3			;Is there more to go?
		BGE	%05dh__ensure		;No -- then extend the heap

		LDR	R0,[R2,#blk__size]	;Load this block's size
		ADD	R0,R0,#blk__oHead+15	;Add on the overhead size
		BIC	R0,R0,#15		;And align to granularity
		LDR	R14,[R2,#blk__anchor]	;Is the block free?
		ADD	R2,R2,R0		;Bump on block pointer
		CMP	R14,#0			;If so, anchor==0
		MOVNE	R5,#0			;If not, clear free size
		BNE	%00dh__ensure		;And loop round again

		; --- Found a free block ---

		CMP	R5,#0			;Is there a free block size?
		SUBEQ	R4,R2,R0		;No -- this is the start then
		ADD	R5,R5,R0		;Add on the size of this blk
		SUBS	R14,R5,R1		;Is this big enough?
		BLT	%00dh__ensure		;No -- keep on round

		; --- Found a big enough space ---

		BEQ	%03dh__ensure		;If no leftover, skip on
		ADD	R3,R4,R1		;Point to bit left over
		MOV	R0,#0			;This block is free
		SUB	R2,R14,#blk__oHead	;Subtract info overhead
		STMIA	R3,{R0,R2}		;Save this in the block

		; --- Return address of this memory ---

03dh__ensure	MOV	R0,R4			;Point to the free block
		LDMFD	R13!,{R1-R5,R14}	;Unstack registers
		BICS	PC,R14,#V_flag		;And clear error indicator

		; --- Main size ensuring loop ---

05dh__ensure	LDR	R14,dyn_areaSize	;Get the dynamic area size
		LDR	R2,dyn_heapSize		;And the size we're using
		SUB	R3,R14,R2		;How much do we have?
		SUBS	R3,R1,R3		;And is it enough?
		BLE	%10dh__ensure		;Yes -- skip onwards

		; --- Try to get some more pages ---

		LDR	R14,dyn_pageSize	;Load machine page size
		SUB	R14,R14,#1		;Subtract one -- round up
		ADD	R3,R3,R14		;Add it on for rounding
		LDR	R4,dyn_log2PageSize	;Load the page size log
		MOV	R0,R3,LSR R4		;How many do I need?
		BL	da_addPages		;Get some more
		BVC	%10dh__ensure		;It worked -- skip onwards

		; --- Hmm... -- try compacting the heap ---

		BL	dh_compact		;Try to compact the heap
		BCC	%05dh__ensure		;If it did, try again

		ADRL	R0,msg_errNoMem		;Point to the error
		LDMFD	R13!,{R1-R5,R14}	;Restore the registers
		ORRS	PC,R14,#V_flag		;And return to caller

		; --- Extend the heap and return the base address ---

10dh__ensure	ADD	R14,R2,R1		;Work out the new heap size
		STR	R14,dyn_heapSize	;Save this away for later
		DIR	R0			;Get the heap's direcection
		LDRGE	R0,dyn_areaBase		;Yes -- load the area base
		ADDGE	R0,R0,R2		;And add the old heap size
		RSBLT	R0,R14,#&01800000	;Otherwise find the heap base
		LDMFD	R13!,{R1-R5,R14}	;Unstack registers
		BICS	PC,R14,#V_flag		;And clear error indicator

		LTORG

; --- dh_reduce ---
;
; On entry:	--
;
; On exit:	CS if there was nothing we could do
;
; Use:		Tries to shunt the free space in the heap off the end and
;		back into the operating system's free pool.  It does it a
;		little bit and then stops, rather like those workmen on the
;		M40.

		EXPORT	dh_reduce
dh_reduce	ROUT

		STMFD	R13!,{R14}		;Save some registers
		LDR	R14,dyn_hpFlags		;Load the heap's flags
		TST	R14,#hpFlag_tidy	;Is the heap tidy?
		LDREQ	R14,dyn_lockCount	;No -- then load lock count
		CMPEQ	R14,#0			;Is the heap locked?
		BNE	%91dh_reduce		;Yes -- then return CS now

		; --- Do search for free blocks ---

		STMFD	R13!,{R0-R9}		;Save some more registers
		LDR	R1,dyn_heapSize		;Load the current heap size
		DIR	R14			;Is it RISC PC?
		LDRGE	R5,dyn_areaBase		;Yes -- load the area base
		RSBLT	R5,R1,#&01800000	;No -- find the base anyway
		ADD	R1,R1,R5		;Find the heap end address
		MOV	R9,R5			;Remember heap base address

		; --- Find a free block ---

		MOV	R7,#0			;No previous block
00dh_reduce	CMP	R5,R1			;Are we at the end yet?
		BGE	%04dh_reduce		;Yes -- jump ahead a little

		LDR	R2,[R5,#blk__anchor]	;Get the block's anchor addr
		CMP	R2,#0			;Is the block free?
		LDR	R2,[R5,#blk__size]	;Get the block size
		ADD	R2,R2,#blk__oHead+15	;Add on the overhead bytes
		BIC	R2,R2,#15		;And word align the size
		MOVNE	R7,R5			;No -- remember where it is
		ADDNE	R5,R5,R2		;...move on to next one
		BNE	%00dh_reduce		;...go round for another one

		; --- We've found a free block ---

01dh_reduce	ADD	R6,R5,R2		;Point to the next block
		CMP	R6,R1			;Is that the end of the heap?
		MOVGE	R8,R7			;Yes -- set up prev pointer
		SUBGE	R2,R2,#blk__oHead	;...take off overhead
		STRGE	R2,[R5,#blk__size]	;...store overall block size
		BGE	%04dh_reduce		;...and jump ahead a little

		; --- Check for two free blocks together ---

		LDR	R0,[R6,#blk__anchor]	;Does this have an anchor?
		CMP	R0,#0			;Check if it's free
		SUBNE	R2,R2,#blk__oHead	;Not -- take off overhead
		STRNE	R2,[R5,#blk__size]	;...store overall block size
		BNE	%02dh_reduce		;...jump ahead a little

		; --- Join two adjacent free blocks together ---

		LDR	R0,[R6,#blk__size]	;Yes -- get its size
		ADD	R2,R0,R2		;Concatenate the two blocks
		ADD	R2,R2,#blk__oHead+15	;Add on the overhead bytes
		BIC	R2,R2,#15		;And word align the size
		B	%01dh_reduce		;And check again...

		; --- We may be searching for the last block ---

02dh_reduce
		DIR	R14			;Get the heap direction
		MOVLT	R5,R6			;Down -- point to next block
		MOVLT	R8,R7			;...remember last block pos.
		BLT	%00dh_reduce		;...and keep on searching

		; --- There's a block to bring down ---

		LDR	R4,[R6,#blk__size]	;Get size of block to move
		ADD	R4,R4,#blk__oHead+15	;Add the flex overhead
		BIC	R4,R4,#15		;And word align the size
		MOVS	R2,R4			;This is the size to move
		MOV	R0,R5			;Where to move it to
		MOV	R1,R6			;Where it is right now
		BLNE	dh__move		;Copy it down PDQ
		ADD	R0,R5,R4		;Point after block we moved
		MOV	R1,#0			;Block doesn't have an anchor
		STR	R1,[R0,#blk__anchor]	;Store that away for later
		SUB	R1,R6,R5		;Find the difference here
		SUB	R1,R1,#blk__oHead	;Don't count this size here
		STR	R1,[R0,#blk__size]	;Store the old size in free

		; --- We need to fix up the block we moved ---

		LDR	R0,[R5,#blk__anchor]	;Get the anchor pointer
		ADD	R1,R5,#blk__oHead	;Point to the real data
		STR	R1,[R0]			;Store client's new anchor

		; --- That's it -- return to caller ---

		B	%10dh_reduce	;Return to caller

		; --- We've reached the end of the heap ---
		;
		; Now things get a little more complicated:
		;
		; If the heap goes upwards, then there may be a free block
		; on the end that we can free (R5 < R1), otherwise the heap
		; is compacted.
		;
		; If the heap goes downwards, then R8 points to the block
		; immediately before the last free one. If R8 is 0, then
		; either the heap is compacted (the first block is not free)
		; or there is only on free block, and it's at the lower
		; end of the heap.

04dh_reduce
		DIR	R14			;Get the heap direction
		BGE	%05dh_reduce		;Upwards --  jump ahead

		CMP	R8,#0			;Was there a previous block?
		BNE	%07dh_reduce		;Yes -- compact heap then

		LDR	R14,[R9,#blk__anchor]	;Get previous block anchor
		CMP	R14,#0			;Is the first block free?
		BNE	%90dh_reduce		;No -- the heap is compacted

		LDR	R14,[R9,#blk__size]	;Get the size of the free blk
		ADD	R14,R14,#blk__oHead+15	;Add on the overhead
		BIC	R14,R14,#15		;And correctly align
		ADD	R7,R9,R14		;Point past the free block

		LDR	R0,dyn_areaSize		;Get the area size
		RSB	R14,R0,#&01800000	;Find the base address
		SUB	R5,R7,R14		;Get size of unsused area
		SUB	R14,R0,R5		;Get the area size left
		STR	R14,dyn_heapSize	;Store it away nicely
		LDR	R14,dyn_log2PageSize	;Get the log page size
		MOVS	R0,R5,LSR R14		;How many pages can we free?
		BLNE	da_removePages		;More than 0 -- free them
		B	%20dh_reduce		;Return to caller

		; --- Merge the last block with the free area ---

05dh_reduce	CMP	R5,R1			;Had we reached the end?
		BGE	%90dh_reduce		;Yes -- heaps compact then

		SUB	R14,R5,R9		;Get the used area size
		STR	R14,dyn_heapSize	;And store it away
		LDR	R0,dyn_pageSize		;Get the machine page size
		SUB	R0,R0,#1		;Turn into a bitmask
		ADD	R5,R5,R0		;Align this to page boundary
		BIC	R0,R5,R0		;And finish off the align
		LDR	R1,dyn_areaSize		;Get the dyn area size
		ADD	R1,R1,R9		;Point to end of area
		SUBS	R0,R1,R0		;Are these different?
		BEQ	%10dh_reduce		;No -- return
		LDR	R14,dyn_log2PageSize	;Get the log page size
		MOVS	R0,R0,LSR R14		;How many pages can we free?
		BLNE	da_removePages		;More than 0 -- free them
		B	%20dh_reduce		;Return to caller

		; --- Move a block in a downwards heap ---

07dh_reduce	LDR	R2,[R8,#blk__size]	;Get size of block to move
		ADD	R2,R2,#blk__oHead+15	;Add the flex overhead
		BIC	R2,R2,#15		;And word align the size
		ADD	R0,R8,R2		;Point to the free block
		LDR	R4,[R0,#blk__size]	;Load out it's size
		ADD	R14,R4,#blk__oHead+15	;Add the flex overhead
		BIC	R14,R14,#15		;And word align the size
		ADD	R0,R0,R14		;Point to the end of the blk
		SUB	R0,R0,R2		;Copy the block to here
		MOV	R1,R8			;Where it is right now
		BLNE	dh__move		;Copy it down PDQ
		MOV	R1,#0			;Block doesn't have an anchor
		STR	R1,[R8,#blk__anchor]	;Store that away for later
		STR	R4,[R8,#blk__size]	;Store the old size in free

		; --- We need to fix up the block we moved ---

		LDR	R14,[R0,#blk__anchor]	;Get the anchor pointer
		ADD	R0,R0,#blk__oHead	;Point to the real data
		STR	R0,[R14]		;Store client's new anchor

		; --- That's it -- return ---

10dh_reduce	LDMFD	R13!,{R0-R9,R14}	;Load back registers
		BICS	PC,R14,#C_flag		;Return with C clear

		; --- There wasn't anything to do -- we're compacted ---

20dh_reduce	LDR	R0,dyn_hpFlags		;Load my flags
		ORR	R0,R0,#hpFlag_tidy	;We're compacted
		STR	R0,dyn_hpFlags		;Store back the flags
		LDMFD	R13!,{R0-R9,R14}	;Load back registers
		BICS	PC,R14,#C_flag		;Return with C clear

		; --- Nothing could be done ---

90dh_reduce	LDMFD	R13!,{R0-R9}		;Load back registers
91dh_reduce	LDMFD	R13!,{R14}		;And the link too
		ORRS	PC,R14,#C_flag		;Return with C set

		LTORG

; --- dh_compact ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Does a full compaction of the heap.

		EXPORT	dh_compact
dh_compact	ROUT

		STMFD	R13!,{R14}		;Stack the link register
		BL	dh_reduce		;Try to reduce the heap
		LDMCSFD	R13!,{PC}		;If it couldn't, return CS
00dh_compact	BL	dh_reduce		;Try to reduce the heap
		BCC	%00dh_compact		;Did something -- try again
		LDMFD	R13!,{R14}		;Return to caller...
		BICS	PC,R14,#C_flag		;... saying we did something

		LTORG

; --- dh__unCompact ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Marks the heap as being uncompact.

dh__unCompact	ROUT

		STMFD	R13!,{R14}		;Stack the link register
		LDR	R14,dyn_hpFlags		;Load the flags word
		TST	R14,#hpFlag_tidy	;Is the tidy bit on?
		BICNE	R14,R14,#hpFlag_tidy	;Clear the 'is tidy' bit
		STRNE	R14,dyn_hpFlags		;Store back the flags
		BLNE	dt_message		;Yes -- prod compactor
		LDMFD	R13!,{PC}^		;Return to caller

		LTORG

; --- dh_lock ---
;
; On entry:	--
;
; On exit:	R10 corrupted (SWIs don't care about this)
;
; Use:		Locks the heap, so that compaction entirely fails to happen.

		EXPORT	dh_lock
dh_lock		ROUT

		LDR	R10,dyn_lockCount	;Load the old lock count
		ADD	R10,R10,#1		;Bump the counter a little
		STR	R10,dyn_lockCount	;Store the counter back
		MOVS	PC,R14			;And return to caller

		LTORG

; --- dh_unlock ---
;
; On entry:	--
;
; On exit:	R10 corrupted (SWIs don't care about this)
;
; Use:		Unlocks the heap, so that compaction can happen again, maybe.

		EXPORT	dh_unlock
dh_unlock	ROUT

		LDR	R10,dyn_lockCount	;Load the old lock count
		SUBS	R10,R10,#1		;Knock the counter down
		STRGE	R10,dyn_lockCount	;Store the counter back
		BEQ	dt_message		;If now enabled, signal task
		MOVS	PC,R14			;And return to caller

		LTORG

; --- dh_save ---
;
; On entry:	R0 == mask of registers to save
;
; On exit:	R10, R11 corrupted
;
; Use:		Saves a load of registers on the Dynamite relocation stack.
;		The mask in R0 contains a bit set for each register to save:
;		bit 3 set means save R3 etc.  Since this is a SWI, only
;		R1-R9 can be saved on the stack.

		EXPORT	dh_save
dh_save		ROUT

		; --- StrongARM friendly version 1st October 1996 [mdw] ---

		LDR	R10,dyn_stackPtr	;Load the stack pointer

		TST	R0,#&03F
		BEQ	%f05
		MOVS	R11,R0,LSL #31
		STRCS	R1,[R10],#4
		TST	R0,#&3FC
		BEQ	%f00
		MOVS	R11,R0,LSL #29
		STRMI	R2,[R10],#4
		STRCS	R3,[R10],#4
		TST	R0,#&3F0
		BEQ	%f00
		MOVS	R11,R0,LSL #27
		STRMI	R4,[R10],#4
		STRCS	R5,[R10],#4
		TST	R0,#&3C0
		BEQ	%f00
05		MOVS	R11,R0,LSL #25
		STRMI	R6,[R10],#4
		STRCS	R7,[R10],#4
		MOVS	R11,R0,LSL #23
		STRMI	R8,[R10],#4
		STRCS	R9,[R10],#4
00
		STR	R10,dyn_stackPtr	;Save stack pointer back
		MOVS	PC,R14			;And return to caller

		LTORG

; --- dh_load ---
;
; On entry:	R0 == mask of registers to load
;
; On exit:	R10, R11 corrupted
;
; Use:		Loads a load of registers on the Dynamite relocation stack.
;		The mask in R0 contains a bit set for each register to load:
;		bit 3 set means load R3 etc.  Since this is a SWI, only
;		R1-R9 can be read from the stack.

		EXPORT	dh_load
dh_load		ROUT

		; --- StrongARM friendly version 1st October 1996 [mdw] ---

		LDR	R10,dyn_stackPtr	;Load the stack pointer

		TST	R0,#&3F0
		BEQ	%f05
		MOVS	R11,R0,LSL #23
		LDRCS	R9,[R10,#-4]!
		LDRMI	R8,[R10,#-4]!
		TST	R0,#&0FF
		BEQ	%f00
		MOVS	R11,R0,LSL #25
		LDRCS	R7,[R10,#-4]!
		LDRMI	R6,[R10,#-4]!
		TST	R0,#&03F
		BEQ	%f00
		MOVS	R11,R0,LSL #27
		LDRCS	R5,[R10,#-4]!
		LDRMI	R4,[R10,#-4]!
		TST	R0,#&00F
		BEQ	%f00
05		MOVS	R11,R0,LSL #29
		LDRCS	R3,[R10,#-4]!
		LDRMI	R2,[R10,#-4]!
		MOVS	R11,R0,LSL #31
		LDRCS	R1,[R10,#4]!
00
		STR	R10,dyn_stackPtr	;Save stack pointer back
		MOVS	PC,R14			;And return to caller

		LTORG

; --- dh_extend ---
;
; On entry:	R0 == address of block anchor
;		R1 == new size for block
;
; On exit:	R0 preserved
;		R1 == address of block, may have moved
;
; Use:		Changes the size of a block.

		EXPORT	dh_extend
dh_extend	ROUT

		STMFD	R13!,{R2,R14}		;Save some registers
		MOV	R2,R1			;Keep the size safe a while
		BL	dh__checkAnchor		;Make sure anchor's kosher
		LDRVC	R1,[R1,#blk__size]	;Load the size word nicely
		SUBVC	R2,R2,R1		;Get the `by' value I need
		BLVC	dh_midExtend		;Do the messing about
		LDMFD	R13!,{R2,PC}		;Return to caller

		LTORG

; --- dh_midExtend ---
;
; On entry:	R0 == address of block anchor
;		R1 == byte offset from block start
;		R2 == number of bytes to insert
;
; On exit:	R0 preserved
;		R1 == address of block, may have moved
;
; Use:		Inserts or removes bytes at a given offset into a Dynamite
;		heap block.

		EXPORT	dh_midExtend
dh_midExtend	ROUT

		STMFD	R13!,{R0,R2-R9,R14}	;Save some registers
		MOV	R5,R0			;Keep the anchor address
		MOV	R6,R1			;And the byte offset
		MOV	R7,R2			;And the size to insert

		; --- To start with, some sanity checks ---

		BL	dh__checkAnchor		;Make sure anchor is OK
		BVS	%90dh_midExtend		;If not, return error
		CMP	R7,#0			;Are we growing the block?
		ADDLT	R14,R6,R7		;No -- get lowest byte access
		MOVGE	R14,R6			;Yes -- similarly
		CMP	R14,#0			;Is this off the end?
		ADRLTL	R0,msg_errBadMid	;Yes -- point to error
		BLT	%90dh_midExtend		;And return to caller
		LDR	R4,[R1,#blk__size]	;Get the block's size
		CMP	R6,R4			;Are we going too far here?
		ADRGTL	R0,msg_errBadMid	;Yes -- point to error
		BGT	%90dh_midExtend		;And return to caller

		; --- Now do the correct extend job ---

		CMP	R7,#0			;Are we growing the block?
		BEQ	%85dh_midExtend		;Not changing -- return
		BLT	%50dh_midExtend		;Shrinking -- skip to do that

		; --- Make a block bigger ---
		;
		; We do this in 3 stages:
		;
		; * Get the amount of dead space at the end of the block, and
		;   see if this is enough.
		;
		; * If not, gather together the free blocks immediately
		;   following the block and add this to the dead space.
		;
		; * If we still don't have enough, we ensure a block of the
		;   required size (plus block descriptor) and copy the data
		;   into there.
		;
		; Registers will be used as follows:
		;
		; R5-R7 are original arguments
		; R4 == current size of block
		; R3 == size of area we have found
		; R2 == base address of extension area
		; R1 == base address of block

		ADD	R2,R1,R4		;Find the end of the block
		ADD	R3,R4,#blk__oHead+15	;Align block size to gran.
		BIC	R0,R3,#15		;To get dead space too
		SUB	R3,R0,#blk__oHead	;But don't have the overhead
		SUB	R3,R3,R4		;Get size of the dead space
		CMP	R3,R7			;Is there enough for us?
		BGE	%30dh_midExtend		;Yes -- use it then

		; --- Now we must gather free blocks together nicely ---

		STMFD	R13!,{R8-R10}		;Save some more registers
		ADD	R8,R1,R0		;Find start of next block
		DIR	R14			;Which way is the heap going?
		LDRGE	R14,dyn_areaBase	;Upwards -- get base address
		LDRGE	R10,dyn_heapSize	;And the heap's size
		ADDGE	R10,R14,R10		;To get the top of the heap
		MOVLT	R10,#&01800000		;Downwards -- get heap top

05dh_midExtend	CMP	R8,R10			;Are we there yet?
		BGE	%10dh_midExtend		;Yes -- stop there then
		LDR	R14,[R8,#blk__anchor]	;Get the block's anchor
		CMP	R14,#0			;Is it a free block?
		BNE	%10dh_midExtend		;No -- stop here then
		LDR	R9,[R8,#blk__size]	;Get the block's size
		ADD	R9,R9,#blk__oHead+15	;Add information overhead
		BIC	R9,R9,#15		;And align size nicely
		ADD	R8,R8,R9		;Move on to next block
		ADD	R3,R3,R9		;And increase available space
		CMP	R3,R7			;Do we have enough yet?
		BLT	%05dh_midExtend		;No -- go round again

		LDMFD	R13!,{R8-R10}		;Restore the stack pointer
		B	%30dh_midExtend		;And do the extend op

		; --- Not enough space in free blocks ---
		;
		; We dh__ensure enough space in the heap, and copy the whole
		; lot.

10dh_midExtend	LDMFD	R13!,{R8-R10}		;Restore the stack pointer
		ADD	R0,R4,R7		;Get the required size
		ADD	R0,R0,#blk__oHead+15	;Add information overhead
		BIC	R0,R0,#15		;And align size nicely
		BL	dh__ensure		;Make the space available
		BVS	%90dh_midExtend		;If it failed, return error
		LDR	R1,[R5,#0]		;Reload anchor -- may move
		SUB	R1,R1,#blk__oHead	;And find real block base
		ADD	R2,R4,#blk__oHead	;Add on the info overhead
		BL	dh__move		;Copy the data over
		ADD	R14,R0,#blk__oHead	;Point to the usable area
		STR	R14,[R5,#0]		;Save client's new anchor
		MOV	R14,#0			;Get a zero word
		STR	R14,[R1,#blk__anchor]	;To mark old block as free
		BL	dh__unCompact		;The heap is not compact now

		; --- Set up registers for the resize op ---

		MOV	R1,R0			;Point at the new block base
		ADD	R2,R1,R4		;Find area to extend from
		MOV	R3,R7			;And the size we have found

		; --- Perform the block resize ---

30dh_midExtend	ADD	R14,R4,R7		;Get the new block size
		STR	R14,[R1,#blk__size]	;And save it away
		ADD	R3,R3,R4		;Get the total area size
		ADD	R14,R14,#blk__oHead+15	;Add overhead to new size
		BIC	R14,R14,#15		;And align nicely

		; --- Increase the heap size if we need to ---

		ADD	R0,R1,R14		;Find the end of the area
		LDR	R9,dyn_heapSize		;Load the current heap size
		DIR	R8			;Is it RISC PC?
		LDRGE	R8,dyn_areaBase		;Yes -- load the area base
		RSBLT	R8,R9,#&01800000	;No -- find the base anyway
		ADD	R9,R9,R8		;Find the heap end address
		CMP	R0,R9			;Is end too high?
		SUBGT	R0,R0,R8		;Yes -- get the heap size
		STRGT	R0,dyn_heapSize		;...and store it back again

		ADD	R3,R3,#blk__oHead+15	;Do the same for the whole...
		BIC	R3,R3,#15		;... area size
		SUBS	R3,R3,R14		;Get the space left at end
		BLE	%35dh_midExtend		;Perfect fit -- skip on

		; --- Insert a free block here ---

		ADD	R0,R1,R14		;Find the end of the area
		MOV	R2,#0			;No anchor -- it's free
		SUB	R3,R3,#blk__oHead	;Subtract overhead size
		STMIA	R0,{R2,R3}		;Save in descriptor block

		; --- Now split the block as required ---

35dh_midExtend	ADD	R1,R1,#blk__oHead	;Point at usable part of blk
		ADD	R1,R1,R6		;Find the split offset
		ADD	R0,R1,R7		;Find where to move to
		SUBS	R2,R4,R6		;How much we have to move
		BLNE	dh__move		;Do the split op
		B	%85dh_midExtend		;And return happily to caller

		; --- We have to reduce a block ---

50dh_midExtend	ADD	R14,R4,R7		;Get the new size
		STR	R14,[R1,#blk__size]	;This is the new size
		ADD	R1,R1,#blk__oHead	;Point at usable part of blk
		ADD	R1,R1,R6		;Find the split offset
		ADD	R0,R1,R7		;Find where to move to
		SUBS	R2,R4,R6		;How much we have to move
		BLNE	dh__move		;Do the split op

		; --- Now update the size and insert free block ---

		ADD	R3,R4,R7		;Find the new size
		ADD	R4,R4,#blk__oHead+15	;Add overhead to new size
		BIC	R4,R4,#15		;And align nicely
		ADD	R3,R3,#blk__oHead+15	;Do the same for the whole...
		BIC	R3,R3,#15		;... area size
		SUBS	R14,R4,R3		;Get the space left at end
		BEQ	%85dh_midExtend		;Perfect fit -- skip onwards

		; --- Insert a free block here ---

		LDR	R1,[R5,#0]		;Load the block address
		SUB	R1,R1,#blk__oHead	;Point to the block descr.
		ADD	R0,R1,R3		;Find the end of the area
		MOV	R2,#0			;No anchor -- it's free
		SUB	R3,R14,#blk__oHead	;Subtract overhead size
		STMIA	R0,{R2,R3}		;Save in descriptor block
		BL	dh__unCompact		;The heap is not compact now

		; --- Now everything is great ---

85dh_midExtend	LDR	R1,[R5,#0]		;Load the block address
		LDMFD	R13!,{R0,R2-R9,R14}	;Unstack registers
		BICS	PC,R14,#V_flag		;And return to caller

		; --- We failed miserably ---

90dh_midExtend	ADD	R13,R13,#4		;Don't restore R0 on exit
		LDMFD	R13!,{R2-R9,R14}	;Unstack registers
		ORRS	PC,R14,#V_flag		;And return to caller

		LTORG

; --- dh__move ---
;
; On entry:	R0 == destination of movement
;		R1 == base of block to move
;		R2 == size of block to move
;
; On exit:	--
;
; Use:		Shunts memory around in the heap, relocating everything that
;		needs relocation.

dh__move	ROUT

		STMFD	R13!,{R3,R4,R14}	;Save some registers
		BL	fastMove		;Do the memory movement

		; --- Now relocate entries on the stack ---

10dh__move	LDR	R4,dyn_stackPtr		;Find the stack pointer now
		ADR	R3,dyn_stack		;Point to the stack base
15dh__move	CMP	R3,R4			;Have we finished yet?
		BGE	%20dh__move		;Yes -- return then
		LDR	R14,[R3],#4		;Load next entry from stack
		SUB	R14,R14,R1		;Subtract source address
		CMP	R14,R2			;Is it in the block?
		ADDLO	R14,R14,R0		;Yes -- relocate
		STRLO	R14,[R3,#-4]		;And store back in stack
		B	%15dh__move		;And carry on relocating

20dh__move	LDMFD	R13!,{R3,R4,PC}^	;Return to caller

		LTORG

; --- dh_checkHeap ---
;
; On entry:	--
;
; On exit:	May return an error
;
; Use:		Checks the current internal format of the heap to make
;		sure that it hasn't been corrupted in any way.
;		If the integrity check fails then an error is returned.

		EXPORT	dh_checkHeap
dh_checkHeap	ROUT

		STMFD	R13!,{R0-R7,R14}	;Save some registers

		; --- Start going throught the blocks ---

		LDR	R6,dyn_heapSize		;Load the current heap size
		DIR	R14			;Is it RISC PC?
		LDRGE	R5,dyn_areaBase		;Yes -- load the area base
		RSBLT	R5,R6,#&01800000	;No -- find the base anyway
		ADD	R6,R6,R5		;Find the heap end address
		MOV	R9,R5			;Remember heap base address

		; --- Find a block ---

		MOV	R7,R5			;Previous block
00dh_checkHeap	CMP	R5,R6			;Are we at the end yet?
		ADRGTL	R0,msg_errBadHeap2	;Oops -- must have a bad len
		BGT	%90dh_checkHeap		;Gone past -- oops
		BEQ	%50dh_checkHeap		;Yes -- jump ahead a little

		MOV	R0,R5			;Get the base of area to chk
		ADD	R1,R0,#blk__oHead	;Get the overhead size
		SWI	OS_ValidateAddress	;Make sure this is kosher
		ADRCSL	R0,msg_errBadHeap2	;No -- must have a bad len
		BCS	%90dh_checkHeap		;If not, moan at client
		LDR	R2,[R5,#blk__anchor]	;Get the block's anchor addr
		CMP	R2,#0			;Is the block free?
		BEQ	%10dh_checkHeap		;Yes -- jump ahead

		; --- Make sure the anchor checks OK ---

		MOV	R7,R5			;This block could be wrong
		MOV	R0,R2			;Get the base of area to chk
		ADD	R1,R0,#4		;Just check one word
		SWI	OS_ValidateAddress	;Make sure this is kosher
		ADRCSL	R0,msg_errBadHeap3	;Address must be dead then
		BCS	%90dh_checkHeap		;If not, moan at client

		LDR	R0,[R2,#0]		;Load the anchors value
		ADD	R14,R5,#blk__oHead	;This is what R0 should be
		CMP	R0,R14			;Do they match?
		ADRNEL	R0,msg_errBadHeap1	;No -- point to the error
		BNE	%90dh_checkHeap		;And return it joyfully

		; --- Go round for more then ---

10dh_checkHeap	LDR	R3,[R5,#blk__size]	;Get the block size
		ADD	R3,R3,#blk__oHead+15	;Add on the overhead bytes
		BIC	R3,R3,#15		;And word align the size
		ADD	R5,R5,R3		;Yes -- move on to next one
		B	%00dh_checkHeap		;...go round for another one

50dh_checkHeap	LDMFD	R13!,{R0-R7,R14}	;Load registers back
		BICS	PC,R14,#V_flag		;Return without error

90dh_checkHeap	ADD	R13,R13,#4
		STR	R7,[R0,#0]		;Store as the error number!
		LDMFD	R13!,{R1-R7,R14}	;Load registers back
		ORRS	PC,R14,#V_flag		;Return with error

		LTORG

; --- dh_changeAnchor ---
;
; On entry:	R0 == pointer to anchor for block
;		R1 == address of new anchor
;
; On exit:	--
;
; Use:		Adjusts a block's anchor, in case it moves.

		EXPORT	dh_changeAnchor
dh_changeAnchor	ROUT

		STMFD	R13!,{R2,R14}		;Save a register
		MOV	R2,R1			;Remember this value
		BL	dh__checkAnchor		;Make sure the anchor's OK
		STRVC	R2,[R1,#blk__anchor]	;Save the new anchor pointer
		ADDVC	R14,R1,#blk__oHead	;Skip onto the actual data
		STRVC	R14,[R2,#0]		;And set the new anchor up
		LDMFD	R13!,{R2,PC}		;Return to caller

		LTORG

; --- dh_dump ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Outputs a textual description of the dynamite heap, giving
;		details of each block within it.

dh__preDump	LDR	R12,[R12]

		EXPORT	dh_dump
dh_dump		ROUT

		STMFD	R13!,{R0-R4,R14}	;Stack some registers

		LDR	R4,dyn_heapSize		;Get the current heap size
		DIR	R14			;Which direction does it go?
		LDRGE	R2,dyn_areaBase		;Up -- find the base then
		RSBLT	R2,R4,#&1800000		;Down -- start below the RMA
		ADD	R3,R2,R4		;Find the heap limit address

		; --- Display information about the heap in general ---

		ADRL	R0,msg_dumpHpBase	;Find the message
		MOV	R1,R2			;Get the heap base address
		BL	dh__writeHex		;And display it

		MOV	R1,R4			;Get the heap size
		ADRL	R0,msg_dumpHpSize	;Find the message
		BL	dh__writeHex		;And display it

		LDR	R1,dyn_areaSize		;Get the dynamic area size
		ADRL	R0,msg_dumpHpArSz	;Find the message
		BL	dh__writeHex		;And display it

		; --- Now start on the loop ---

00		CMP	R2,R3			;Have we finished yet?
		LDMCSFD	R13!,{R0-R4,PC}^	;Yes -- then return

		SWI	OS_NewLine		;Start a new line here

		ADRL	R0,msg_dumpBlkAddr	;Point to the message
		ADD	R1,R2,#blk__oHead	;Point to the current block
		BL	dh__writeHex		;Display it

		ADRL	R0,msg_dumpBlkSize	;Point at the message
		MOV	R0,R0			;No-op to prevent objasm bug!
		LDR	R1,[R2,#blk__size]	;Get the block's size
		BL	dh__writeHex		;Display it

		LDR	R1,[R2,#blk__id]	;Load the magic ID
		ADRL	R0,msg_dumpBlkId	;Point at the message
		BL	dh__writeHex		;Display it nicely

		LDR	R1,[R2,#blk__anchor]	;Find the anchor address
		CMP	R1,#0			;Is the block free?
		ADREQL	R0,msg_dumpBlkFree	;Yes -- point to the message
		SWIEQ	XOS_Write0		;And display it on screen
		ADRNEL	R0,msg_dumpBlkAnch	;Otherwise show anchor addr
		BLNE	dh__writeHex		;And move on to next block

		LDR	R14,[R2,#blk__size]	;Load the block size again
		ADD	R14,R14,#blk__oHead+15	;Add overhead and align
		BIC	R14,R14,#15		;To find the next block
		ADD	R2,R2,R14		;Move onto the next block
		B	%b00			;And skip back into the loop

dh__writeHex	STMFD	R13!,{R2,R14}		;Save some registers
		SWI	XOS_Write0		;Display the string
		SUB	R13,R13,#12		;Make a small buffer
		MOV	R0,R1			;Get the number to display
		MOV	R1,R13			;Point to the buffer
		MOV	R2,#12			;The buffer size, sir
		SWI	XOS_ConvertHex8		;Convert it into ASCII
		SWI	XOS_Write0		;Display that too
		SWI	XOS_NewLine		;Move on to a new line
		ADD	R13,R13,#12		;Restore the stack pointer
		LDMFD	R13!,{R2,PC}^		;And return to caller

		LTORG

;----- * Commands -----------------------------------------------------------

		AREA	|Dynamite$$Commands|,CODE,READONLY

		DCB	"Dynamite_HeapDump",0
		DCD	dh__preDump
		DCD	0
		DCD	synt_heapDump
		DCD	help_heapDump

;----- Data structures ------------------------------------------------------

; --- Block descriptors ---

		^	0
blk__anchor	#	4			;Address of block's anchor
blk__size	#	4			;Block's size, as allocated
blk__id		#	4			;Client's magic ID number
blk__oHead	#	0			;Overhead on allocated blocks

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

		END
