1 /*******************************************************************
3 ** Forth Inspired Command Language - dictionary methods
4 ** Author: John Sadler (john_sadler@alum.mit.edu)
5 ** Created: 19 July 1997
6 ** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler Exp $
7 *******************************************************************/
9 ** This file implements the dictionary -- FICL's model of
10 ** memory management. All FICL words are stored in the
11 ** dictionary. A word is a named chunk of data with its
12 ** associated code. FICL treats all words the same, even
13 ** precompiled ones, so your words become first-class
14 ** extensions of the language. You can even define new
15 ** control structures.
17 ** 29 jun 1998 (sadler) added variable sized hash table support
20 ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
21 ** All rights reserved.
23 ** Get the latest Ficl release at http://ficl.sourceforge.net
25 ** I am interested in hearing from anyone who uses ficl. If you have
26 ** a problem, a success story, a defect, an enhancement request, or
27 ** if you would like to contribute to the ficl release, please
28 ** contact me by email at the address above.
30 ** L I C E N S E and D I S C L A I M E R
32 ** Redistribution and use in source and binary forms, with or without
33 ** modification, are permitted provided that the following conditions
35 ** 1. Redistributions of source code must retain the above copyright
36 ** notice, this list of conditions and the following disclaimer.
37 ** 2. Redistributions in binary form must reproduce the above copyright
38 ** notice, this list of conditions and the following disclaimer in the
39 ** documentation and/or other materials provided with the distribution.
41 ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
42 ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
43 ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
44 ** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
45 ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
46 ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
47 ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
48 ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
49 ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
50 ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
55 * $FreeBSD: src/sys/boot/ficl/dict.c,v 1.13 2002/04/09 17:45:11 dcs Exp $
56 * $DragonFly: src/sys/boot/ficl/dict.c,v 1.3 2003/11/10 06:08:33 dillon Exp $
68 /* Dictionary on-demand resizing control variables */
73 static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
75 /**************************************************************************
76 d i c t A b o r t D e f i n i t i o n
77 ** Abort a definition in process: reclaim its memory and unlink it
78 ** from the dictionary list. Assumes that there is a smudged
79 ** definition in process...otherwise does nothing.
80 ** NOTE: this function is not smart enough to unlink a word that
81 ** has been successfully defined (ie linked into a hash). It
82 ** only works for defs in process. If the def has been unsmudged,
84 **************************************************************************/
85 void dictAbortDefinition(FICL_DICT *pDict)
88 ficlLockDictionary(TRUE);
91 if (pFW->flags & FW_SMUDGE)
92 pDict->here = (CELL *)pFW->name;
94 ficlLockDictionary(FALSE);
99 /**************************************************************************
101 ** Aligns the given pointer to FICL_ALIGN address units.
102 ** Returns the aligned pointer value.
103 **************************************************************************/
104 void *alignPtr(void *ptr)
109 cp = (char *)ptr + FICL_ALIGN_ADD;
111 c.u = c.u & (~FICL_ALIGN_ADD);
118 /**************************************************************************
120 ** Align the dictionary's free space pointer
121 **************************************************************************/
122 void dictAlign(FICL_DICT *pDict)
124 pDict->here = alignPtr(pDict->here);
128 /**************************************************************************
130 ** Allocate or remove n chars of dictionary space, with
131 ** checks for underrun and overrun
132 **************************************************************************/
133 int dictAllot(FICL_DICT *pDict, int n)
135 char *cp = (char *)pDict->here;
139 if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
142 return 1; /* dict is full */
147 if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
149 else /* prevent underflow */
150 cp -= dictCellsUsed(pDict) * sizeof (CELL);
155 pDict->here = PTRtoCELL cp;
160 /**************************************************************************
161 d i c t A l l o t C e l l s
162 ** Reserve space for the requested number of cells in the
163 ** dictionary. If nCells < 0 , removes space from the dictionary.
164 **************************************************************************/
165 int dictAllotCells(FICL_DICT *pDict, int nCells)
170 if (nCells <= dictCellsAvail(pDict))
171 pDict->here += nCells;
173 return 1; /* dict is full */
178 if (nCells <= dictCellsUsed(pDict))
179 pDict->here -= nCells;
180 else /* prevent underflow */
181 pDict->here -= dictCellsUsed(pDict);
184 pDict->here += nCells;
190 /**************************************************************************
191 d i c t A p p e n d C e l l
192 ** Append the specified cell to the dictionary
193 **************************************************************************/
194 void dictAppendCell(FICL_DICT *pDict, CELL c)
201 /**************************************************************************
202 d i c t A p p e n d C h a r
203 ** Append the specified char to the dictionary
204 **************************************************************************/
205 void dictAppendChar(FICL_DICT *pDict, char c)
207 char *cp = (char *)pDict->here;
209 pDict->here = PTRtoCELL cp;
214 /**************************************************************************
215 d i c t A p p e n d W o r d
216 ** Create a new word in the dictionary with the specified
217 ** name, code, and flags. Name must be NULL-terminated.
218 **************************************************************************/
219 FICL_WORD *dictAppendWord(FICL_DICT *pDict,
225 SI_SETLEN(si, strlen(name));
227 return dictAppendWord2(pDict, si, pCode, flags);
231 /**************************************************************************
232 d i c t A p p e n d W o r d 2
233 ** Create a new word in the dictionary with the specified
234 ** STRINGINFO, code, and flags. Does not require a NULL-terminated
236 **************************************************************************/
237 FICL_WORD *dictAppendWord2(FICL_DICT *pDict,
242 FICL_COUNT len = (FICL_COUNT)SI_COUNT(si);
246 ficlLockDictionary(TRUE);
249 ** NOTE: dictCopyName advances "here" as a side-effect.
250 ** It must execute before pFW is initialized.
252 pName = dictCopyName(pDict, si);
253 pFW = (FICL_WORD *)pDict->here;
255 pFW->hash = hashHashCode(si);
257 pFW->flags = (UNS8)(flags | FW_SMUDGE);
258 pFW->nName = (char)len;
261 ** Point "here" to first cell of new word's param area...
263 pDict->here = pFW->param;
265 if (!(flags & FW_SMUDGE))
268 ficlLockDictionary(FALSE);
273 /**************************************************************************
274 d i c t A p p e n d U N S
275 ** Append the specified FICL_UNS to the dictionary
276 **************************************************************************/
277 void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
279 *pDict->here++ = LVALUEtoCELL(u);
284 /**************************************************************************
285 d i c t C e l l s A v a i l
286 ** Returns the number of empty cells left in the dictionary
287 **************************************************************************/
288 int dictCellsAvail(FICL_DICT *pDict)
290 return pDict->size - dictCellsUsed(pDict);
294 /**************************************************************************
295 d i c t C e l l s U s e d
296 ** Returns the number of cells consumed in the dicionary
297 **************************************************************************/
298 int dictCellsUsed(FICL_DICT *pDict)
300 return pDict->here - pDict->dict;
304 /**************************************************************************
306 ** Checks the dictionary for corruption and throws appropriate
308 ** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
309 ** -n number of ADDRESS UNITS proposed to de-allot
310 ** 0 just do a consistency check
311 **************************************************************************/
312 void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
314 if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
316 vmThrowErr(pVM, "Error: dictionary full");
319 if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
321 vmThrowErr(pVM, "Error: dictionary underflow");
324 if (pDict->nLists > FICL_DEFAULT_VOCS)
326 dictResetSearchOrder(pDict);
327 vmThrowErr(pVM, "Error: search order overflow");
329 else if (pDict->nLists < 0)
331 dictResetSearchOrder(pDict);
332 vmThrowErr(pVM, "Error: search order underflow");
339 /**************************************************************************
340 d i c t C o p y N a m e
341 ** Copy up to nFICLNAME characters of the name specified by si into
342 ** the dictionary starting at "here", then NULL-terminate the name,
343 ** point "here" to the next available byte, and return the address of
344 ** the beginning of the name. Used by dictAppendWord.
346 ** 1. "here" is guaranteed to be aligned after this operation.
347 ** 2. If the string has zero length, align and return "here"
348 **************************************************************************/
349 static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
351 char *oldCP = (char *)pDict->here;
353 char *name = SI_PTR(si);
354 int i = SI_COUNT(si);
359 return (char *)pDict->here;
372 pDict->here = PTRtoCELL cp;
378 /**************************************************************************
380 ** Create and initialize a dictionary with the specified number
381 ** of cells capacity, and no hashing (hash size == 1).
382 **************************************************************************/
383 FICL_DICT *dictCreate(unsigned nCells)
385 return dictCreateHashed(nCells, 1);
389 FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash)
394 nAlloc = sizeof (FICL_HASH) + nCells * sizeof (CELL)
395 + (nHash - 1) * sizeof (FICL_WORD *);
397 pDict = ficlMalloc(sizeof (FICL_DICT));
399 memset(pDict, 0, sizeof (FICL_DICT));
400 pDict->dict = ficlMalloc(nAlloc);
403 pDict->size = nCells;
404 dictEmpty(pDict, nHash);
409 /**************************************************************************
410 d i c t C r e a t e W o r d l i s t
411 ** Create and initialize an anonymous wordlist
412 **************************************************************************/
413 FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets)
418 pHash = (FICL_HASH *)dp->here;
419 dictAllot(dp, sizeof (FICL_HASH)
420 + (nBuckets-1) * sizeof (FICL_WORD *));
422 pHash->size = nBuckets;
428 /**************************************************************************
430 ** Free all memory allocated for the given dictionary
431 **************************************************************************/
432 void dictDelete(FICL_DICT *pDict)
440 /**************************************************************************
442 ** Empty the dictionary, reset its hash table, and reset its search order.
443 ** Clears and (re-)creates the hash table with the size specified by nHash.
444 **************************************************************************/
445 void dictEmpty(FICL_DICT *pDict, unsigned nHash)
449 pDict->here = pDict->dict;
452 pHash = (FICL_HASH *)pDict->here;
454 sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
459 pDict->pForthWords = pHash;
460 pDict->smudge = NULL;
461 dictResetSearchOrder(pDict);
466 /**************************************************************************
467 d i c t H a s h S u m m a r y
468 ** Calculate a figure of merit for the dictionary hash table based
469 ** on the average search depth for all the words in the dictionary,
470 ** assuming uniform distribution of target keys. The figure of merit
471 ** is the ratio of the total search depth for all keys in the table
472 ** versus a theoretical optimum that would be achieved if the keys
473 ** were distributed into the table as evenly as possible.
474 ** The figure would be worse if the hash table used an open
475 ** addressing scheme (i.e. collisions resolved by searching the
476 ** table for an empty slot) for a given size table.
477 **************************************************************************/
479 void dictHashSummary(FICL_VM *pVM)
481 FICL_DICT *dp = vmGetDict(pVM);
492 int nAvg, nRem, nDepth;
494 dictCheck(dp, pVM, 0);
496 pFHash = dp->pSearch[dp->nLists - 1];
497 pHash = pFHash->table;
501 for (i = 0; i < size; i++)
513 avg += (double)(n * (n+1)) / 2.0;
521 /* Calc actual avg search depth for this hash */
524 /* Calc best possible performance with this size hash */
525 nAvg = nWords / size;
526 nRem = nWords % size;
527 nDepth = size * (nAvg * (nAvg+1))/2 + (nAvg+1)*nRem;
528 best = (double)nDepth/nWords;
531 "%d bins, %2.0f%% filled, Depth: Max=%d, Avg=%2.1f, Best=%2.1f, Score: %2.0f%%",
533 (double)nFilled * 100.0 / size, nMax,
538 ficlTextOut(pVM, pVM->pad, 1);
544 /**************************************************************************
545 d i c t I n c l u d e s
546 ** Returns TRUE iff the given pointer is within the address range of
548 **************************************************************************/
549 int dictIncludes(FICL_DICT *pDict, void *p)
551 return ((p >= (void *) &pDict->dict)
552 && (p < (void *)(&pDict->dict + pDict->size))
556 /**************************************************************************
558 ** Find the FICL_WORD that matches the given name and length.
559 ** If found, returns the word's address. Otherwise returns NULL.
560 ** Uses the search order list to search multiple wordlists.
561 **************************************************************************/
562 FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
564 FICL_WORD *pFW = NULL;
567 UNS16 hashCode = hashHashCode(si);
571 ficlLockDictionary(1);
573 for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
575 pHash = pDict->pSearch[i];
576 pFW = hashLookup(pHash, si, hashCode);
579 ficlLockDictionary(0);
584 /**************************************************************************
585 f i c l L o o k u p L o c
586 ** Same as dictLookup, but looks in system locals dictionary first...
587 ** Assumes locals dictionary has only one wordlist...
588 **************************************************************************/
590 FICL_WORD *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si)
592 FICL_WORD *pFW = NULL;
593 FICL_DICT *pDict = pSys->dp;
594 FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords;
596 UNS16 hashCode = hashHashCode(si);
601 ficlLockDictionary(1);
603 ** check the locals dict first...
605 pFW = hashLookup(pHash, si, hashCode);
608 ** If no joy, (!pFW) --------------------------v
609 ** iterate over the search list in the main dict
611 for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
613 pHash = pDict->pSearch[i];
614 pFW = hashLookup(pHash, si, hashCode);
617 ficlLockDictionary(0);
623 /**************************************************************************
624 d i c t R e s e t S e a r c h O r d e r
625 ** Initialize the dictionary search order list to sane state
626 **************************************************************************/
627 void dictResetSearchOrder(FICL_DICT *pDict)
630 pDict->pCompile = pDict->pForthWords;
632 pDict->pSearch[0] = pDict->pForthWords;
637 /**************************************************************************
638 d i c t S e t F l a g s
639 ** Changes the flags field of the most recently defined word:
640 ** Set all bits that are ones in the set parameter, clear all bits
641 ** that are ones in the clr parameter. Clear wins in case the same bit
642 ** is set in both parameters.
643 **************************************************************************/
644 void dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr)
646 assert(pDict->smudge);
647 pDict->smudge->flags |= set;
648 pDict->smudge->flags &= ~clr;
653 /**************************************************************************
654 d i c t S e t I m m e d i a t e
655 ** Set the most recently defined word as IMMEDIATE
656 **************************************************************************/
657 void dictSetImmediate(FICL_DICT *pDict)
659 assert(pDict->smudge);
660 pDict->smudge->flags |= FW_IMMEDIATE;
665 /**************************************************************************
666 d i c t U n s m u d g e
667 ** Completes the definition of a word by linking it
668 ** into the main list
669 **************************************************************************/
670 void dictUnsmudge(FICL_DICT *pDict)
672 FICL_WORD *pFW = pDict->smudge;
673 FICL_HASH *pHash = pDict->pCompile;
678 ** :noname words never get linked into the list...
681 hashInsertWord(pHash, pFW);
682 pFW->flags &= ~(FW_SMUDGE);
687 /**************************************************************************
689 ** Returns the value of the HERE pointer -- the address
690 ** of the next free cell in the dictionary
691 **************************************************************************/
692 CELL *dictWhere(FICL_DICT *pDict)
698 /**************************************************************************
700 ** Unlink all words in the hash that have addresses greater than or
701 ** equal to the address supplied. Implementation factor for FORGET
703 **************************************************************************/
704 void hashForget(FICL_HASH *pHash, void *where)
712 for (i = 0; i < pHash->size; i++)
714 pWord = pHash->table[i];
716 while ((void *)pWord >= where)
721 pHash->table[i] = pWord;
728 /**************************************************************************
729 h a s h H a s h C o d e
731 ** Generate a 16 bit hashcode from a character string using a rolling
732 ** shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
733 ** the name before hashing it...
734 ** N O T E : If string has zero length, returns zero.
735 **************************************************************************/
736 UNS16 hashHashCode(STRINGINFO si)
740 UNS16 code = (UNS16)si.count;
746 /* changed to run without errors under Purify -- lch */
747 for (cp = (UNS8 *)si.cp; si.count && *cp; cp++, si.count--)
749 code = (UNS16)((code << 4) + tolower(*cp));
750 shift = (UNS16)(code & 0xf000);
753 code ^= (UNS16)(shift >> 8);
754 code ^= (UNS16)shift;
764 /**************************************************************************
765 h a s h I n s e r t W o r d
766 ** Put a word into the hash table using the word's hashcode as
767 ** an index (modulo the table size).
768 **************************************************************************/
769 void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW)
776 if (pHash->size == 1)
778 pList = pHash->table;
782 pList = pHash->table + (pFW->hash % pHash->size);
791 /**************************************************************************
793 ** Find a name in the hash table given the hashcode and text of the name.
794 ** Returns the address of the corresponding FICL_WORD if found,
796 ** Note: outer loop on link field supports inheritance in wordlists.
797 ** It's not part of ANS Forth - ficl only. hashReset creates wordlists
798 ** with NULL link fields.
799 **************************************************************************/
800 FICL_WORD *hashLookup(FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode)
802 FICL_UNS nCmp = si.count;
806 if (nCmp > nFICLNAME)
809 for (; pHash != NULL; pHash = pHash->link)
812 hashIdx = (UNS16)(hashCode % pHash->size);
813 else /* avoid the modulo op for single threaded lists */
816 for (pFW = pHash->table[hashIdx]; pFW; pFW = pFW->link)
818 if ( (pFW->nName == si.count)
819 && (!strincmp(si.cp, pFW->name, nCmp)) )
822 assert(pFW != pFW->link);
831 /**************************************************************************
833 ** Initialize a FICL_HASH to empty state.
834 **************************************************************************/
835 void hashReset(FICL_HASH *pHash)
841 for (i = 0; i < pHash->size; i++)
843 pHash->table[i] = NULL;
851 /**************************************************************************
852 d i c t C h e c k T h r e s h o l d
853 ** Verify if an increase in the dictionary size is warranted, and do it if
855 **************************************************************************/
857 void dictCheckThreshold(FICL_DICT* dp)
859 if( dictCellsAvail(dp) < dictThreshold.u ) {
860 dp->dict = ficlMalloc( dictIncrease.u * sizeof (CELL) );
863 dp->size = dictIncrease.u;