--- gforth/look.fs 2000/09/23 15:46:57 1.15 +++ gforth/look.fs 2003/01/02 21:40:22 1.21 @@ -26,20 +26,37 @@ \ Problems: A compiled xt via compile, might be created with noname: \ a noname: leaves now a empty name field +require stuff.fs +require environ.fs + decimal \ look 17may93jaw \ 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 ) - false swap - BEGIN @ dup - WHILE dup name>int - 3 pick = IF nip dup THEN - REPEAT - drop nip - dup 0<> ; + swap + [IFDEF] decompile-prim + decompile-prim + [THEN] + >r false swap + BEGIN + @ dup + WHILE + dup name>int xt>threaded + r@ = IF + nip dup + THEN + REPEAT + drop rdrop + dup 0<> ; \ !!! nicht optimal!