gforth/except.fs - diff

Return to except.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/except.fs between versions 1.19 and 1.24

version 1.19, 2007/02/23 14:50:02	version 1.24, 2010/09/05 17:58:41
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) [if]
	: (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! ( ... ball frame )	\ cr .s dup 64 dump
cell+ dup @ lp!	(throw1)
cell+ dup @ fp!
cell+ dup @ ( ... ball addr sp ) -rot 2>r sp! drop 2r>
cell+ @ perform
THEN ;	THEN ;
is throw	is throw

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.19
changed lines
	Added in v.1.24