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! |