The Design and Implementation of the FreeBSD Operating System, Second Edition
Now available: The Design and Implementation of the FreeBSD Operating System (Second Edition)


[ source navigation ] [ diff markup ] [ identifier search ] [ freetext search ] [ file search ] [ list types ] [ track identifier ]

FreeBSD/Linux Kernel Cross Reference
sys/boot/ficl/search.c

Version: -  FREEBSD  -  FREEBSD-13-STABLE  -  FREEBSD-13-0  -  FREEBSD-12-STABLE  -  FREEBSD-12-0  -  FREEBSD-11-STABLE  -  FREEBSD-11-0  -  FREEBSD-10-STABLE  -  FREEBSD-10-0  -  FREEBSD-9-STABLE  -  FREEBSD-9-0  -  FREEBSD-8-STABLE  -  FREEBSD-8-0  -  FREEBSD-7-STABLE  -  FREEBSD-7-0  -  FREEBSD-6-STABLE  -  FREEBSD-6-0  -  FREEBSD-5-STABLE  -  FREEBSD-5-0  -  FREEBSD-4-STABLE  -  FREEBSD-3-STABLE  -  FREEBSD22  -  l41  -  OPENBSD  -  linux-2.6  -  MK84  -  PLAN9  -  xnu-8792 
SearchContext: -  none  -  3  -  10 

    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.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 **
   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 /* $FreeBSD$ */
   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 **************************************************************************/
   58 static void definitions(FICL_VM *pVM)
   59 {
   60     FICL_DICT *pDict = vmGetDict(pVM);
   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];
   69     return;
   70 }
   71 
   72 
   73 /**************************************************************************
   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 **************************************************************************/
   80 static void forthWordlist(FICL_VM *pVM)
   81 {
   82     FICL_HASH *pHash = vmGetDict(pVM)->pForthWords;
   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 **************************************************************************/
   93 static void getCurrent(FICL_VM *pVM)
   94 {
   95     ficlLockDictionary(TRUE);
   96     stackPushPtr(pVM->pStack, vmGetDict(pVM)->pCompile);
   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 **************************************************************************/
  110 static void getOrder(FICL_VM *pVM)
  111 {
  112     FICL_DICT *pDict = vmGetDict(pVM);
  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     }
  121 
  122     stackPushUNS(pVM->pStack, nLists);
  123     ficlLockDictionary(FALSE);
  124     return;
  125 }
  126 
  127 
  128 /**************************************************************************
  129                         s e a r c h - w o r d l i s t
  130 ** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
  131 ** Find the definition identified by the string c-addr u in the word list
  132 ** identified by wid. If the definition is not found, return zero. If the
  133 ** definition is found, return its execution token xt and one (1) if the
  134 ** definition is immediate, minus-one (-1) otherwise. 
  135 **************************************************************************/
  136 static void searchWordlist(FICL_VM *pVM)
  137 {
  138     STRINGINFO si;
  139     UNS16 hashCode;
  140     FICL_WORD *pFW;
  141     FICL_HASH *pHash = stackPopPtr(pVM->pStack);
  142 
  143     si.count         = (FICL_COUNT)stackPopUNS(pVM->pStack);
  144     si.cp            = stackPopPtr(pVM->pStack);
  145     hashCode         = hashHashCode(si);
  146 
  147     ficlLockDictionary(TRUE);
  148     pFW = hashLookup(pHash, si, hashCode);
  149     ficlLockDictionary(FALSE);
  150 
  151     if (pFW)
  152     {
  153         stackPushPtr(pVM->pStack, pFW);
  154         stackPushINT(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1));
  155     }
  156     else
  157     {
  158         stackPushUNS(pVM->pStack, 0);
  159     }
  160 
  161     return;
  162 }
  163 
  164 
  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 **************************************************************************/
  170 static void setCurrent(FICL_VM *pVM)
  171 {
  172     FICL_HASH *pHash = stackPopPtr(pVM->pStack);
  173     FICL_DICT *pDict = vmGetDict(pVM);
  174     ficlLockDictionary(TRUE);
  175     pDict->pCompile = pHash;
  176     ficlLockDictionary(FALSE);
  177     return;
  178 }
  179 
  180 
  181 /**************************************************************************
  182                         s e t - o r d e r
  183 ** SEARCH ( widn ... wid1 n -- )
  184 ** Set the search order to the word lists identified by widn ... wid1.
  185 ** Subsequently, word list wid1 will be searched first, and word list
  186 ** widn searched last. If n is zero, empty the search order. If n is minus
  187 ** one, set the search order to the implementation-defined minimum
  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 **************************************************************************/
  192 static void setOrder(FICL_VM *pVM)
  193 {
  194     int i;
  195     int nLists = stackPopINT(pVM->pStack);
  196     FICL_DICT *dp = vmGetDict(pVM);
  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 
  205     if (nLists >= 0)
  206     {
  207         dp->nLists = nLists;
  208         for (i = nLists-1; i >= 0; --i)
  209         {
  210             dp->pSearch[i] = stackPopPtr(pVM->pStack);
  211         }
  212     }
  213     else
  214     {
  215         dictResetSearchOrder(dp);
  216     }
  217 
  218     ficlLockDictionary(FALSE);
  219     return;
  220 }
  221 
  222 
  223 /**************************************************************************
  224                         f i c l - w o r d l i s t
  225 ** SEARCH ( -- wid )
  226 ** Create a new empty word list, returning its word list identifier wid.
  227 ** The new word list may be returned from a pool of preallocated word
  228 ** lists or may be dynamically allocated in data space. A system shall
  229 ** allow the creation of at least 8 new word lists in addition to any
  230 ** provided as part of the system. 
  231 ** Notes: 
  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 **************************************************************************/
  238 static void ficlWordlist(FICL_VM *pVM)
  239 {
  240     FICL_DICT *dp = vmGetDict(pVM);
  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);
  249     stackPushPtr(pVM->pStack, pHash);
  250     return;
  251 }
  252 
  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 **************************************************************************/
  259 static void searchPop(FICL_VM *pVM)
  260 {
  261     FICL_DICT *dp = vmGetDict(pVM);
  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     }
  270     stackPushPtr(pVM->pStack, dp->pSearch[--dp->nLists]);
  271     ficlLockDictionary(FALSE);
  272     return;
  273 }
  274 
  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 **************************************************************************/
  281 static void searchPush(FICL_VM *pVM)
  282 {
  283     FICL_DICT *dp = vmGetDict(pVM);
  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);
  292     return;
  293 }
  294 
  295 
  296 /**************************************************************************
  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 **************************************************************************/
  301 static void widGetName(FICL_VM *pVM)
  302 {
  303     FICL_HASH *pHash = vmPop(pVM).p;
  304     char *cp = pHash->name;
  305     FICL_INT len = 0;
  306     
  307     if (cp)
  308         len = strlen(cp);
  309 
  310     vmPush(pVM, LVALUEtoCELL(cp));
  311     vmPush(pVM, LVALUEtoCELL(len));
  312     return;
  313 }
  314 
  315 /**************************************************************************
  316                         W I D - S E T - N A M E
  317 ** ficl  ( wid c-addr -- )
  318 ** Set wid's name pointer to the \0 terminated string address supplied
  319 **************************************************************************/
  320 static void widSetName(FICL_VM *pVM)
  321 {
  322     char *cp = (char *)vmPop(pVM).p;
  323     FICL_HASH *pHash = vmPop(pVM).p;
  324     pHash->name = cp;
  325     return;
  326 }
  327 
  328 
  329 /**************************************************************************
  330                         setParentWid
  331 ** FICL
  332 ** setparentwid   ( parent-wid wid -- )
  333 ** Set WID's link field to the parent-wid. search-wordlist will 
  334 ** iterate through all the links when finding words in the child wid.
  335 **************************************************************************/
  336 static void setParentWid(FICL_VM *pVM)
  337 {
  338     FICL_HASH *parent, *child;
  339 #if FICL_ROBUST > 1
  340     vmCheckStack(pVM, 2, 0);
  341 #endif
  342     child  = (FICL_HASH *)stackPopPtr(pVM->pStack);
  343     parent = (FICL_HASH *)stackPopPtr(pVM->pStack);
  344 
  345     child->link = parent;
  346     return;
  347 }
  348 
  349 
  350 /**************************************************************************
  351                         f i c l C o m p i l e S e a r c h
  352 ** Builds the primitive wordset and the environment-query namespace.
  353 **************************************************************************/
  354 
  355 void ficlCompileSearch(FICL_SYSTEM *pSys)
  356 {
  357     FICL_DICT *dp = pSys->dp;
  358     assert (dp);
  359 
  360     /*
  361     ** optional SEARCH-ORDER word set 
  362     */
  363     dictAppendWord(dp, ">search",   searchPush,     FW_DEFAULT);
  364     dictAppendWord(dp, "search>",   searchPop,      FW_DEFAULT);
  365     dictAppendWord(dp, "definitions",
  366                                     definitions,    FW_DEFAULT);
  367     dictAppendWord(dp, "forth-wordlist",  
  368                                     forthWordlist,  FW_DEFAULT);
  369     dictAppendWord(dp, "get-current",  
  370                                     getCurrent,     FW_DEFAULT);
  371     dictAppendWord(dp, "get-order", getOrder,       FW_DEFAULT);
  372     dictAppendWord(dp, "search-wordlist",  
  373                                     searchWordlist, FW_DEFAULT);
  374     dictAppendWord(dp, "set-current",  
  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     */
  383     ficlSetEnv(pSys, "search-order",      FICL_TRUE);
  384     ficlSetEnv(pSys, "search-order-ext",  FICL_TRUE);
  385     ficlSetEnv(pSys, "wordlists",         FICL_DEFAULT_VOCS);
  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 

Cache object: 19f263e3e038665d527c5ebff9087eb0


[ source navigation ] [ diff markup ] [ identifier search ] [ freetext search ] [ file search ] [ list types ] [ track identifier ]


This page is part of the FreeBSD/Linux Linux Kernel Cross-Reference, and was automatically generated using a modified version of the LXR engine.