Exception handling in DX-Forth

\ return to OS with exit code
: RETURN ( code -- ) ... ;

\ perform ANS QUIT
: (quit) ( -- )  r0 @ rp! reset normal /interpret
  begin cr (refill) drop interpret state? 0= if (vstat)
  @execute then again ;

\ exit to OS or back to forth
: ?return ( code -- )  turnkey? if return then drop (quit) ;

\ clear data stacks
: (abort) ( i*x -- )  s0 @ sp!  fs0 @ fsp !  1 ?return ;

: error ( n -- )  \ part of THROW
  -1 of (abort) then
  -2 of boot cell+ @ 0= if .error then
     space errmsg 2@ type (abort) then
  -56 of 1 ?return then
  ."  THROW #" @base decimal swap . !base (abort) ;

: QUIT ( -- )  0 ?return ;  \ QUIT not trapped

: QUIT  -56 throw ;  \ QUIT trapped

: ?ABORT ( flag c-addr u -- )
  rot if errmsg 2! -2 throw then 2drop ;

: (abort") ( flag -- )  r> count 2dup + >r ?abort ;

: ABORT"  state @ if postpone (abort") ," end
  postpone s" ?abort ; immediate

: ABORT  -1 throw ;

: THROW ( n -- )
  ?dup if catcher @ ?dup 0= if error then rp!
  r> catcher ! 2r> fsp ! swap >r sp! drop r>  then ;

: CATCH ( xt -- n | 0 )
  sp@ fsp @ 2>r catcher @ >r rp@ catcher !
  execute 0 r> catcher ! 2r> 2drop ;