;
; except.s
;
; Sapphire exception handling (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:sapphire
		GET	sapphire:suballoc

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

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- except_init ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Initialises the exception handler.

		EXPORT	except_init
except_init	ROUT

		STMFD	R13!,{R0,R12,R14}	;Stash registers away
		WSPACE	exc__wSpace		;Point to my workspace

		; --- Make sure I'm not already going ---

		LDR	R0,exc__flags		;Find the flags word
		TST	R0,#eFlag__inited	;Am I going yet?
		LDMNEFD	R13!,{R0,R12,PC}^	;Yes -- return right now

		; --- Start up suballocation for exit list ---

		BL	sub_init		;Make sure suballoc's going

		; --- Fill in the flags and exit list ---

		MOV	R0,#eFlag__inited	;Set the initialised flag
		STR	R0,exc__flags		;Store it away nicely

		MOV	R0,#0
		STR	R0,exc__exitList	;No atexit routines yet
		STR	R0,exc__query		;No error handler either
		STR	R11,exc__R11		;Save R11 pointer

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

		LTORG

; --- exc__setHnd ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Sets up the OS handlers so we get called when strange things
;		happen.

exc__setHnd	ROUT

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

		; --- Make sure we need to do this ---

		LDR	R0,exc__flags		;Get my current flags
		TST	R0,#eFlag__handling	;Are we now handling errors?
		LDMNEFD	R13!,{R0-R4,PC}^	;Yes -- return right now

		ADR	R4,exc__handlers	;Point to old handlers block

		; --- Set up the error handler ---

		MOV	R0,#6			;Error handler number
		ADR	R1,exc__err		;Point to my handler routine
		MOV	R2,R12			;I want my workspace pointer
		MOV	R3,R11			;Use scratchpad for error
		SWI	XOS_ChangeEnvironment	;Set the handler up
		STMIA	R4!,{R1-R3}		;Save the old handler away

		; --- Set up the exit handler ---

		MOV	R0,#11			;Exit handler number
		ADR	R1,exc__exit		;Point to my handler
		MOV	R2,R12			;Give me my workspace
		SWI	XOS_ChangeEnvironment	;Set the handler up
		STMIA	R4!,{R1-R3}		;Save the old handler away

		; --- Set up the UpCall handler ---

		MOV	R0,#16			;UpCall handler number
		ADR	R1,exc__upc		;Point to my handler
		MOV	R2,R12			;Give me my workspace
		SWI	XOS_ChangeEnvironment	;Set the handler up
		STMIA	R4!,{R1-R3}		;Save the old handler away

		; --- Done ---

		LDR	R0,exc__flags		;Get my current flags
		ORR	R0,R0,#eFlag__handling	;We are now handling errors
		STR	R0,exc__flags		;Store them away again
		LDMFD	R13!,{R0-R4,PC}^	;Return to caller

		LTORG

; --- exc__killHnd ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Releases any handlers we set up.

exc__killHnd	ROUT

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

		; --- Make sure we need to do this ---

		LDR	R0,exc__flags		;Get my current flags
		TST	R0,#eFlag__handling	;Are we now handling errors?
		LDMEQFD	R13!,{R0-R4,PC}^	;No -- return right now

		ADR	R4,exc__handlers	;Point to old handlers block

		; --- Reset the error handler ---

		MOV	R0,#6			;Error handler number
		LDMIA	R4!,{R1-R3}		;Get the old handler
		SWI	XOS_ChangeEnvironment	;Set the handler up

		; --- Reset the exit handler ---

		MOV	R0,#11			;Exit handler number
		LDMIA	R4!,{R1-R3}		;Get the old handler
		SWI	XOS_ChangeEnvironment	;Set the handler up

		; --- Reset the UpCall handler ---

		MOV	R0,#16			;UpCall handler number
		LDMIA	R4!,{R1-R3}		;Get the old handler
		SWI	XOS_ChangeEnvironment	;Set the handler up

		; --- Done ---

		LDR	R0,exc__flags		;Get my current flags
		BIC	R0,R0,#eFlag__handling	;We are not handling errors
		STR	R0,exc__flags		;Store them away again
		LDMFD	R13!,{R0-R4,PC}^	;Return to caller

		LTORG

; --- exc__error ---
;
; On entry:	R0 == pointer to workspace
;
; On exit:	Doesn't, really
;
; Use:		Handles an error, and dispatches it to the right place,
;		properly handling multiple exceptions (i.e. it falls over
;		and dies).

exc__err	ROUT

		MOV	R12,R0			;Because RISC OS is weird
		LDR	R11,exc__R11		;Find the scratchpad pointer

		; --- Am I already handling an error? ---

		LDR	R0,exc__flags		;Find the flags word
		TST	R0,#eFlag__inError	;Check the flag bit
		BNE	%50exc__err		;Yes -- skip ahead

		; --- Remember that I'm handling an error ---

		ORR	R0,R0,#eFlag__inError	;Set the bit
		STR	R0,exc__flags		;And put my flags word away

		; --- Do I have an error handler? ---

		LDR	R2,exc__query		;Find the handler function
		CMP	R2,#0			;Is it defined?
		BEQ	%20exc__err		;No -- skip ahead

		; --- Locate the error buffer and dispatch the error ---

		ADD	R0,R11,#4		;Point to the error block
		STMFD	R13!,{R12}		;Save my workspace on stack
		LDR	R12,exc__qR12		;Get the workspace they want
		MOV	R14,PC			;Get a return address
		MOV	PC,R2			;Call the handler

		; --- We now have a resume routine to call ---

		LDMFD	R13!,{R12}		;Restore my workspace pointer
		LDR	R2,exc__flags		;Find the flags word
		BIC	R2,R2,#eFlag__inError	;We're leaving the handler
		STR	R2,exc__flags		;And put my flags word away
		LDR	R13,exc__stackPtr	;Get the stack pointer
		MOV	R12,R1			;Get the resumer's wSpace
		MOV	PC,R0			;And call the resumer.

		; --- No error handler registered ---

20exc__err	LDR	R13,sapph_stackBase	;We won't be coming back
		BL	exc__killHnd		;Reset all the handlers
		BL	exc__atexits		;Perform tidy-up operations
		ADD	R0,R11,#4		;Point to the error block
		SWI	OS_GenerateError	;And report error to caller

		; --- Something went catastrophically wrong ---

50exc__err	ADD	R0,R11,#4		;Point to the error block
		B	except_fatal		;And report the error

		LTORG

exc__wSpace	DCD	0			;Pointer to my workspace

; --- except_fatal ---
;
; On entry:	R0 == pointer to an error block
;
; On exit:	Doesn't
;
; Use:		Reports an error to our /caller's/ error handler.  We quit
;		and die at this point.  Don't use unless you have absolutely
;		no choice in the matter.

		EXPORT	except_fatal
except_fatal	ROUT

		WSPACE	exc__wSpace		;Find my workspace address
		LDR	R13,sapph_stackBase	;Find a good piece of stack
		BL	exc__killHnd		;Get rid of our handlers
		SWI	OS_GenerateError	;And report the error

		LTORG

; --- exc__atexits ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Calls all the registered atexit functions

exc__atexits	ROUT

		STMFD	R13!,{R1,R10-R12,R14}	;Save the registers I want
		LDR	R10,exc__exitList	;Get the list of handlers

01exc__atexits	CMP	R10,#0			;Is the list empty
		LDMEQFD	R13!,{R1,R10-R12,PC}^	;Return to call if so
		LDR	R12,[R10,#eExit__R12]	;Get the required R12
		LDR	R1,[R10,#eExit__handler] ;Get pointer to handler
		MOV	R14,PC			;Set up return address
		MOV	PC,R1			;Call atexit routine
		LDR	R10,[R10,#eExit__next]	;Get next handler
		B	%01exc__atexits

		LTORG

; --- exc__exit ---
;
; On entry:	R12 == pointer to my workspace
;
; On exit:	Doesn't
;
; Use:		Gets called by OS_Exit

exc__exit	ROUT

		; --- Find a stack somewhere ---

		LDR	R11,exc__R11		;Load scratchpad pointer
		BL	sapphire_resetStack	;Use initial stack
		BL	exc__killHnd		;Kill existing handlers
		BL	exc__atexits		;Call things on the exit list
		SWI	XOS_Exit		;Quit the application

		LTORG

; --- exc__upc ---
;
; On entry:	R12 == pointer to my workspace
;
; On exit:	Handlers are restored
;
; Use:		Upcall handler

exc__upc	ROUT

		; --- Are we interested in this UpCall? ---

		CMP	R0,#256			;Is a new app starting?
		MOVNES	PC,R14			;No -- return to caller

		; --- Stick everything on the SVC stack ---

		STMFD	R13!,{R14}		;Save the return address
		TEQP	PC,#0			;Enter USR mode to keep the
						;atexit routines happy
		MOV	R0,R0			;Keep ARM happy too
		LDR	R11,exc__R11		;Load scratchpad pointer
		BL	sapphire_resetStack	;Use initial stack
		BL	exc__killHnd		;Restore the handlers
		BL	exc__atexits		;Close everything down now
		SWI	OS_EnterOS		;Go back to SVC mode
		LDMFD	R13!,{PC}^		;Return and be killed :-)

		LTORG

; --- except_atExit ---
;
; On entry:	R0 == pointer to routine to call on exit
;		R1 == R12 value to call with
;
; On exit:	--
;
; Use:		Registers a routine to get called when the application quits.
;		Later-registered routines are called earlier than earlier-
;		registered routines, so everything closes down in a nice
;		manner.

		EXPORT	except_atExit
except_atExit	ROUT

		STMFD	R13!,{R0-R3,R12,R14}	;Save everything on stack
		WSPACE	exc__wSpace		;Find my workspace
		BL	exc__setHnd		;Set up my handlers

		; --- Create the list item ---

		MOV	R0,#eExit__size		;Size of the block to get
		BL	sub_alloc		;Allocate the memory
		SWIVS	OS_GenerateError	;Barf if it failed
		MOV	R2,R0			;Move to a nicer register

		; --- Fill it in and link it to the list ---

		LDR	R0,exc__exitList	;Get the current list head
		STR	R0,[R2,#eExit__next]	;Store this in the link
		LDMIA	R13!,{R0,R1}		;Get the stuff from the stack
		STMIB	R2,{R0,R1}		;Store them in the block
		STR	R2,exc__exitList	;This is the new list head

		; --- Done ---

		LDMFD	R13!,{R2,R3,R12,PC}^	;Return to caller

		LTORG

; --- except_returnPt ---
;
; On entry:	R0 == pointer to exception handler routine
;		R1 == R12 value to enter routine with
;		R2 == R13 value to enter routine with
;
; On exit:	--
;
; Use:		Sets up a routine to be called whenever there's an error.
;		The idea is that it should ask the user whether to quit,
;		and if not, resume to some known (safe?) state.
;
; 		The routine is called with R0 == pointer to error block, and
;		R12 and R13 being the values set up here(*).  It should
;		return with R0 == pointer to a routine to resume at, and R1
;		being the value to pass to the resume routine in R12.  If
;		you decide to quit, just call OS_Exit -- this should tidy
;		everything up.
;
;		Note that the error is held in the scratchpad buffer, so
;		you can't use the first 256 bytes of that until you've
;		finished with the error message.
;
;		(*) Actually, R13 is 4 bytes lower because it's assumed that
;		it points to a full descending stack that we can use.  This
;		shouldn't make any difference as long as you're using R13
;		as a full descending stack pointer.

		EXPORT	except_returnPt
except_returnPt	ROUT

		STMFD	R13!,{R12,R14}		;Save some registers
		WSPACE	exc__wSpace		;Get my workspace pointer
		BL	exc__setHnd		;Set up all the handlers
		ADR	R14,exc__query		;Point to my stack variable
		STMIA	R14,{R0-R2}		;Store the handler away
		LDMFD	R13!,{R12,PC}^		;Return to caller

		LTORG

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

		^	0,R12
exc__wStart	#	0

exc__flags	#	4			;Error handling flags
exc__handlers	#	36			;Old handlers information
exc__query	#	4			;Pointer to query routine
exc__qR12	#	4			;R12 for query routine
exc__stackPtr	#	4			;Stack pointer for handling
exc__exitList	#	4			;The list of exit routines
exc__R11	#	4			;Sapphire's R11 magic pointer

exc__wSize	EQU	{VAR}-exc__wStart	;My workspace size

eFlag__inited	EQU	(1<<0)			;Are we initialised?
eFlag__inError	EQU	(1<<1)			;Currently in error handler
eFlag__handling	EQU	(1<<2)			;We have handlers set up

; --- Exit routine block format ---

		^	0
eExit__next	#	4			;Address of next block
eExit__handler	#	4			;Address of routine to call
eExit__R12	#	4			;R12 to call handler with
eExit__size	#	0			;Size of the block

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	exc__wSize
		DCD	exc__wSpace
		DCD	256
		DCD	except_init

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

		END