dict.c revision 60959
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: head/sys/boot/ficl/dict.c 60959 2000-05-26 21:35:08Z dcs $ */ 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 */ 33unsigned int dictThreshold; 34unsigned int dictIncrease; 35 36 37static 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**************************************************************************/ 49void 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**************************************************************************/ 68void *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**************************************************************************/ 86void 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**************************************************************************/ 97int 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**************************************************************************/ 129int 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**************************************************************************/ 158void 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**************************************************************************/ 169void 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**************************************************************************/ 183FICL_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**************************************************************************/ 201FICL_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 3 2 239** Append the specified UNS32 to the dictionary 240**************************************************************************/ 241void dictAppendUNS(FICL_DICT *pDict, UNS32 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**************************************************************************/ 252int 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**************************************************************************/ 262int 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**************************************************************************/ 273void 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**************************************************************************/ 310static 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**************************************************************************/ 344FICL_DICT *dictCreate(unsigned nCells) 345{ 346 return dictCreateHashed(nCells, 1); 347} 348 349 350FICL_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**************************************************************************/ 373void 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**************************************************************************/ 386void 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**************************************************************************/ 412int 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**************************************************************************/ 426FICL_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 454FICL_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**************************************************************************/ 490void 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**************************************************************************/ 507void 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**************************************************************************/ 520void 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**************************************************************************/ 533void 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**************************************************************************/ 555CELL *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**************************************************************************/ 567void 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**************************************************************************/ 599UNS16 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**************************************************************************/ 629void 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**************************************************************************/ 660FICL_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**************************************************************************/ 695void 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 716void 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 726