Initial import from FreeBSD RELENG_4:
[dragonfly.git] / sys / boot / ficl / dict.c
1 /*******************************************************************
2 ** d i c t . c
3 ** Forth Inspired Command Language - dictionary methods
4 ** Author: John Sadler (john_sadler@alum.mit.edu)
5 ** Created: 19 July 1997
6 ** 
7 *******************************************************************/
8 /*
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.
16 **
17 ** 29 jun 1998 (sadler) added variable sized hash table support
18 */
19
20 /* $FreeBSD: src/sys/boot/ficl/dict.c,v 1.6.2.1 2000/07/06 23:51:45 obrien Exp $ */
21
22 #ifdef TESTMAIN
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <ctype.h>
26 #else
27 #include <stand.h>
28 #endif
29 #include <string.h>
30 #include "ficl.h"
31
32 /* Dictionary on-demand resizing control variables */
33 unsigned int dictThreshold;
34 unsigned int dictIncrease;
35
36
37 static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si);
38
39 /**************************************************************************
40                         d i c t A b o r t D e f i n i t i o n
41 ** Abort a definition in process: reclaim its memory and unlink it
42 ** from the dictionary list. Assumes that there is a smudged 
43 ** definition in process...otherwise does nothing.
44 ** NOTE: this function is not smart enough to unlink a word that
45 ** has been successfully defined (ie linked into a hash). It
46 ** only works for defs in process. If the def has been unsmudged,
47 ** nothing happens.
48 **************************************************************************/
49 void dictAbortDefinition(FICL_DICT *pDict)
50 {
51     FICL_WORD *pFW;
52     ficlLockDictionary(TRUE);
53     pFW = pDict->smudge;
54
55     if (pFW->flags & FW_SMUDGE)
56         pDict->here = (CELL *)pFW->name;
57
58     ficlLockDictionary(FALSE);
59     return;
60 }
61
62
63 /**************************************************************************
64                         a l i g n P t r
65 ** Aligns the given pointer to FICL_ALIGN address units.
66 ** Returns the aligned pointer value.
67 **************************************************************************/
68 void *alignPtr(void *ptr)
69 {
70 #if FICL_ALIGN > 0
71     char *cp;
72     CELL c;
73     cp = (char *)ptr + FICL_ALIGN_ADD;
74     c.p = (void *)cp;
75     c.u = c.u & (~FICL_ALIGN_ADD);
76     ptr = (CELL *)c.p;
77 #endif
78     return ptr;
79 }
80
81
82 /**************************************************************************
83                         d i c t A l i g n
84 ** Align the dictionary's free space pointer
85 **************************************************************************/
86 void dictAlign(FICL_DICT *pDict)
87 {
88     pDict->here = alignPtr(pDict->here);
89 }
90
91
92 /**************************************************************************
93                         d i c t A l l o t
94 ** Allocate or remove n chars of dictionary space, with
95 ** checks for underrun and overrun
96 **************************************************************************/
97 int dictAllot(FICL_DICT *pDict, int n)
98 {
99     char *cp = (char *)pDict->here;
100 #if FICL_ROBUST
101     if (n > 0)
102     {
103         if ((unsigned)n <= dictCellsAvail(pDict) * sizeof (CELL))
104             cp += n;
105         else
106             return 1;       /* dict is full */
107     }
108     else
109     {
110         n = -n;
111         if ((unsigned)n <= dictCellsUsed(pDict) * sizeof (CELL))
112             cp -= n;
113         else                /* prevent underflow */
114             cp -= dictCellsUsed(pDict) * sizeof (CELL);
115     }
116 #else
117     cp += n;
118 #endif
119     pDict->here = PTRtoCELL cp;
120     return 0;
121 }
122
123
124 /**************************************************************************
125                         d i c t A l l o t C e l l s
126 ** Reserve space for the requested number of cells in the
127 ** dictionary. If nCells < 0 , removes space from the dictionary.
128 **************************************************************************/
129 int dictAllotCells(FICL_DICT *pDict, int nCells)
130 {
131 #if FICL_ROBUST
132     if (nCells > 0)
133     {
134         if (nCells <= dictCellsAvail(pDict))
135             pDict->here += nCells;
136         else
137             return 1;       /* dict is full */
138     }
139     else
140     {
141         nCells = -nCells;
142         if (nCells <= dictCellsUsed(pDict))
143             pDict->here -= nCells;
144         else                /* prevent underflow */
145             pDict->here -= dictCellsUsed(pDict);
146     }
147 #else
148     pDict->here += nCells;
149 #endif
150     return 0;
151 }
152
153
154 /**************************************************************************
155                         d i c t A p p e n d C e l l
156 ** Append the specified cell to the dictionary
157 **************************************************************************/
158 void dictAppendCell(FICL_DICT *pDict, CELL c)
159 {
160     *pDict->here++ = c;
161     return;
162 }
163
164
165 /**************************************************************************
166                         d i c t A p p e n d C h a r
167 ** Append the specified char to the dictionary
168 **************************************************************************/
169 void dictAppendChar(FICL_DICT *pDict, char c)
170 {
171     char *cp = (char *)pDict->here;
172     *cp++ = c;
173     pDict->here = PTRtoCELL cp;
174     return;
175 }
176
177
178 /**************************************************************************
179                         d i c t A p p e n d W o r d
180 ** Create a new word in the dictionary with the specified
181 ** name, code, and flags. Name must be NULL-terminated.
182 **************************************************************************/
183 FICL_WORD *dictAppendWord(FICL_DICT *pDict, 
184                           char *name, 
185                           FICL_CODE pCode, 
186                           UNS8 flags)
187 {
188     STRINGINFO si;
189     SI_SETLEN(si, strlen(name));
190     SI_SETPTR(si, name);
191     return dictAppendWord2(pDict, si, pCode, flags);
192 }
193
194
195 /**************************************************************************
196                         d i c t A p p e n d W o r d 2
197 ** Create a new word in the dictionary with the specified
198 ** STRINGINFO, code, and flags. Does not require a NULL-terminated
199 ** name.
200 **************************************************************************/
201 FICL_WORD *dictAppendWord2(FICL_DICT *pDict, 
202                            STRINGINFO si, 
203                            FICL_CODE pCode, 
204                            UNS8 flags)
205 {
206     FICL_COUNT len  = (FICL_COUNT)SI_COUNT(si);
207     char *pName;
208     FICL_WORD *pFW;
209
210     ficlLockDictionary(TRUE);
211
212     /*
213     ** NOTE: dictCopyName advances "here" as a side-effect.
214     ** It must execute before pFW is initialized.
215     */
216     pName         = dictCopyName(pDict, si);
217     pFW           = (FICL_WORD *)pDict->here;
218     pDict->smudge = pFW;
219     pFW->hash     = hashHashCode(si);
220     pFW->code     = pCode;
221     pFW->flags    = (UNS8)(flags | FW_SMUDGE);
222     pFW->nName    = (char)len;
223     pFW->name     = pName;
224     /*
225     ** Point "here" to first cell of new word's param area...
226     */
227     pDict->here   = pFW->param;
228
229     if (!(flags & FW_SMUDGE))
230         dictUnsmudge(pDict);
231
232     ficlLockDictionary(FALSE);
233     return pFW;
234 }
235
236
237 /**************************************************************************
238                         d i c t A p p e n d U N S
239 ** Append the specified FICL_UNS to the dictionary
240 **************************************************************************/
241 void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
242 {
243     *pDict->here++ = LVALUEtoCELL(u);
244     return;
245 }
246
247
248 /**************************************************************************
249                         d i c t C e l l s A v a i l
250 ** Returns the number of empty cells left in the dictionary
251 **************************************************************************/
252 int dictCellsAvail(FICL_DICT *pDict)
253 {
254     return pDict->size - dictCellsUsed(pDict);
255 }
256
257
258 /**************************************************************************
259                         d i c t C e l l s U s e d
260 ** Returns the number of cells consumed in the dicionary
261 **************************************************************************/
262 int dictCellsUsed(FICL_DICT *pDict)
263 {
264     return pDict->here - pDict->dict;
265 }
266
267
268 /**************************************************************************
269                         d i c t C h e c k
270 ** Checks the dictionary for corruption and throws appropriate
271 ** errors
272 **************************************************************************/
273 void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
274 {
275     if ((n >= 0) && (dictCellsAvail(pDict) * sizeof (CELL) < n))
276     {
277         vmThrowErr(pVM, "Error: dictionary full");
278     }
279
280     if ((n <= 0) && (dictCellsUsed(pDict) * sizeof (CELL) < -n))
281     {
282         vmThrowErr(pVM, "Error: dictionary underflow");
283     }
284
285     if (pDict->nLists > FICL_DEFAULT_VOCS)
286     {
287         dictResetSearchOrder(pDict);
288         vmThrowErr(pVM, "Error: search order overflow");
289     }
290     else if (pDict->nLists < 0)
291     {
292         dictResetSearchOrder(pDict);
293         vmThrowErr(pVM, "Error: search order underflow");
294     }
295
296     return;
297 }
298
299
300 /**************************************************************************
301                         d i c t C o p y N a m e
302 ** Copy up to nFICLNAME characters of the name specified by si into
303 ** the dictionary starting at "here", then NULL-terminate the name,
304 ** point "here" to the next available byte, and return the address of
305 ** the beginning of the name. Used by dictAppendWord.
306 ** N O T E S :
307 ** 1. "here" is guaranteed to be aligned after this operation.
308 ** 2. If the string has zero length, align and return "here"
309 **************************************************************************/
310 static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si)
311 {
312     char *oldCP    = (char *)pDict->here;
313     char *cp       = oldCP;
314     char *name     = SI_PTR(si);
315     int   i        = SI_COUNT(si);
316
317     if (i == 0)
318     {
319         dictAlign(pDict);
320         return (char *)pDict->here;
321     }
322
323     if (i > nFICLNAME)
324         i = nFICLNAME;
325     
326     for (; i > 0; --i)
327     {
328         *cp++ = *name++;
329     }
330
331     *cp++ = '\0';
332
333     pDict->here = PTRtoCELL cp;
334     dictAlign(pDict);
335     return oldCP;
336 }
337
338
339 /**************************************************************************
340                         d i c t C r e a t e
341 ** Create and initialize a dictionary with the specified number
342 ** of cells capacity, and no hashing (hash size == 1).
343 **************************************************************************/
344 FICL_DICT  *dictCreate(unsigned nCells)
345 {
346     return dictCreateHashed(nCells, 1);
347 }
348
349
350 FICL_DICT  *dictCreateHashed(unsigned nCells, unsigned nHash)
351 {
352     FICL_DICT *pDict;
353     size_t nAlloc;
354
355     nAlloc =  sizeof (FICL_HASH) + nCells      * sizeof (CELL)
356                                  + (nHash - 1) * sizeof (FICL_WORD *);
357
358     pDict = ficlMalloc(sizeof (FICL_DICT));
359     assert(pDict);
360     memset(pDict, 0, sizeof (FICL_DICT));
361     pDict->dict = ficlMalloc(nAlloc);
362     assert(pDict->dict);
363     pDict->size = nCells;
364     dictEmpty(pDict, nHash);
365     return pDict;
366 }
367
368
369 /**************************************************************************
370                         d i c t D e l e t e 
371 ** Free all memory allocated for the given dictionary 
372 **************************************************************************/
373 void dictDelete(FICL_DICT *pDict)
374 {
375     assert(pDict);
376     ficlFree(pDict);
377     return;
378 }
379
380
381 /**************************************************************************
382                         d i c t E m p t y
383 ** Empty the dictionary, reset its hash table, and reset its search order.
384 ** Clears and (re-)creates the hash table with the size specified by nHash.
385 **************************************************************************/
386 void dictEmpty(FICL_DICT *pDict, unsigned nHash)
387 {
388     FICL_HASH *pHash;
389
390     pDict->here = pDict->dict;
391
392     dictAlign(pDict);
393     pHash = (FICL_HASH *)pDict->here;
394     dictAllot(pDict, 
395               sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
396
397     pHash->size = nHash;
398     hashReset(pHash);
399
400     pDict->pForthWords = pHash;
401     pDict->smudge = NULL;
402     dictResetSearchOrder(pDict);
403     return;
404 }
405
406
407 /**************************************************************************
408                         d i c t I n c l u d e s
409 ** Returns TRUE iff the given pointer is within the address range of 
410 ** the dictionary.
411 **************************************************************************/
412 int dictIncludes(FICL_DICT *pDict, void *p)
413 {
414     return ((p >= (void *) &pDict->dict)
415         &&  (p <  (void *)(&pDict->dict + pDict->size)) 
416            );
417 }
418
419
420 /**************************************************************************
421                         d i c t L o o k u p
422 ** Find the FICL_WORD that matches the given name and length.
423 ** If found, returns the word's address. Otherwise returns NULL.
424 ** Uses the search order list to search multiple wordlists.
425 **************************************************************************/
426 FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si)
427 {
428     FICL_WORD *pFW = NULL;
429     FICL_HASH *pHash;
430     int i;
431     UNS16 hashCode   = hashHashCode(si);
432
433     assert(pDict);
434
435     ficlLockDictionary(1);
436
437     for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
438     {
439         pHash = pDict->pSearch[i];
440         pFW = hashLookup(pHash, si, hashCode);
441     }
442
443     ficlLockDictionary(0);
444     return pFW;
445 }
446
447
448 /**************************************************************************
449                         d i c t L o o k u p L o c
450 ** Same as dictLookup, but looks in system locals dictionary first...
451 ** Assumes locals dictionary has only one wordlist...
452 **************************************************************************/
453 #if FICL_WANT_LOCALS
454 FICL_WORD *dictLookupLoc(FICL_DICT *pDict, STRINGINFO si)
455 {
456     FICL_WORD *pFW = NULL;
457     FICL_HASH *pHash = ficlGetLoc()->pForthWords;
458     int i;
459     UNS16 hashCode   = hashHashCode(si);
460
461     assert(pHash);
462     assert(pDict);
463
464     ficlLockDictionary(1);
465     /* 
466     ** check the locals dict first... 
467     */
468     pFW = hashLookup(pHash, si, hashCode);
469
470     /* 
471     ** If no joy, (!pFW) --------------------------v
472     ** iterate over the search list in the main dict 
473     */
474     for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i)
475     {
476         pHash = pDict->pSearch[i];
477         pFW = hashLookup(pHash, si, hashCode);
478     }
479
480     ficlLockDictionary(0);
481     return pFW;
482 }
483 #endif
484
485
486 /**************************************************************************
487                     d i c t R e s e t S e a r c h O r d e r
488 ** Initialize the dictionary search order list to sane state
489 **************************************************************************/
490 void dictResetSearchOrder(FICL_DICT *pDict)
491 {
492     assert(pDict);
493     pDict->pCompile = pDict->pForthWords;
494     pDict->nLists = 1;
495     pDict->pSearch[0] = pDict->pForthWords;
496     return;
497 }
498
499
500 /**************************************************************************
501                         d i c t S e t F l a g s
502 ** Changes the flags field of the most recently defined word:
503 ** Set all bits that are ones in the set parameter, clear all bits
504 ** that are ones in the clr parameter. Clear wins in case the same bit
505 ** is set in both parameters.
506 **************************************************************************/
507 void dictSetFlags(FICL_DICT *pDict, UNS8 set, UNS8 clr)
508 {
509     assert(pDict->smudge);
510     pDict->smudge->flags |= set;
511     pDict->smudge->flags &= ~clr;
512     return;
513 }
514
515
516 /**************************************************************************
517                         d i c t S e t I m m e d i a t e 
518 ** Set the most recently defined word as IMMEDIATE
519 **************************************************************************/
520 void dictSetImmediate(FICL_DICT *pDict)
521 {
522     assert(pDict->smudge);
523     pDict->smudge->flags |= FW_IMMEDIATE;
524     return;
525 }
526
527
528 /**************************************************************************
529                         d i c t U n s m u d g e 
530 ** Completes the definition of a word by linking it
531 ** into the main list
532 **************************************************************************/
533 void dictUnsmudge(FICL_DICT *pDict)
534 {
535     FICL_WORD *pFW = pDict->smudge;
536     FICL_HASH *pHash = pDict->pCompile;
537
538     assert(pHash);
539     assert(pFW);
540     /*
541     ** :noname words never get linked into the list...
542     */
543     if (pFW->nName > 0)
544         hashInsertWord(pHash, pFW);
545     pFW->flags &= ~(FW_SMUDGE);
546     return;
547 }
548
549
550 /**************************************************************************
551                         d i c t W h e r e
552 ** Returns the value of the HERE pointer -- the address
553 ** of the next free cell in the dictionary
554 **************************************************************************/
555 CELL *dictWhere(FICL_DICT *pDict)
556 {
557     return pDict->here;
558 }
559
560
561 /**************************************************************************
562                         h a s h F o r g e t
563 ** Unlink all words in the hash that have addresses greater than or
564 ** equal to the address supplied. Implementation factor for FORGET
565 ** and MARKER.
566 **************************************************************************/
567 void hashForget(FICL_HASH *pHash, void *where)
568 {
569     FICL_WORD *pWord;
570     unsigned i;
571
572     assert(pHash);
573     assert(where);
574
575     for (i = 0; i < pHash->size; i++)
576     {
577         pWord = pHash->table[i];
578
579         while ((void *)pWord >= where)
580         {
581             pWord = pWord->link;
582         }
583
584         pHash->table[i] = pWord;
585     }
586
587     return;
588 }
589
590
591 /**************************************************************************
592                         h a s h H a s h C o d e
593 ** 
594 ** Generate a 16 bit hashcode from a character string using a rolling
595 ** shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
596 ** the name before hashing it...
597 ** N O T E : If string has zero length, returns zero.
598 **************************************************************************/
599 UNS16 hashHashCode(STRINGINFO si)
600 {   
601     /* hashPJW */
602     UNS8 *cp;
603     UNS16 code = (UNS16)si.count;
604     UNS16 shift = 0;
605
606     if (si.count == 0)
607         return 0;
608
609     for (cp = (UNS8 *)si.cp; *cp && si.count; cp++, si.count--)
610     {
611         code = (UNS16)((code << 4) + tolower(*cp));
612         shift = (UNS16)(code & 0xf000);
613         if (shift)
614         {
615             code ^= (UNS16)(shift >> 8);
616             code ^= (UNS16)shift;
617         }
618     }
619
620     return (UNS16)code;
621 }
622
623
624 /**************************************************************************
625                         h a s h I n s e r t W o r d
626 ** Put a word into the hash table using the word's hashcode as
627 ** an index (modulo the table size).
628 **************************************************************************/
629 void hashInsertWord(FICL_HASH *pHash, FICL_WORD *pFW)
630 {
631     FICL_WORD **pList;
632
633     assert(pHash);
634     assert(pFW);
635
636     if (pHash->size == 1)
637     {
638         pList = pHash->table;
639     }
640     else
641     {
642         pList = pHash->table + (pFW->hash % pHash->size);
643     }
644
645     pFW->link = *pList;
646     *pList = pFW;
647     return;
648 }
649
650
651 /**************************************************************************
652                         h a s h L o o k u p
653 ** Find a name in the hash table given the hashcode and text of the name.
654 ** Returns the address of the corresponding FICL_WORD if found, 
655 ** otherwise NULL.
656 ** Note: outer loop on link field supports inheritance in wordlists.
657 ** It's not part of ANS Forth - ficl only. hashReset creates wordlists
658 ** with NULL link fields.
659 **************************************************************************/
660 FICL_WORD *hashLookup(FICL_HASH *pHash, STRINGINFO si, UNS16 hashCode)
661 {
662     FICL_COUNT nCmp = (FICL_COUNT)si.count;
663     FICL_WORD *pFW;
664     UNS16 hashIdx;
665
666     if (nCmp > nFICLNAME)
667         nCmp = nFICLNAME;
668
669     for (; pHash != NULL; pHash = pHash->link)
670     {
671         if (pHash->size > 1)
672             hashIdx = (UNS16)(hashCode % pHash->size);
673         else            /* avoid the modulo op for single threaded lists */
674             hashIdx = 0;
675
676         for (pFW = pHash->table[hashIdx]; pFW; pFW = pFW->link)
677         {
678             if ( (pFW->nName == si.count) 
679                 && (!strincmp(si.cp, pFW->name, nCmp)) )
680                 return pFW;
681 #if FICL_ROBUST
682             assert(pFW != pFW->link);
683 #endif
684         }
685     }
686
687     return NULL;
688 }
689
690
691 /**************************************************************************
692                              h a s h R e s e t
693 ** Initialize a FICL_HASH to empty state.
694 **************************************************************************/
695 void hashReset(FICL_HASH *pHash)
696 {
697     unsigned i;
698
699     assert(pHash);
700
701     for (i = 0; i < pHash->size; i++)
702     {
703         pHash->table[i] = NULL;
704     }
705
706     pHash->link = NULL;
707     return;
708 }
709
710 /**************************************************************************
711                     d i c t C h e c k T h r e s h o l d
712 ** Verify if an increase in the dictionary size is warranted, and do it if
713 ** so.
714 **************************************************************************/
715
716 void dictCheckThreshold(FICL_DICT* dp)
717 {
718     if( dictCellsAvail(dp) < dictThreshold ) {
719         dp->dict = ficlMalloc( dictIncrease * sizeof (CELL) );
720         assert(dp->dict);
721         dp->here = dp->dict;
722         dp->size = dictIncrease;
723     }
724 }
725