--- gforth/except.fs 2007/02/18 17:57:12 1.16 +++ gforth/except.fs 2007/12/31 17:34:58 1.20 @@ -1,6 +1,6 @@ \ 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. @@ -87,12 +87,12 @@ Variable first-throw rp@ handler ! >r ; -: try ( compilation -- orig ; run-time -- ) \ gforth - \ !! does not work correctly for gforth-native +: 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 -: (recover) ( -- ) +: (endtry) ( -- ) \ normal end of try block: restore handler, forget rest r> r> handler ! @@ -102,24 +102,45 @@ Variable first-throw rdrop \ recovery address >r ; -: recover ( compilation orig1 -- orig2 ; run-time -- ) \ gforth - \ !! check using a special tag - POSTPONE else +: handler-intro, ( -- ) docol: here 0 , 0 , code-address! \ start a colon def postpone rdrop \ drop the return address +; + +: iferror ( compilation orig1 -- orig2 ; run-time -- ) \ gforth + \G Starts the exception handling code (executed if there is an + \G exception between @code{try} and @code{endtry}). This part has + \G to be finished with @code{then}. + \ !! check using a special tag + POSTPONE else handler-intro, +; immediate compile-only + +: restore ( compilation orig1 -- ; run-time -- ) \ gforth + \G Starts restoring code, that is executed if there is an + \G exception, and if there is no exception. + POSTPONE iferror POSTPONE then +; immediate compile-only + +: endtry ( compilation -- ; run-time R:sys1 -- ) \ gforth + \G End an exception-catching region. + POSTPONE (endtry) ; immediate compile-only -: endtry ( compilation orig -- ; run-time -- ) \ gforth - POSTPONE then - POSTPONE (recover) +: endtry-iferror ( compilation orig1 -- orig2 ; run-time R:sys1 -- ) \ gforth + \G End an exception-catching region while starting + \G exception-handling code outside that region (executed if there + \G is an exception between @code{try} and @code{endtry-iferror}). + \G This part has to be finished with @code{then} (or + \G @code{else}...@code{then}). + POSTPONE (endtry) POSTPONE iferror POSTPONE (endtry) ; immediate compile-only :noname ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception try execute 0 - recover - nip - endtry ; + iferror + nip + then endtry ; is catch :noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception @@ -134,11 +155,10 @@ is catch 2 (bye) \ quit THEN - dup rp! - rdrop - r> lp! - r> fp! - r> -rot 2>r sp! drop 2r> - r@ swap rp! perform + dup rp! ( ... ball frame ) + cell+ dup @ lp! + cell+ dup @ fp! + cell+ dup @ ( ... ball addr sp ) -rot 2>r sp! drop 2r> + cell+ @ perform THEN ; is throw