gforth: gforth/look.fs

1 :	anton	1.1	\ LOOK.FS xt -> lfa 22may93jaw
2 :
3 :			\ Look checks first if the word is a primitive. If yes then the
4 :			\ vocabulary in the primitive area is beeing searched, meaning
5 :			\ creating for each word a xt and comparing it...
6 :
7 :			\ If a word is no primitive look searches backwards to find the nfa.
8 :			\ Problems: A compiled xt via compile, might be created with noname:
9 :			\ a noname: leaves now a empty name field
10 :
11 :			decimal
12 :
13 :			\ >NAME PRIMSTART 22may93jaw
14 :
15 :			\ : >name ( xt -- nfa )
16 :			\ BEGIN 1 chars -
17 :			\ dup c@ 128 and
18 :			\ UNTIL ;
19 :
20 :			: PrimStart ['] true >name ;
21 :
22 :			\ look 17may93jaw
23 :
24 :			: (look) ( xt startlfa -- lfa flag )
25 :			false swap
26 :			BEGIN @ dup
27 :	pazsan	1.2	WHILE dup name>
28 :	anton	1.1	3 pick = IF nip dup THEN
29 :			REPEAT
30 :			drop nip
31 :			dup 0<> ;
32 :
33 :			: look ( cfa -- lfa flag )
34 :	pazsan	1.2	dup forthstart <
35 :	anton	1.1	IF PrimStart (look)
36 :			ELSE >name true THEN ;
37 :