license
hash ( c-addr u wid --thread )

Given the address of a character string, the number of chracters and the wid return the address of the thread that should contain the word.

 
	\ hash value of last word hashed
	uvariable %name_hash
	: hash ( c-addr u wid -- list)
		-rot checksum %name_hash !
		[ _#voc_head> _#voc_wid - ]T LITERAL + @                     \ c-addr heads<-
		%name_hash @                                                 \ heads char (--
		OVER [ _#voc_heads_count  _#voc_heads_base - ]T LITERAL + @  \ heads char count (-- 
		1- AND                                                       \ heads list (--
		CELLS                                                        \ heads offset (-- 
		[ _#voc_heads_data _#voc_heads_base - ]T LITERAL + + 
	;
	 
search_thread ( c-addr u head -- 0 | xt 1 | xt -1 )

Find the definition identified by the string c-addr u in the thread identified by head. If the definition is not found, return zero. If the definition is found, return its execution token xt and one (1) if the definition is immediate, minus-one (-1) otherwise.

 



	0  CONSTANT _#not_found
	1  CONSTANT _#immediate
	-1 CONSTANT _#otherwise

	: search_thread ( c-addr u thread -- 0 | xt 1 | xt -1 )
		>R                             \ c-addr u (--
		BEGIN
			R> @ >R
			R@
		WHILE  
			R@ 	[ _#head_hash _#head_link - ]T LITERAL + @
			%name_hash @ = IF  \ c-addr u(--
				R@                         \ c-addr u lfa (--
				lfa>nfa                    \ c-addr u nfa (--
				name_count NIP             \ c-adr u u1 (--
				[ _#name_count_bits _#smudge_bit OR ]T LITERAL AND OVER
				= IF \ counts are equal and smudge bit not set
					\ c-addr u (--
					2DUP R@ lfa>nfa      \ c-addr u c-addr u addr (--
					name_count _#name_count_bits AND \ c-addr u c-addr u c-addr1 u1(--
					COMPARE not IF         \ we have a match
						2DROP              \ (--
						( R@ last_lfa ! ) R@ lfa>nfa C@ _#immediate_bit AND IF
							R> lfa>xt _#immediate
						ELSE
							R> lfa>xt _#otherwise 
						THEN
						EXIT
					THEN
					\ count u (--
				THEN
			THEN
		REPEAT
		r>drop
		2DROP
		_#not_found
	;


	 
ANS 16.6.1.2192 SEARCH-WORDLIST

( c-addr u wid -- 0 | xt 1 | xt -1 )

Find the definition identified by the string c-addr u in the word-list identified by wid. If the definition is not found, return zero. If the definition is found, return its execution token xt and one (1) if the definition is immediate, minus-one (-1) otherwise.

The string argument to SEARCH-WORDLIST is represented by c-addr u, rather than by just c-addr as with FIND. The committee wishes to establish c-addr u as the preferred representation of a string on the stack, and has adopted that representation for all new functions that accept string arguments. While this decision may cause the implementation of SEARCH-WORDLIST to be somewhat more difficult in existing systems, the committee feels that the additional difficulty is minor.

When SEARCH-WORDLIST fails to find the word, it does not return the string, as does FIND. This is in accordance with the general principle that Forth words consume their arguments.

COLDFORTH No truncated names here. The head is the name string with no truncation

  
	: SEARCH-WORDLIST ( c-addr u wid -- 0 | xt 1 | xt -1 )
		3DUP                           \ c-addr u wid c-addr u wid (--
		hash                          \ c-addr u wid thread (--
		NIP                            \ c-addr u thread(--
		search_thread
	;
	 
FIND

ANS 6.1.1550 FIND

( c-addr -- c-addr 0 | xt 1 | xt -1 )

Find the definition named in the counted string at c-addr. If the definition is not found, return c-addr and zero. If the definition is found, return its execution token xt. If the definition is immediate, also return one (1), otherwise also return minus-one (-1). For a given string, the values returned by FIND while compiling may differ from those returned while not compiling.

One of the more difficult issues which the Committee took on was the problem of divorcing the specification of implementation mechanisms from the specification of the Forth language. Three basic implementation approaches can be quickly enumerated:

1) Threaded code mechanisms.
These are the traditional approaches to implementing Forth, but other techniques may be used.
2) Subroutine threading with macro-expansion (code copying).
Short routines, like the code for DUP, are copied into a definition rather than compiling a JSR reference.
3) Native coding with optimization.
This may include stack optimization (replacing such phrases as SWAP ROT + with one or two machine instructions, for example), parallelization (the trend in the newer RISC chips is to have several functional subunits which can execute in parallel), and so on.

The initial requirement (inherited from Forth-83) that compilation addresses be compiled into the dictionary disallowed type 2 and type 3 implementations.

Type 3 mechanisms and optimizations of type 2 implementations were hampered by the explicit specification of immediacy or non-immediacy of all standard words. POSTPONE allowed de-specification of immediacy or non-immediacy for all but a few Forth words whose behavior must be STATE-independent.

One type 3 implementation, Charles Moore's cmForth, has both compiling and interpreting versions of many Forth words. At the present, this appears to be a common approach for type 3 implementations. The Committee felt that this implementation approach must be allowed. Consequently, it is possible that words without interpretation semantics can be found only during compilation, and other words may exist in two versions: a compiling version and an interpreting version. Hence the values returned by FIND may depend on STATE, and ' and ['] may be unable to find words without interpretation semantics.

 
	: sfind  ( addr n -- 0 | xt 1 | xt -1 )
		2DUP checksum %name_hash !
		n_context_count @ zero ?DO
			2DUP 				    \ addr n addr n (--
			I CELLS context + @		\ addr n  addr  n wid(--
			SEARCH-WORDLIST			\ addr n ; 0 | xt 1 | xt -1 (--
			?DUP IF					\ addr n ; xt 1 | xt -1 (--
				2SWAP 2DROP UNLOOP EXIT	\ xt 1 | xt -1 (--
			THEN					\ addr n (--
		LOOP						
		2DROP zero
	;

	: FIND  ( $ -- $ 0 | xt 1 | xt -1 )
		DUP COUNT sfind DUP IF
			ROT DROP 
		THEN
	;