~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / Sapphire / s / except
1 ;
2 ; except.s
3 ;
4 ; Sapphire exception handling (MDW)
5 ;
6 ; © 1994-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's Sapphire library.
12 ;
13 ; Sapphire is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; Sapphire is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with Sapphire. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard header ------------------------------------------------------
28
29 GET libs:header
30 GET libs:swis
31
32 ;----- External dependencies ------------------------------------------------
33
34 GET sapphire:sapphire
35 GET sapphire:suballoc
36
37 ;----- Main code ------------------------------------------------------------
38
39 AREA |Sapphire$$Code|,CODE,READONLY
40
41 ; --- except_init ---
42 ;
43 ; On entry: --
44 ;
45 ; On exit: --
46 ;
47 ; Use: Initialises the exception handler.
48
49 EXPORT except_init
50 except_init ROUT
51
52 STMFD R13!,{R0,R12,R14} ;Stash registers away
53 WSPACE exc__wSpace ;Point to my workspace
54
55 ; --- Make sure I'm not already going ---
56
57 LDR R0,exc__flags ;Find the flags word
58 TST R0,#eFlag__inited ;Am I going yet?
59 LDMNEFD R13!,{R0,R12,PC}^ ;Yes -- return right now
60
61 ; --- Start up suballocation for exit list ---
62
63 BL sub_init ;Make sure suballoc's going
64
65 ; --- Fill in the flags and exit list ---
66
67 MOV R0,#eFlag__inited ;Set the initialised flag
68 STR R0,exc__flags ;Store it away nicely
69
70 MOV R0,#0
71 STR R0,exc__exitList ;No atexit routines yet
72 STR R0,exc__query ;No error handler either
73 STR R11,exc__R11 ;Save R11 pointer
74
75 LDMFD R13!,{R0,R12,PC}^ ;Return to caller
76
77 LTORG
78
79 ; --- exc__setHnd ---
80 ;
81 ; On entry: --
82 ;
83 ; On exit: --
84 ;
85 ; Use: Sets up the OS handlers so we get called when strange things
86 ; happen.
87
88 exc__setHnd ROUT
89
90 STMFD R13!,{R0-R4,R14} ;Save registers
91
92 ; --- Make sure we need to do this ---
93
94 LDR R0,exc__flags ;Get my current flags
95 TST R0,#eFlag__handling ;Are we now handling errors?
96 LDMNEFD R13!,{R0-R4,PC}^ ;Yes -- return right now
97
98 ADR R4,exc__handlers ;Point to old handlers block
99
100 ; --- Set up the error handler ---
101
102 MOV R0,#6 ;Error handler number
103 ADR R1,exc__err ;Point to my handler routine
104 MOV R2,R12 ;I want my workspace pointer
105 MOV R3,R11 ;Use scratchpad for error
106 SWI XOS_ChangeEnvironment ;Set the handler up
107 STMIA R4!,{R1-R3} ;Save the old handler away
108
109 ; --- Set up the exit handler ---
110
111 MOV R0,#11 ;Exit handler number
112 ADR R1,exc__exit ;Point to my handler
113 MOV R2,R12 ;Give me my workspace
114 SWI XOS_ChangeEnvironment ;Set the handler up
115 STMIA R4!,{R1-R3} ;Save the old handler away
116
117 ; --- Set up the UpCall handler ---
118
119 MOV R0,#16 ;UpCall handler number
120 ADR R1,exc__upc ;Point to my handler
121 MOV R2,R12 ;Give me my workspace
122 SWI XOS_ChangeEnvironment ;Set the handler up
123 STMIA R4!,{R1-R3} ;Save the old handler away
124
125 ; --- Done ---
126
127 LDR R0,exc__flags ;Get my current flags
128 ORR R0,R0,#eFlag__handling ;We are now handling errors
129 STR R0,exc__flags ;Store them away again
130 LDMFD R13!,{R0-R4,PC}^ ;Return to caller
131
132 LTORG
133
134 ; --- exc__killHnd ---
135 ;
136 ; On entry: --
137 ;
138 ; On exit: --
139 ;
140 ; Use: Releases any handlers we set up.
141
142 exc__killHnd ROUT
143
144 STMFD R13!,{R0-R4,R14} ;Save registers
145
146 ; --- Make sure we need to do this ---
147
148 LDR R0,exc__flags ;Get my current flags
149 TST R0,#eFlag__handling ;Are we now handling errors?
150 LDMEQFD R13!,{R0-R4,PC}^ ;No -- return right now
151
152 ADR R4,exc__handlers ;Point to old handlers block
153
154 ; --- Reset the error handler ---
155
156 MOV R0,#6 ;Error handler number
157 LDMIA R4!,{R1-R3} ;Get the old handler
158 SWI XOS_ChangeEnvironment ;Set the handler up
159
160 ; --- Reset the exit handler ---
161
162 MOV R0,#11 ;Exit handler number
163 LDMIA R4!,{R1-R3} ;Get the old handler
164 SWI XOS_ChangeEnvironment ;Set the handler up
165
166 ; --- Reset the UpCall handler ---
167
168 MOV R0,#16 ;UpCall handler number
169 LDMIA R4!,{R1-R3} ;Get the old handler
170 SWI XOS_ChangeEnvironment ;Set the handler up
171
172 ; --- Done ---
173
174 LDR R0,exc__flags ;Get my current flags
175 BIC R0,R0,#eFlag__handling ;We are not handling errors
176 STR R0,exc__flags ;Store them away again
177 LDMFD R13!,{R0-R4,PC}^ ;Return to caller
178
179 LTORG
180
181 ; --- exc__error ---
182 ;
183 ; On entry: R0 == pointer to workspace
184 ;
185 ; On exit: Doesn't, really
186 ;
187 ; Use: Handles an error, and dispatches it to the right place,
188 ; properly handling multiple exceptions (i.e. it falls over
189 ; and dies).
190
191 exc__err ROUT
192
193 MOV R12,R0 ;Because RISC OS is weird
194 LDR R11,exc__R11 ;Find the scratchpad pointer
195
196 ; --- Am I already handling an error? ---
197
198 LDR R0,exc__flags ;Find the flags word
199 TST R0,#eFlag__inError ;Check the flag bit
200 BNE %50exc__err ;Yes -- skip ahead
201
202 ; --- Remember that I'm handling an error ---
203
204 ORR R0,R0,#eFlag__inError ;Set the bit
205 STR R0,exc__flags ;And put my flags word away
206
207 ; --- Do I have an error handler? ---
208
209 LDR R2,exc__query ;Find the handler function
210 CMP R2,#0 ;Is it defined?
211 BEQ %20exc__err ;No -- skip ahead
212
213 ; --- Locate the error buffer and dispatch the error ---
214
215 ADD R0,R11,#4 ;Point to the error block
216 STMFD R13!,{R12} ;Save my workspace on stack
217 LDR R12,exc__qR12 ;Get the workspace they want
218 MOV R14,PC ;Get a return address
219 MOV PC,R2 ;Call the handler
220
221 ; --- We now have a resume routine to call ---
222
223 LDMFD R13!,{R12} ;Restore my workspace pointer
224 LDR R2,exc__flags ;Find the flags word
225 BIC R2,R2,#eFlag__inError ;We're leaving the handler
226 STR R2,exc__flags ;And put my flags word away
227 LDR R13,exc__stackPtr ;Get the stack pointer
228 MOV R12,R1 ;Get the resumer's wSpace
229 MOV PC,R0 ;And call the resumer.
230
231 ; --- No error handler registered ---
232
233 20exc__err LDR R13,sapph_stackBase ;We won't be coming back
234 BL exc__killHnd ;Reset all the handlers
235 BL exc__atexits ;Perform tidy-up operations
236 ADD R0,R11,#4 ;Point to the error block
237 SWI OS_GenerateError ;And report error to caller
238
239 ; --- Something went catastrophically wrong ---
240
241 50exc__err ADD R0,R11,#4 ;Point to the error block
242 B except_fatal ;And report the error
243
244 LTORG
245
246 exc__wSpace DCD 0 ;Pointer to my workspace
247
248 ; --- except_fatal ---
249 ;
250 ; On entry: R0 == pointer to an error block
251 ;
252 ; On exit: Doesn't
253 ;
254 ; Use: Reports an error to our /caller's/ error handler. We quit
255 ; and die at this point. Don't use unless you have absolutely
256 ; no choice in the matter.
257
258 EXPORT except_fatal
259 except_fatal ROUT
260
261 WSPACE exc__wSpace ;Find my workspace address
262 LDR R13,sapph_stackBase ;Find a good piece of stack
263 BL exc__killHnd ;Get rid of our handlers
264 SWI OS_GenerateError ;And report the error
265
266 LTORG
267
268 ; --- exc__atexits ---
269 ;
270 ; On entry: --
271 ;
272 ; On exit: --
273 ;
274 ; Use: Calls all the registered atexit functions
275
276 exc__atexits ROUT
277
278 STMFD R13!,{R1,R10-R12,R14} ;Save the registers I want
279 LDR R10,exc__exitList ;Get the list of handlers
280
281 01exc__atexits CMP R10,#0 ;Is the list empty
282 LDMEQFD R13!,{R1,R10-R12,PC}^ ;Return to call if so
283 LDR R12,[R10,#eExit__R12] ;Get the required R12
284 LDR R1,[R10,#eExit__handler] ;Get pointer to handler
285 MOV R14,PC ;Set up return address
286 MOV PC,R1 ;Call atexit routine
287 LDR R10,[R10,#eExit__next] ;Get next handler
288 B %01exc__atexits
289
290 LTORG
291
292 ; --- exc__exit ---
293 ;
294 ; On entry: R12 == pointer to my workspace
295 ;
296 ; On exit: Doesn't
297 ;
298 ; Use: Gets called by OS_Exit
299
300 exc__exit ROUT
301
302 ; --- Find a stack somewhere ---
303
304 LDR R11,exc__R11 ;Load scratchpad pointer
305 BL sapphire_resetStack ;Use initial stack
306 BL exc__killHnd ;Kill existing handlers
307 BL exc__atexits ;Call things on the exit list
308 SWI XOS_Exit ;Quit the application
309
310 LTORG
311
312 ; --- exc__upc ---
313 ;
314 ; On entry: R12 == pointer to my workspace
315 ;
316 ; On exit: Handlers are restored
317 ;
318 ; Use: Upcall handler
319
320 exc__upc ROUT
321
322 ; --- Are we interested in this UpCall? ---
323
324 CMP R0,#256 ;Is a new app starting?
325 MOVNES PC,R14 ;No -- return to caller
326
327 ; --- Stick everything on the SVC stack ---
328
329 STMFD R13!,{R14} ;Save the return address
330 TEQP PC,#0 ;Enter USR mode to keep the
331 ;atexit routines happy
332 MOV R0,R0 ;Keep ARM happy too
333 LDR R11,exc__R11 ;Load scratchpad pointer
334 BL sapphire_resetStack ;Use initial stack
335 BL exc__killHnd ;Restore the handlers
336 BL exc__atexits ;Close everything down now
337 SWI OS_EnterOS ;Go back to SVC mode
338 LDMFD R13!,{PC}^ ;Return and be killed :-)
339
340 LTORG
341
342 ; --- except_atExit ---
343 ;
344 ; On entry: R0 == pointer to routine to call on exit
345 ; R1 == R12 value to call with
346 ;
347 ; On exit: --
348 ;
349 ; Use: Registers a routine to get called when the application quits.
350 ; Later-registered routines are called earlier than earlier-
351 ; registered routines, so everything closes down in a nice
352 ; manner.
353
354 EXPORT except_atExit
355 except_atExit ROUT
356
357 STMFD R13!,{R0-R3,R12,R14} ;Save everything on stack
358 WSPACE exc__wSpace ;Find my workspace
359 BL exc__setHnd ;Set up my handlers
360
361 ; --- Create the list item ---
362
363 MOV R0,#eExit__size ;Size of the block to get
364 BL sub_alloc ;Allocate the memory
365 SWIVS OS_GenerateError ;Barf if it failed
366 MOV R2,R0 ;Move to a nicer register
367
368 ; --- Fill it in and link it to the list ---
369
370 LDR R0,exc__exitList ;Get the current list head
371 STR R0,[R2,#eExit__next] ;Store this in the link
372 LDMIA R13!,{R0,R1} ;Get the stuff from the stack
373 STMIB R2,{R0,R1} ;Store them in the block
374 STR R2,exc__exitList ;This is the new list head
375
376 ; --- Done ---
377
378 LDMFD R13!,{R2,R3,R12,PC}^ ;Return to caller
379
380 LTORG
381
382 ; --- except_returnPt ---
383 ;
384 ; On entry: R0 == pointer to exception handler routine
385 ; R1 == R12 value to enter routine with
386 ; R2 == R13 value to enter routine with
387 ;
388 ; On exit: --
389 ;
390 ; Use: Sets up a routine to be called whenever there's an error.
391 ; The idea is that it should ask the user whether to quit,
392 ; and if not, resume to some known (safe?) state.
393 ;
394 ; The routine is called with R0 == pointer to error block, and
395 ; R12 and R13 being the values set up here(*). It should
396 ; return with R0 == pointer to a routine to resume at, and R1
397 ; being the value to pass to the resume routine in R12. If
398 ; you decide to quit, just call OS_Exit -- this should tidy
399 ; everything up.
400 ;
401 ; Note that the error is held in the scratchpad buffer, so
402 ; you can't use the first 256 bytes of that until you've
403 ; finished with the error message.
404 ;
405 ; (*) Actually, R13 is 4 bytes lower because it's assumed that
406 ; it points to a full descending stack that we can use. This
407 ; shouldn't make any difference as long as you're using R13
408 ; as a full descending stack pointer.
409
410 EXPORT except_returnPt
411 except_returnPt ROUT
412
413 STMFD R13!,{R12,R14} ;Save some registers
414 WSPACE exc__wSpace ;Get my workspace pointer
415 BL exc__setHnd ;Set up all the handlers
416 ADR R14,exc__query ;Point to my stack variable
417 STMIA R14,{R0-R2} ;Store the handler away
418 LDMFD R13!,{R12,PC}^ ;Return to caller
419
420 LTORG
421
422 ;----- Workspace ------------------------------------------------------------
423
424 ^ 0,R12
425 exc__wStart # 0
426
427 exc__flags # 4 ;Error handling flags
428 exc__handlers # 36 ;Old handlers information
429 exc__query # 4 ;Pointer to query routine
430 exc__qR12 # 4 ;R12 for query routine
431 exc__stackPtr # 4 ;Stack pointer for handling
432 exc__exitList # 4 ;The list of exit routines
433 exc__R11 # 4 ;Sapphire's R11 magic pointer
434
435 exc__wSize EQU {VAR}-exc__wStart ;My workspace size
436
437 eFlag__inited EQU (1<<0) ;Are we initialised?
438 eFlag__inError EQU (1<<1) ;Currently in error handler
439 eFlag__handling EQU (1<<2) ;We have handlers set up
440
441 ; --- Exit routine block format ---
442
443 ^ 0
444 eExit__next # 4 ;Address of next block
445 eExit__handler # 4 ;Address of routine to call
446 eExit__R12 # 4 ;R12 to call handler with
447 eExit__size # 0 ;Size of the block
448
449 AREA |Sapphire$$LibData|,CODE,READONLY
450
451 DCD exc__wSize
452 DCD exc__wSpace
453 DCD 256
454 DCD except_init
455
456 ;----- That's all, folks ----------------------------------------------------
457
458 END
The Straylight Source Distribution (obsolete software for RISC OS)