[gforth] / gforth / kernel / basics.fs  

gforth: gforth/kernel/basics.fs

Diff for /gforth/kernel/basics.fs between version 1.4 and 1.5

version 1.4, Sun Aug 31 19:32:29 1997 UTC version 1.5, Sat Sep 13 12:05:51 1997 UTC
Line 169 
Line 169 
 \ !! allow the user to add rollback actions    anton  \ !! allow the user to add rollback actions    anton
 \ !! use a separate exception stack?           anton  \ !! use a separate exception stack?           anton
   
 has-locals [IF]  has? glocals [IF]
 : lp@ ( -- addr ) \ gforth      l-p-fetch  : lp@ ( -- addr ) \ gforth      l-p-fetch
  laddr# [ 0 , ] ;   laddr# [ 0 , ] ;
 [THEN]  [THEN]
Line 183 
Line 183 
 : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception  : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
     'catch      'catch
     sp@ >r      sp@ >r
 [ has-floats [IF] ]  [ has? floating [IF] ]
     fp@ >r      fp@ >r
 [ [THEN] ]  [ [THEN] ]
 [ has-locals [IF] ]  [ has? glocals [IF] ]
     lp@ >r      lp@ >r
 [ [THEN] ]  [ [THEN] ]
     handler @ >r      handler @ >r
     rp@ handler !      rp@ handler !
     execute      execute
     r> handler ! rdrop      r> handler ! rdrop
 [ has-floats [IF] ]  [ has? floating [IF] ]
     rdrop      rdrop
 [ [THEN] ]  [ [THEN] ]
 [ has-locals [IF] ]  [ has? glocals [IF] ]
     rdrop      rdrop
 [ [THEN] ]  [ [THEN] ]
     0 ;      0 ;
   
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception  : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
     ?DUP IF      ?DUP IF
         [ has-header [IF] here 9 cells ! [THEN] ] ] \ entry point for signal handler          [ has? header [IF] here 9 cells ! [THEN] ] ] \ entry point for signal handler
 [ has-interpreter [IF] ]  [ has? interpreter [IF] ]
         handler @ dup 0= IF          handler @ dup 0= IF
 [ has-os [IF] ]  [ has? os [IF] ]
             2 (bye)              2 (bye)
 [ [ELSE] ]  [ [ELSE] ]
             quit              quit
Line 215 
Line 215 
 [ [THEN] ]  [ [THEN] ]
         rp!          rp!
         r> handler !          r> handler !
 [ has-locals [IF] ]  [ has? glocals [IF] ]
         r> lp!          r> lp!
 [ [THEN] ]  [ [THEN] ]
 [ has-floats [IF] ]  [ has? floating [IF] ]
         r> fp!          r> fp!
 [ [THEN] ]  [ [THEN] ]
         r> swap >r sp! drop r>          r> swap >r sp! drop r>
Line 232 
Line 232 
   ?DUP IF    ?DUP IF
       handler @ rp!        handler @ rp!
       r> handler !        r> handler !
 [ has-locals [IF] ]  [ has? glocals [IF] ]
       r> lp!        r> lp!
 [ [THEN] ]  [ [THEN] ]
 [ has-floats [IF] ]  [ has? floating [IF] ]
       rdrop        rdrop
 [ [THEN] ]  [ [THEN] ]
       rdrop        rdrop
Line 255 
Line 255 
   
 : ?stack ( ?? -- ?? ) \ gforth  : ?stack ( ?? -- ?? ) \ gforth
     sp@ sp0 @ u> IF    -4 throw  THEN      sp@ sp0 @ u> IF    -4 throw  THEN
 [ has-floats [IF] ]  [ has? floating [IF] ]
     fp@ fp0 @ u> IF  -&45 throw  THEN      fp@ fp0 @ u> IF  -&45 throw  THEN
 [ [THEN] ]  [ [THEN] ]
 ;  ;

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help