mirror of
https://git.FreeBSD.org/src.git
synced 2024-12-27 11:55:06 +00:00
be88b71603
due Jon Mini. PR: 36308 Submitted by: Jon Mini <mini@haikugeek.com> MFC after: 4 weeks
865 lines
25 KiB
C
865 lines
25 KiB
C
/*******************************************************************
|
|
** d i c t . c
|
|
** Forth Inspired Command Language - dictionary methods
|
|
** Author: John Sadler (john_sadler@alum.mit.edu)
|
|
** Created: 19 July 1997
|
|
** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler Exp $
|
|
*******************************************************************/
|
|
/*
|
|
** This file implements the dictionary -- FICL's model of
|
|
** memory management. All FICL words are stored in the
|
|
** dictionary. A word is a named chunk of data with its
|
|
** associated code. FICL treats all words the same, even
|
|
** precompiled ones, so your words become first-class
|
|
** extensions of the language. You can even define new
|
|
** control structures.
|
|
**
|
|
** 29 jun 1998 (sadler) added variable sized hash table support
|
|
*/
|
|
/*
|
|
** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
|
|
** All rights reserved.
|
|
**
|
|
** Get the latest Ficl release at http://ficl.sourceforge.net
|
|
**
|
|
** I am interested in hearing from anyone who uses ficl. If you have
|
|
** a problem, a success story, a defect, an enhancement request, or
|
|
** if you would like to contribute to the ficl release, please
|
|
** contact me by email at the address above.
|
|
**
|
|
** L I C E N S E and D I S C L A I M E R
|
|
**
|
|
** Redistribution and use in source and binary forms, with or without
|
|
** modification, are permitted provided that the following conditions
|
|
** are met:
|
|
** 1. Redistributions of source code must retain the above copyright
|
|
** notice, this list of conditions and the following disclaimer.
|
|
** 2. Redistributions in binary form must reproduce the above copyright
|
|
** notice, this list of conditions and the following disclaimer in the
|
|
** documentation and/or other materials provided with the distribution.
|
|
**
|
|
** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
|
** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
|
** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
** SUCH DAMAGE.
|
|
*/
|
|
|
|
/* $FreeBSD$ */
|
|
|
|
#ifdef TESTMAIN
|
|
#include <stdio.h>
|
|
#include <ctype.h>
|
|
#else
|
|
#include <stand.h>
|
|
#endif
|
|
#include <string.h>
|
|
#include "ficl.h"
|
|
|
|
/* Dictionary on-demand resizing control variables */
|
|
CELL dictThreshold;
|
|
CELL dictIncrease;
|
|
|
|
|
|
static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
|
|
|
|
/**************************************************************************
|
|
d i c t A b o r t D e f i n i t i o n
|
|
** Abort a definition in process: reclaim its memory and unlink it
|
|
** from the dictionary list. Assumes that there is a smudged
|
|
** definition in process...otherwise does nothing.
|
|
** NOTE: this function is not smart enough to unlink a word that
|
|
** has been successfully defined (ie linked into a hash). It
|
|
** only works for defs in process. If the def has been unsmudged,
|
|
** nothing happens.
|
|
**************************************************************************/
|
|
void dictAbortDefinition(FICL_DICT *pDict)
|
|
{
|
|
FICL_WORD *pFW;
|
|
ficlLockDictionary(TRUE);
|
|
pFW = pDict->smudge;
|
|
|
|
if (pFW->flags & FW_SMUDGE)
|
|
pDict->here = (CELL *)pFW->name;
|
|
|
|
ficlLockDictionary(FALSE);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
a l i g n P t r
|
|
** Aligns the given pointer to FICL_ALIGN address units.
|
|
** Returns the aligned pointer value.
|
|
**************************************************************************/
|
|
void *alignPtr(void *ptr)
|
|
{
|
|
#if FICL_ALIGN > 0
|
|
char *cp;
|
|
CELL c;
|
|
cp = (char *)ptr + FICL_ALIGN_ADD;
|
|
c.p = (void *)cp;
|
|
c.u = c.u & (~FICL_ALIGN_ADD);
|
|
ptr = (CELL *)c.p;
|
|
#endif
|
|
return ptr;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A l i g n
|
|
** Align the dictionary's free space pointer
|
|
**************************************************************************/
|
|
void dictAlign(FICL_DICT *pDict)
|
|
{
|
|
pDict->here = alignPtr(pDict->here);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A l l o t
|
|
** Allocate or remove n chars of dictionary space, with
|
|
** checks for underrun and overrun
|
|
**************************************************************************/
|
|
int dictAllot(FICL_DICT *pDict, int n)
|
|
{
|
|
char *cp = (char *)pDict->here;
|
|
#if FICL_ROBUST
|
|
if (n > 0)
|
|
{
|
|
if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
|
|
cp += n;
|
|
else
|
|
return 1; /* dict is full */
|
|
}
|
|
else
|
|
{
|
|
n = -n;
|
|
if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
|
|
cp -= n;
|
|
else /* prevent underflow */
|
|
cp -= dictCellsUsed(pDict) * sizeof (CELL);
|
|
}
|
|
#else
|
|
cp += n;
|
|
#endif
|
|
pDict->here = PTRtoCELL cp;
|
|
return 0;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A l l o t C e l l s
|
|
** Reserve space for the requested number of cells in the
|
|
** dictionary. If nCells < 0 , removes space from the dictionary.
|
|
**************************************************************************/
|
|
int dictAllotCells(FICL_DICT *pDict, int nCells)
|
|
{
|
|
#if FICL_ROBUST
|
|
if (nCells > 0)
|
|
{
|
|
if (nCells <= dictCellsAvail(pDict))
|
|
pDict->here += nCells;
|
|
else
|
|
return 1; /* dict is full */
|
|
}
|
|
else
|
|
{
|
|
nCells = -nCells;
|
|
if (nCells <= dictCellsUsed(pDict))
|
|
pDict->here -= nCells;
|
|
else /* prevent underflow */
|
|
pDict->here -= dictCellsUsed(pDict);
|
|
}
|
|
#else
|
|
pDict->here += nCells;
|
|
#endif
|
|
return 0;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A p p e n d C e l l
|
|
** Append the specified cell to the dictionary
|
|
**************************************************************************/
|
|
void dictAppendCell(FICL_DICT *pDict, CELL c)
|
|
{
|
|
*pDict->here++ = c;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A p p e n d C h a r
|
|
** Append the specified char to the dictionary
|
|
**************************************************************************/
|
|
void dictAppendChar(FICL_DICT *pDict, char c)
|
|
{
|
|
char *cp = (char *)pDict->here;
|
|
*cp++ = c;
|
|
pDict->here = PTRtoCELL cp;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A p p e n d W o r d
|
|
** Create a new word in the dictionary with the specified
|
|
** name, code, and flags. Name must be NULL-terminated.
|
|
**************************************************************************/
|
|
FICL_WORD *dictAppendWord(FICL_DICT *pDict,
|
|
char *name,
|
|
FICL_CODE pCode,
|
|
UNS8 flags)
|
|
{
|
|
STRINGINFO si;
|
|
SI_SETLEN(si, strlen(name));
|
|
SI_SETPTR(si, name);
|
|
return dictAppendWord2(pDict, si, pCode, flags);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A p p e n d W o r d 2
|
|
** Create a new word in the dictionary with the specified
|
|
** STRINGINFO, code, and flags. Does not require a NULL-terminated
|
|
** name.
|
|
**************************************************************************/
|
|
FICL_WORD *dictAppendWord2(FICL_DICT *pDict,
|
|
STRINGINFO si,
|
|
FICL_CODE pCode,
|
|
UNS8 flags)
|
|
{
|
|
FICL_COUNT len = (FICL_COUNT)SI_COUNT(si);
|
|
char *pName;
|
|
FICL_WORD *pFW;
|
|
|
|
ficlLockDictionary(TRUE);
|
|
|
|
/*
|
|
** NOTE: dictCopyName advances "here" as a side-effect.
|
|
** It must execute before pFW is initialized.
|
|
*/
|
|
pName = dictCopyName(pDict, si);
|
|
pFW = (FICL_WORD *)pDict->here;
|
|
pDict->smudge = pFW;
|
|
pFW->hash = hashHashCode(si);
|
|
pFW->code = pCode;
|
|
pFW->flags = (UNS8)(flags | FW_SMUDGE);
|
|
pFW->nName = (char)len;
|
|
pFW->name = pName;
|
|
/*
|
|
** Point "here" to first cell of new word's param area...
|
|
*/
|
|
pDict->here = pFW->param;
|
|
|
|
if (!(flags & FW_SMUDGE))
|
|
dictUnsmudge(pDict);
|
|
|
|
ficlLockDictionary(FALSE);
|
|
return pFW;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t A p p e n d U N S
|
|
** Append the specified FICL_UNS to the dictionary
|
|
**************************************************************************/
|
|
void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
|
|
{
|
|
*pDict->here++ = LVALUEtoCELL(u);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C e l l s A v a i l
|
|
** Returns the number of empty cells left in the dictionary
|
|
**************************************************************************/
|
|
int dictCellsAvail(FICL_DICT *pDict)
|
|
{
|
|
return pDict->size - dictCellsUsed(pDict);
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C e l l s U s e d
|
|
** Returns the number of cells consumed in the dicionary
|
|
**************************************************************************/
|
|
int dictCellsUsed(FICL_DICT *pDict)
|
|
{
|
|
return pDict->here - pDict->dict;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C h e c k
|
|
** Checks the dictionary for corruption and throws appropriate
|
|
** errors.
|
|
** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
|
|
** -n number of ADDRESS UNITS proposed to de-allot
|
|
** 0 just do a consistency check
|
|
**************************************************************************/
|
|
void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
|
|
{
|
|
if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
|
|
{
|
|
vmThrowErr(pVM, "Error: dictionary full");
|
|
}
|
|
|
|
if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
|
|
{
|
|
vmThrowErr(pVM, "Error: dictionary underflow");
|
|
}
|
|
|
|
if (pDict->nLists > FICL_DEFAULT_VOCS)
|
|
{
|
|
dictResetSearchOrder(pDict);
|
|
vmThrowErr(pVM, "Error: search order overflow");
|
|
}
|
|
else if (pDict->nLists < 0)
|
|
{
|
|
dictResetSearchOrder(pDict);
|
|
vmThrowErr(pVM, "Error: search order underflow");
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C o p y N a m e
|
|
** Copy up to nFICLNAME characters of the name specified by si into
|
|
** the dictionary starting at "here", then NULL-terminate the name,
|
|
** point "here" to the next available byte, and return the address of
|
|
** the beginning of the name. Used by dictAppendWord.
|
|
** N O T E S :
|
|
** 1. "here" is guaranteed to be aligned after this operation.
|
|
** 2. If the string has zero length, align and return "here"
|
|
**************************************************************************/
|
|
static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
|
|
{
|
|
char *oldCP = (char *)pDict->here;
|
|
char *cp = oldCP;
|
|
char *name = SI_PTR(si);
|
|
int i = SI_COUNT(si);
|
|
|
|
if (i == 0)
|
|
{
|
|
dictAlign(pDict);
|
|
return (char *)pDict->here;
|
|
}
|
|
|
|
if (i > nFICLNAME)
|
|
i = nFICLNAME;
|
|
|
|
for (; i > 0; --i)
|
|
{
|
|
*cp++ = *name++;
|
|
}
|
|
|
|
*cp++ = '\0';
|
|
|
|
pDict->here = PTRtoCELL cp;
|
|
dictAlign(pDict);
|
|
return oldCP;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C r e a t e
|
|
** Create and initialize a dictionary with the specified number
|
|
** of cells capacity, and no hashing (hash size == 1).
|
|
**************************************************************************/
|
|
FICL_DICT *dictCreate(unsigned nCells)
|
|
{
|
|
return dictCreateHashed(nCells, 1);
|
|
}
|
|
|
|
|
|
FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash)
|
|
{
|
|
FICL_DICT *pDict;
|
|
size_t nAlloc;
|
|
|
|
nAlloc = sizeof (FICL_HASH) + nCells * sizeof (CELL)
|
|
+ (nHash - 1) * sizeof (FICL_WORD *);
|
|
|
|
pDict = ficlMalloc(sizeof (FICL_DICT));
|
|
assert(pDict);
|
|
memset(pDict, 0, sizeof (FICL_DICT));
|
|
pDict->dict = ficlMalloc(nAlloc);
|
|
assert(pDict->dict);
|
|
|
|
pDict->size = nCells;
|
|
dictEmpty(pDict, nHash);
|
|
return pDict;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t C r e a t e W o r d l i s t
|
|
** Create and initialize an anonymous wordlist
|
|
**************************************************************************/
|
|
FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets)
|
|
{
|
|
FICL_HASH *pHash;
|
|
|
|
dictAlign(dp);
|
|
pHash = (FICL_HASH *)dp->here;
|
|
dictAllot(dp, sizeof (FICL_HASH)
|
|
+ (nBuckets-1) * sizeof (FICL_WORD *));
|
|
|
|
pHash->size = nBuckets;
|
|
hashReset(pHash);
|
|
return pHash;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t D e l e t e
|
|
** Free all memory allocated for the given dictionary
|
|
**************************************************************************/
|
|
void dictDelete(FICL_DICT *pDict)
|
|
{
|
|
assert(pDict);
|
|
ficlFree(pDict);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t E m p t y
|
|
** Empty the dictionary, reset its hash table, and reset its search order.
|
|
** Clears and (re-)creates the hash table with the size specified by nHash.
|
|
**************************************************************************/
|
|
void dictEmpty(FICL_DICT *pDict, unsigned nHash)
|
|
{
|
|
FICL_HASH *pHash;
|
|
|
|
pDict->here = pDict->dict;
|
|
|
|
dictAlign(pDict);
|
|
pHash = (FICL_HASH *)pDict->here;
|
|
dictAllot(pDict,
|
|
sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
|
|
|
|
pHash->size = nHash;
|
|
hashReset(pHash);
|
|
|
|
pDict->pForthWords = pHash;
|
|
pDict->smudge = NULL;
|
|
dictResetSearchOrder(pDict);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t H a s h S u m m a r y
|
|
** Calculate a figure of merit for the dictionary hash table based
|
|
** on the average search depth for all the words in the dictionary,
|
|
** assuming uniform distribution of target keys. The figure of merit
|
|
** is the ratio of the total search depth for all keys in the table
|
|
** versus a theoretical optimum that would be achieved if the keys
|
|
** were distributed into the table as evenly as possible.
|
|
** The figure would be worse if the hash table used an open
|
|
** addressing scheme (i.e. collisions resolved by searching the
|
|
** table for an empty slot) for a given size table.
|
|
**************************************************************************/
|
|
#if FICL_WANT_FLOAT
|
|
void dictHashSummary(FICL_VM *pVM)
|
|
{
|
|
FICL_DICT *dp = vmGetDict(pVM);
|
|
FICL_HASH *pFHash;
|
|
FICL_WORD **pHash;
|
|
unsigned size;
|
|
FICL_WORD *pFW;
|
|
unsigned i;
|
|
int nMax = 0;
|
|
int nWords = 0;
|
|
int nFilled;
|
|
double avg = 0.0;
|
|
double best;
|
|
int nAvg, nRem, nDepth;
|
|
|
|
dictCheck(dp, pVM, 0);
|
|
|
|
pFHash = dp->pSearch[dp->nLists - 1];
|
|
pHash = pFHash->table;
|
|
size = pFHash->size;
|
|
nFilled = size;
|
|
|
|
for (i = 0; i < size; i++)
|
|
{
|
|
int n = 0;
|
|
pFW = pHash[i];
|
|
|
|
while (pFW)
|
|
{
|
|
++n;
|
|
++nWords;
|
|
pFW = pFW->link;
|
|
}
|
|
|
|
avg += (double)(n * (n+1)) / 2.0;
|
|
|
|
if (n > nMax)
|
|
nMax = n;
|
|
if (n == 0)
|
|
--nFilled;
|
|
}
|
|
|
|
/* Calc actual avg search depth for this hash */
|
|
avg = avg / nWords;
|
|
|
|
/* Calc best possible performance with this size hash */
|
|
nAvg = nWords / size;
|
|
nRem = nWords % size;
|
|
nDepth = size * (nAvg * (nAvg+1))/2 + (nAvg+1)*nRem;
|
|
best = (double)nDepth/nWords;
|
|
|
|
sprintf(pVM->pad,
|
|
"%d bins, %2.0f%% filled, Depth: Max=%d, Avg=%2.1f, Best=%2.1f, Score: %2.0f%%",
|
|
size,
|
|
(double)nFilled * 100.0 / size, nMax,
|
|
avg,
|
|
best,
|
|
100.0 * best / avg);
|
|
|
|
ficlTextOut(pVM, pVM->pad, 1);
|
|
|
|
return;
|
|
}
|
|
#endif
|
|
|
|
/**************************************************************************
|
|
d i c t I n c l u d e s
|
|
** Returns TRUE iff the given pointer is within the address range of
|
|
** the dictionary.
|
|
**************************************************************************/
|
|
int dictIncludes(FICL_DICT *pDict, void *p)
|
|
{
|
|
return ((p >= (void *) &pDict->dict)
|
|
&& (p < (void *)(&pDict->dict + pDict->size))
|
|
);
|
|
}
|
|
|
|
/**************************************************************************
|
|
d i c t L o o k u p
|
|
** Find the FICL_WORD that matches the given name and length.
|
|
** If found, returns the word's address. Otherwise returns NULL.
|
|
** Uses the search order list to search multiple wordlists.
|
|
**************************************************************************/
|
|
FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
|
|
{
|
|
FICL_WORD *pFW = NULL;
|
|
FICL_HASH *pHash;
|
|
int i;
|
|
UNS16 hashCode = hashHashCode(si);
|
|
|
|
assert(pDict);
|
|
|
|
ficlLockDictionary(1);
|
|
|
|
for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
|
|
{
|
|
pHash = pDict->pSearch[i];
|
|
pFW = hashLookup(pHash, si, hashCode);
|
|
}
|
|
|
|
ficlLockDictionary(0);
|
|
return pFW;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
f i c l L o o k u p L o c
|
|
** Same as dictLookup, but looks in system locals dictionary first...
|
|
** Assumes locals dictionary has only one wordlist...
|
|
**************************************************************************/
|
|
#if FICL_WANT_LOCALS
|
|
FICL_WORD *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si)
|
|
{
|
|
FICL_WORD *pFW = NULL;
|
|
FICL_DICT *pDict = pSys->dp;
|
|
FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords;
|
|
int i;
|
|
UNS16 hashCode = hashHashCode(si);
|
|
|
|
assert(pHash);
|
|
assert(pDict);
|
|
|
|
ficlLockDictionary(1);
|
|
/*
|
|
** check the locals dict first...
|
|
*/
|
|
pFW = hashLookup(pHash, si, hashCode);
|
|
|
|
/*
|
|
** If no joy, (!pFW) --------------------------v
|
|
** iterate over the search list in the main dict
|
|
*/
|
|
for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
|
|
{
|
|
pHash = pDict->pSearch[i];
|
|
pFW = hashLookup(pHash, si, hashCode);
|
|
}
|
|
|
|
ficlLockDictionary(0);
|
|
return pFW;
|
|
}
|
|
#endif
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t R e s e t S e a r c h O r d e r
|
|
** Initialize the dictionary search order list to sane state
|
|
**************************************************************************/
|
|
void dictResetSearchOrder(FICL_DICT *pDict)
|
|
{
|
|
assert(pDict);
|
|
pDict->pCompile = pDict->pForthWords;
|
|
pDict->nLists = 1;
|
|
pDict->pSearch[0] = pDict->pForthWords;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t S e t F l a g s
|
|
** Changes the flags field of the most recently defined word:
|
|
** Set all bits that are ones in the set parameter, clear all bits
|
|
** that are ones in the clr parameter. Clear wins in case the same bit
|
|
** is set in both parameters.
|
|
**************************************************************************/
|
|
void dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr)
|
|
{
|
|
assert(pDict->smudge);
|
|
pDict->smudge->flags |= set;
|
|
pDict->smudge->flags &= ~clr;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t S e t I m m e d i a t e
|
|
** Set the most recently defined word as IMMEDIATE
|
|
**************************************************************************/
|
|
void dictSetImmediate(FICL_DICT *pDict)
|
|
{
|
|
assert(pDict->smudge);
|
|
pDict->smudge->flags |= FW_IMMEDIATE;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t U n s m u d g e
|
|
** Completes the definition of a word by linking it
|
|
** into the main list
|
|
**************************************************************************/
|
|
void dictUnsmudge(FICL_DICT *pDict)
|
|
{
|
|
FICL_WORD *pFW = pDict->smudge;
|
|
FICL_HASH *pHash = pDict->pCompile;
|
|
|
|
assert(pHash);
|
|
assert(pFW);
|
|
/*
|
|
** :noname words never get linked into the list...
|
|
*/
|
|
if (pFW->nName > 0)
|
|
hashInsertWord(pHash, pFW);
|
|
pFW->flags &= ~(FW_SMUDGE);
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
d i c t W h e r e
|
|
** Returns the value of the HERE pointer -- the address
|
|
** of the next free cell in the dictionary
|
|
**************************************************************************/
|
|
CELL *dictWhere(FICL_DICT *pDict)
|
|
{
|
|
return pDict->here;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
h a s h F o r g e t
|
|
** Unlink all words in the hash that have addresses greater than or
|
|
** equal to the address supplied. Implementation factor for FORGET
|
|
** and MARKER.
|
|
**************************************************************************/
|
|
void hashForget(FICL_HASH *pHash, void *where)
|
|
{
|
|
FICL_WORD *pWord;
|
|
unsigned i;
|
|
|
|
assert(pHash);
|
|
assert(where);
|
|
|
|
for (i = 0; i < pHash->size; i++)
|
|
{
|
|
pWord = pHash->table[i];
|
|
|
|
while ((void *)pWord >= where)
|
|
{
|
|
pWord = pWord->link;
|
|
}
|
|
|
|
pHash->table[i] = pWord;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
h a s h H a s h C o d e
|
|
**
|
|
** Generate a 16 bit hashcode from a character string using a rolling
|
|
** shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
|
|
** the name before hashing it...
|
|
** N O T E : If string has zero length, returns zero.
|
|
**************************************************************************/
|
|
UNS16 hashHashCode(STRINGINFO si)
|
|
{
|
|
/* hashPJW */
|
|
UNS8 *cp;
|
|
UNS16 code = (UNS16)si.count;
|
|
UNS16 shift = 0;
|
|
|
|
if (si.count == 0)
|
|
return 0;
|
|
|
|
/* changed to run without errors under Purify -- lch */
|
|
for (cp = (UNS8 *)si.cp; si.count && *cp; cp++, si.count--)
|
|
{
|
|
code = (UNS16)((code << 4) + tolower(*cp));
|
|
shift = (UNS16)(code & 0xf000);
|
|
if (shift)
|
|
{
|
|
code ^= (UNS16)(shift >> 8);
|
|
code ^= (UNS16)shift;
|
|
}
|
|
}
|
|
|
|
return (UNS16)code;
|
|
}
|
|
|
|
|
|
|
|
|
|
/**************************************************************************
|
|
h a s h I n s e r t W o r d
|
|
** Put a word into the hash table using the word's hashcode as
|
|
** an index (modulo the table size).
|
|
**************************************************************************/
|
|
void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW)
|
|
{
|
|
FICL_WORD **pList;
|
|
|
|
assert(pHash);
|
|
assert(pFW);
|
|
|
|
if (pHash->size == 1)
|
|
{
|
|
pList = pHash->table;
|
|
}
|
|
else
|
|
{
|
|
pList = pHash->table + (pFW->hash % pHash->size);
|
|
}
|
|
|
|
pFW->link = *pList;
|
|
*pList = pFW;
|
|
return;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
h a s h L o o k u p
|
|
** Find a name in the hash table given the hashcode and text of the name.
|
|
** Returns the address of the corresponding FICL_WORD if found,
|
|
** otherwise NULL.
|
|
** Note: outer loop on link field supports inheritance in wordlists.
|
|
** It's not part of ANS Forth - ficl only. hashReset creates wordlists
|
|
** with NULL link fields.
|
|
**************************************************************************/
|
|
FICL_WORD *hashLookup(FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode)
|
|
{
|
|
FICL_UNS nCmp = si.count;
|
|
FICL_WORD *pFW;
|
|
UNS16 hashIdx;
|
|
|
|
if (nCmp > nFICLNAME)
|
|
nCmp = nFICLNAME;
|
|
|
|
for (; pHash != NULL; pHash = pHash->link)
|
|
{
|
|
if (pHash->size > 1)
|
|
hashIdx = (UNS16)(hashCode % pHash->size);
|
|
else /* avoid the modulo op for single threaded lists */
|
|
hashIdx = 0;
|
|
|
|
for (pFW = pHash->table[hashIdx]; pFW; pFW = pFW->link)
|
|
{
|
|
if ( (pFW->nName == si.count)
|
|
&& (!strincmp(si.cp, pFW->name, nCmp)) )
|
|
return pFW;
|
|
#if FICL_ROBUST
|
|
assert(pFW != pFW->link);
|
|
#endif
|
|
}
|
|
}
|
|
|
|
return NULL;
|
|
}
|
|
|
|
|
|
/**************************************************************************
|
|
h a s h R e s e t
|
|
** Initialize a FICL_HASH to empty state.
|
|
**************************************************************************/
|
|
void hashReset(FICL_HASH *pHash)
|
|
{
|
|
unsigned i;
|
|
|
|
assert(pHash);
|
|
|
|
for (i = 0; i < pHash->size; i++)
|
|
{
|
|
pHash->table[i] = NULL;
|
|
}
|
|
|
|
pHash->link = NULL;
|
|
pHash->name = NULL;
|
|
return;
|
|
}
|
|
|
|
/**************************************************************************
|
|
d i c t C h e c k T h r e s h o l d
|
|
** Verify if an increase in the dictionary size is warranted, and do it if
|
|
** so.
|
|
**************************************************************************/
|
|
|
|
void dictCheckThreshold(FICL_DICT* dp)
|
|
{
|
|
if( dictCellsAvail(dp) < dictThreshold.u ) {
|
|
dp->dict = ficlMalloc( dictIncrease.u * sizeof (CELL) );
|
|
assert(dp->dict);
|
|
dp->here = dp->dict;
|
|
dp->size = dictIncrease.u;
|
|
dictAlign(dp);
|
|
}
|
|
}
|
|
|