level0/urforth0_w_exceptions.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 urword_var "(EXC-FRAME-PTR)",par_exc_frame_ptr,0
  20 urword_hidden
  21
  22
  23 urword_forth "CATCH",catch
  24 ;; ( i * x xt -- j * x 0 | i * x n )
  25   ;; this is using return stack to hold previous catch frame
  26   ;; of course, this prevents Very Smart return stack manipulation, but idc (for now)
  27   ;; exception frame consists of:
  28   ;;   return-to-catch EIP (return stack TOS)
  29   ;;   sp (frame points here)
  30   ;;   prev_frame_ptr
  31   ;;   return-to-catch-caller EIP
  32   ;; create exception frame
  33   UF par_exc_frame_ptr @ rpush
  34   UF spget rpush
  35     ;; UF spget cellinc endcr dothex8 cr dotstack
  36   UF rpget par_exc_frame_ptr !  ;; update exception frame pointer
  37   UF execute  ;; and execute
  38   ;; we will return here only if no exception was thrown
  39   UF rdrop    ;; drop spdepth
  40   UF rpop par_exc_frame_ptr !   ;; restore previous exception frame
  41   UF 0        ;; exception code (none)
  42 urword_end
  43
  44
  45 urword_forth "THROW",throw
  46 ;; ( k * x n -- k * x | i * x n )
  47   UF qdup
  48   ur_if
  49       ;; UF spget endcr dothex8 cr dotstack
  50     ;; check if we have exception frame set
  51     UF par_exc_frame_ptr @ qdup
  52     ur_ifnot
  53       ;; panic!
  54       UF par_exc_frame_ptr 0poke
  55       UF state 0poke  ;; just in case
  56       UF errid_throw_without_catch par_error
  57       UF 1 nbye ;; just in case
  58     ur_endif
  59     ;; check if return stack is not exhausted
  60     UF rpget celldec over ugreat
  61     ur_if
  62       ;; panic!
  63       UF par_exc_frame_ptr 0poke
  64       UF state 0poke  ;; just in case
  65       UF errid_throw_chain_corrupted par_error
  66       UF 1 nbye ;; just in case
  67     ur_endif
  68     ;; restore return stack
  69     UF rpset
  70     ;; exchange return stack top and data stack top (save exception code, and pop sp to data stack)
  71     UF rpop swap rpush
  72     ;; blindly restore data stack (let's hope it is not too badly trashed)
  73     UF spset drop  ;; drop the thing that was CFA
  74       ;; UF spget endcr dothex8 space rpeek dothex8 cr
  75     ;; restore exception code
  76     UF rpop
  77     ;; restore previous exception frame
  78     UF rpop par_exc_frame_ptr !
  79     ;; now EXIT will return to CATCH caller
  80   ur_endif
  81 urword_end