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