chiark - git - mdw - ssr/blob - 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