[gforth] / gforth / Attic / exceptions.fs  

gforth: gforth/Attic/exceptions.fs

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

version 1.3, Sun Dec 12 18:35:54 1999 UTC version 1.4, Sun Dec 12 20:27:53 1999 UTC
Line 29 
Line 29 
 ' 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 
Line 42 
     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 
Line 63 
   
 : 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
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help