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