search.c revision 76116
176116Sdcs/******************************************************************* 276116Sdcs** s e a r c h . c 376116Sdcs** Forth Inspired Command Language 476116Sdcs** ANS Forth SEARCH and SEARCH-EXT word-set written in C 576116Sdcs** Author: John Sadler (john_sadler@alum.mit.edu) 676116Sdcs** Created: 6 June 2000 776116Sdcs** $Id: search.c,v 1.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $ 876116Sdcs*******************************************************************/ 976116Sdcs/* 1076116Sdcs** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 1176116Sdcs** All rights reserved. 1276116Sdcs** 1376116Sdcs** Get the latest Ficl release at http://ficl.sourceforge.net 1476116Sdcs** 1576116Sdcs** L I C E N S E and D I S C L A I M E R 1676116Sdcs** 1776116Sdcs** Redistribution and use in source and binary forms, with or without 1876116Sdcs** modification, are permitted provided that the following conditions 1976116Sdcs** are met: 2076116Sdcs** 1. Redistributions of source code must retain the above copyright 2176116Sdcs** notice, this list of conditions and the following disclaimer. 2276116Sdcs** 2. Redistributions in binary form must reproduce the above copyright 2376116Sdcs** notice, this list of conditions and the following disclaimer in the 2476116Sdcs** documentation and/or other materials provided with the distribution. 2576116Sdcs** 2676116Sdcs** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 2776116Sdcs** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 2876116Sdcs** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 2976116Sdcs** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 3076116Sdcs** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 3176116Sdcs** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 3276116Sdcs** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 3376116Sdcs** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 3476116Sdcs** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 3576116Sdcs** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 3676116Sdcs** SUCH DAMAGE. 3776116Sdcs** 3876116Sdcs** I am interested in hearing from anyone who uses ficl. If you have 3976116Sdcs** a problem, a success story, a defect, an enhancement request, or 4076116Sdcs** if you would like to contribute to the ficl release, please send 4176116Sdcs** contact me by email at the address above. 4276116Sdcs** 4376116Sdcs** $Id: search.c,v 1.4 2001-04-26 21:41:31-07 jsadler Exp jsadler $ 4476116Sdcs*/ 4576116Sdcs 4676116Sdcs/* $FreeBSD: head/sys/boot/ficl/search.c 76116 2001-04-29 02:36:36Z dcs $ */ 4776116Sdcs 4876116Sdcs#include <string.h> 4976116Sdcs#include "ficl.h" 5076116Sdcs#include "math64.h" 5176116Sdcs 5276116Sdcs/************************************************************************** 5376116Sdcs d e f i n i t i o n s 5476116Sdcs** SEARCH ( -- ) 5576116Sdcs** Make the compilation word list the same as the first word list in the 5676116Sdcs** search order. Specifies that the names of subsequent definitions will 5776116Sdcs** be placed in the compilation word list. Subsequent changes in the search 5876116Sdcs** order will not affect the compilation word list. 5976116Sdcs**************************************************************************/ 6076116Sdcsstatic void definitions(FICL_VM *pVM) 6176116Sdcs{ 6276116Sdcs FICL_DICT *pDict = ficlGetDict(); 6376116Sdcs 6476116Sdcs assert(pDict); 6576116Sdcs if (pDict->nLists < 1) 6676116Sdcs { 6776116Sdcs vmThrowErr(pVM, "DEFINITIONS error - empty search order"); 6876116Sdcs } 6976116Sdcs 7076116Sdcs pDict->pCompile = pDict->pSearch[pDict->nLists-1]; 7176116Sdcs return; 7276116Sdcs} 7376116Sdcs 7476116Sdcs 7576116Sdcs/************************************************************************** 7676116Sdcs f o r t h - w o r d l i s t 7776116Sdcs** SEARCH ( -- wid ) 7876116Sdcs** Return wid, the identifier of the word list that includes all standard 7976116Sdcs** words provided by the implementation. This word list is initially the 8076116Sdcs** compilation word list and is part of the initial search order. 8176116Sdcs**************************************************************************/ 8276116Sdcsstatic void forthWordlist(FICL_VM *pVM) 8376116Sdcs{ 8476116Sdcs FICL_HASH *pHash = ficlGetDict()->pForthWords; 8576116Sdcs stackPushPtr(pVM->pStack, pHash); 8676116Sdcs return; 8776116Sdcs} 8876116Sdcs 8976116Sdcs 9076116Sdcs/************************************************************************** 9176116Sdcs g e t - c u r r e n t 9276116Sdcs** SEARCH ( -- wid ) 9376116Sdcs** Return wid, the identifier of the compilation word list. 9476116Sdcs**************************************************************************/ 9576116Sdcsstatic void getCurrent(FICL_VM *pVM) 9676116Sdcs{ 9776116Sdcs ficlLockDictionary(TRUE); 9876116Sdcs stackPushPtr(pVM->pStack, ficlGetDict()->pCompile); 9976116Sdcs ficlLockDictionary(FALSE); 10076116Sdcs return; 10176116Sdcs} 10276116Sdcs 10376116Sdcs 10476116Sdcs/************************************************************************** 10576116Sdcs g e t - o r d e r 10676116Sdcs** SEARCH ( -- widn ... wid1 n ) 10776116Sdcs** Returns the number of word lists n in the search order and the word list 10876116Sdcs** identifiers widn ... wid1 identifying these word lists. wid1 identifies 10976116Sdcs** the word list that is searched first, and widn the word list that is 11076116Sdcs** searched last. The search order is unaffected. 11176116Sdcs**************************************************************************/ 11276116Sdcsstatic void getOrder(FICL_VM *pVM) 11376116Sdcs{ 11476116Sdcs FICL_DICT *pDict = ficlGetDict(); 11576116Sdcs int nLists = pDict->nLists; 11676116Sdcs int i; 11776116Sdcs 11876116Sdcs ficlLockDictionary(TRUE); 11976116Sdcs for (i = 0; i < nLists; i++) 12076116Sdcs { 12176116Sdcs stackPushPtr(pVM->pStack, pDict->pSearch[i]); 12276116Sdcs } 12376116Sdcs 12476116Sdcs stackPushUNS(pVM->pStack, nLists); 12576116Sdcs ficlLockDictionary(FALSE); 12676116Sdcs return; 12776116Sdcs} 12876116Sdcs 12976116Sdcs 13076116Sdcs/************************************************************************** 13176116Sdcs s e a r c h - w o r d l i s t 13276116Sdcs** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 ) 13376116Sdcs** Find the definition identified by the string c-addr u in the word list 13476116Sdcs** identified by wid. If the definition is not found, return zero. If the 13576116Sdcs** definition is found, return its execution token xt and one (1) if the 13676116Sdcs** definition is immediate, minus-one (-1) otherwise. 13776116Sdcs**************************************************************************/ 13876116Sdcsstatic void searchWordlist(FICL_VM *pVM) 13976116Sdcs{ 14076116Sdcs STRINGINFO si; 14176116Sdcs UNS16 hashCode; 14276116Sdcs FICL_WORD *pFW; 14376116Sdcs FICL_HASH *pHash = stackPopPtr(pVM->pStack); 14476116Sdcs 14576116Sdcs si.count = (FICL_COUNT)stackPopUNS(pVM->pStack); 14676116Sdcs si.cp = stackPopPtr(pVM->pStack); 14776116Sdcs hashCode = hashHashCode(si); 14876116Sdcs 14976116Sdcs ficlLockDictionary(TRUE); 15076116Sdcs pFW = hashLookup(pHash, si, hashCode); 15176116Sdcs ficlLockDictionary(FALSE); 15276116Sdcs 15376116Sdcs if (pFW) 15476116Sdcs { 15576116Sdcs stackPushPtr(pVM->pStack, pFW); 15676116Sdcs stackPushINT(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1)); 15776116Sdcs } 15876116Sdcs else 15976116Sdcs { 16076116Sdcs stackPushUNS(pVM->pStack, 0); 16176116Sdcs } 16276116Sdcs 16376116Sdcs return; 16476116Sdcs} 16576116Sdcs 16676116Sdcs 16776116Sdcs/************************************************************************** 16876116Sdcs s e t - c u r r e n t 16976116Sdcs** SEARCH ( wid -- ) 17076116Sdcs** Set the compilation word list to the word list identified by wid. 17176116Sdcs**************************************************************************/ 17276116Sdcsstatic void setCurrent(FICL_VM *pVM) 17376116Sdcs{ 17476116Sdcs FICL_HASH *pHash = stackPopPtr(pVM->pStack); 17576116Sdcs FICL_DICT *pDict = ficlGetDict(); 17676116Sdcs ficlLockDictionary(TRUE); 17776116Sdcs pDict->pCompile = pHash; 17876116Sdcs ficlLockDictionary(FALSE); 17976116Sdcs return; 18076116Sdcs} 18176116Sdcs 18276116Sdcs 18376116Sdcs/************************************************************************** 18476116Sdcs s e t - o r d e r 18576116Sdcs** SEARCH ( widn ... wid1 n -- ) 18676116Sdcs** Set the search order to the word lists identified by widn ... wid1. 18776116Sdcs** Subsequently, word list wid1 will be searched first, and word list 18876116Sdcs** widn searched last. If n is zero, empty the search order. If n is minus 18976116Sdcs** one, set the search order to the implementation-defined minimum 19076116Sdcs** search order. The minimum search order shall include the words 19176116Sdcs** FORTH-WORDLIST and SET-ORDER. A system shall allow n to 19276116Sdcs** be at least eight. 19376116Sdcs**************************************************************************/ 19476116Sdcsstatic void setOrder(FICL_VM *pVM) 19576116Sdcs{ 19676116Sdcs int i; 19776116Sdcs int nLists = stackPopINT(pVM->pStack); 19876116Sdcs FICL_DICT *dp = ficlGetDict(); 19976116Sdcs 20076116Sdcs if (nLists > FICL_DEFAULT_VOCS) 20176116Sdcs { 20276116Sdcs vmThrowErr(pVM, "set-order error: list would be too large"); 20376116Sdcs } 20476116Sdcs 20576116Sdcs ficlLockDictionary(TRUE); 20676116Sdcs 20776116Sdcs if (nLists >= 0) 20876116Sdcs { 20976116Sdcs dp->nLists = nLists; 21076116Sdcs for (i = nLists-1; i >= 0; --i) 21176116Sdcs { 21276116Sdcs dp->pSearch[i] = stackPopPtr(pVM->pStack); 21376116Sdcs } 21476116Sdcs } 21576116Sdcs else 21676116Sdcs { 21776116Sdcs dictResetSearchOrder(dp); 21876116Sdcs } 21976116Sdcs 22076116Sdcs ficlLockDictionary(FALSE); 22176116Sdcs return; 22276116Sdcs} 22376116Sdcs 22476116Sdcs 22576116Sdcs/************************************************************************** 22676116Sdcs f i c l - w o r d l i s t 22776116Sdcs** SEARCH ( -- wid ) 22876116Sdcs** Create a new empty word list, returning its word list identifier wid. 22976116Sdcs** The new word list may be returned from a pool of preallocated word 23076116Sdcs** lists or may be dynamically allocated in data space. A system shall 23176116Sdcs** allow the creation of at least 8 new word lists in addition to any 23276116Sdcs** provided as part of the system. 23376116Sdcs** Notes: 23476116Sdcs** 1. ficl creates a new single-list hash in the dictionary and returns 23576116Sdcs** its address. 23676116Sdcs** 2. ficl-wordlist takes an arg off the stack indicating the number of 23776116Sdcs** hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as 23876116Sdcs** : wordlist 1 ficl-wordlist ; 23976116Sdcs**************************************************************************/ 24076116Sdcsstatic void ficlWordlist(FICL_VM *pVM) 24176116Sdcs{ 24276116Sdcs FICL_DICT *dp = ficlGetDict(); 24376116Sdcs FICL_HASH *pHash; 24476116Sdcs FICL_UNS nBuckets; 24576116Sdcs 24676116Sdcs#if FICL_ROBUST > 1 24776116Sdcs vmCheckStack(pVM, 1, 1); 24876116Sdcs#endif 24976116Sdcs nBuckets = stackPopUNS(pVM->pStack); 25076116Sdcs pHash = dictCreateWordlist(dp, nBuckets); 25176116Sdcs stackPushPtr(pVM->pStack, pHash); 25276116Sdcs return; 25376116Sdcs} 25476116Sdcs 25576116Sdcs 25676116Sdcs/************************************************************************** 25776116Sdcs S E A R C H > 25876116Sdcs** ficl ( -- wid ) 25976116Sdcs** Pop wid off the search order. Error if the search order is empty 26076116Sdcs**************************************************************************/ 26176116Sdcsstatic void searchPop(FICL_VM *pVM) 26276116Sdcs{ 26376116Sdcs FICL_DICT *dp = ficlGetDict(); 26476116Sdcs int nLists; 26576116Sdcs 26676116Sdcs ficlLockDictionary(TRUE); 26776116Sdcs nLists = dp->nLists; 26876116Sdcs if (nLists == 0) 26976116Sdcs { 27076116Sdcs vmThrowErr(pVM, "search> error: empty search order"); 27176116Sdcs } 27276116Sdcs stackPushPtr(pVM->pStack, dp->pSearch[--dp->nLists]); 27376116Sdcs ficlLockDictionary(FALSE); 27476116Sdcs return; 27576116Sdcs} 27676116Sdcs 27776116Sdcs 27876116Sdcs/************************************************************************** 27976116Sdcs > S E A R C H 28076116Sdcs** ficl ( wid -- ) 28176116Sdcs** Push wid onto the search order. Error if the search order is full. 28276116Sdcs**************************************************************************/ 28376116Sdcsstatic void searchPush(FICL_VM *pVM) 28476116Sdcs{ 28576116Sdcs FICL_DICT *dp = ficlGetDict(); 28676116Sdcs 28776116Sdcs ficlLockDictionary(TRUE); 28876116Sdcs if (dp->nLists > FICL_DEFAULT_VOCS) 28976116Sdcs { 29076116Sdcs vmThrowErr(pVM, ">search error: search order overflow"); 29176116Sdcs } 29276116Sdcs dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack); 29376116Sdcs ficlLockDictionary(FALSE); 29476116Sdcs return; 29576116Sdcs} 29676116Sdcs 29776116Sdcs 29876116Sdcs/************************************************************************** 29976116Sdcs W I D - G E T - N A M E 30076116Sdcs** ficl ( wid -- c-addr u ) 30176116Sdcs** Get wid's (optional) name and push onto stack as a counted string 30276116Sdcs**************************************************************************/ 30376116Sdcsstatic void widGetName(FICL_VM *pVM) 30476116Sdcs{ 30576116Sdcs FICL_HASH *pHash = vmPop(pVM).p; 30676116Sdcs char *cp = pHash->name; 30776116Sdcs int len = 0; 30876116Sdcs 30976116Sdcs if (cp) 31076116Sdcs len = strlen(cp); 31176116Sdcs 31276116Sdcs vmPush(pVM, LVALUEtoCELL(cp)); 31376116Sdcs vmPush(pVM, LVALUEtoCELL(len)); 31476116Sdcs return; 31576116Sdcs} 31676116Sdcs 31776116Sdcs/************************************************************************** 31876116Sdcs W I D - S E T - N A M E 31976116Sdcs** ficl ( wid c-addr -- ) 32076116Sdcs** Set wid's name pointer to the \0 terminated string address supplied 32176116Sdcs**************************************************************************/ 32276116Sdcsstatic void widSetName(FICL_VM *pVM) 32376116Sdcs{ 32476116Sdcs char *cp = (char *)vmPop(pVM).p; 32576116Sdcs FICL_HASH *pHash = vmPop(pVM).p; 32676116Sdcs pHash->name = cp; 32776116Sdcs return; 32876116Sdcs} 32976116Sdcs 33076116Sdcs 33176116Sdcs/************************************************************************** 33276116Sdcs setParentWid 33376116Sdcs** FICL 33476116Sdcs** setparentwid ( parent-wid wid -- ) 33576116Sdcs** Set WID's link field to the parent-wid. search-wordlist will 33676116Sdcs** iterate through all the links when finding words in the child wid. 33776116Sdcs**************************************************************************/ 33876116Sdcsstatic void setParentWid(FICL_VM *pVM) 33976116Sdcs{ 34076116Sdcs FICL_HASH *parent, *child; 34176116Sdcs#if FICL_ROBUST > 1 34276116Sdcs vmCheckStack(pVM, 2, 0); 34376116Sdcs#endif 34476116Sdcs child = (FICL_HASH *)stackPopPtr(pVM->pStack); 34576116Sdcs parent = (FICL_HASH *)stackPopPtr(pVM->pStack); 34676116Sdcs 34776116Sdcs child->link = parent; 34876116Sdcs return; 34976116Sdcs} 35076116Sdcs 35176116Sdcs 35276116Sdcs/************************************************************************** 35376116Sdcs f i c l C o m p i l e S e a r c h 35476116Sdcs** Builds the primitive wordset and the environment-query namespace. 35576116Sdcs**************************************************************************/ 35676116Sdcs 35776116Sdcsvoid ficlCompileSearch(FICL_SYSTEM *pSys) 35876116Sdcs{ 35976116Sdcs FICL_DICT *dp = pSys->dp; 36076116Sdcs assert (dp); 36176116Sdcs 36276116Sdcs /* 36376116Sdcs ** optional SEARCH-ORDER word set 36476116Sdcs */ 36576116Sdcs dictAppendWord(dp, ">search", searchPush, FW_DEFAULT); 36676116Sdcs dictAppendWord(dp, "search>", searchPop, FW_DEFAULT); 36776116Sdcs dictAppendWord(dp, "definitions", 36876116Sdcs definitions, FW_DEFAULT); 36976116Sdcs dictAppendWord(dp, "forth-wordlist", 37076116Sdcs forthWordlist, FW_DEFAULT); 37176116Sdcs dictAppendWord(dp, "get-current", 37276116Sdcs getCurrent, FW_DEFAULT); 37376116Sdcs dictAppendWord(dp, "get-order", getOrder, FW_DEFAULT); 37476116Sdcs dictAppendWord(dp, "search-wordlist", 37576116Sdcs searchWordlist, FW_DEFAULT); 37676116Sdcs dictAppendWord(dp, "set-current", 37776116Sdcs setCurrent, FW_DEFAULT); 37876116Sdcs dictAppendWord(dp, "set-order", setOrder, FW_DEFAULT); 37976116Sdcs dictAppendWord(dp, "ficl-wordlist", 38076116Sdcs ficlWordlist, FW_DEFAULT); 38176116Sdcs 38276116Sdcs /* 38376116Sdcs ** Set SEARCH environment query values 38476116Sdcs */ 38576116Sdcs ficlSetEnv("search-order", FICL_TRUE); 38676116Sdcs ficlSetEnv("search-order-ext", FICL_TRUE); 38776116Sdcs ficlSetEnv("wordlists", FICL_DEFAULT_VOCS); 38876116Sdcs 38976116Sdcs dictAppendWord(dp, "wid-get-name", widGetName, FW_DEFAULT); 39076116Sdcs dictAppendWord(dp, "wid-set-name", widSetName, FW_DEFAULT); 39176116Sdcs dictAppendWord(dp, "wid-set-super", 39276116Sdcs setParentWid, FW_DEFAULT); 39376116Sdcs return; 39476116Sdcs} 39576116Sdcs 396