version 1.1, 2000/07/24 13:48:36
|
version 1.6, 2003/02/17 22:42:09
|
Line 1
|
Line 1
|
\ catch, throw, etc. |
\ catch, throw, etc. |
|
|
\ Copyright (C) 1999 Free Software Foundation, Inc. |
\ Copyright (C) 1999,2000 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 16
|
Line 16
|
|
|
\ 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, write to the Free Software |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
\ !! use a separate exception stack? anton |
\ !! use a separate exception stack? anton |
|
|
Line 33 Defer store-backtrace
|
Line 33 Defer store-backtrace
|
' noop IS store-backtrace |
' noop IS store-backtrace |
\ [THEN] |
\ [THEN] |
|
|
: (try) ( -- ) |
: (try) ( ahandler -- ) |
\ inline argument: address of the handler |
|
r> |
r> |
dup dup @ + >r \ recovery address |
swap >r \ recovery address |
rp@ 'catch >r |
rp@ 'catch >r |
sp@ >r |
sp@ >r |
fp@ >r |
fp@ >r |
Line 44 Defer store-backtrace
|
Line 43 Defer store-backtrace
|
handler @ >r |
handler @ >r |
rp@ handler ! |
rp@ handler ! |
backtrace-empty on |
backtrace-empty on |
cell+ >r ; |
>r ; |
|
|
: try ( compilation -- orig ; run-time -- ) \ gforth |
: try ( compilation -- orig ; run-time -- ) \ gforth |
POSTPONE (try) >mark ; immediate compile-only |
\ !! does not work correctly for gforth-native |
|
POSTPONE lit >mark POSTPONE (try) ; immediate compile-only |
|
|
: (recover) ( -- ) |
: (recover) ( -- ) |
\ normal end of try block: restore handler, forget rest |
\ normal end of try block: restore handler, forget rest |
Line 81 is catch
|
Line 81 is catch
|
[ here forthstart 9 cells + ! ] |
[ here forthstart 9 cells + ! ] |
store-backtrace |
store-backtrace |
handler @ ?dup-0=-IF |
handler @ ?dup-0=-IF |
cr ." uncaught exception: " .error cr |
>stderr cr ." uncaught exception: " .error cr |
2 (bye) |
2 (bye) |
quit |
\ quit |
THEN |
THEN |
rp! |
rp! |
r> handler ! |
r> handler ! |