;
; seh.s
;
; Structured Exception Handling, the Sapphire way
;
;  1995-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 ------------------------------------------------

		GET	sapphire:except
		GET	sapphire:msgs
		GET	sapphire:sapphire

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

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- seh_try ---
;
; On entry:	R0 == pointer to catch definition block
;
; On exit:	R13 dropped by a (small) amount
;
; Use:		Inserts an exception handler at the current position.
;		Exceptions are matched against those described in the catch
;		block.  If there is a handler for the exception, the
;		corresponding handler is called, and expected to resume
;		normally.  Otherwise the tidy-up routine is called and we
;		unwind the stack further to find an appropriate handler.
;
;		The catch block has the following format:
;
;		word	B to tidy-up routine
;		word	1st exception mask
;		word	1st B to catch routine
;		word	2nd exception mask
;		word	2nd B to catch routine
;		...
;		word	0
;
;		An exception mask contains two halfwords.  Bits 16-31 are the
;		class to match, or -1 for all classes.  Bits 0-15 are the
;		subtype to match, or -1 for all subtypes.  You can do really
;		odd things if you set bits 16-31 to -1 and leave 0-15
;		matching specific subtypes -- do this at your own risk.

		EXPORT	seh_try
seh_try		ROUT

		SUB	R13,R13,#16		;Leave space for our record
		STMFD	R13!,{R0,R12,R14}	;Save some registers

		; --- Save caller's R10 and R12 ---

		ADD	R14,R13,#16		;Point to area in frame
		STMIA	R14,{R0,R10,R12}	;Save the registers away

		; --- Now fiddle with the try list ---

		WSPACE	seh__wSpace		;Find my workspace
		LDR	R14,seh__currList	;Find the current list
		LDR	R0,[R14,#0]		;Load the current value
		STR	R0,[R13,#12]		;Save that away nicely
		ADD	R0,R13,#12		;Point to the frame we made
		STR	R0,[R14,#0]		;This is the new list head
		LDMFD	R13!,{R0,R12,PC}^	;And return to caller

		LTORG

; --- seh_unTry ---
;
; On entry:	--
;
; On exit:	R13 moved to position before corresponding seh_try
;
; Use:		Removes the try block marker in the stack at the current
;		position.  Note that the stack will be unwound to where it
;		was when seh_try was called.

		EXPORT	seh_unTry
seh_unTry	ROUT

		STMFD	R13!,{R0,R1,R12,R14}	;Save some registers
		MOV	R1,R13			;Remember this stack frame
		WSPACE	seh__wSpace		;Find my workspace
		LDR	R14,seh__currList	;Find the current list
		LDR	R13,[R14,#0]		;Load the unwound stack ptr
		LDR	R0,[R13],#16		;Load the old list position
		STR	R0,[R14,#0]		;Store this away nicely
		LDMIA	R1,{R0,R1,R12,PC}^	;And return to caller

		LTORG

; --- seh_throw ---
;
; On entry:	R0 == exception to match
;		R1-R3 == useful bits of information
;
; On exit:	Doesn't return, unless you've done something /really/ odd
;
; Use:		Throws an exception.  The stack is unwound until we find
;		a handler which can cope.  If there is no handler, we abort
;		the program.

		EXPORT	seh_throw
seh_throw	ROUT

		WSPACE	seh__wSpace		;Find my workspace
		LDR	R9,seh__currList	;Find the current list

		; --- Now go through the list ---

05		LDR	R13,[R9,#0]		;Get the top try block
		CMP	R13,#0			;Have we run out of trys?
		BEQ	%90seh_throw		;Yes -- oh deary me
		LDR	R14,[R13],#4		;Load the previous pointer
		STR	R14,[R9,#0]		;And store it away
		LDMIA	R13!,{R8,R10,R12}	;Load useful things out

		; --- Now find a matching catch ---

		MOV	R14,#&00FF		;Build &FFFF
		ORR	R14,R14,#&FF00		;Because it's useful

		ADD	R7,R8,#4		;Skip past tidy-up routine
01		LDR	R6,[R7],#8		;Load the exception mask
		CMP	R6,#0			;Have we finished here?
		BEQ	%10seh_throw		;Yes -- deal with this then
		MOV	R5,R6,LSL #16		;Isolate the bottom half
		CMP	R5,R14,LSL #16		;Is it a wildcard?
		CMPNE	R5,R0,LSL #16		;Or does it match?
		BNE	%b01			;No -- move on then
		MOV	R5,R6,LSR #16		;Isolate the top half
		CMP	R5,R14			;Is it a wildcard?
		CMPNE	R5,R0,LSR #16		;Or does it match?
		BNE	%b01			;No -- move on then

		SUB	PC,R7,#4		;Go and do the exception

10seh_throw	MOV	R14,PC			;Set up return address
		MOV	PC,R8			;So call tidy-up code
		B	%b05			;And try another block

		; --- No catch blocks found ---
		;
		; Oh dear.  Things go very badly now.

90seh_throw	MOV	R2,R0			;Get the exception type
		LDR	R13,sapph_stackBase	;Find a stack somewhere
		ADR	R0,seh__noHandler	;Point to the error block
		BL	msgs_error		;Translate it nicely
		B	except_fatal		;Report a fatal error

seh__noHandler	DCD	1
		DCB	"sehNOHND",0

		LTORG

; --- seh_throwErrors ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Sets up an except-style error handler to throw errors
;		as SEH exceptions.

		EXPORT	seh_throwErrors
seh_throwErrors	ROUT

		STMFD	R13!,{R0-R2,R14}	;Save some registers
		ADR	R0,seh__handler		;Point to the handler
		MOV	R1,#0			;Don't care about R12
		MOV	R2,#0			;Don't even care about R13
		BL	except_returnPt		;Register that nicely
		LDMFD	R13!,{R0-R2,PC}^	;And return to caller

seh__handler	ADD	R0,PC,#0		;Point to `resume point'
		MOVS	PC,R14			;And return to except

		ADD	R1,R11,#4		;Point to error message
		MOV	R0,#&00010000		;Exception number for error
		B	seh_throw		;Throw it to the handler

		LTORG

; --- seh_setListBase ---
;
; On entry:	R0 == pointer to try block list base, or 0 to use global
;
; On exit:	--
;
; Use:		Sets the try block list base.  This should only be used by
;		coroutine providers, like coRoutine and thread.

		EXPORT	seh_setListBase
seh_setListBase	ROUT

		STMFD	R13!,{R12,R14}		;Save some registers
		WSPACE	seh__wSpace		;Find my workspace
		MOVS	R14,R0			;Get the value to save
		ADREQ	R14,seh__tryList	;If zero, use our pointer
		STR	R14,seh__currList	;Store away in the block
		LDMFD	R13!,{R12,PC}^		;And return to caller

		LTORG

; --- seh_init ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Initialises SEH's facilities.

		EXPORT	seh_init
seh_init	ROUT

		STMFD	R13!,{R12,R14}		;Save some registers
		WSPACE	seh__wSpace		;Find my workspace
		ADR	R14,seh__tryList	;Find the global list
		STR	R14,seh__currList	;This is the current one
		LDMFD	R13!,{R12,PC}^		;And return to caller

		LTORG

seh__wSpace	DCD	0

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

		^	0,R12
seh__wStart	#	0

seh__tryList	#	4			;The global try list head
seh__currList	#	4			;Address of current list

seh__wSize	EQU	{VAR}-seh__wStart

		AREA	|Sapphire$$LibData|,CODE,READONLY

		DCD	seh__wSize
		DCD	seh__wSpace
		DCD	0
		DCD	seh_init

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

		END
