xref: /illumos-gate/usr/src/common/ficl/search.c (revision c0bb4f7308f9d7f3f31eb636c73ef07c6d19b5f3)
1 /*
2  * s e a r c h . c
3  * Forth Inspired Command Language
4  * ANS Forth SEARCH and SEARCH-EXT word-set written in C
5  * Author: John Sadler (john_sadler@alum.mit.edu)
6  * Created: 6 June 2000
7  * $Id: search.c,v 1.10 2010/08/12 13:57:22 asau Exp $
8  */
9 /*
10  * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
11  * All rights reserved.
12  *
13  * Get the latest Ficl release at http://ficl.sourceforge.net
14  *
15  * I am interested in hearing from anyone who uses Ficl. If you have
16  * a problem, a success story, a defect, an enhancement request, or
17  * if you would like to contribute to the Ficl release, please
18  * contact me by email at the address above.
19  *
20  * L I C E N S E  and  D I S C L A I M E R
21  *
22  * Redistribution and use in source and binary forms, with or without
23  * modification, are permitted provided that the following conditions
24  * are met:
25  * 1. Redistributions of source code must retain the above copyright
26  *    notice, this list of conditions and the following disclaimer.
27  * 2. Redistributions in binary form must reproduce the above copyright
28  *    notice, this list of conditions and the following disclaimer in the
29  *    documentation and/or other materials provided with the distribution.
30  *
31  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
32  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
33  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
34  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
35  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
36  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
37  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
38  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
39  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
40  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
41  * SUCH DAMAGE.
42  */
43 
44 #include <string.h>
45 #include "ficl.h"
46 
47 /*
48  * d e f i n i t i o n s
49  * SEARCH ( -- )
50  * Make the compilation word list the same as the first word list in the
51  * search order. Specifies that the names of subsequent definitions will
52  * be placed in the compilation word list. Subsequent changes in the search
53  * order will not affect the compilation word list.
54  */
55 static void
ficlPrimitiveDefinitions(ficlVm * vm)56 ficlPrimitiveDefinitions(ficlVm *vm)
57 {
58 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
59 
60 	FICL_VM_ASSERT(vm, dictionary);
61 	if (dictionary->wordlistCount < 1) {
62 		ficlVmThrowError(vm, "DEFINITIONS error - empty search order");
63 	}
64 
65 	dictionary->compilationWordlist =
66 	    dictionary->wordlists[dictionary->wordlistCount-1];
67 }
68 
69 /*
70  * f o r t h - w o r d l i s t
71  * SEARCH ( -- wid )
72  * Return wid, the identifier of the word list that includes all standard
73  * words provided by the implementation. This word list is initially the
74  * compilation word list and is part of the initial search order.
75  */
76 static void
ficlPrimitiveForthWordlist(ficlVm * vm)77 ficlPrimitiveForthWordlist(ficlVm *vm)
78 {
79 	ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
80 	ficlStackPushPointer(vm->dataStack, hash);
81 }
82 
83 
84 /*
85  * g e t - c u r r e n t
86  * SEARCH ( -- wid )
87  * Return wid, the identifier of the compilation word list.
88  */
89 static void
ficlPrimitiveGetCurrent(ficlVm * vm)90 ficlPrimitiveGetCurrent(ficlVm *vm)
91 {
92 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
93 	ficlDictionaryLock(dictionary, FICL_TRUE);
94 	ficlStackPushPointer(vm->dataStack, dictionary->compilationWordlist);
95 	ficlDictionaryLock(dictionary, FICL_FALSE);
96 }
97 
98 /*
99  * g e t - o r d e r
100  * SEARCH ( -- widn ... wid1 n )
101  * Returns the number of word lists n in the search order and the word list
102  * identifiers widn ... wid1 identifying these word lists. wid1 identifies
103  * the word list that is searched first, and widn the word list that is
104  * searched last. The search order is unaffected.
105  */
106 static void
ficlPrimitiveGetOrder(ficlVm * vm)107 ficlPrimitiveGetOrder(ficlVm *vm)
108 {
109 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
110 	int wordlistCount = dictionary->wordlistCount;
111 	int i;
112 
113 	ficlDictionaryLock(dictionary, FICL_TRUE);
114 	for (i = 0; i < wordlistCount; i++) {
115 		ficlStackPushPointer(vm->dataStack, dictionary->wordlists[i]);
116 	}
117 
118 	ficlStackPushUnsigned(vm->dataStack, wordlistCount);
119 	ficlDictionaryLock(dictionary, FICL_FALSE);
120 }
121 
122 /*
123  * s e a r c h - w o r d l i s t
124  * SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
125  * Find the definition identified by the string c-addr u in the word list
126  * identified by wid. If the definition is not found, return zero. If the
127  * definition is found, return its execution token xt and one (1) if the
128  * definition is immediate, minus-one (-1) otherwise.
129  */
130 static void
ficlPrimitiveSearchWordlist(ficlVm * vm)131 ficlPrimitiveSearchWordlist(ficlVm *vm)
132 {
133 	ficlString name;
134 	ficlUnsigned16 hashCode;
135 	ficlWord *word;
136 	ficlHash *hash = ficlStackPopPointer(vm->dataStack);
137 
138 	name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
139 	name.text = ficlStackPopPointer(vm->dataStack);
140 	hashCode = ficlHashCode(name);
141 
142 	ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_TRUE);
143 	word = ficlHashLookup(hash, name, hashCode);
144 	ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_FALSE);
145 
146 	if (word) {
147 		ficlStackPushPointer(vm->dataStack, word);
148 		ficlStackPushInteger(vm->dataStack,
149 		    (ficlWordIsImmediate(word) ? 1 : -1));
150 	} else {
151 		ficlStackPushUnsigned(vm->dataStack, 0);
152 	}
153 }
154 
155 /*
156  * s e t - c u r r e n t
157  * SEARCH ( wid -- )
158  * Set the compilation word list to the word list identified by wid.
159  */
160 static void
ficlPrimitiveSetCurrent(ficlVm * vm)161 ficlPrimitiveSetCurrent(ficlVm *vm)
162 {
163 	ficlHash *hash = ficlStackPopPointer(vm->dataStack);
164 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
165 	ficlDictionaryLock(dictionary, FICL_TRUE);
166 	dictionary->compilationWordlist = hash;
167 	ficlDictionaryLock(dictionary, FICL_FALSE);
168 }
169 
170 /*
171  *                      s e t - o r d e r
172  * SEARCH ( widn ... wid1 n -- )
173  * Set the search order to the word lists identified by widn ... wid1.
174  * Subsequently, word list wid1 will be searched first, and word list
175  * widn searched last. If n is zero, empty the search order. If n is minus
176  * one, set the search order to the implementation-defined minimum
177  * search order. The minimum search order shall include the words
178  * FORTH-WORDLIST and SET-ORDER. A system shall allow n to
179  * be at least eight.
180  */
181 static void
ficlPrimitiveSetOrder(ficlVm * vm)182 ficlPrimitiveSetOrder(ficlVm *vm)
183 {
184 	int i;
185 	int wordlistCount = ficlStackPopInteger(vm->dataStack);
186 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
187 
188 	if (wordlistCount > FICL_MAX_WORDLISTS) {
189 		ficlVmThrowError(vm,
190 		    "set-order error: list would be too large");
191 	}
192 
193 	ficlDictionaryLock(dictionary, FICL_TRUE);
194 
195 	if (wordlistCount >= 0) {
196 		dictionary->wordlistCount = wordlistCount;
197 		for (i = wordlistCount-1; i >= 0; --i) {
198 			dictionary->wordlists[i] =
199 			    ficlStackPopPointer(vm->dataStack);
200 		}
201 	} else {
202 		ficlDictionaryResetSearchOrder(dictionary);
203 	}
204 
205 	ficlDictionaryLock(dictionary, FICL_FALSE);
206 }
207 
208 /*
209  * f i c l - w o r d l i s t
210  * SEARCH ( -- wid )
211  * Create a new empty word list, returning its word list identifier wid.
212  * The new word list may be returned from a pool of preallocated word
213  * lists or may be dynamically allocated in data space. A system shall
214  * allow the creation of at least 8 new word lists in addition to any
215  * provided as part of the system.
216  * Notes:
217  * 1. Ficl creates a new single-list hash in the dictionary and returns
218  *    its address.
219  * 2. ficl-wordlist takes an arg off the stack indicating the number of
220  *    hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
221  *    : wordlist 1 ficl-wordlist ;
222  */
223 static void
ficlPrimitiveFiclWordlist(ficlVm * vm)224 ficlPrimitiveFiclWordlist(ficlVm *vm)
225 {
226 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
227 	ficlHash *hash;
228 	ficlUnsigned nBuckets;
229 
230 	FICL_STACK_CHECK(vm->dataStack, 1, 1);
231 
232 	nBuckets = ficlStackPopUnsigned(vm->dataStack);
233 	hash = ficlDictionaryCreateWordlist(dictionary, nBuckets);
234 	ficlStackPushPointer(vm->dataStack, hash);
235 }
236 
237 /*
238  * S E A R C H >
239  * Ficl  ( -- wid )
240  * Pop wid off the search order. Error if the search order is empty
241  */
242 static void
ficlPrimitiveSearchPop(ficlVm * vm)243 ficlPrimitiveSearchPop(ficlVm *vm)
244 {
245 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
246 	int wordlistCount;
247 
248 	ficlDictionaryLock(dictionary, FICL_TRUE);
249 	wordlistCount = dictionary->wordlistCount;
250 	if (wordlistCount == 0) {
251 		ficlVmThrowError(vm, "search> error: empty search order");
252 	}
253 	ficlStackPushPointer(vm->dataStack,
254 	    dictionary->wordlists[--dictionary->wordlistCount]);
255 	ficlDictionaryLock(dictionary, FICL_FALSE);
256 }
257 
258 /*
259  * > S E A R C H
260  * Ficl  ( wid -- )
261  * Push wid onto the search order. Error if the search order is full.
262  */
263 static void
ficlPrimitiveSearchPush(ficlVm * vm)264 ficlPrimitiveSearchPush(ficlVm *vm)
265 {
266 	ficlDictionary *dictionary = ficlVmGetDictionary(vm);
267 
268 	ficlDictionaryLock(dictionary, FICL_TRUE);
269 	if (dictionary->wordlistCount > FICL_MAX_WORDLISTS) {
270 		ficlVmThrowError(vm, ">search error: search order overflow");
271 	}
272 	dictionary->wordlists[dictionary->wordlistCount++] =
273 	    ficlStackPopPointer(vm->dataStack);
274 	ficlDictionaryLock(dictionary, FICL_FALSE);
275 }
276 
277 /*
278  * W I D - G E T - N A M E
279  * Ficl  ( wid -- c-addr u )
280  * Get wid's (optional) name and push onto stack as a counted string
281  */
282 static void
ficlPrimitiveWidGetName(ficlVm * vm)283 ficlPrimitiveWidGetName(ficlVm *vm)
284 {
285 	ficlHash *hash;
286 	char *name;
287 	ficlInteger length;
288 	ficlCell c;
289 
290 	hash = ficlVmPop(vm).p;
291 	name = hash->name;
292 
293 	if (name != NULL)
294 		length = strlen(name);
295 	else
296 		length = 0;
297 
298 	c.p = name;
299 	ficlVmPush(vm, c);
300 
301 	c.i = length;
302 	ficlVmPush(vm, c);
303 }
304 
305 /*
306  * W I D - S E T - N A M E
307  * Ficl  ( wid c-addr -- )
308  * Set wid's name pointer to the \0 terminated string address supplied
309  */
310 static void
ficlPrimitiveWidSetName(ficlVm * vm)311 ficlPrimitiveWidSetName(ficlVm *vm)
312 {
313 	char *name = (char *)ficlVmPop(vm).p;
314 	ficlHash *hash = ficlVmPop(vm).p;
315 	hash->name = name;
316 }
317 
318 /*
319  * setParentWid
320  * Ficl
321  * setparentwid   ( parent-wid wid -- )
322  * Set WID's link field to the parent-wid. search-wordlist will
323  * iterate through all the links when finding words in the child wid.
324  */
325 static void
ficlPrimitiveSetParentWid(ficlVm * vm)326 ficlPrimitiveSetParentWid(ficlVm *vm)
327 {
328 	ficlHash *parent, *child;
329 
330 	FICL_STACK_CHECK(vm->dataStack, 2, 0);
331 
332 	child  = (ficlHash *)ficlStackPopPointer(vm->dataStack);
333 	parent = (ficlHash *)ficlStackPopPointer(vm->dataStack);
334 
335 	child->link = parent;
336 }
337 
338 /*
339  * f i c l C o m p i l e S e a r c h
340  * Builds the primitive wordset and the environment-query namespace.
341  */
342 void
ficlSystemCompileSearch(ficlSystem * system)343 ficlSystemCompileSearch(ficlSystem *system)
344 {
345 	ficlDictionary *dictionary = ficlSystemGetDictionary(system);
346 	ficlDictionary *environment = ficlSystemGetEnvironment(system);
347 
348 	FICL_SYSTEM_ASSERT(system, dictionary);
349 	FICL_SYSTEM_ASSERT(system, environment);
350 
351 	/*
352 	 * optional SEARCH-ORDER word set
353 	 */
354 	(void) ficlDictionarySetPrimitive(dictionary, ">search",
355 	    ficlPrimitiveSearchPush, FICL_WORD_DEFAULT);
356 	(void) ficlDictionarySetPrimitive(dictionary, "search>",
357 	    ficlPrimitiveSearchPop, FICL_WORD_DEFAULT);
358 	(void) ficlDictionarySetPrimitive(dictionary, "definitions",
359 	    ficlPrimitiveDefinitions, FICL_WORD_DEFAULT);
360 	(void) ficlDictionarySetPrimitive(dictionary, "forth-wordlist",
361 	    ficlPrimitiveForthWordlist, FICL_WORD_DEFAULT);
362 	(void) ficlDictionarySetPrimitive(dictionary, "get-current",
363 	    ficlPrimitiveGetCurrent, FICL_WORD_DEFAULT);
364 	(void) ficlDictionarySetPrimitive(dictionary, "get-order",
365 	    ficlPrimitiveGetOrder, FICL_WORD_DEFAULT);
366 	(void) ficlDictionarySetPrimitive(dictionary, "search-wordlist",
367 	    ficlPrimitiveSearchWordlist, FICL_WORD_DEFAULT);
368 	(void) ficlDictionarySetPrimitive(dictionary, "set-current",
369 	    ficlPrimitiveSetCurrent, FICL_WORD_DEFAULT);
370 	(void) ficlDictionarySetPrimitive(dictionary, "set-order",
371 	    ficlPrimitiveSetOrder, FICL_WORD_DEFAULT);
372 	(void) ficlDictionarySetPrimitive(dictionary, "ficl-wordlist",
373 	    ficlPrimitiveFiclWordlist, FICL_WORD_DEFAULT);
374 
375 	/*
376 	 * Set SEARCH environment query values
377 	 */
378 	(void) ficlDictionarySetConstant(environment, "search-order",
379 	    FICL_TRUE);
380 	(void) ficlDictionarySetConstant(environment, "search-order-ext",
381 	    FICL_TRUE);
382 	(void) ficlDictionarySetConstant(environment, "wordlists",
383 	    FICL_MAX_WORDLISTS);
384 	(void) ficlDictionarySetPrimitive(dictionary, "wid-get-name",
385 	    ficlPrimitiveWidGetName, FICL_WORD_DEFAULT);
386 	(void) ficlDictionarySetPrimitive(dictionary, "wid-set-name",
387 	    ficlPrimitiveWidSetName, FICL_WORD_DEFAULT);
388 	(void) ficlDictionarySetPrimitive(dictionary, "wid-set-super",
389 	    ficlPrimitiveSetParentWid, FICL_WORD_DEFAULT);
390 }
391