; ; 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