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