Deleted Added
sdiff udiff text old ( 76116 ) new ( 94290 )
full compact
search.c (76116) search.c (94290)
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
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.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $
7** $Id: search.c,v 1.9 2001/12/05 07:21:34 jsadler 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**
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**
15** L I C E N S E and D I S C L A I M E R
16**
17** Redistribution and use in source and binary forms, with or without
18** modification, are permitted provided that the following conditions
19** are met:
20** 1. Redistributions of source code must retain the above copyright
21** notice, this list of conditions and the following disclaimer.
22** 2. Redistributions in binary form must reproduce the above copyright

--- 6 unchanged lines hidden (view full) ---

29** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
30** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
31** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
34** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
35** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
36** SUCH DAMAGE.
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

--- 6 unchanged lines hidden (view full) ---

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.
37**
38** I am interested in hearing from anyone who uses ficl. If you have
39** a problem, a success story, a defect, an enhancement request, or
40** if you would like to contribute to the ficl release, please send
41** contact me by email at the address above.
42**
43** $Id: search.c,v 1.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $
44*/
45
42*/
43
46/* $FreeBSD: head/sys/boot/ficl/search.c 76116 2001-04-29 02:36:36Z dcs $ */
44/* $FreeBSD: head/sys/boot/ficl/search.c 94290 2002-04-09 17:45:28Z dcs $ */
47
48#include <string.h>
49#include "ficl.h"
50#include "math64.h"
51
52/**************************************************************************
53 d e f i n i t i o n s
54** SEARCH ( -- )
55** Make the compilation word list the same as the first word list in the
56** search order. Specifies that the names of subsequent definitions will
57** be placed in the compilation word list. Subsequent changes in the search
58** order will not affect the compilation word list.
59**************************************************************************/
60static void definitions(FICL_VM *pVM)
61{
45
46#include <string.h>
47#include "ficl.h"
48#include "math64.h"
49
50/**************************************************************************
51 d e f i n i t i o n s
52** SEARCH ( -- )
53** Make the compilation word list the same as the first word list in the
54** search order. Specifies that the names of subsequent definitions will
55** be placed in the compilation word list. Subsequent changes in the search
56** order will not affect the compilation word list.
57**************************************************************************/
58static void definitions(FICL_VM *pVM)
59{
62 FICL_DICT *pDict = ficlGetDict();
60 FICL_DICT *pDict = vmGetDict(pVM);
63
64 assert(pDict);
65 if (pDict->nLists < 1)
66 {
67 vmThrowErr(pVM, "DEFINITIONS error - empty search order");
68 }
69
70 pDict->pCompile = pDict->pSearch[pDict->nLists-1];

--- 5 unchanged lines hidden (view full) ---

76 f o r t h - w o r d l i s t
77** SEARCH ( -- wid )
78** Return wid, the identifier of the word list that includes all standard
79** words provided by the implementation. This word list is initially the
80** compilation word list and is part of the initial search order.
81**************************************************************************/
82static void forthWordlist(FICL_VM *pVM)
83{
61
62 assert(pDict);
63 if (pDict->nLists < 1)
64 {
65 vmThrowErr(pVM, "DEFINITIONS error - empty search order");
66 }
67
68 pDict->pCompile = pDict->pSearch[pDict->nLists-1];

--- 5 unchanged lines hidden (view full) ---

74 f o r t h - w o r d l i s t
75** SEARCH ( -- wid )
76** Return wid, the identifier of the word list that includes all standard
77** words provided by the implementation. This word list is initially the
78** compilation word list and is part of the initial search order.
79**************************************************************************/
80static void forthWordlist(FICL_VM *pVM)
81{
84 FICL_HASH *pHash = ficlGetDict()->pForthWords;
82 FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
85 stackPushPtr(pVM->pStack, pHash);
86 return;
87}
88
89
90/**************************************************************************
91 g e t - c u r r e n t
92** SEARCH ( -- wid )
93** Return wid, the identifier of the compilation word list.
94**************************************************************************/
95static void getCurrent(FICL_VM *pVM)
96{
97 ficlLockDictionary(TRUE);
83 stackPushPtr(pVM->pStack, pHash);
84 return;
85}
86
87
88/**************************************************************************
89 g e t - c u r r e n t
90** SEARCH ( -- wid )
91** Return wid, the identifier of the compilation word list.
92**************************************************************************/
93static void getCurrent(FICL_VM *pVM)
94{
95 ficlLockDictionary(TRUE);
98 stackPushPtr(pVM->pStack, ficlGetDict()->pCompile);
96 stackPushPtr(pVM->pStack, vmGetDict(pVM)->pCompile);
99 ficlLockDictionary(FALSE);
100 return;
101}
102
103
104/**************************************************************************
105 g e t - o r d e r
106** SEARCH ( -- widn ... wid1 n )
107** Returns the number of word lists n in the search order and the word list
108** identifiers widn ... wid1 identifying these word lists. wid1 identifies
109** the word list that is searched first, and widn the word list that is
110** searched last. The search order is unaffected.
111**************************************************************************/
112static void getOrder(FICL_VM *pVM)
113{
97 ficlLockDictionary(FALSE);
98 return;
99}
100
101
102/**************************************************************************
103 g e t - o r d e r
104** SEARCH ( -- widn ... wid1 n )
105** Returns the number of word lists n in the search order and the word list
106** identifiers widn ... wid1 identifying these word lists. wid1 identifies
107** the word list that is searched first, and widn the word list that is
108** searched last. The search order is unaffected.
109**************************************************************************/
110static void getOrder(FICL_VM *pVM)
111{
114 FICL_DICT *pDict = ficlGetDict();
112 FICL_DICT *pDict = vmGetDict(pVM);
115 int nLists = pDict->nLists;
116 int i;
117
118 ficlLockDictionary(TRUE);
119 for (i = 0; i < nLists; i++)
120 {
121 stackPushPtr(pVM->pStack, pDict->pSearch[i]);
122 }

--- 44 unchanged lines hidden (view full) ---

167/**************************************************************************
168 s e t - c u r r e n t
169** SEARCH ( wid -- )
170** Set the compilation word list to the word list identified by wid.
171**************************************************************************/
172static void setCurrent(FICL_VM *pVM)
173{
174 FICL_HASH *pHash = stackPopPtr(pVM->pStack);
113 int nLists = pDict->nLists;
114 int i;
115
116 ficlLockDictionary(TRUE);
117 for (i = 0; i < nLists; i++)
118 {
119 stackPushPtr(pVM->pStack, pDict->pSearch[i]);
120 }

--- 44 unchanged lines hidden (view full) ---

165/**************************************************************************
166 s e t - c u r r e n t
167** SEARCH ( wid -- )
168** Set the compilation word list to the word list identified by wid.
169**************************************************************************/
170static void setCurrent(FICL_VM *pVM)
171{
172 FICL_HASH *pHash = stackPopPtr(pVM->pStack);
175 FICL_DICT *pDict = ficlGetDict();
173 FICL_DICT *pDict = vmGetDict(pVM);
176 ficlLockDictionary(TRUE);
177 pDict->pCompile = pHash;
178 ficlLockDictionary(FALSE);
179 return;
180}
181
182
183/**************************************************************************

--- 6 unchanged lines hidden (view full) ---

190** search order. The minimum search order shall include the words
191** FORTH-WORDLIST and SET-ORDER. A system shall allow n to
192** be at least eight.
193**************************************************************************/
194static void setOrder(FICL_VM *pVM)
195{
196 int i;
197 int nLists = stackPopINT(pVM->pStack);
174 ficlLockDictionary(TRUE);
175 pDict->pCompile = pHash;
176 ficlLockDictionary(FALSE);
177 return;
178}
179
180
181/**************************************************************************

--- 6 unchanged lines hidden (view full) ---

188** search order. The minimum search order shall include the words
189** FORTH-WORDLIST and SET-ORDER. A system shall allow n to
190** be at least eight.
191**************************************************************************/
192static void setOrder(FICL_VM *pVM)
193{
194 int i;
195 int nLists = stackPopINT(pVM->pStack);
198 FICL_DICT *dp = ficlGetDict();
196 FICL_DICT *dp = vmGetDict(pVM);
199
200 if (nLists > FICL_DEFAULT_VOCS)
201 {
202 vmThrowErr(pVM, "set-order error: list would be too large");
203 }
204
205 ficlLockDictionary(TRUE);
206

--- 27 unchanged lines hidden (view full) ---

234** 1. ficl creates a new single-list hash in the dictionary and returns
235** its address.
236** 2. ficl-wordlist takes an arg off the stack indicating the number of
237** hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
238** : wordlist 1 ficl-wordlist ;
239**************************************************************************/
240static void ficlWordlist(FICL_VM *pVM)
241{
197
198 if (nLists > FICL_DEFAULT_VOCS)
199 {
200 vmThrowErr(pVM, "set-order error: list would be too large");
201 }
202
203 ficlLockDictionary(TRUE);
204

--- 27 unchanged lines hidden (view full) ---

232** 1. ficl creates a new single-list hash in the dictionary and returns
233** its address.
234** 2. ficl-wordlist takes an arg off the stack indicating the number of
235** hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
236** : wordlist 1 ficl-wordlist ;
237**************************************************************************/
238static void ficlWordlist(FICL_VM *pVM)
239{
242 FICL_DICT *dp = ficlGetDict();
240 FICL_DICT *dp = vmGetDict(pVM);
243 FICL_HASH *pHash;
244 FICL_UNS nBuckets;
245
246#if FICL_ROBUST > 1
247 vmCheckStack(pVM, 1, 1);
248#endif
249 nBuckets = stackPopUNS(pVM->pStack);
250 pHash = dictCreateWordlist(dp, nBuckets);

--- 4 unchanged lines hidden (view full) ---

255
256/**************************************************************************
257 S E A R C H >
258** ficl ( -- wid )
259** Pop wid off the search order. Error if the search order is empty
260**************************************************************************/
261static void searchPop(FICL_VM *pVM)
262{
241 FICL_HASH *pHash;
242 FICL_UNS nBuckets;
243
244#if FICL_ROBUST > 1
245 vmCheckStack(pVM, 1, 1);
246#endif
247 nBuckets = stackPopUNS(pVM->pStack);
248 pHash = dictCreateWordlist(dp, nBuckets);

--- 4 unchanged lines hidden (view full) ---

253
254/**************************************************************************
255 S E A R C H >
256** ficl ( -- wid )
257** Pop wid off the search order. Error if the search order is empty
258**************************************************************************/
259static void searchPop(FICL_VM *pVM)
260{
263 FICL_DICT *dp = ficlGetDict();
261 FICL_DICT *dp = vmGetDict(pVM);
264 int nLists;
265
266 ficlLockDictionary(TRUE);
267 nLists = dp->nLists;
268 if (nLists == 0)
269 {
270 vmThrowErr(pVM, "search> error: empty search order");
271 }

--- 5 unchanged lines hidden (view full) ---

277
278/**************************************************************************
279 > S E A R C H
280** ficl ( wid -- )
281** Push wid onto the search order. Error if the search order is full.
282**************************************************************************/
283static void searchPush(FICL_VM *pVM)
284{
262 int nLists;
263
264 ficlLockDictionary(TRUE);
265 nLists = dp->nLists;
266 if (nLists == 0)
267 {
268 vmThrowErr(pVM, "search> error: empty search order");
269 }

--- 5 unchanged lines hidden (view full) ---

275
276/**************************************************************************
277 > S E A R C H
278** ficl ( wid -- )
279** Push wid onto the search order. Error if the search order is full.
280**************************************************************************/
281static void searchPush(FICL_VM *pVM)
282{
285 FICL_DICT *dp = ficlGetDict();
283 FICL_DICT *dp = vmGetDict(pVM);
286
287 ficlLockDictionary(TRUE);
288 if (dp->nLists > FICL_DEFAULT_VOCS)
289 {
290 vmThrowErr(pVM, ">search error: search order overflow");
291 }
292 dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack);
293 ficlLockDictionary(FALSE);

--- 5 unchanged lines hidden (view full) ---

299 W I D - G E T - N A M E
300** ficl ( wid -- c-addr u )
301** Get wid's (optional) name and push onto stack as a counted string
302**************************************************************************/
303static void widGetName(FICL_VM *pVM)
304{
305 FICL_HASH *pHash = vmPop(pVM).p;
306 char *cp = pHash->name;
284
285 ficlLockDictionary(TRUE);
286 if (dp->nLists > FICL_DEFAULT_VOCS)
287 {
288 vmThrowErr(pVM, ">search error: search order overflow");
289 }
290 dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack);
291 ficlLockDictionary(FALSE);

--- 5 unchanged lines hidden (view full) ---

297 W I D - G E T - N A M E
298** ficl ( wid -- c-addr u )
299** Get wid's (optional) name and push onto stack as a counted string
300**************************************************************************/
301static void widGetName(FICL_VM *pVM)
302{
303 FICL_HASH *pHash = vmPop(pVM).p;
304 char *cp = pHash->name;
307 int len = 0;
305 FICL_INT len = 0;
308
309 if (cp)
310 len = strlen(cp);
311
312 vmPush(pVM, LVALUEtoCELL(cp));
313 vmPush(pVM, LVALUEtoCELL(len));
314 return;
315}

--- 61 unchanged lines hidden (view full) ---

377 setCurrent, FW_DEFAULT);
378 dictAppendWord(dp, "set-order", setOrder, FW_DEFAULT);
379 dictAppendWord(dp, "ficl-wordlist",
380 ficlWordlist, FW_DEFAULT);
381
382 /*
383 ** Set SEARCH environment query values
384 */
306
307 if (cp)
308 len = strlen(cp);
309
310 vmPush(pVM, LVALUEtoCELL(cp));
311 vmPush(pVM, LVALUEtoCELL(len));
312 return;
313}

--- 61 unchanged lines hidden (view full) ---

375 setCurrent, FW_DEFAULT);
376 dictAppendWord(dp, "set-order", setOrder, FW_DEFAULT);
377 dictAppendWord(dp, "ficl-wordlist",
378 ficlWordlist, FW_DEFAULT);
379
380 /*
381 ** Set SEARCH environment query values
382 */
385 ficlSetEnv("search-order", FICL_TRUE);
386 ficlSetEnv("search-order-ext", FICL_TRUE);
387 ficlSetEnv("wordlists", FICL_DEFAULT_VOCS);
383 ficlSetEnv(pSys, "search-order", FICL_TRUE);
384 ficlSetEnv(pSys, "search-order-ext", FICL_TRUE);
385 ficlSetEnv(pSys, "wordlists", FICL_DEFAULT_VOCS);
388
389 dictAppendWord(dp, "wid-get-name", widGetName, FW_DEFAULT);
390 dictAppendWord(dp, "wid-set-name", widSetName, FW_DEFAULT);
391 dictAppendWord(dp, "wid-set-super",
392 setParentWid, FW_DEFAULT);
393 return;
394}
395
386
387 dictAppendWord(dp, "wid-get-name", widGetName, FW_DEFAULT);
388 dictAppendWord(dp, "wid-set-name", widSetName, FW_DEFAULT);
389 dictAppendWord(dp, "wid-set-super",
390 setParentWid, FW_DEFAULT);
391 return;
392}
393