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: WHILE dup cell+ name>
28: 3 pick = IF nip dup THEN
29: REPEAT
30: drop nip
31: dup 0<> ;
32:
33: : look ( cfa -- lfa flag )
34: dup forthstart u<
35: IF PrimStart (look)
36: ELSE >name true THEN ;
37:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>