Annotation of gforth/search-order.fs, revision 1.22
1.1 anton 1: \ search order wordset 14may93py
2:
1.13 anton 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:
1.1 anton 21: $10 constant maxvp
22: Variable vp
1.5 pazsan 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,
1.1 anton 25:
26: : get-current ( -- wid ) current @ ;
27: : set-current ( wid -- ) current ! ;
28:
29: : context ( -- addr ) vp dup @ cells + ;
30: : definitions ( -- ) context @ current ! ;
31:
1.5 pazsan 32: \ wordlist Vocabulary also previous 14may93py
1.3 pazsan 33:
1.5 pazsan 34: AVariable voclink
1.3 pazsan 35:
1.5 pazsan 36: Defer 'initvoc
1.18 anton 37: ' drop ' 'initvoc >body !
1.1 anton 38:
1.5 pazsan 39: Variable slowvoc slowvoc off
1.1 anton 40:
1.21 pazsan 41: Forth-wordlist AConstant Forth-wordlist
42:
1.1 anton 43: : wordlist ( -- wid )
1.21 pazsan 44: here 0 A,
45: slowvoc @
46: IF [ Forth-wordlist wordlist-map @ ] ALiteral
47: ELSE Forth-wordlist wordlist-map @ THEN
48: A, voclink @ A, slowvoc @ A,
1.10 pazsan 49: dup wordlist-link dup voclink ! 'initvoc ;
1.1 anton 50:
51: : Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
52:
53: : also ( -- )
54: context @ vp @ 1+ dup maxvp > abort" Vocstack full"
55: vp ! context ! ;
56:
57: : previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
58:
59: \ vocabulary find 14may93py
60:
1.15 anton 61: : (vocfind) ( addr count wid -- nfa|false )
1.2 anton 62: \ !! generalize this to be independent of vp
1.10 pazsan 63: drop vp dup @ 1- cells over +
64: DO 2dup I 2@ over <>
65: IF (search-wordlist) dup
66: IF nip nip UNLOOP EXIT
67: THEN drop
68: ELSE drop 2drop THEN
69: [ -1 cells ] Literal +LOOP
1.2 anton 70: 2drop false ;
71:
72: 0 value locals-wordlist
73:
1.15 anton 74: : (localsvocfind) ( addr count wid -- nfa|false )
1.2 anton 75: \ !! use generalized (vocfind)
76: drop locals-wordlist
77: IF 2dup locals-wordlist (search-wordlist) dup
78: IF nip nip
79: EXIT
80: THEN drop
81: THEN
82: 0 (vocfind) ;
83:
1.20 pazsan 84: \ In the kernel the dictionary search works on only one wordlist.
85: \ The following stuff builds a thing that looks to the kernel like one
1.2 anton 86: \ wordlist, but when searched it searches the whole search order
87: \ (including locals)
1.1 anton 88:
1.2 anton 89: \ this is the wordlist-map of the dictionary
1.19 anton 90: Create vocsearch ( -- wordlist-map )
91: ' (localsvocfind) A, ' (reveal) A, ' drop A,
1.1 anton 92:
93: \ Only root 14may93py
94:
1.2 anton 95: wordlist \ the wordlist structure
1.21 pazsan 96: vocsearch over wordlist-map ! \ patch the map into it
1.1 anton 97:
98: Vocabulary Forth
99: Vocabulary Root
100:
101: : Only vp off also Root also definitions ;
102:
103: \ set initial search order 14may93py
104:
1.21 pazsan 105: Forth-wordlist @ ' Forth >body !
1.1 anton 106:
1.8 pazsan 107: vp off also Root also definitions
1.1 anton 108: Only Forth also definitions
109:
1.21 pazsan 110: lookup ! \ our dictionary search order becomes the law
1.3 pazsan 111:
1.21 pazsan 112: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
1.12 anton 113:
114:
1.1 anton 115: \ get-order set-order 14may93py
116:
117: : get-order ( -- wid1 .. widn n )
118: vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ;
119:
120: : set-order ( wid1 .. widn n / -1 -- )
121: dup -1 = IF drop Only exit THEN dup vp !
122: ?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ;
123:
124: : seal ( -- ) context @ 1 set-order ;
125:
126: \ words visible in roots 14may93py
127:
1.14 anton 128: : .name ( name -- ) \ gforth dot-name
129: name>string type space ;
130:
131: require termsize.fs
132:
133: : words ( -- ) \ tools
134: cr 0 context @
135: BEGIN
136: @ dup
137: WHILE
138: 2dup name>string nip 2 + dup >r +
139: cols >=
140: IF
141: cr nip 0 swap
142: THEN
143: dup .name space r> rot + swap
144: REPEAT
145: 2drop ;
1.1 anton 146:
1.16 anton 147: ' words alias vlist ( -- ) \ gforth
148: \g Old (pre-Forth-83) name for @code{WORDS}.
149:
1.1 anton 150: : body> ( data -- cfa ) 0 >body - ;
151:
1.14 anton 152: : .voc
153: body> >name .name ;
1.12 anton 154: : order ( -- ) \ search-ext
155: \g prints the search order and the @code{current} wordlist. The
156: \g standard requires that the wordlists are printed in the order
157: \g in which they are searched. Therefore, the output is reversed
158: \g with respect to the conventional way of displaying stacks. The
159: \g @code{current} wordlist is displayed last.
160: get-order 0
161: ?DO
162: .voc
163: LOOP
164: 4 spaces get-current .voc ;
165: : vocs ( -- ) \ gforth
166: \g prints vocabularies and wordlists defined in the system.
167: voclink
168: BEGIN
169: @ dup @
170: WHILE
171: dup 0 wordlist-link - .voc
172: REPEAT
173: drop ;
1.1 anton 174:
175: Root definitions
176:
177: ' words Alias words
178: ' Forth Alias Forth
1.11 anton 179: ' forth-wordlist alias forth-wordlist
180: ' set-order alias set-order
181: ' order alias order
1.1 anton 182:
183: Forth definitions
1.5 pazsan 184:
1.6 anton 185: include hash.fs
1.9 pazsan 186:
1.17 anton 187: \ table (case-sensitive wordlist)
188:
189: : table-find ( addr len wordlist -- nfa / false )
190: >r 2dup r> bucket @ (tablefind) ;
191:
192: Create tablesearch-map ( -- wordlist-map )
193: ' table-find A, ' hash-reveal A, ' (rehash) A,
194:
195: : table ( -- wid )
196: \g create a case-sensitive wordlist
197: wordlist
198: tablesearch-map over wordlist-map ! ;
199:
1.9 pazsan 200: \ marker 18dec94py
201:
202: \ Marker creates a mark that is removed (including everything
203: \ defined afterwards) when executing the mark.
204:
205: : marker, ( -- mark ) here dup A,
206: voclink @ A, voclink
1.10 pazsan 207: BEGIN @ dup @ WHILE dup 0 wordlist-link - @ A, REPEAT drop
1.9 pazsan 208: udp @ , ;
209:
1.22 ! anton 210: : marker! ( mark -- )
! 211: dup @ swap cell+
! 212: dup @ voclink ! cell+
! 213: voclink
! 214: BEGIN
! 215: @ dup @
! 216: WHILE
! 217: over @ over 0 wordlist-link - !
! 218: swap cell+ swap
! 219: REPEAT
! 220: drop voclink
! 221: BEGIN
! 222: @ dup @
! 223: WHILE
! 224: dup 0 wordlist-link - rehash
! 225: REPEAT
! 226: drop
! 227: @ udp ! dp ! ;
1.9 pazsan 228:
229: : marker ( "mark" -- )
1.22 ! anton 230: marker, Create A,
! 231: DOES> ( -- )
! 232: @ marker! ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to search-order.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth