Annotation of gforth/search.fs, revision 1.4
1.1 anton 1: \ search order wordset 14may93py
2:
3: \ Copyright (C) 1995 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
21: $10 constant maxvp
22: Variable vp
23: 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
24: 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A, 0 A,
25:
26: : get-current ( -- wid ) current @ ;
27: : set-current ( wid -- ) current ! ;
28:
1.2 jwilke 29: \ : context ( -- addr ) vp dup @ cells + ;
30: : vp! dup vp ! cells vp + to context ;
1.1 anton 31: : definitions ( -- ) context @ current ! ;
32:
33: \ wordlist Vocabulary also previous 14may93py
34:
1.2 jwilke 35: Variable slowvoc 0 slowvoc !
1.1 anton 36:
1.2 jwilke 37: \ Forth-wordlist AConstant Forth-wordlist
1.1 anton 38:
1.2 jwilke 39: : mappedwordlist ( map-struct -- wid ) \ gforth
40: \G creates a wordlist with a special map-structure
41: here 0 A, swap A, voclink @ A, 0 A,
42: dup wordlist-link voclink !
43: dup initvoc ;
1.1 anton 44:
45: : wordlist ( -- wid )
46: slowvoc @
1.2 jwilke 47: IF \ this is now f83search because hashing may be loaded already
48: \ jaw
49: f83search
1.1 anton 50: ELSE Forth-wordlist wordlist-map @ THEN
1.2 jwilke 51: mappedwordlist ;
1.1 anton 52:
53: : Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
54:
55: : also ( -- )
56: context @ vp @ 1+ dup maxvp > abort" Vocstack full"
1.2 jwilke 57: vp! context ! ;
1.1 anton 58:
1.2 jwilke 59: : previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp! ;
1.1 anton 60:
61: \ vocabulary find 14may93py
62:
63: : (vocfind) ( addr count wid -- nfa|false )
64: \ !! generalize this to be independent of vp
65: drop vp dup @ 1- cells over +
66: DO 2dup I 2@ over <>
67: IF (search-wordlist) dup
68: IF nip nip UNLOOP EXIT
69: THEN drop
70: ELSE drop 2drop THEN
71: [ -1 cells ] Literal +LOOP
72: 2drop false ;
73:
74: 0 value locals-wordlist
75:
76: : (localsvocfind) ( addr count wid -- nfa|false )
77: \ !! use generalized (vocfind)
78: drop locals-wordlist
79: IF 2dup locals-wordlist (search-wordlist) dup
80: IF nip nip
81: EXIT
82: THEN drop
83: THEN
84: 0 (vocfind) ;
85:
86: \ In the kernel the dictionary search works on only one wordlist.
87: \ The following stuff builds a thing that looks to the kernel like one
88: \ wordlist, but when searched it searches the whole search order
89: \ (including locals)
90:
91: \ this is the wordlist-map of the dictionary
92: Create vocsearch ( -- wordlist-map )
1.2 jwilke 93: ' (localsvocfind) A, ' (reveal) A, ' drop A, ' drop A,
94:
95: \ create dummy wordlist for kernel
96: slowvoc on
97: vocsearch mappedwordlist \ the wordlist structure ( -- wid )
98:
99: \ we don't want the dummy wordlist in our linked list
100: 0 Voclink !
101: slowvoc off
1.1 anton 102:
103: \ Only root 14may93py
104:
105: Vocabulary Forth
106: Vocabulary Root
107:
1.3 anton 108: : Only 1 vp! Root also ;
1.1 anton 109:
110: \ set initial search order 14may93py
111:
112: Forth-wordlist @ ' Forth >body !
113:
1.2 jwilke 114: 0 vp! also Root also definitions
1.1 anton 115: Only Forth also definitions
1.2 jwilke 116: lookup ! \ our dictionary search order becomes the law ( -- )
1.1 anton 117:
118: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
119:
120:
121: \ get-order set-order 14may93py
122:
123: : get-order ( -- wid1 .. widn n )
124: vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ;
125:
126: : set-order ( wid1 .. widn n / -1 -- )
1.2 jwilke 127: dup -1 = IF drop Only exit THEN dup vp!
1.1 anton 128: ?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ;
129:
130: : seal ( -- ) context @ 1 set-order ;
131:
1.2 jwilke 132: : .voc
1.4 ! pazsan 133: body> >head name>string type space ;
1.1 anton 134:
135: : order ( -- ) \ search-ext
136: \g prints the search order and the @code{current} wordlist. The
137: \g standard requires that the wordlists are printed in the order
138: \g in which they are searched. Therefore, the output is reversed
139: \g with respect to the conventional way of displaying stacks. The
140: \g @code{current} wordlist is displayed last.
141: get-order 0
142: ?DO
143: .voc
144: LOOP
145: 4 spaces get-current .voc ;
1.2 jwilke 146:
1.1 anton 147: : vocs ( -- ) \ gforth
148: \g prints vocabularies and wordlists defined in the system.
149: voclink
150: BEGIN
1.2 jwilke 151: @ dup
1.1 anton 152: WHILE
153: dup 0 wordlist-link - .voc
154: REPEAT
155: drop ;
156:
157: Root definitions
158:
159: ' words Alias words
160: ' Forth Alias Forth
161: ' forth-wordlist alias forth-wordlist
162: ' set-order alias set-order
163: ' order alias order
164:
165: Forth definitions
166:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>