[gforth] / gforth / except.fs  

gforth: gforth/except.fs

1 : anton 1.1 \ catch, throw, etc.
2 :    
3 : anton 1.15 \ Copyright (C) 1999,2000,2003,2006 Free Software Foundation, Inc.
4 : anton 1.1
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 :     \ as published by the Free Software Foundation; either version 2
10 :     \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 :     \ along with this program; if not, write to the Free Software
19 : anton 1.3 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20 : anton 1.1
21 :     \ !! use a separate exception stack? anton
22 :    
23 :     \ has? backtrace [IF]
24 :     Defer store-backtrace
25 :     ' noop IS store-backtrace
26 :     \ [THEN]
27 :    
28 : anton 1.9 \ Ok, here's the story about how we get to the native code for the
29 :     \ recovery code in case of a THROW, and why there is all this funny
30 :     \ stuff being compiled by TRY and RECOVER:
31 :    
32 :     \ Upon a THROW, we cannot just return through the ordinary return
33 :     \ address, but have to use a different one, for code after the
34 :     \ RECOVER. How do we do that, in a way portable between the various
35 :     \ threaded and native code engines? In particular, how does the
36 :     \ native code engine learn about the address of the native recovery
37 :     \ code?
38 :    
39 :     \ On the Forth level, we can compile only references to threaded code.
40 :     \ The only thing that translates a threaded code address to a native
41 :     \ code address is docol, which is only called with EXECUTE and
42 :     \ friends. So we start the recovery code with a docol, and invoke it
43 :     \ with PERFORM; the recovery code then rdrops the superfluously
44 :     \ generated return address and continues with the proper recovery
45 :     \ code.
46 :    
47 :     \ At compile time, since we cannot compile a forward reference (to the
48 :     \ recovery code) as a literal (backpatching does not work for
49 :     \ native-code literals), we produce a data cell (wrapped in AHEAD
50 :     \ ... THEN) that we can backpatch, and compile the address of that as
51 :     \ literal.
52 :    
53 :     \ Overall, this leads to the following resulting code:
54 :    
55 :     \ ahead
56 :     \ +><recovery address>-+
57 :     \ | then |
58 :     \ +-lit |
59 :     \ (try) |
60 :     \ ... |
61 :     \ (recover) |
62 :     \ ahead |
63 :     \ docol: <-----------+
64 :     \ rdrop
65 :     \ ...
66 :     \ then
67 :     \ ...
68 :    
69 :     \ !! explain handler on-stack structure
70 :    
71 : pazsan 1.12 Variable first-throw
72 : anton 1.13 : nothrow ( -- ) \ gforth
73 :     \G Use this (or the standard sequence @code{['] false catch drop})
74 :     \G after a @code{catch} or @code{endtry} that does not rethrow;
75 :     \G this ensures that the next @code{throw} will record a
76 :     \G backtrace.
77 :     first-throw on ;
78 : pazsan 1.12
79 : anton 1.5 : (try) ( ahandler -- )
80 : pazsan 1.12 first-throw on
81 : anton 1.1 r>
82 : anton 1.5 swap >r \ recovery address
83 : anton 1.1 sp@ >r
84 :     fp@ >r
85 :     lp@ >r
86 :     handler @ >r
87 :     rp@ handler !
88 : anton 1.5 >r ;
89 : anton 1.1
90 :     : try ( compilation -- orig ; run-time -- ) \ gforth
91 : anton 1.5 \ !! does not work correctly for gforth-native
92 : anton 1.8 POSTPONE ahead here >r >mark 1 cs-roll POSTPONE then
93 : anton 1.9 r> POSTPONE literal POSTPONE (try) ; immediate compile-only
94 : anton 1.1
95 :     : (recover) ( -- )
96 :     \ normal end of try block: restore handler, forget rest
97 :     r>
98 :     r> handler !
99 :     rdrop \ lp
100 :     rdrop \ fp
101 :     rdrop \ sp
102 :     rdrop \ recovery address
103 :     >r ;
104 :    
105 :     : recover ( compilation orig1 -- orig2 ; run-time -- ) \ gforth
106 :     \ !! check using a special tag
107 : anton 1.9 POSTPONE else
108 :     docol: here 0 , 0 , code-address! \ start a colon def
109 :     postpone rdrop \ drop the return address
110 :     ; immediate compile-only
111 : anton 1.1
112 :     : endtry ( compilation orig -- ; run-time -- ) \ gforth
113 : anton 1.16 POSTPONE then
114 :     POSTPONE (recover)
115 :     ; immediate compile-only
116 : anton 1.1
117 :     :noname ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
118 :     try
119 :     execute 0
120 :     recover
121 :     nip
122 :     endtry ;
123 :     is catch
124 :    
125 :     :noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
126 :     ?DUP IF
127 :     [ here forthstart 9 cells + ! ]
128 : pazsan 1.12 first-throw @ IF
129 :     store-backtrace error-stack off
130 :     first-throw off
131 :     THEN
132 : anton 1.1 handler @ ?dup-0=-IF
133 : anton 1.6 >stderr cr ." uncaught exception: " .error cr
134 : anton 1.1 2 (bye)
135 : anton 1.6 \ quit
136 : anton 1.1 THEN
137 : anton 1.16 dup rp!
138 :     rdrop
139 : anton 1.1 r> lp!
140 :     r> fp!
141 : anton 1.16 r> -rot 2>r sp! drop 2r>
142 :     r@ swap rp! perform
143 : anton 1.1 THEN ;
144 :     is throw
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help