gforth/look.fs - diff

Return to look.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/look.fs between versions 1.22 and 1.23

version 1.22, 2003/01/04 08:26:57	version 1.23, 2003/01/06 11:18:59
Line 41 decimal	Line 41 decimal
@	@
then ;	then ;

: (look) ( xt startlfa -- lfa flag )	: search-name ( xt startlfa -- nt\|0 )
\ look up name of primitive with code at xt	\ look up name of primitive with code at xt
swap	swap
>r false swap	>r false swap
Line 53 decimal	Line 53 decimal
nip dup	nip dup
THEN	THEN
REPEAT	REPEAT
drop rdrop	drop rdrop ;
dup 0<> ;

: threaded>xt ( ca -- xt\|0 )	: threaded>xt ( ca -- xt\|0 )
\G For the code address ca of a primitive, find the xt (or 0).	\G For the code address ca of a primitive, find the xt (or 0).
Line 77 has? ec [IF]	Line 76 has? ec [IF]

has? rom	has? rom
[IF]	[IF]
: prim>name ( xt -- nt flag )	: prim>name ( xt -- nt\|0 )
forth-wordlist @ (look) ;	forth-wordlist @ search-name ;

: look	: look ( xt -- lfa flag )
dup [ unlock rom-dictionary area lock ]	dup [ unlock rom-dictionary area lock ]
literal literal within	literal literal within
IF	IF
>head-noprim dup ?? <>	>head-noprim dup ?? <>
ELSE	ELSE
xt>threaded threaded>name	prim>name dup 0<>
THEN ;	THEN ;
[ELSE]	[ELSE]
: look ( cfa -- lfa flag )	: look ( cfa -- lfa flag )
Line 97 has? rom	Line 96 has? rom

: PrimStart ['] true >head-noprim ;	: PrimStart ['] true >head-noprim ;

: prim>name ( xt -- lfa flag )	: prim>name ( xt -- nt\|0 )
PrimStart (look) ;	PrimStart search-name ;

: look ( cfa -- lfa flag )	: look ( xt -- lfa flag )
dup in-dictionary?	dup in-dictionary?
IF	IF
>head-noprim dup ??? <>	>head-noprim dup ??? <>
ELSE	ELSE
prim>name	prim>name dup 0<>
THEN ;	THEN ;

[THEN]	[THEN]
[THEN]	[THEN]

: threaded>name ( ca -- lfa flag )	: threaded>name ( ca -- nt\|0 )
threaded>xt prim>name ;	threaded>xt prim>name ;

: >head ( cfa -- nt\|0 ) \ gforth to-head	: >head ( cfa -- nt\|0 ) \ gforth to-head

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

Removed from v.1.22
changed lines
	Added in v.1.23