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

Diff for /gforth/kernel/basics.fs between versions 1.16 and 1.17

version 1.16, 1999/05/17 15:07:02 version 1.17, 1999/11/20 12:12:54
Line 199  has? glocals [IF] Line 199  has? glocals [IF]
  laddr# [ 0 , ] ;   laddr# [ 0 , ] ;
 [THEN]  [THEN]
   
 \- 'catch Defer 'catch  defer catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
 \- 'throw Defer 'throw  :noname ( ... xt -- ... 0 )
       execute 0 ;
 ' noop IS 'catch  is catch
 ' noop IS 'throw  
   
 has? backtrace [IF]  
 Defer store-backtrace  
 ' noop IS store-backtrace  
 [THEN]  
   
 : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception  
     'catch  
     sp@ >r  
 [ has? floating [IF] ]  
     fp@ >r  
 [ [THEN] ]  
 [ has? glocals [IF] ]  
     lp@ >r  
 [ [THEN] ]  
     handler @ >r  
     rp@ handler !  
 [ has? backtrace [IF] ]  
     backtrace-empty on  
 [ [THEN] ]  
     execute  
     r> handler ! rdrop   
 [ has? floating [IF] ]  
     rdrop  
 [ [THEN] ]  
 [ has? glocals [IF] ]  
     rdrop  
 [ [THEN] ]  
     0 ;  
   
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception  
     ?DUP IF  
         [ has? header [IF] here 9 cells ! [THEN] ] \ entry point for signal handler  
 [ has? backtrace [IF] ]  
         store-backtrace  
 [ [THEN] ]  
 [ has? interpreter [IF] ]  
         handler @ dup 0= IF  
 [ has? os [IF] ]  
             2 (bye)  
 [ [ELSE] ]  
             quit  
 [ [THEN] ]  
         THEN  
 [ [THEN] ]  
         rp!  
         r> handler !  
 [ has? glocals [IF] ]  
         r> lp!  
 [ [THEN] ]  
 [ has? floating [IF] ]  
         r> fp!  
 [ [THEN] ]  
         r> swap >r sp! drop r>  
         'throw  
     THEN ;  
   
 \ Bouncing is very fine,  
 \ programming without wasting time...   jaw  
 : bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) \ gforth  
 \ a throw without data or fp stack restauration  
   ?DUP IF  
 [ has? backtrace [IF] ]  
       store-backtrace  
 [ [THEN] ]  
       handler @ rp!  
       r> handler !  
 [ has? glocals [IF] ]  
       r> lp!  
 [ [THEN] ]  
 [ has? floating [IF] ]  
       rdrop  
 [ [THEN] ]  
       rdrop  
       'throw  
   THEN ;  
   
   defer throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
   ' drop is throw
 \ (abort")  \ (abort")
   
 : (abort")  : (abort")
Removed from v.1.16  
changed lines
  Added in v.1.17

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