src/catch-throw.4th

   1 \ Exception handling
   2
   3 variable handler
   4 0 handler !
   5
   6 : catch ( cfa -- exception# | 0 )
   7     psp@ >R
   8     handler @ >R
   9     rsp@ handler !
  10     execute
  11     R> handler !
  12     R> drop
  13     0
  14 ;
  15
  16 : throw ( ... exception# -- ... exception# )
  17     ?dup 0= if exit then
  18
  19     handler @ ?dup 0= if
  20         ." Aborting: Uncaught exception " . ." ." cr
  21         abort
  22     then
  23
  24     rsp!
  25     R> handler !
  26
  27     R> swap >R
  28     psp! drop R>
  29 ;