urflibs/exceptions.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; THROW and CATCH
   8 ;; note that you cannot CATCH system errors (produced with "ERROR")
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11
  12 ;; reset all exception frames
  13 : (exc0!)  ( -- )  ... (exc-frame-ptr) 0! ; (hidden)
  14
  15 ;; this should save all necessary data to the return stack
  16 ;; the format is: ( ...data restorecfa )
  17 ;;   restorecfa:  ( restoreflag -- )
  18 ;;   if "restoreflag" is 0, drop the data
  19 : (catch-saver)  ( -- )  ... ; (hidden)
  20
  21
  22 : CATCH  ( i * x xt -- j * x 0 | i * x n )
  23   ;; this is using return stack to hold previous catch frame
  24   ;; of course, this prevents Very Smart return stack manipulation, but idc (for now)
  25   ;; exception frame consists of:
  26   ;;   return-to-catch EIP (return stack TOS)
  27   ;;   sp (frame points here)
  28   ;;   prev_self
  29   ;;   prev_lp
  30   ;;   prev_lbp
  31   ;;   prev_a
  32   ;;   prev
  33   ;;   return-to-catch-caller EIP
  34   ;; create exception frame
  35   (exc-frame-ptr) @ >r
  36   ;; our local data
  37   (self@) >r             ;; self
  38   0 mtask:state-lp@ >r   ;; lp
  39   0 mtask:state-lbp@ >r  ;; lbp
  40   a>r                    ;; a
  41   ;; section to save various custom data
  42   0x8bad_c0de >r (catch-saver)
  43   ;; custom data section end
  44   sp@ >r                 ;; sp
  45   rp@ (exc-frame-ptr) !  ;; update exception frame pointer
  46   execute  ;; and execute
  47   ;; we will return here only if no exception was thrown
  48   rdrop begin r> 0x8bad_c0de <> while false swap execute repeat
  49   rdrop rdrop rdrop rdrop  ;; drop our saved local data
  50   r> (exc-frame-ptr) !     ;; restore previous exception frame
  51   0  ;; exception code (none)
  52 ;
  53
  54
  55 : THROW  ( k * x n -- k * x | i * x n )
  56   ?dup if
  57     ;; check if we have exception frame set
  58     (exc-frame-ptr) @ ?dup ifnot
  59       ;; panic!
  60       (exc0!)
  61       compiler:exec!  ;; just in case
  62       \ fatal-error  ;; err-throw-without-catch (error)
  63       " throw without catch" fatal-error
  64       \ 1 n-bye ;; just in case
  65     endif
  66     ;; check if return stack is not exhausted
  67     ;; note that UrForth/C stacks grow from 0 to higher numbers!
  68     rp@ over u<= if
  69       ;; panic!
  70       (exc0!)
  71       compiler:exec!  ;; just in case
  72       \ err-throw-chain-corrupted fatal-error
  73       " throw chain corrupted" fatal-error
  74       \ 1 n-bye ;; just in case
  75     endif
  76     rp!  ;; restore return stack
  77     r> swap >r  ;; exchange return stack top and data stack top (save exception code, and pop sp to data stack)
  78     ;; blindly restore data stack (let's hope it is not too badly trashed)
  79     sp! drop  ;; drop the thing that was CFA
  80     r>  ;; restore exception code
  81     ;; restore custom data
  82     begin r> 0x8bad_c0de <> while true swap execute repeat
  83     ;; restore our custom data
  84     r>a
  85     r> 0 mtask:state-lbp!
  86     r> 0 mtask:state-lp!
  87     r> (self!)
  88     ;; restore previous exception frame
  89     r> (exc-frame-ptr) !
  90     ;; now EXIT will return to CATCH caller
  91   endif
  92 ;