Annotation of gforth/except.fs, revision 1.17
1.1 anton 1: \ catch, throw, etc.
2:
1.15 anton 3: \ Copyright (C) 1999,2000,2003,2006 Free Software Foundation, Inc.
1.1 anton 4:
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
1.3 anton 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1 anton 20:
21: \ !! use a separate exception stack? anton
22:
23: \ has? backtrace [IF]
24: Defer store-backtrace
25: ' noop IS store-backtrace
26: \ [THEN]
27:
1.9 anton 28: \ 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:
1.12 pazsan 71: Variable first-throw
1.13 anton 72: : 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 ;
1.12 pazsan 78:
1.5 anton 79: : (try) ( ahandler -- )
1.12 pazsan 80: first-throw on
1.1 anton 81: r>
1.5 anton 82: swap >r \ recovery address
1.1 anton 83: sp@ >r
84: fp@ >r
85: lp@ >r
86: handler @ >r
87: rp@ handler !
1.5 anton 88: >r ;
1.1 anton 89:
90: : try ( compilation -- orig ; run-time -- ) \ gforth
1.5 anton 91: \ !! does not work correctly for gforth-native
1.8 anton 92: POSTPONE ahead here >r >mark 1 cs-roll POSTPONE then
1.9 anton 93: r> POSTPONE literal POSTPONE (try) ; immediate compile-only
1.1 anton 94:
1.17 ! anton 95: : (endtry) ( -- )
1.1 anton 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:
1.17 ! anton 105: : handler-intro, ( -- )
1.9 anton 106: docol: here 0 , 0 , code-address! \ start a colon def
107: postpone rdrop \ drop the return address
1.17 ! anton 108: ;
! 109:
! 110: : iferror ( compilation orig1 -- orig2 ; run-time -- ) \ gforth
! 111: \ !! check using a special tag
! 112: POSTPONE else handler-intro,
! 113: ; immediate compile-only
! 114:
! 115: : restore ( compilation orig1 -- ; run-time -- ) \ gforth
! 116: POSTPONE iferror POSTPONE then
1.9 anton 117: ; immediate compile-only
1.1 anton 118:
1.17 ! anton 119: : endtry ( compilation -- ; run-time -- ) \ gforth
! 120: POSTPONE (endtry)
1.16 anton 121: ; immediate compile-only
1.1 anton 122:
123: :noname ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
124: try
125: execute 0
1.17 ! anton 126: iferror
! 127: nip
! 128: then endtry ;
1.1 anton 129: is catch
130:
131: :noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
132: ?DUP IF
133: [ here forthstart 9 cells + ! ]
1.12 pazsan 134: first-throw @ IF
135: store-backtrace error-stack off
136: first-throw off
137: THEN
1.1 anton 138: handler @ ?dup-0=-IF
1.6 anton 139: >stderr cr ." uncaught exception: " .error cr
1.1 anton 140: 2 (bye)
1.6 anton 141: \ quit
1.1 anton 142: THEN
1.16 anton 143: dup rp!
144: rdrop
1.1 anton 145: r> lp!
146: r> fp!
1.16 anton 147: r> -rot 2>r sp! drop 2r>
148: r@ swap rp! perform
1.1 anton 149: THEN ;
150: is throw
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>