version 1.18, 2007/02/19 00:08:20
|
version 1.23, 2010/09/01 16:52:12
|
Line 1
|
Line 1
|
\ catch, throw, etc. |
\ catch, throw, etc. |
|
|
\ Copyright (C) 1999,2000,2003,2006 Free Software Foundation, Inc. |
\ Copyright (C) 1999,2000,2003,2006,2007 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
\ !! use a separate exception stack? anton |
\ !! use a separate exception stack? anton |
|
|
Line 76 Variable first-throw
|
Line 75 Variable first-throw
|
\G backtrace. |
\G backtrace. |
first-throw on ; |
first-throw on ; |
|
|
|
: (try0) ( -- aoldhandler ) |
|
first-throw on |
|
handler @ ; |
|
|
|
[undefined] (try1) [if] |
|
: (try1) ( aoldhandler arecovery -- anewhandler ) |
|
r> |
|
swap >r \ recovery address |
|
sp@ cell+ >r |
|
fp@ >r |
|
lp@ >r |
|
swap >r \ old handler |
|
rp@ swap \ new handler |
|
>r ; |
|
[endif] |
|
|
|
: (try2) |
|
handler ! ; |
|
|
: (try) ( ahandler -- ) |
: (try) ( ahandler -- ) |
first-throw on |
first-throw on |
r> |
r> |
Line 87 Variable first-throw
|
Line 105 Variable first-throw
|
rp@ handler ! |
rp@ handler ! |
>r ; |
>r ; |
|
|
|
\ : try ( compilation -- orig ; run-time -- R:sys1 ) \ gforth |
|
\ \G Start an exception-catching region. |
|
\ POSTPONE ahead here >r >mark 1 cs-roll POSTPONE then |
|
\ r> POSTPONE literal POSTPONE (try) ; immediate compile-only |
|
|
: try ( compilation -- orig ; run-time -- R:sys1 ) \ gforth |
: try ( compilation -- orig ; run-time -- R:sys1 ) \ gforth |
\G Start an exception-catching region. |
\G Start an exception-catching region. |
POSTPONE ahead here >r >mark 1 cs-roll POSTPONE then |
POSTPONE ahead here >r >mark 1 cs-roll POSTPONE then |
r> POSTPONE literal POSTPONE (try) ; immediate compile-only |
POSTPONE (try0) r> POSTPONE literal POSTPONE (try1) POSTPONE (try2) |
|
; immediate compile-only |
|
|
|
|
: (endtry) ( -- ) |
: (endtry) ( -- ) |
\ normal end of try block: restore handler, forget rest |
\ normal end of try block: restore handler, forget rest |
Line 143 Variable first-throw
|
Line 168 Variable first-throw
|
then endtry ; |
then endtry ; |
is catch |
is catch |
|
|
|
[undefined] (throw1) |
|
: (throw1) ( ... ball frame -- ... ball ) |
|
dup rp! ( ... ball frame ) |
|
cell+ dup @ lp! |
|
cell+ dup @ fp! |
|
cell+ dup @ ( ... ball addr sp ) -rot 2>r sp! drop 2r> |
|
cell+ @ perform ; |
|
[endif] |
|
|
:noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception |
:noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception |
?DUP IF |
?DUP IF |
[ here forthstart 9 cells + ! ] |
[ here forthstart 9 cells + ! ] |
Line 155 is catch
|
Line 189 is catch
|
2 (bye) |
2 (bye) |
\ quit |
\ quit |
THEN |
THEN |
dup rp! |
\ cr .s dup 64 dump |
rdrop |
(throw1) |
r> lp! |
|
r> fp! |
|
r> -rot 2>r sp! drop 2r> |
|
r@ swap rp! perform |
|
THEN ; |
THEN ; |
is throw |
is throw |