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

version 1.4, 1999/12/12 20:27:53 version 1.5, 1999/12/12 20:39:00
Line 33  Defer store-backtrace Line 33  Defer store-backtrace
     \ inline argument: address of the handler      \ inline argument: address of the handler
     r>      r>
     'catch      'catch
       dup dup @ + >r \ recovery address
     sp@ >r      sp@ >r
     fp@ >r      fp@ >r
     dup dup @ + >r \ recovery address  
     lp@ >r      lp@ >r
     handler @ >r      handler @ >r
     rp@ handler !      rp@ handler !
Line 50  Defer store-backtrace Line 50  Defer store-backtrace
     r>      r>
     r> handler !      r> handler !
     rdrop \ lp      rdrop \ lp
     rdrop \ recovery address  
     rdrop \ fp      rdrop \ fp
     rdrop \ sp      rdrop \ sp
       rdrop \ recovery address
     >r ;      >r ;
   
 : (recover2) ( ... x -- ... x )  
     \ restore sp and fp  
     r>  
     r> fp!  
     r> -rot >r >r sp! drop r> ;  
   
 : recover ( compilation  orig -- ; run-time  -- ) \ gforth  : recover ( compilation  orig -- ; run-time  -- ) \ gforth
     \ !! check using a special tag      \ !! check using a special tag
     POSTPONE (recover)      POSTPONE (recover)
     POSTPONE else      POSTPONE else ; immediate compile-only
     POSTPONE (recover2) ; immediate compile-only  
   
 : endtry ( compilation  orig -- ; run-time  -- ) \ gforth  : endtry ( compilation  orig -- ; run-time  -- ) \ gforth
     POSTPONE then ; immediate compile-only      POSTPONE then ; immediate compile-only
Line 78  Defer store-backtrace Line 71  Defer store-backtrace
     endtry ;      endtry ;
 is catch  is catch
   
 \ :noname ( 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 ;  
 \ is catch  
   
 :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 + ! ]
 \       [ has? header [IF] here 9 cells ! [THEN] ] \ entry point for signal handler  
 \ [ has? backtrace [IF] ]  
         store-backtrace          store-backtrace
 \ [ [THEN] ]  
 \ [ has? interpreter [IF] ]  
         handler @ ?dup-0=-IF          handler @ ?dup-0=-IF
 \ [ has? os [IF] ]  
             cr .error cr              cr .error cr
             2 (bye)              2 (bye)
 \ [ [ELSE] ]  
             quit              quit
 \ [ [THEN] ]  
         THEN          THEN
 \ [ [THEN] ]  
         rp!          rp!
         r> handler !          r> handler !
 \ [ has? glocals [IF] ]          r> lp!
         r> lp!          r> fp!
 \ [ [THEN] ]          r> swap >r sp! drop r>
         'throw          'throw
     THEN ;      THEN ;
 is throw  is throw

Removed from v.1.4  
changed lines
  Added in v.1.5


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