[BACK]Return to exceptions.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/exceptions.fs between versions 1.3 and 1.4

version 1.3, 1999/12/12 18:35:54 version 1.4, 1999/12/12 20:27:53
Line 29  Defer store-backtrace Line 29  Defer store-backtrace
 ' noop IS store-backtrace  ' noop IS store-backtrace
 \ [THEN]  \ [THEN]
   
 : (protect) ( -- )  : (try) ( -- )
     \ inline argument: address of the handler      \ inline argument: address of the handler
     r>      r>
     'catch      'catch
       sp@ >r
       fp@ >r
     dup dup @ + >r \ recovery address      dup dup @ + >r \ recovery address
     lp@ >r      lp@ >r
     handler @ >r      handler @ >r
Line 40  Defer store-backtrace Line 42  Defer store-backtrace
     backtrace-empty on      backtrace-empty on
     cell+ >r ;      cell+ >r ;
   
 : protect ( compilation  -- orig ; run-time  -- ) \ gforth  
     POSTPONE (protect) >mark ; immediate compile-only  
   
 : (endprotect) ( -- )  
     \ end of protect block: restore handler, forget rest  
     r>  
     r> handler !  
     rdrop \ lp  
     rdrop \ recovery address  
     >r ;  
   
 : endprotect ( compilation  orig -- ; run-time  -- x ) \ gforth  
     0 POSTPONE literal  
     POSTPONE (endprotect)  
     POSTPONE then ; immediate compile-only  
   
 : catch-protect ( ... xt -- ... x )  
     protect execute endprotect ;  
   
 : (try) ( -- )  
     \ inline argument: address of the handler  
     r>  
     sp@ >r  
     fp@ >r  
     >r ;  
   
 : try ( compilation  -- orig ; run-time  -- ) \ gforth  : try ( compilation  -- orig ; run-time  -- ) \ gforth
     POSTPONE (try) POSTPONE (protect) >mark ; immediate compile-only      POSTPONE (try) >mark ; immediate compile-only
   
 : (recover) ( -- )  : (recover) ( -- )
     \ normal end of try block: restore handler, forget rest      \ normal end of try block: restore handler, forget rest
Line 87  Defer store-backtrace Line 63  Defer store-backtrace
   
 : recover ( compilation  orig -- ; run-time  -- ) \ gforth  : recover ( compilation  orig -- ; run-time  -- ) \ gforth
     \ !! check using a special tag      \ !! check using a special tag
     POSTPONE (endprotect) POSTPONE rdrop POSTPONE rdrop      POSTPONE (recover)
     POSTPONE else      POSTPONE else
     POSTPONE (recover2) ; immediate compile-only      POSTPONE (recover2) ; immediate compile-only
   
Removed from v.1.3  
changed lines
  Added in v.1.4

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