Diff for /gforth/look.fs between versions 1.15 and 1.21

version 1.15, 2000/09/23 15:46:57 version 1.21, 2003/01/02 21:40:22
Line 26 Line 26
 \ Problems: A compiled xt via compile, might be created with noname:  \ Problems: A compiled xt via compile, might be created with noname:
 \           a noname: leaves now a empty name field  \           a noname: leaves now a empty name field
   
   require stuff.fs
   require environ.fs
   
 decimal  decimal
   
 \ look                                                  17may93jaw  \ look                                                  17may93jaw
   
 \ rename to discover!!!  \ rename to discover!!!
   
   : xt>threaded ( xt -- x )
   \G produces the threaded-code cell for the primitive xt
       threading-method 0= if
           @
       then ;
   
 : (look)  ( xt startlfa -- lfa flag )  : (look)  ( xt startlfa -- lfa flag )
         false swap      swap
         BEGIN @ dup      [IFDEF] decompile-prim
         WHILE dup name>int      decompile-prim
               3 pick = IF nip dup THEN      [THEN]
         REPEAT      >r false swap
         drop nip      BEGIN
         dup 0<> ;          @ dup
       WHILE
               dup name>int xt>threaded
               r@ = IF
                   nip dup
               THEN
       REPEAT
       drop rdrop
       dup 0<> ;
   
   
 \ !!! nicht optimal!  \ !!! nicht optimal!

Removed from v.1.15  
changed lines
  Added in v.1.21


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