--- gforth/look.fs 2000/09/23 15:46:57 1.15 +++ gforth/look.fs 2002/12/13 21:20:39 1.19 @@ -26,20 +26,33 @@ \ 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 decompile-prim false rot + BEGIN + @ dup + WHILE + dup name>int xt>threaded + 3 pick = IF + nip dup + THEN + REPEAT + drop nip + dup 0<> ; \ !!! nicht optimal!