;
; kernel.s
;
; Sapphire library kernel
;
;  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

		GET	libs:stream

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

		[	:LNOT::DEF: sapphire__dynaLink

		IMPORT  |Image$$RW$$Base|,WEAK
		IMPORT  |Image$$RW$$Limit|,WEAK
		IMPORT  |Sapphire$$ClientData$$Base|,WEAK
		IMPORT  |Sapphire$$ClientData$$Limit|,WEAK
		IMPORT  |Sapphire$$ExtTable$$Base|,WEAK
		IMPORT  |Sapphire$$ExtTable$$Limit|,WEAK

		]

		IMPORT  |Sapphire$$LibData$$Base|,WEAK
		IMPORT  |Sapphire$$LibData$$Limit|,WEAK

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

		AREA	|Sapphire$$Code|,CODE,READONLY

		[	:LNOT::DEF: sapphire__dynaLink

; --- sapphire_init ---
;
; On entry:	R0 == pointer to application name
;		R1 == application's workspace size
;		R2 == size of stack required
;
; On exit:	R10 == pointer to heap base
;		R11 == pointer to ScratchPad
;		R12 == pointer to application workspace
;		R13 == pointer to full descending stack
;		Other registers are corrupted
;
; Use:		Initialises the Sapphire kernel, sets up the memory map,
;		and allocates workspace for library and client units.  The
;		initialisation performed is fairly minimal; in particular,
;		the library units are not initialised -- you must call
;		sapphire_libInit for this to take place.  This allows you
;		to check command line arguments etc. before initialising
;		the Wimp.

		EXPORT  sapphire_init
sapphire_init	ROUT

		ADR	R3,sapph__initTable	;Point to initialisation tbl
		B	sapphire_doInit		;Do main initialisation

		LTORG

; --- sapphire_libInit ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Initialises the Sapphire library and client units.

		EXPORT  sapphire_libInit
sapphire_libInit ROUT

		STMFD	R13!,{R0,R14}		;Save some registers
		ADR	R0,sapph__initTable	;Point to initialisation tbl
		BL	sapphire_doLibInit	;Do library initialisation
		LDMFD	R13!,{R0,PC}^		;Return to caller

		LTORG

; --- sapphire_disable ---
;
; On entry:	R0 == pointer to 0-terminated list of initialise routines
;
; On exit:	--
;
; Use:		Prevents the given initialisation routines from being called.
;		This is mainly useful in the dynamic-linking environment,
;		where all Sapphire units are normally active.  This routine
;		allows you to inactivate units which for example do not
;		have the resources they require, or use up unnecesary
;		memory.

		EXPORT	sapphire_disable
sapphire_disable ROUT

		STMFD	R13!,{R1,R14}		;Save some registers
		ADR	R1,sapph__initTable	;Point to initialisation tbl
		BL	sapphire_doDisable	;Do the disabling bits
		LDMFD	R13!,{R1,PC}^		;Return to caller

		LTORG

sapph__initTable

		DCD	|Image$$RW$$Limit|
		DCD	|Sapphire$$ClientData$$Base|
		DCD	|Sapphire$$ClientData$$Limit|
		DCD	-1
		DCD	|Sapphire$$ExtTable$$Base|
		DCD	|Sapphire$$ExtTable$$Limit|

		]

; --- sapphire_doInit ---
;
; On entry:	R0 == pointer to application name
;		R1 == client workspace size
;		R2 == requested stack size
;		R3 == pointer to initialisation table
;
; On exit:	R10 == base address of Sapphire heap
;		R11 == pointer to scratchpad and global data
;		R12 == pointer to client global workspace
;		R13 == pointer to a full descendion stack
;
; Use:		Performs initialisation of the Sapphire library and the
;		client's sections.  This is intended for use by the Sapphire
;		stub, while initialising the dynamically linked version of
;		Sapphire.

		EXPORT  sapphire_doInit
