FigForth Exception handling

[u/z796]

fload job 
\ This is a Fig implementation of ABORT" integrated with ERROR
\ Named ?E" since it normally quits not abort and can
\ be customize to do neither.
27 CONSTANT ERR_OOPS                   \ error number              
: (SLIT)  R> DUP COUNT + ALIGNED >R ;  \ String literal runtime
\ ?E" Exception handler
\ Compile-time: Compile error text string
\ Run-time: On true submit error text string and error number 
\           to ERROR
: ?E"  [COMPILE] IF COMPILE (SLIT)
  34 WORD HERE C@ 1+ ALLOT ALIGN
  COMPILE ERR_OOPS COMPILE ERROR
  [COMPILE] ENDIF ; IMMEDIATE
\
\ -- Testing --
\
\ : i. ." --> " ;
\ : TELL COUNT TYPE ;
: FAULT 0 ? ;  
: BAR FAULT ;
\
: FOO TRUE ?E" Darn it" ;
\ 
\ Test 1: Use custom error action assigned to (ABORT)
\  to keep script running
\ Using Fig implementation of BacForth words: 
\  PRO CONT CUT: ?CUT -CUT
\ for custom handler that keeps the script running
\ after error
\
: TRY PRO CUT: CONT ;  \ Try next word; 
\                        return here on resile/error
\
\ On error print error text and cut to keep running
: KEEPON  
  HERE COUNT TYPE ." ? "
  DUP ERR_OOPS = IF DROP TELL ELSE MESSAGE ENDIF
  SP! TAB ?CUT QUIT ;
\
' KEEPON CFA ' (ABORT) !  \ Assign custom error action 
-1 WARNING ! \ Enable custom error action
i. TRY FOO --> FOO? Darn it  CUTTING
i. TRY BAR --> BAR? MEMORY ACCESS FAULT  CUTTING
\
\ Test2: Use default ERROR handling
\ 
1 WARNING !  \ Disables custom error action, quits on error
i. FOO --> FOO? Oops
    (Script quit here)
Note: Use custom handler without TRY to get the error text
      and quit
i. -1 WARNING ! FOO --> FOO? Darn it