1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
\ @(#) catch.fth 98/01/26 1.2
\ Catch and Throw support
\
\ Lifted from X3J14 dpANS-6 document.
anew task-catch.fth
variable CATCH-HANDLER
0 catch-handler !
: CATCH ( xt -- exception# | 0 )
sp@ >r ( xt ) \ save data stack pointer
catch-handler @ >r ( xt ) \ save previous handler
rp@ catch-handler ! ( xt ) \ set current handler
execute ( ) \ execute returns if no throw
r> catch-handler ! ( ) \ restore previous handler
r> drop ( ) \ discard saved stack pointer
0 ( ) \ normal completion
;
: THROW ( ???? exception# -- ???? exception# )
?dup ( exc# ) \ 0 THROW is a no-op
IF
catch-handler @
dup 0=
IF
." THROW has noone to catch!" cr
quit
THEN
rp! ( exc# ) \ restore prev return stack
r> catch-handler ! ( exc# ) \ restore prev handler
r> swap >r ( saved-sp ) \ exc# on return stack
sp! drop r> ( exc# ) \ restore stack
THEN
\ return to caller of catch
;
: (ABORT) ERR_ABORT throw ;
defer old.abort
what's abort is old.abort
' (abort) is abort
: restore.abort what's old.abort is abort ;
if.forgotten restore.abort
hex
: BAD.WORD -5 throw ;
: NAIVE.WORD ( -- )
7777 8888 23 . cr
bad.word
." After bad word!" cr
;
: CATCH.BAD ( -- )
['] naive.word catch .
;
: CATCH.GOOD ( -- )
777 ['] . catch . cr
;
decimal
|
