gforth/look.fs - diff

Return to look.fs CVS log

Up to [gforth] / gforth

version 1.15, 2000/09/23 15:46:57	version 1.19, 2002/12/13 21:20:39
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 decompile-prim false rot
BEGIN @ dup	BEGIN
WHILE dup name>int	@ dup
3 pick = IF nip dup THEN	WHILE
REPEAT	dup name>int xt>threaded
drop nip	3 pick = IF
dup 0<> ;	nip dup
	THEN
	REPEAT
	drop nip
	dup 0<> ;


\ !!! nicht optimal!	\ !!! nicht optimal!