sapphire_doInit ROUT

		; --- Stash arguments in high registers ---

		MOV	R6,R0			;Pointer to application name
		MOV	R5,R1			;Client's workspace size
		MOV	R7,R2			;Client's stack size
		MOV	R8,R3			;Pointer to intialise table

		; --- Find the top of our memory area ---

		SWI	OS_GetEnv		;Find the memory limit
		MOV	R13,R1			;This will do as a stack
		LDR	R12,[R8],#4		;Load the application end

		; --- Set up workspace allocation registers ---

		ADD	R9,R12,#sapph__wSize	;Allocate my workspace
		ADD	R7,R7,#3		;Make sure stack size...
		BIC	R7,R7,#3		;... is word aligned
		CMP	R7,#sapph__minStack	;Is his stack big enough?
		SUBCC	R10,R13,#sapph__minStack ;No -- allocate it big
		SUBCS	R10,R13,R7		;Yes -- allocate his amount

		CMP	R9,R10			;Do we have enough memory?
		BCS	%90sapphire_doInit	;No -- complain then

		; --- Now find out how much we need ---

		STMFD	R13!,{R5,R6,R14}	;Save some registers
		ADD	R5,R5,#3		;Amount of workspace required
		BIC	R5,R5,#3		;Make sure it's aligned
		MOV	R6,#20			;Space below R11 used so far
		MOV	R7,#256			;Force scratchpad to 256

		ADR	R4,sapph__ownTable	;Point to the internal table
		LDMIA	R4,{R0,R1}		;Load the base and limit
		BL	sapph__readSize		;Work out sizes here

		MOV	R4,R8			;Point to init table
00		LDMIA	R4!,{R0,R1}		;Load the base and limit
		CMP	R0,#-1			;Is it the end of the table?
		BLNE	sapph__readSize		;No -- work out the sizes
		BNE	%00sapphire_doInit	;And go back for more

		SUB	R4,R4,#4		;We went a little too far
		LDMIA	R4,{R3,R4}		;Load these values out
05		CMP	R3,R4			;Reached the end yet?
		BCS	%09sapphire_doInit	;Yes -- skip onwards
		MOV	R14,PC			;Set up return address
		LDR	PC,[R3],#4		;Get next return address
		CMP	R2,R6			;Need more space below R11?
		MOVHI	R6,R2			;Yes -- then increase size
		BL	sapph__readSize		;Work out the sizes here
		B	%05sapphire_doInit	;And go back for more

		; --- Make initial allocations ---

