Annotation of gforth/search-order.fs, revision 1.5
1.1 anton 1: \ search order wordset 14may93py
2:
3: $10 constant maxvp
4: Variable vp
1.5 ! pazsan 5: 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
! 6: 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
1.1 anton 7:
8: : get-current ( -- wid ) current @ ;
9: : set-current ( wid -- ) current ! ;
10:
11: : context ( -- addr ) vp dup @ cells + ;
12: : definitions ( -- ) context @ current ! ;
13:
1.5 ! pazsan 14: \ wordlist Vocabulary also previous 14may93py
1.3 pazsan 15:
1.5 ! pazsan 16: AVariable voclink
1.3 pazsan 17:
1.5 ! pazsan 18: Defer 'initvoc
! 19: ' drop IS 'initvoc
1.1 anton 20:
1.5 ! pazsan 21: Variable slowvoc slowvoc off
1.1 anton 22:
23: : wordlist ( -- wid )
1.5 ! pazsan 24: here 0 A, Forth-wordlist cell+ @ A, voclink @ A, slowvoc @ A,
! 25: dup 2 cells + dup voclink ! 'initvoc ;
1.1 anton 26:
27: : Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
28:
29: : also ( -- )
30: context @ vp @ 1+ dup maxvp > abort" Vocstack full"
31: vp ! context ! ;
32:
33: : previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
34:
35: \ vocabulary find 14may93py
36:
1.5 ! pazsan 37: : (vocfind) ( addr count nfa1 -- nfa2|false )
1.2 anton 38: \ !! generalize this to be independent of vp
39: drop 1 vp @
40: DO 2dup vp I cells + @ (search-wordlist) dup
41: IF nip nip
42: UNLOOP EXIT
43: THEN drop
44: -1 +LOOP
45: 2drop false ;
46:
47: 0 value locals-wordlist
48:
1.5 ! pazsan 49: : (localsvocfind) ( addr count nfa1 -- nfa2|false )
1.2 anton 50: \ !! use generalized (vocfind)
51: drop locals-wordlist
52: IF 2dup locals-wordlist (search-wordlist) dup
53: IF nip nip
54: EXIT
55: THEN drop
56: THEN
57: 0 (vocfind) ;
58:
59: \ In the kernal the dictionary search works on only one wordlist.
60: \ The following stuff builds a thing that looks to the kernal like one
61: \ wordlist, but when searched it searches the whole search order
62: \ (including locals)
1.1 anton 63:
1.2 anton 64: \ this is the wordlist-map of the dictionary
1.5 ! pazsan 65: Create vocsearch ' (localsvocfind) A, ' (reveal) A, ' drop A,
1.1 anton 66:
67: \ Only root 14may93py
68:
1.2 anton 69: wordlist \ the wordlist structure
70: vocsearch over cell+ A! \ patch the map into it
1.1 anton 71:
72: Vocabulary Forth
73: Vocabulary Root
74:
75: : Only vp off also Root also definitions ;
76:
77: \ set initial search order 14may93py
78:
79: Forth-wordlist @ ' Forth >body A!
80:
81: Only Forth also definitions
82:
1.2 anton 83: search A! \ our dictionary search order becomes the law
1.3 pazsan 84:
1.1 anton 85: \ get-order set-order 14may93py
86:
87: : get-order ( -- wid1 .. widn n )
88: vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ;
89:
90: : set-order ( wid1 .. widn n / -1 -- )
91: dup -1 = IF drop Only exit THEN dup vp !
92: ?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ;
93:
94: : seal ( -- ) context @ 1 set-order ;
95:
96: \ words visible in roots 14may93py
97:
98: : .name ( name -- ) name>string type space ;
99: : words cr 0 context @
100: BEGIN @ dup WHILE 2dup cell+ c@ $1F and 2 + dup >r +
101: &79 > IF cr nip 0 swap THEN
102: dup .name space r> rot + swap REPEAT 2drop ;
103:
104: : body> ( data -- cfa ) 0 >body - ;
105:
106: : .voc body> >name .name ;
107: : order 1 vp @ DO vp I cells + @ .voc -1 +LOOP 2 spaces
108: current @ .voc ;
109: : vocs voclink BEGIN @ dup @ WHILE dup 2 cells - .voc REPEAT drop ;
110:
111: Root definitions
112:
113: ' words Alias words
114: ' Forth Alias Forth
115:
116: Forth definitions
1.5 ! pazsan 117:
! 118: [IFDEF] (hashkey) include hash.fs [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>