09		SUB	R11,R10,R7		;Allocate the scratchpad
		SUB	R10,R11,R6		;And allocate workspace ptrs

		ADD	R1,R9,R5		;Add on workspace reqments
		SUBS	R3,R10,R1		;Do we have enough memory?
		BCC	%90sapphire_doInit	;No -- make an error then

		; --- Set up initial contents of magic area ---

		LDR	R0,[R13,#4]		;Load application name ptr
		ADD	R7,R13,#12		;Find stack base address
		STMDB	R11,{R0,R1,R7,R9}	;Save values in the area

		; --- Initialise the heap ---

		MOV	R0,#0			;Initialise a heap area
		SWI	OS_Heap			;Set it up then

		; --- Set up kernel workspace ---

		MOV	R0,#0			;No global areas allocated
		STR	R0,sapph__globCnt	;So clear the counter value

		; --- Now start setting up workspace ---

		MOV	R7,#0			;Current workspace offset
		MOV	R2,#4			;Current R11 negative offset

		ADR	R6,sapph__ownTable	;Point to internal table
		LDMIA	R6,{R0,R1}		;Load the base and limit
		BL	sapph__setWSpace	;Set up the workspace for it

10		LDMIA	R8!,{R0,R1}		;Load the base and limit
		CMP	R0,#-1			;Is this the end yet?
		BLNE	sapph__setWSpace	;No -- set up workspace
		BNE	%10sapphire_doInit	;And go back round again

		; --- Allocate the client's workspace ---

		ADD	R9,R9,R7		;Find current workspace pos
		LDMIA	R13!,{R5,R6}		;Load workspace size back
		STR	R9,sapph_clientWS	;Save client workspace ptr
		ADD	R9,R9,R5		;Move past client work size
		MOV	R7,#0			;Clear offset now

		; --- Now allocate workspace for extensions ---

		SUB	R8,R8,#4		;We overshot at the end
		LDMIA	R8,{R5,R6}		;Load the values out
15		CMP	R5,R6			;Have we finished yet?
		BCS	%19sapphire_doInit	;Yes -- skip out then
		MOV	R14,PC			;Set up return address
		LDR	PC,[R5],#4		;Call the routine
		ADD	R9,R9,R7		;Get updated workspace offset
		STR	R9,[R11,-R2]		;Save in magic place
		MOV	R7,#0			;No offset set up yet
		BL	sapph__setWSpace	;Set up its workspace
		B	%15sapphire_doInit	;And go back round again

		; --- That's it -- we're done ---

19		LDR	R12,sapph_clientWS	;Load client's workspace
		LDR	R10,sapph_heapBase	;Load the heap base too
		LDMFD	R13!,{PC}^		;Return to caller

		; --- Not enough memory to start up ---

90		ADR	R0,sapph__noMem		;Point to the error message
		SWI	OS_GenerateError	;Generate the error

sapph__ownTable DCD	|Sapphire$$LibData$$Base|
		DCD	|Sapphire$$LibData$$Limit|

sapph__noMem	DCD	0
		DCB	"Not enough memory to initialise",0

		LTORG

; --- sapph__readSize ---
;
; On entry:	R0 == base of initialisation block
;		R1 == limit of initialisation block
;		R5 == amount of workspace required so far
;		R7 == required size of scratchpad
;
; On exit:	R5, R7 updated as necessary
;
; Use:		Adjusts workspace parameters given an initialisation block.

sapph__readSize ROUT

		STMFD	R13!,{R0-R4,R14}	;Save some registers
00		CMP	R0,R1			;Have we finished yet?
		LDMCSFD R13!,{R0-R4,PC}^	;Yes -- then return
		LDMIA	R0!,{R2-R4,R14}		;Load values from block
		ADD	R2,R2,#3		;Make sure workspace is...
		BIC	R2,R2,#3		;... word aligned
		ADD	R5,R5,R2		;Incrment offset nicely
		CMP	R4,R7			;Is scratchpad big enough?
		MOVHI	R7,R4			;No -- make it bigger then
		B	%00sapph__readSize	;And go back for the rest

		LTORG

; --- sapph__setWSpace ---
;
; On entry:	R0 == base of initialisation block
;		R1 == limit of initialisation block
;		R7 == current workspace offset
;		R9 == workspace chunk base address
;
; On exit:	R7 updated
;
; Use:		Lays out workspace and sets up workspace offsets.

sapph__setWSpace ROUT

		STMFD	R13!,{R0-R4,R14}	;Save some registers
00		CMP	R0,R1			;Have we finished yet?
		LDMCSFD R13!,{R0-R4,PC}^	;Yes -- then return
		LDMIA	R0!,{R2-R4,R14}		;Load values from block
		ADD	R2,R2,#3		;Make sure workspace is...
		BICS	R2,R2,#3		;... word aligned
		STRNE	R7,[R3,#0]		;If any wanted, save offset
		MOVNE	R14,#0			;Zero the first word
		STRNE	R14,[R7,R9]		;Save that in there
		ADD	R7,R7,R2		;And move pointer on
		B	%00sapph__setWSpace	;And keep on going round

		LTORG

; --- sapphire_doLibInit ---
;
; On entry:	R0 == address of library initialisation table
;
; On exit:	--
;
; Use:		Initialises all currently uninitialised library units.

		EXPORT  sapphire_doLibInit
sapphire_doLibInit ROUT

		STMFD	R13!,{R0-R4,R14}	;Save some registers
		ADD	R4,R0,#4		;Look after this pointer

		ADR	R0,sapph__ownTable	;Point to our own init table
		LDMIA	R0,{R0,R1}		;Load base and limit
		LDR	R2,sapph_workspace	;Load workspace base address
		BL	sapph__init		;Initialise from block

00		LDMIA	R4!,{R0,R1}		;Load values from the block
		CMP	R0,#-1			;Have we reached the end yet?
		BLNE	sapph__init		;No -- do more initialising
		BNE	%00sapphire_doLibInit	;And go round again

		SUB	R4,R4,#4		;We overshot a bit
		LDMIA	R4,{R3,R4}		;Load extension table values
05		CMP	R3,R4			;Have we finished yet?
		BCS	%09sapphire_doLibInit	;Yes -- skip out then
		MOV	R14,PC			;Set up return address
		LDR	PC,[R3],#4		;Call finding routine
		LDR	R2,[R11,-R2]		;Load workspace base address
		BL	sapph__init		;Do more initialising
		B	%05sapphire_doLibInit	;And go back round for more

09		LDMFD	R13!,{R0-R4,PC}^	;And return to caller

		LTORG

; --- sapph__init ---
;
; On entry:	R0 == pointer to base of initialise table
;		R1 == pointer to limit of initialise table
;		R2 == base of workspace chunk
;
; On exit:	--
;
; Use:		Initialises currently uninitialised library units.

sapph__init	ROUT

		STMFD	R13!,{R0-R7,R14}	;Save some registers
		MOV	R3,R0			;Look after this pointer
		LDR	R0,sapph_appName	;Find application's name
00		CMP	R3,R1			;Have we finished yet?
		LDMCSFD R13!,{R0-R7,PC}^	;Yes -- then return
		LDMIA	R3!,{R4-R7}		;Load values from block
		CMP	R7,#0			;Is there a init routine?
		MOVNE	R14,PC			;Yes -- set up return address
		MOVNE	PC,R7			;And call the routine
		B	%00sapph__init		;And go round again

		LTORG

; --- sapphire_doDisable ---
;
; On entry:	R0 == pointer to list of initialise routines to disable
;		R1 == pointer to initialisation table
;
; On exit:	--
;
; Use:		Prevents the given initialisation routines from being
;		called.  This is mainly useful in a dynamically linked
;		environment.

		EXPORT	sapphire_doDisable
sapphire_doDisable ROUT

		STMFD	R13!,{R0-R7,R14}	;Save some registers
		MOV	R7,R0			;Keep pointer safe
		ADD	R6,R1,#4		;Point to initialise table

00		LDR	R5,[R7],#4		;Load next entry to remove
		TEQ	R5,#0			;Is this the end yet?
		BEQ	%90sapphire_doDisable	;Yes -- then return

		LDR	R14,[R5,#0]		;Load the first instruction
		AND	R0,R14,#&FF000000	;Get the opcode bits out
		CMP	R0,#&EA000000		;Is this a branch instruction
		BICEQ	R14,R14,#&FF000000	;Yes -- zap instruction bits
		ADDEQ	R14,R14,#2		;Compensate for pipeline
		ADDEQ	R5,R5,R14,LSL #2	;And work out destination

		; --- Now find this routine somewhere ---

		ADR	R0,sapph__ownTable	;Point to our own table
		LDMIA	R0,{R0,R1}		;Load base and limit pointers
		LDR	R2,sapph_workspace	;Load workspace base address
		BL	sapph__disable		;See if it's in there
		BCS	%00sapphire_doDisable	;If so, move to next routine

		; --- Try the client table then ---

		MOV	R4,R6			;Point to init table
05		LDMIA	R4!,{R0,R1}		;Load the values out
		CMP	R0,#0			;Have I finished here yet?
		BEQ	%09sapphire_doDisable	;Yes -- skip out then
		BL	sapph__disable		;See if it's in there
		BCS	%00sapphire_doDisable	;If so, move to next routine
		B	%05sapphire_doDisable	;Else try the next lot

		; --- Now try the external table ---

09		SUB	R4,R4,#4		;We overshot as usual
		LDMIA	R4,{R3,R4}		;Load base and limit out
10		CMP	R3,R4			;Reached the end yet?
		BEQ	%00sapphire_doDisable	;If so, move to next routine
		MOV	R14,PC			;Set up return address
		LDR	PC,[R3],#4		;Find next init table
		LDR	R2,[R11,-R2]		;Load the workspace base
		BL	sapph__disable		;See if it's in there
		BCS	%00sapphire_doDisable	;If so, move to next routine
		B	%10sapphire_doDisable	;Else try the next lot

		; --- Finished all of them ---

90		LDMFD	R13!,{R0-R7,PC}^	;Return to caller

		LTORG

; --- sapph__disable ---
;
; On entry:	R0 == base of initialise table
;		R1 == limit of initialise table
;		R2 == base of workspace for table
;		R5 == address of init routine to match
;
; On exit:	CS if routine found, else CC
;		R0 corrupted
;
; Use:		Finds and disables a given initialise routine.

sapph__disable	ROUT

		BIC	R14,R14,#C_flag		;Clear carry flag initially
		STMFD	R13!,{R3,R4,R6,R14}	;Save some registers
00		CMP	R0,R1			;Reached the end yet?
		LDMCSFD	R13!,{R3,R4,R6,PC}^	;Yes -- return sadly then
		LDMIA	R0!,{R3,R4,R6,R14}	;Load values from table
		CMP	R3,#0			;Is there any workspace?
		BEQ	%00sapph__disable	;No -- ignore this entry
		CMP	R14,R5			;Is this the routine?
		BNE	%00sapph__disable	;No -- ignore this entry
		LDR	R4,[R4,#0]		;Load workspace offset
		MOV	R14,#-1			;Set all of the bits
		STR	R14,[R2,R4]		;Save it in workspace
		LDMFD	R13!,{R3,R4,R6,R14}	;Unstack the registers
		ORRS	PC,R14,#C_flag		;And return with C set

		LTORG

; --- sapphire_heapAddr ---
;
; On entry:	--
;
; On exit:	R1 == pointer to the heap base (for passing to OS_Heap)
;
; Use:		Returns the address of the Sapphire heap.

		EXPORT  sapphire_heapAddr
sapphire_heapAddr ROUT

		LDR	R1,sapph_heapBase
		MOVS	PC,R14

		LTORG

; --- sapphire_appName ---
;
; On entry:	--
;
; On exit:	R0 == pointer to application name (NULL terminated)
;
; Use:		Returns a pointer to the application's name.

		EXPORT  sapphire_appName
sapphire_appName ROUT

		LDR	R0,sapph_appName
		MOVS	PC,R14

		LTORG

; --- sapphire_resetStack ---
;
; On entry:	--
;
; On exit:	R13 == stack pointer
;
; Use:		Resets R13 to point to the top of the stack.

		EXPORT  sapphire_resetStack
sapphire_resetStack
		ROUT

		LDR	R13,sapph_stackBase
		MOVS	PC,R14

		LTORG

; --- sapphire_global ---
;
; On entry:	R0 == magic identifier for global variable
;		R1 == size of area required
;
; On exit:	R0 == pointer to area
;		CS if the area already exists, CC otherwise
;
; Use:		Locates (and creates if necessary) a `named' global area
;		which can be used for inter-section communication without
;		the necessity for dependencies.
;
;		There is a limit on the number of global areas allowed, but
;		this can be raised fairly easily if necessary.
;
;		If an area can't be created, an error is generated.

		EXPORT  sapphire_global
sapphire_global ROUT

		ORR	R14,R14,#C_flag		;Clear C flag normally
		STMFD	R13!,{R1-R4,R12,R14}	;Save some registers
		LDR	R12,sapph_workspace	;Find workspace base address
		SUB	R12,R12,#sapph__wSize	;Subtract to get kernel space

		; --- Try and find a matching global name ---

		ADR	R4,sapph__globals	;Point to the globals block
		LDR	R2,sapph__globCnt	;Load my current pointer
		MOVS	R3,R2			;Is it zero?
		BEQ	%10sapphire_global	;If not present, skip ahead

00		LDR	R14,[R4],#8		;Load the name of this one
		CMP	R0,R14			;Is this a match then?
		LDREQ	R0,[R4,#-4]		;Yes -- point to the block
		LDMEQFD R13!,{R1-R4,R12,PC}^	;Yes -- return the pointer
		SUBS	R3,R3,#1		;Decrement the counter
		BGT	%00sapphire_global	;If more left, check 'em

		; --- No luck there -- allocate a new one ---

10		CMP	R3,#sapph__globMax	;Are we at the limit?
		ADRGE	R0,sapph__noGlob	;Yes -- point to the limit
		SWIGE	OS_GenerateError	;And quit the proggy

		ADD	R2,R2,#1		;Bump the global counter
		STR	R2,sapph__globCnt	;Store the counter away
		STR	R0,[R4,#0]		;Store the name of this one

		MOV	R3,R1			;Get the size in R3 nicely
		MOV	R0,#2			;Allocate a new heap block
		LDR	R1,sapph_heapBase	;Load my heap pointer nicely
		SWI	OS_Heap			;Allocate the memory now
		STR	R2,[R4,#4]		;Store the pointer for later
		MOV	R0,R2			;Return the pointer now

		LDMFD	R13!,{R1-R4,R12,R14}	;Return to caller
		BICS	PC,R14,#C_flag		;Explaining we had to create

sapph__noGlob	DCD	1
		DCB	"Too many global areas",0

		LTORG

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

; --- Data relative to R11 ---

		^	0,R11
sapph__R11	#	0			;Make a symbol for R11

sapph_scratchpad EQU	sapph__R11-0		;Scratchpad data area
sapph_workspace EQU	sapph__R11-4		;Workspace base address
sapph_stackBase EQU	sapph__R11-8		;The top of the system stack
sapph_heapBase  EQU	sapph__R11-12		;Base address of the heap
sapph_appName	EQU	sapph__R11-16		;Pointer to application name
sapph_clientWS  EQU	sapph__R11-20		;Address of client's space

sapph__minStack EQU	2048			;Minimum acceptable stack
sapph__globMax  EQU	5			;Maximum global areas allowed

		^	0,R12
sapph__wStart	#	0

sapph__globCnt  #	4			;Number of global areas
sapph__globals  #	8*sapph__globMax	;The actual global bits

sapph__wSize	EQU	{VAR}-sapph__wStart

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

		END

