1/* BEGIN LICENSE BLOCK 2 * Version: CMPL 1.1 3 * 4 * The contents of this file are subject to the Cisco-style Mozilla Public 5 * License Version 1.1 (the "License"); you may not use this file except 6 * in compliance with the License. You may obtain a copy of the License 7 * at www.eclipse-clp.org/license. 8 * 9 * Software distributed under the License is distributed on an "AS IS" 10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 * the License for the specific language governing rights and limitations 12 * under the License. 13 * 14 * The Original Code is The ECLiPSe Constraint Logic Programming System. 15 * The Initial Developer of the Original Code is Cisco Systems, Inc. 16 * Portions created by the Initial Developer are 17 * Copyright (C) 1992-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * SEPIA C SOURCE MODULE 25 * 26 * VERSION $Id: dict.c,v 1.11 2013/02/08 15:00:52 jschimpf Exp $ 27 */ 28 29/* 30 * IDENTIFICATION dict.c 31 * 32 * AUTHOR: Joachim Schimpf 33 * 34 * DESCRIPTION SEPIA dictionary and related routines 35 * 36 * CONTENTS: 37 * 38 * dict_init() 39 * 40 * initialise the dictionary data structures and enter 41 * some predefined functors. 42 * 43 * dident enter_dict_n(char *name, int namelength, int arity) 44 * 45 * Returns the DID for the functor with given name and arity. 46 * If it is not yet in the dictionary, it is entered. The name 47 * is specified with the length, so it can contain NUL bytes. 48 * 49 * dident enter_dict(char *name, int arity) 50 * 51 * Same as enter_dict_n(), but takes a NUL-terminated C string 52 * 53 * dident in_dict(char *name, int arity) 54 * 55 * Same as enter_dict(), but makes the entry a permanent one, ie. 56 * it will never be garbage collected. It is safe to store such 57 * DIDs in places that the garbage collector does not know about. 58 * 59 * dident ec_did(char *name, int arity) 60 * 61 * Same as in_dict(), for naming like other user functions. 62 * 63 * dident add_dict(dident olddid, int newarity) 64 * 65 * Converts a given DID into one for the same name but different 66 * arity. If such an entry does not yet exist, it is created. 67 * 68 * dident check_did_n(char *name, int namelength, int arity) 69 * 70 * Returns the DID for the functor with given name and arity. 71 * If it is not yet in the dictionary, D_UNKNOWN is returned. 72 * 73 * dident check_did(dident olddid, int newarity) 74 * 75 * Converts a given DID into one for the same name but different 76 * arity. If such an entry does not exist, D_UNKNOWN is returned. 77 * 78 * pword *enter_string_n(char *name, int length, int stability) 79 * 80 * Create an atom with the given stability and returns a pointer 81 * to the corresponding string in the heap. This string exists 82 * only as long as a functor with this name exists. That means, 83 * if the string pointer is stored in a place where it is not 84 * known to the garbage collector, the stability has to be 85 * sufficiently high. 86 * 87 * dident bitfield_did(int bitfield) 88 * 89 * convert a 19-bit bitfield representation of a DID (as used in 90 * the variable names) to a standard 32-bit DID. 91 * 92 * int next_functor(int *index, dident *did) 93 * 94 * support function for traversing the dictionary, see below. 95 * 96 * gc_dictionary(arity) 97 * 98 * Dictionary garbage collector. 99 * 100 */ 101 102 103#include "config.h" 104#include "os_support.h" 105#include "sepia.h" 106#include "types.h" 107#include "embed.h" 108#include "error.h" 109#include "mem.h" 110#include "ec_io.h" 111#include "dict.h" 112#include "emu_export.h" 113 114static dident _in_dict_opt(char *name, register int length, int hval, int arity, int options); 115static void _std_did_init(void); 116static void _constant_table_init(int); 117 118 119/*----------------------------------------------------------------------------- 120 121The basic data structure for the dictionary is the struct dict_item. 122A dictionary identifier (DID) is simply the address of such a dict_item. 123A dict_item contains: 124 125 - arity 126 - pointer to a (Sepia-)string representing the name 127 - procedure chain 128 - property chain 129 - collision chain 130 - flags 131 132dict_items are allocated in blocks of DICT_ITEM_BLOCK_SIZE (1024) elements. 133The addresses of these blocks are kept in a directory array of size 134DICT_DIRECTORY_SIZE (512). The maximum number of dictionary entries is thus 135DICT_DIRECTORY_SIZE * DICT_ITEM_BLOCK_SIZE (524288). 136This scheme is necessary to have a short 19-bit identifier (9 bits directory index, 13710 bits block index) for DIDs, which is used to store variable names in the tag. 138For all other purposes, a DID is stored directly as its 32-bit-address. 139 140For finding DIDs when their name is given, there is a hash table of size 141DICT_HASH_TABLE_SIZE. The hash value is computed from the name only, not 142from the arity. Thus all functors with the same name hash onto the same 143slot of the hash table (together with other functors whose name happens to 144give the same hash value). All colliding entries are kept in a circular 145chain, built using the 'next' field of the dict_items. The dict_item that 146is referenced from the hash table is marked with the 'head' bit. 147 148The circular collision chain is also used to find a functor that has the 149same name but different arity as a given one (e.g. in functor/3), so no 150new hashing is needed in this case, see function add_dict(). 151 152The strings holding the functor names are allocated separately from the 153dict_items. All functors with the same name (but different arities) share 154the same string. Note that, due to the current handling of strings in Sepia, 155these strings are not only referenced by dict_items, but may also be pointed 156to by TSTRG pwords from elsewhere. The dictionary strings look like standard 157Sepia strings, but their tag is TBUFFER|IN_DICT|<ref_counter>. 158The reference counter counts the number of references from dict_items only, 159and is used to free the string when the last functor with this name disappears. 160To make sure that referenced strings are not collected, the marking routine 161marks the corresponding atom whenever a persistent string is encountered. 162 163-----------------------------------------------------------------------------*/ 164 165#define DICT_DIRECTORY_SIZE 512 166#define DICT_ITEM_BLOCK_SIZE 1024 167 168#define DidBlock(i) ((i) >> 10) 169#define DidOffset(i) ((i) & 0x3ff) 170#define MakeBitField(block, offs) ((block)<<10|(offs)) 171 172/* values for the options for _in_dict_opt() */ 173#define IN_DICT_CHECK 0 174#define IN_DICT_ENTER 1 175 176#define NULL_DID ((dident) D_UNKNOWN) 177 178#define Inc_Ref_Ctr(tag) { (tag) += 0x100; } 179#define DecRefCtr(tag) ((tag) -= 0x100, (tag) & 0x0fffff00) 180 181 182/* DICT_HASH_TABLE_SIZE must be a power of 2 (we use masking) */ 183#define DICT_HASH_TABLE_SIZE 8192 184 185/* compute hash value and length of a NULL-terminated string */ 186#define Hash(id, hash, length) { \ 187 register char *str = (id); \ 188 for (length = hash = 0; *str; str++, length++) \ 189 hash += (hash<<3) + *(unsigned char *)str; \ 190 hash &= DICT_HASH_TABLE_SIZE-1; \ 191} 192 193/* compute hash value of a string of given length */ 194#define Hashl(id, hash, n) { \ 195 register char *str = (id); \ 196 register int length = (n); \ 197 for (hash = 0; length > 0; str++, --length) \ 198 hash += (hash<<3) + *(unsigned char *)str; \ 199 hash &= DICT_HASH_TABLE_SIZE-1; \ 200} 201 202 203/* 204 * Compare 2 strings of length length. 205 * length is decremented and is 0 if the strings were equal 206 */ 207#define Compare_N_Chars(length, s1, s2) { \ 208 register char *aux1 = (s1), *aux2 = (s2); \ 209 while (length) { \ 210 if (*aux1++ != *aux2++) \ 211 break; \ 212 --length; \ 213 } \ 214} 215 216#define DidInUse(d) (DidString(d)) 217 218 219/* 220 * TYPEDEFS and GLOBAL VARIABLES 221 */ 222 223static struct dictionary { 224 dident hash_table[DICT_HASH_TABLE_SIZE]; 225 dident directory[DICT_DIRECTORY_SIZE]; /* table of dict_item blocks */ 226 struct dict_item tag_did[NTYPES+1]; /* to hold type properties */ 227 a_mutex_t lock; /* lock for hash table */ 228 int dir_index; /* next free directory slot */ 229 dident free_item_list; /* chain of free dict_items */ 230 int items_free; /* number of elements in this chain */ 231 int table_usage; /* number of hash slots in use */ 232 int collisions; /* number of hash collisions */ 233 int gc_countdown; /* remaining allocations before triggering gc */ 234 int gc_interval; /* remaining allocations before triggering gc */ 235 int gc_number; /* number of garbage collections so far */ 236 word gc_time; /* and the time they took */ 237 int string_used; 238 int string_free; 239} *dict; 240 241 242void 243dict_init(int flags) 244{ 245 if (flags & INIT_SHARED) 246 { 247 register int i; 248 dict = (struct dictionary *) hg_alloc_size(sizeof(struct dictionary)); 249 shared_data->dictionary = (void_ptr) dict; 250 for (i=0; i< DICT_HASH_TABLE_SIZE; i++) 251 dict->hash_table[i] = NULL_DID; 252 for (i=0; i< DICT_DIRECTORY_SIZE; i++) 253 dict->directory[i] = NULL_DID; 254 for (i=0; i <= NTYPES; i++) 255 { 256 dict->tag_did[i].string = 0; 257 dict->tag_did[i].properties = 0; 258 dict->tag_did[i].macro = 0; 259 } 260 dict->dir_index = 0; 261 dict->free_item_list = NULL_DID; 262 dict->items_free = 0; 263 dict->string_used = 0; 264 dict->string_free = 0; 265 dict->table_usage = 0; 266 dict->collisions = 0; 267 dict->gc_interval = DICT_ITEM_BLOCK_SIZE/16*15; 268 /* set initial countdown high enough to make sure the first 269 * collection does not occur too early in the boot phase */ 270 dict->gc_countdown = 2*dict->gc_interval; 271 dict->gc_number = 0; 272 dict->gc_time = 0; 273 a_mutex_init(&dict->lock); 274 } 275 if (flags & INIT_PRIVATE) 276 { 277 int i; 278 279 dict = (struct dictionary *) shared_data->dictionary; 280 _std_did_init(); 281 282 /* Tag descriptor array (more settings in bip_emu_init()) */ 283 for (i=0; i <= NTYPES; i++) 284 { 285 tag_desc[i].super = 286 tag_desc[i].tag.kernel = (word) i; 287 tag_desc[i].order = 0; 288 tag_desc[i].type_name = 289 tag_desc[i].tag_name = D_UNKNOWN; 290 } 291 292 tag_desc[TLIST].tag_name = in_dict("list", 0); 293 tag_desc[TCOMP].tag_name = in_dict("structure", 0); 294 tag_desc[TSTRG].tag_name = d_.string0; 295 tag_desc[TBIG].tag_name = in_dict("bignum", 0); 296 tag_desc[TDBL].tag_name = d_.double0; 297 tag_desc[TRAT].tag_name = d_.rational0; 298 tag_desc[TSUSP].tag_name = d_.goal; 299 tag_desc[THANDLE].tag_name = in_dict("handle", 0); 300 tag_desc[TNIL].tag_name = d_.nil; 301 tag_desc[TINT].tag_name = d_.integer0; 302 tag_desc[TDICT].tag_name = d_.atom0; 303 tag_desc[TPTR].tag_name = d_.meta0; 304 305 tag_desc[TLIST].super = TCOMP; 306 tag_desc[TCOMP].type_name = d_.compound0; 307 tag_desc[TSTRG].type_name = d_.string0; 308 tag_desc[TBIG].super = TINT; 309 tag_desc[TINT].type_name = d_.integer0; 310 tag_desc[TDBL].type_name = d_.float0; 311 tag_desc[TRAT].type_name = d_.rational0; 312 tag_desc[TSUSP].type_name = d_.goal; 313 tag_desc[THANDLE].type_name = in_dict("handle", 0); 314 tag_desc[TNIL].super = TDICT; 315 tag_desc[TDICT].type_name = d_.atom0; 316 tag_desc[TPTR].type_name = d_.meta0; 317 } 318 319 _constant_table_init(flags); 320} 321 322 323/* 324 * Return dict_item for the specified type/tag. 325 * It is used to attach properties to types, in particular macros. 326 */ 327 328dident 329transf_did(word t) 330{ 331 return (dident) &dict->tag_did[tag_desc[TagTypeC(t)].super]; 332} 333 334 335/* 336 * String allocation for dictionary. 337 * These strings are write-once, read-only, except for dictionary gc. 338 */ 339 340#define StringSize(length) (BufferSizePwords(length+1) * sizeof(pword)) 341 342static pword * 343alloc_string(int length) 344{ 345 pword *ptr; 346 ptr = (pword *) hg_alloc_size((int) StringSize(length)); 347 return ptr; 348} 349 350static void 351free_string(pword *ptr) 352{ 353 hg_free_size((generic_ptr) ptr, (int) StringSize(ptr->val.nint)); 354} 355 356 357 358/* 359 * return a new dict_item 360 * 361 * Initializes all fields except .next 362 * Free dict_items are in the free list and can be recognised also 363 * by having a NULL string field. 364 */ 365 366static dident 367_alloc_dict_item(pword *dict_string, int arity) 368{ 369 register dident dip; 370 371 dip = dict->free_item_list; 372 if (!dip) /* free list empty, allocate a new block */ 373 { 374 register int i; 375 if (dict->dir_index == DICT_DIRECTORY_SIZE) 376 ec_panic("dictionary overflow", "atom/functor creation"); 377 dip = 378 dict->free_item_list = 379 dict->directory[dict->dir_index] = 380 (dident) hg_alloc_size(sizeof(struct dict_item) * DICT_ITEM_BLOCK_SIZE); 381 for (i = 0; i < DICT_ITEM_BLOCK_SIZE; ++i) 382 { 383 dip[i].bitfield = MakeBitField(dict->dir_index, i); 384 dip[i].string = (pword *) 0; 385 dip[i].arity = UNUSED_DID_ARITY; 386 dip[i].next = &dip[i+1]; 387 } 388 dip[i-1].next = NULL_DID; 389 dict->dir_index++; 390 dict->items_free += DICT_ITEM_BLOCK_SIZE; 391 } 392 393 dip->string = dict_string; /* initialize the dict_item */ 394 Inc_Ref_Ctr(dict_string->tag.kernel); 395 dip->arity = arity; 396 dip->procedure = 0; 397 dip->properties = 0; 398 dip->macro = 0; 399 dip->attainable = 0; 400 dip->module = 0; 401 dip->isop = 0; 402 dip->head = 0; 403 dip->stability = 0; 404 405 dict->free_item_list = dip->next; /* unlink it from the free list */ 406 dict->items_free--; 407 if (--dict->gc_countdown == 0) 408 { 409 pword pw; 410 Make_Atom(&pw, d_.garbage_collect_dictionary); 411 ec_post_event(pw); 412 } 413 return dip; 414} 415 416 417dident 418in_dict(char *name, int arity) 419{ 420 register int hval, len; 421 register dident dip; 422 Hash(name, hval, len); 423 dip = _in_dict_opt(name, len, hval, arity, IN_DICT_ENTER); 424 Set_Did_Stability(dip, DICT_PERMANENT); 425 return dip; 426} 427 428dident Winapi 429ec_did(const char *name, const int arity) 430{ 431 register int hval, len; 432 register dident dip; 433 Hash((char *)name, hval, len); 434 dip = _in_dict_opt((char *) name, len, hval, arity, IN_DICT_ENTER); 435 Set_Did_Stability(dip, DICT_PERMANENT); 436 return dip; 437} 438 439dident 440enter_dict(char *name, int arity) 441{ 442 register int hval, len; 443 Hash(name, hval, len); 444 return _in_dict_opt(name, len, hval, arity, IN_DICT_ENTER); 445} 446 447dident 448enter_dict_n(char *name, register word len, int arity) 449{ 450 register int hval; 451 Hashl(name, hval, len); 452 return _in_dict_opt(name, (int) len, hval, arity, IN_DICT_ENTER); 453} 454 455dident 456check_did_n(char *name, word len, int arity) 457{ 458 register int hval; 459 Hashl(name, hval, len); 460 return _in_dict_opt(name, (int) len, hval, arity, IN_DICT_CHECK); 461} 462 463pword * 464enter_string_n(char *name, word len, int stability) 465{ 466 register int hval; 467 register dident dip; 468 Hashl(name, hval, len); 469 dip = _in_dict_opt(name, (int) len, hval, 0, IN_DICT_ENTER); 470 Set_Did_Stability(dip, stability); 471 return DidString(dip); 472} 473 474dident 475bitfield_did(word bf) 476{ 477 return (dident) (dict->directory[DidBlock(bf)] + DidOffset(bf)); 478} 479 480 481/* 482 * _in_dict_opt(name, length, hval, arity, options) 483 * options are IN_DICT_CHECK or IN_DICT_ENTER 484 * 485 * We guarantee that functors with the same name always share their name string! 486 * 487 * We only lock on dictionary modifications, assuming that dids are 488 * never removed under our feet. This means that for dictionary gc's 489 * we have to stop all workers! 490 */ 491 492static dident 493_in_dict_opt(char *name, /* might not be NUL-terminated! */ 494 register int length, 495 int hval, 496 int arity, 497 int options) 498{ 499 register dident dip; 500 register dident start; 501 register pword *dict_string; 502 503 start = dict->hash_table[hval]; 504 dict_string = (pword *) 0; 505 if (start) 506 { 507 dip = start; 508 do 509 { 510 if (!dict_string) 511 { 512 if (DidLength(dip) == length) 513 { 514 register word cmp = length; 515 Compare_N_Chars(cmp, name, DidName(dip)); 516 if (!cmp) /* name found */ 517 { 518 if (DidArity(dip) == arity) 519 return (dident) dip; 520 else 521 dict_string = DidString(dip); 522 } 523 } 524 } 525 else if (DidString(dip) == dict_string && DidArity(dip) == arity) 526 return (dident) dip; 527 dip = dip->next; 528 } while (dip != start); 529 } 530 if (options == IN_DICT_CHECK) 531 return (dident) NULL_DID; 532 533 if (!dict_string) /* a functor with a new name */ 534 { 535 dict->string_used += length+1; 536 dict_string = alloc_string(length); 537 Set_Buffer_Size(dict_string, length+1); 538 dict_string->tag.kernel = TBUFFER|IN_DICT; 539 Copy_Bytes((char *)(dict_string+1), name, (int) (length)); 540 ((char *)(dict_string+1))[length] = 0; 541 if (start) 542 dict->collisions++; 543 } 544 dip = _alloc_dict_item(dict_string, arity); 545 a_mutex_lock(&dict->lock); 546 if (start) 547 { 548 dip->next = start->next; 549 start->next = dip; 550 } 551 else /* the first entry in this hash slot */ 552 { 553 dip->next = dip; 554 dip->head = 1; 555 dict->hash_table[hval] = dip; 556 dict->table_usage++; 557 } 558 a_mutex_unlock(&dict->lock); 559 return (dident) dip; 560} 561 562 563dident 564add_dict(register dident old_did, register int new_arity) 565{ 566 register dident dip; 567 568 dip = (dident) old_did; 569 do { 570 if (DidArity(dip) == new_arity && DidString(dip) == DidString(old_did)) 571 return (dident) dip; 572 dip = dip->next; 573 } while (dip != DidPtr(old_did)); 574 575 /* not found, make a new entry */ 576 dip = _alloc_dict_item(DidString(old_did), new_arity); 577 a_mutex_lock(&dict->lock); 578 dip->next = DidNext(old_did); 579 DidNext(old_did) = dip; 580 a_mutex_unlock(&dict->lock); 581 return (dident) dip; 582} 583 584dident 585check_did(register dident old_did, register int new_arity) 586{ 587 register dident dip = (dident) old_did; 588 589 do { 590 if (DidArity(dip) == new_arity && DidString(dip) == DidString(old_did)) 591 return (dident) dip; 592 dip = dip->next; 593 } while (dip != DidPtr(old_did)); 594 return D_UNKNOWN; 595} 596 597 598/* 599 * int next_functor() 600 * 601 * A support function to scan the dictionary. It is used to implement 602 * current_functor/1 and the like. 603 * The update semantics of this function is unclear (i.e. if a new 604 * functor is entered between successive calls of next_functor(), 605 * it will be returned or not, depending of where it is inserted). 606 * Note also that dictionary GCs might happen between successive calls 607 * to this function, which has similar consequences. 608 * However, the function is at least robust and will not crash. 609 * 610 * To be used like: 611 * 612 * int idx = 0; 613 * dident did; 614 * 615 * while (next_functor(&idx, &did)) 616 * { 617 * <use did> 618 * } 619 */ 620 621int 622next_functor( /* returns 0 when dictionary exhausted */ 623 int *pidx, /* in/out: current dict index */ 624 dident *pdid) /* output: valid did */ 625{ 626 register dident dip; 627 register int idx = *pidx; 628 629 while (DidBlock(idx) < dict->dir_index) 630 { 631 dip = dict->directory[DidBlock(idx)]; 632 if (dip) 633 { 634 dip += DidOffset(idx); 635 do 636 { 637 idx++; 638 if (DidInUse(dip)) 639 { 640 *pdid = (dident) dip; 641 *pidx = idx; 642 return 1; 643 } 644 dip++; 645 } while (DidOffset(idx)); 646 } 647 else 648 idx = (DidBlock(idx) + 1) * DICT_ITEM_BLOCK_SIZE; 649 } 650 return 0; 651} 652 653 654 655/*-------------------------------------------------------------- 656 * Dictionary garbage collection 657 *--------------------------------------------------------------*/ 658 659/* 660 * _tidy_dictionary() 661 */ 662 663#define Useful(d) ((d)->attainable || (d)->stability > DICT_VOLATILE \ 664 || (d)->procedure || (d)->properties) 665 666#if 0 667 668/* 669 * The free list is built such that the oldest dids are reused first in order 670 * to quickly fill did blocks again, so that they are more or less read-only 671 * afterwards. 672 * Another advantage of this scheme is that we can easily detect when a block 673 * becomes completely unused, and then free the whole block. 674 */ 675 676static void 677_tidy_dictionary0(void) 678{ 679 int block, idx; 680 register dident dip, aux; 681 register dident *free_list_tail = &dict->free_item_list; 682 683 *free_list_tail = NULL_DID; 684 for (block = 0; block < dict->dir_index; block++) 685 { 686 dip = dict->directory[block]; 687 for (idx = 0; idx < DICT_ITEM_BLOCK_SIZE; idx++, dip++) 688 { 689 if (DidInUse(dip) && Useful(dip)) 690 { 691 dip->attainable = 0; 692 continue; 693 } 694 else if (DidInUse(dip)) /* a garbage did, unlink it */ 695 { 696 /* Tidy the collision chain in which dip occurs. This assumes that 697 * all DIDs with this name are in the same chain! 698 */ 699 register dident prev = dip; 700 int head_removed = 0; 701 702 do 703 { 704 aux = prev->next; 705 if (Useful(aux)) /* no garbage, skip it */ 706 { 707 prev = aux; 708 continue; 709 } 710 else /* remove aux */ 711 { 712 pword *str = DidString(aux); 713 prev->next = aux->next; 714 aux->next = NULL_DID; 715 dict->items_free++; 716 if (DecRefCtr(str->tag.kernel) == 0) 717 { 718 dict->string_used -= str->val.nint + 1; 719 free_string(str); 720 /* 721 p_fprintf(current_err_, "%s/%d (with string)\n", 722 DidName(aux), DidArity(aux)); 723 */ 724 } 725 /* 726 else 727 { 728 p_fprintf(current_err_, "%s/%d\n", 729 DidName(aux), DidArity(aux)); 730 } 731 */ 732 aux->string = (pword *) 0; 733 aux->arity = -1; 734 if (aux->head) 735 head_removed = 1; 736 } 737 } while (aux != dip); 738 739 if (head_removed) 740 { 741 register char *dummy1; 742 register int dummy2; 743 register hval; 744 Hash(DidName(dip), hval, dummy2, dummy1); 745 if (prev != dip) 746 { 747 prev->head = 1; 748 dict->hash_table[hval] = prev; 749 } 750 else /* we removed all chain elements */ 751 { 752 dict->hash_table[hval] = NULL_DID; 753 dict->table_usage--; 754 } 755 } 756 } /* else: an already unlinked garbage did */ 757 *free_list_tail = dip; /* add it to the free list */ 758 free_list_tail = &dip->next; 759 } 760 } 761 *free_list_tail = NULL_DID; 762 Succeed_; 763} 764 765#endif /* 0 */ 766 767/* 768 * alternatively, scan through the hash table 769 */ 770 771static void 772_tidy_dictionary(void) 773{ 774 int idx; 775 register dident dip; 776 register dident prev; 777 778 for (idx = 0; idx < DICT_HASH_TABLE_SIZE; idx++) 779 { 780 prev = dict->hash_table[idx]; 781 if (prev) 782 { 783 do 784 { 785 dip = prev->next; 786 if (Useful(dip)) 787 { 788 dip->attainable = 0; 789 prev = dip; 790 } 791 else /* a garbage did, unlink it */ 792 { 793 pword *str = DidString(dip); 794 prev->next = dip->next; 795 /* 796 p_fprintf(current_err_, "\n%s/%d", DidName(dip), DidArity(dip)); 797 */ 798 if (DecRefCtr(str->tag.kernel) == 0) 799 { 800 dict->collisions--; 801 dict->string_used -= str->val.nint + 1; 802 free_string(str); 803 /* 804 p_fprintf(current_err_, " (with string)"); 805 */ 806 } 807 /* add it to the free list */ 808#ifdef DEBUG_DICT 809 dip->arity = (word) dip->string; 810 dip->string = (pword *) 0; 811#else 812 dip->arity = UNUSED_DID_ARITY; 813 dip->string = (pword *) 0; 814 dip->next = dict->free_item_list; 815 dict->free_item_list = dip; 816 dict->items_free++; 817#endif 818 if (dip->head) /* removing the chain header */ 819 { 820 if (prev != dip) 821 { 822 prev->head = 1; 823 dict->hash_table[idx] = prev; 824 } 825 else /* we removed all chain elements */ 826 { 827 dict->hash_table[idx] = NULL_DID; 828 dict->collisions++; /* was not a collision */ 829 dict->table_usage--; 830 } 831 } 832 } 833 } while (!dip->head); 834 } 835 } 836} 837 838static void 839_mark_dids_from_procs(pri *proc) 840{ 841 for (; proc; proc = PriNext(proc)) 842 { 843 if (proc->module_def) 844 Mark_Did(proc->module_def); 845 if (proc->module_ref) 846 Mark_Did(proc->module_ref); 847 if (proc->trans_function) 848 Mark_Did(proc->trans_function); 849 if (DynamicProc(proc)) 850 ec_mark_dids_dyn_code(PriCode(proc)); 851 /* PriDid does not need to be marked because it has a procedure 852 * and will therefore not be collected */ 853 } 854} 855 856int 857ec_gc_dictionary(void) 858{ 859 int usage_before, garbage, idx = 0; 860 dident d; 861 word gc_time; 862 extern int in_exception(void); 863 extern void mark_dids_from_properties(property *prop_list), 864 mark_dids_from_stacks(word arity), 865 mark_dids_from_streams(void); 866 867 dict->gc_countdown = dict->gc_interval; 868 869 if (!(GlobalFlags & GC_ENABLED) /* if switched off */ 870 || ec_options.parallel_worker /* or heap is shared */ 871 || g_emu_.nesting_level > 1 /* or when emulators are nested */ 872 || in_exception()) /* or inside exception */ 873 { 874 Succeed_; /* then don't gc (not implemented) */ 875 } 876 877#ifndef PRINTAM 878 Disable_Int() 879#endif 880 881 if (GlobalFlags & GC_VERBOSE) 882 { 883 (void) ec_outfs(log_output_,"DICTIONARY GC ."); 884 ec_flush(log_output_); 885 } 886 887 usage_before = dict->dir_index * DICT_ITEM_BLOCK_SIZE - 888 dict->items_free; 889 gc_time = user_time(); 890 891 mark_dids_from_stacks(0L); /* mark the abstract machine's data */ 892 893 while (next_functor(&idx, &d)) /* mark from all the properties */ 894 { 895 if (DidProc(d)) 896 _mark_dids_from_procs(DidProc(d)); 897 if (DidProperties(d)) 898 mark_dids_from_properties(DidProperties(d)); 899 } 900 901 mark_dids_from_streams(); /* mark from the stream descriptors */ 902 903 if (GlobalFlags & GC_VERBOSE) 904 { 905 (void) ec_outfs(log_output_,"."); ec_flush(log_output_); 906 } 907 908 _tidy_dictionary(); 909 910 gc_time = user_time() - gc_time; 911 dict->gc_number++; 912 dict->gc_time += gc_time; 913 garbage = usage_before - (dict->dir_index * DICT_ITEM_BLOCK_SIZE - 914 dict->items_free); 915 916#ifndef PRINTAM 917 Enable_Int() 918#endif 919 920 if (GlobalFlags & GC_VERBOSE) 921 { 922 p_fprintf(log_output_, ". %d - %d, (%.1f %%), time: %.3f\n", 923 usage_before, 924 garbage, 925 (100.0*garbage)/usage_before, 926 (float)gc_time/clock_hz); 927 ec_flush(log_output_); 928 } 929 930 Succeed_; 931} 932 933 934 935/*-------------------------------------------------------------- 936 * Statistics and debugging 937 *--------------------------------------------------------------*/ 938 939/*ARGSUSED*/ 940int 941ec_dict_param(value vwhat, type twhat, value vval, type tval) 942{ 943 pword result; 944 945 result.tag.kernel = TINT; 946 switch(vwhat.nint) 947 { 948 case 0: /* # entries */ 949 result.val.nint = dict->dir_index * DICT_ITEM_BLOCK_SIZE - 950 dict->items_free; 951 break; 952 case 1: /* # free items */ 953 result.val.nint = dict->items_free; 954 break; 955 case 2: /* hash table size */ 956 result.val.nint = DICT_HASH_TABLE_SIZE; 957 break; 958 case 3: /* hash table usage */ 959 result.val.nint = dict->table_usage; 960 break; 961 case 4: /* collisions */ 962 result.val.nint = dict->collisions; 963 break; 964 case 5: /* gc_number */ 965 result.val.nint = dict->gc_number; 966 break; 967 case 6: /* gc time */ 968 Return_Unify_Float(vval, tval, dict->gc_time/clock_hz); 969 case 7: /* set or get the gc interval */ 970 if (IsInteger(tval)) 971 { 972 dict->gc_countdown = dict->gc_interval = vval.nint; 973 } 974 result.tag.kernel = TINT; 975 result.val.nint = dict->gc_interval; 976 break; 977 default: 978 Fail_; 979 } 980 Return_Unify_Pw(vval, tval, result.val, result.tag); 981} 982 983 984/* 985 * auxiliary functions for debugging 986 */ 987 988#ifdef PRINTAM 989#ifndef lint 990 991pr_functors(value v, type t) 992{ 993 register dident dip; 994 int index, len; 995 996 Check_Integer(t); 997 for (index = 0; index < DICT_HASH_TABLE_SIZE; index++) 998 { 999 dip = dict->hash_table[index]; 1000 if (dip) 1001 { 1002 len = 0; 1003 do { 1004 len++; 1005 dip = dip->next; 1006 } while (!dip->head); 1007 if (dip != dict->hash_table[index]) 1008 p_fprintf(current_output_,"BAD COLLISION LIST\n"); 1009 if (len >= v.nint) 1010 { 1011 p_fprintf(current_output_,"[%d]", index); 1012 do { 1013 p_fprintf(current_output_," %s/%d", 1014 DidName(dip), DidArity(dip)); 1015 dip = dip->next; 1016 } while (!dip->head); 1017 p_fprintf(current_output_,"\n"); 1018 } 1019 } 1020 } 1021 Succeed_; 1022} 1023 1024pr_dict(void) 1025{ 1026 p_fprintf(current_output_, "blocks allocated = %d\n", dict->dir_index); 1027 p_fprintf(current_output_, "items used = %d\n", 1028 dict->dir_index*DICT_ITEM_BLOCK_SIZE-dict->items_free); 1029 p_fprintf(current_output_, "items free = %d\n", dict->items_free); 1030 p_fprintf(current_output_, "string_used = %d\n", dict->string_used); 1031 p_fprintf(current_output_, "table_usage = %d/%d\n", 1032 dict->table_usage, DICT_HASH_TABLE_SIZE); 1033 p_fprintf(current_output_, "table_usage ratio = %.1f%%\n", 1034 100.0*dict->table_usage/DICT_HASH_TABLE_SIZE); 1035 p_fprintf(current_output_, "collisions = %d\n", dict->collisions); 1036 p_fprintf(current_output_, "collision ratio = %.1f%%\n", 1037 100.0*dict->collisions/dict->table_usage); 1038 p_fprintf(current_output_, "gc countdown = %d\n", dict->gc_countdown); 1039 p_fprintf(current_output_, "gc number = %d\n", dict->gc_number); 1040 p_fprintf(current_output_, "gc time = %.3f\n", 1041 (float)dict->gc_time/clock_hz); 1042 Succeed_; 1043} 1044 1045 1046/* 1047 * help debugging: print a dictionary entry 1048*/ 1049static dident 1050_pdict(dident entry) 1051{ 1052 pri *proc; 1053 1054 p_fprintf(current_err_, "%s/", DidName(entry)); 1055 p_fprintf(current_err_, "%d", DidArity(entry)); 1056 p_fprintf(current_err_, "\n length=%d ", DidLength(entry)); 1057 p_fprintf(current_err_, "module=%d ", DidModule(entry)); 1058 p_fprintf(current_err_, "macro=%d ", DidMacro(entry)); 1059 p_fprintf(current_err_, "attainable=%d ", DidAttainable(entry)); 1060 p_fprintf(current_err_, "stability=%d ", DidStability(entry)); 1061 p_fprintf(current_err_, "head=%d ", DidPtr(entry)->head); 1062 p_fprintf(current_err_, "isop=%d", DidIsOp(entry)); 1063 p_fprintf(current_err_, "\n next=%x ", DidPtr(entry)->next); 1064 p_fprintf(current_err_, "properties=%x ", DidProperties(entry)); 1065 proc = DidPtr(entry)->procedure; 1066 p_fprintf(current_err_, "\n proc=0x%x", proc); 1067 if (proc) { 1068 p_fprintf(current_err_, "(code=0x%x", PriCode(proc)); 1069 p_fprintf(current_err_, " next=0x%x", PriNext(proc)); 1070 p_fprintf(current_err_, " module=%d", PriModule(proc)); 1071 p_fprintf(current_err_, " flags=0x%x", PriFlags(proc)); 1072 p_fprintf(current_err_, " did=0x%x)", PriDid(proc)); 1073 } 1074 (void) ec_newline(current_err_); 1075 return entry; 1076} 1077 1078#endif /* lint */ 1079#endif /* PRINTAM */ 1080 1081 1082static void 1083_std_did_init(void) 1084{ 1085 /* The first did entered is the empty name. This is used for 1086 * unknown variable names. It has a zero bitfield representation. 1087 */ 1088 d_.empty = in_dict("", 0); 1089 1090 d_.semi0 = in_dict(";", 0); 1091 d_.naf = in_dict("\\+", 1); 1092 d_.not1 = in_dict("not", 1); 1093 d_.fail_if = in_dict("fail_if", 1); 1094 d_.once = in_dict("once", 1); 1095 d_.not_unify = in_dict("\\=", 2); 1096 d_.diff_reg = in_dict("~=",2); 1097 d_.not_identical = in_dict("\\==", 2); 1098 d_.not_equal = in_dict("=\\=", 2); 1099 1100 d_.comment = in_dict("/*", 0); 1101 d_.eocl = in_dict( ".", 0); 1102 d_.eof = in_dict( "end_of_file", 0); 1103 d_.list = in_dict( ".", 2); 1104 d_.rulech0 = in_dict(":-",0); 1105 d_.rulech1 = in_dict( ":-", 1); 1106 d_.rulech2 = in_dict( ":-", 2); 1107 d_.goalch = in_dict( "?-", 1); 1108 d_.grammar = in_dict("-->", 2); 1109 d_.nil = in_dict( "[]", 0); 1110 d_.fail = in_dict("fail",0); 1111 d_.nilcurbr = in_dict( "{}", 0); 1112 d_.nilcurbr1 = in_dict( "{}", 1); 1113 d_.eoi = in_dict( "\004", 0); 1114 d_.cond = in_dict( "->", 2); 1115 d_.ampersand = in_dict( "&", 2); 1116 d_.cut = in_dict( "!", 0); 1117 d_.syscut = in_dict( "syscut", 0); 1118 d_.cut_to = in_dict( "cut_to", 1); 1119 d_.arg = in_dict("arg", 3); 1120 d_.subscript = in_dict("subscript", 2); 1121 d_.comma = in_dict( ",", 2); 1122 d_.semicolon = in_dict( ";", 2); 1123 d_.colon = in_dict(":", 2); 1124 d_.bar = in_dict( "|", 2); 1125 d_.uref = in_dict( "_", 0); 1126 d_.univ = in_dict("=..", 2); 1127 /* arithmetic */ 1128 d_.plus1 = in_dict("+", 1); 1129 d_.plus = in_dict("+", 2); 1130 d_.minus1 = in_dict("-", 1); 1131 d_.minus = in_dict("-", 2); 1132 d_.times = in_dict("*", 2); 1133 d_.inf = in_dict("<", 2); 1134 d_.sup = in_dict(">", 2); 1135 d_.supq = in_dict(">=", 2); 1136 d_.infq = in_dict("=<", 2); 1137 d_.inf0 = in_dict("<", 0); 1138 d_.sup0 = in_dict(">", 0); 1139 d_.supq0 = in_dict(">=", 0); 1140 d_.infq0 = in_dict("=<", 0); 1141 d_.quotient = in_dict("/",2); 1142 d_.div = in_dict("//", 2); 1143 d_.modulo = in_dict("mod", 2); 1144 d_.equal = in_dict("=:=", 2); 1145 d_.is = in_dict("is",2); 1146 d_.rshift = in_dict(">>", 2); 1147 d_.lshift = in_dict("<<", 2); 1148 d_.and2 = in_dict("/\\",2); 1149 d_.or2 = in_dict("\\/", 2); 1150 d_.power = in_dict("^", 2); 1151 d_.bitnot = in_dict("\\", 1); 1152 d_.min = in_dict("min",2); 1153 d_.minint = in_dict("minint",1); 1154 d_.max = in_dict("max",2); 1155 d_.maxint = in_dict("maxint",1); 1156 d_.abs = in_dict("abs",1); 1157 d_.xor2 = in_dict("xor",2); 1158 d_.pi = in_dict("pi",0); 1159 d_.e = in_dict("e",0); 1160 d_.sin = in_dict("sin",1); 1161 d_.cos = in_dict("cos",1); 1162 d_.tan = in_dict("tan",1); 1163 d_.asin = in_dict("asin",1); 1164 d_.acos = in_dict("acos",1); 1165 d_.atan = in_dict("atan",1); 1166 d_.exp = in_dict("exp",1); 1167 d_.sqrt = in_dict("sqrt",1); 1168 d_.ln = in_dict("ln",1); 1169 d_.fix = in_dict("fix",1); 1170 d_.float1 = in_dict("float",1); 1171 d_.breal1 = in_dict("breal",1); 1172 d_.breal_from_bounds = in_dict("breal_from_bounds",1); 1173 d_.breal_min = in_dict("breal_min",1); 1174 d_.breal_max = in_dict("breal_max",1); 1175 d_.round = in_dict("round",1); 1176 d_.floor1 = in_dict("floor",1); 1177 d_.rational1 = in_dict("rational",1); 1178 d_.numerator1 = in_dict("numerator",1); 1179 d_.denominator1 = in_dict("denominator",1); 1180 1181 /* term comparison */ 1182 d_.unify = in_dict("=", 2); 1183 d_.identical = in_dict("==", 2); 1184 d_.less = in_dict("@<", 2); 1185 d_.lessq = in_dict("@=<", 2); 1186 d_.greater = in_dict("@>", 2); 1187 d_.greaterq = in_dict("@>=", 2); 1188 1189 d_.reset = in_dict("reset",0); 1190 d_.block = in_dict("block", 3); 1191 d_.exit_block = in_dict("exit_block",1); 1192 d_.call = in_dict("call", 1); 1193 d_.call_body = in_dict("call_", 2); 1194 d_.metacall = in_dict("call", 3); 1195 d_.go = in_dict("go", 0); 1196 d_.break0 = in_dict("break", 0); 1197 d_.local_break = in_dict("local_break", 0); 1198 d_.compile = in_dict("compile",1); 1199 d_.pcompile = in_dict("pcompile", 3); 1200 d_.error = in_dict("error",2); 1201 d_.syserror = in_dict("syserror", 4); 1202 d_.user = in_dict("user", 0); 1203 d_.true0 = in_dict("true", 0); 1204 d_.default0 = in_dict("default", 0); 1205 d_.read = in_dict("read",0); 1206 d_.write = in_dict("write",0); 1207 d_.update = in_dict("update",0); 1208 d_.append = in_dict("append", 0); 1209 d_.string = in_dict("string", 1); 1210 d_.input = in_dict("input",0); 1211 d_.output = in_dict("output",0); 1212 d_.err = in_dict("error",0); 1213 d_.answer = in_dict("answer",0); 1214 d_.dummy_call = in_dict("dummy_call",0); 1215 d_.no_err_handler = in_dict("no_err_handler",2); 1216 d_.exit_postponed = in_dict("exit_postponed",0); 1217 d_.error_handler = in_dict("error_handler",2); 1218 d_.call_explicit = in_dict("call_explicit",2); 1219 d_.garbage_collect_dictionary = in_dict("garbage_collect_dictionary",0); 1220 d_.throw1 = in_dict("throw",1); 1221 1222 d_.hang = in_dict("hang",0); 1223 d_.nohang = in_dict("nohang",0); 1224 1225 d_.warning_output = in_dict("warning_output",0); 1226 d_.log_output = in_dict("log_output",0); 1227 d_.user_input = in_dict("user_input",0); 1228 d_.user_output = in_dict("user_output",0); 1229 d_.user_error = in_dict("user_error",0); 1230 d_.null = in_dict("null", 0); 1231 d_.flush = in_dict("flush",0); 1232 d_.emulate = in_dict("Emulate",0); 1233 d_.abort = in_dict("abort",0); 1234 d_.eerrno = in_dict("sys_errno", 0); 1235 d_.cprolog = in_dict("cprolog", 0); 1236 d_.bsi = in_dict("bsi", 0); 1237 d_.quintus = in_dict("quintus", 0); 1238 d_.sicstus = in_dict("sicstus", 0); 1239 d_.var = in_dict("var", 1); 1240 d_.nonground = in_dict("nonground", 1); 1241 d_.ground = in_dict("ground", 1); 1242 d_.on = in_dict("on", 0); 1243 d_.off = in_dict("off", 0); 1244 d_.prolog = in_dict("prolog", 0); 1245 d_.system = in_dict("system", 0); 1246 d_.built_in = in_dict("built_in", 0); 1247 1248 /* assert */ 1249 d_.clause = in_dict("clause", 3); 1250 1251 d_.halt = in_dict("halt",0); 1252 d_.halt0 = in_dict("halt0",0); 1253 d_.debugger = in_dict("debugger", 0); 1254 1255 /* declarations */ 1256 d_.dynamic = in_dict("dynamic",1); 1257 d_.abolish = in_dict("abolish",1); 1258 d_.mode = in_dict("mode",1); 1259 d_.delay = in_dict("delay", 1); 1260 d_.if2 = in_dict("if", 2); 1261 d_.local = in_dict("local",1); 1262 d_.global = in_dict("global",1); 1263 d_.export1 = in_dict("export",1); 1264 d_.import = in_dict("import",1); 1265 d_.from = in_dict("from",2); 1266 d_.module1 = in_dict("module", 1); 1267 d_.module_directive = in_dict("module_directive", 4); 1268 1269 /* module names */ 1270 d_.default_module = in_dict(ec_options.default_module, 0); 1271 d_.eclipse_home = in_dict(ec_eclipse_home, 0); 1272 d_.kernel_sepia = in_dict("sepia_kernel", 0); 1273 d_.cn = in_dict("cn", 0); 1274 1275 /* operators */ 1276 d_.local0 = in_dict("local", 0); 1277 d_.global0 = in_dict("global", 0); 1278 1279 /* debugger */ 1280 d_.sepia = in_dict("sepia", 0); 1281 d_.macro = in_dict("macro", 0); 1282 d_.skip = in_dict("skip", 0); 1283 d_.spy = in_dict("spy", 0); 1284 d_.leash = in_dict("leash", 0); 1285 d_.command = in_dict("command", 0); 1286 d_.ellipsis = in_dict("...",0); 1287 1288 /* modes */ 1289 d_.plus0 = in_dict("+", 0); 1290 d_.plusplus = in_dict("++", 0); 1291 d_.minus0 = in_dict("-", 0); 1292 d_.question = in_dict("?", 0); 1293 1294 d_.unify0 = in_dict("=", 0); 1295 d_.stop = in_dict("stop", 0); 1296 d_.print = in_dict("print", 0); 1297 d_.notrace = in_dict("notrace", 0); 1298 d_.trace = in_dict("trace", 0); 1299 d_.trace_frame = in_dict("tf", TF_ARITY); 1300 d_.debug = in_dict("debug", 0); 1301 d_.nodebug = in_dict("nodebug", 0); 1302 d_.global_trail_overflow = in_dict("global_trail_overflow", 0); 1303 d_.local_control_overflow = in_dict("local_control_overflow", 0); 1304 1305 d_.at2 = in_dict("@", 2); 1306 d_.lock = in_dict("lock", 1); 1307 d_.localb = in_dict("local_", 2); 1308 d_.globalb = in_dict("global_", 2); 1309 d_.exportb = in_dict("export_", 2); 1310 d_.import_fromb = in_dict("import_from_", 3); 1311 d_.woken = in_dict("woken", WL_ARITY); 1312 d_.write1 = in_dict("write", 1); 1313 d_.write2 = in_dict("write", 2); 1314 d_.writeq1 = in_dict("writeq", 1); 1315 d_.writeq2 = in_dict("writeq", 2); 1316 d_.read1 = in_dict("read", 1); 1317 d_.read2 = in_dict("read", 2); 1318 d_.define_global_macro3 = in_dict("define_global_macro",3); 1319 d_.define_local_macro3 = in_dict("define_local_macro",3); 1320 d_.erase_macro1 = in_dict("erase_macro",1); 1321 d_.trans_term = in_dict("trans_term",2); 1322 1323 d_.var0 = in_dict("var", 0); 1324 d_.atom0 = in_dict("atom", 0); 1325 d_.string0 = in_dict("string", 0); 1326 d_.float0 = in_dict("float",0); 1327 d_.integer0 = in_dict("integer", 0); 1328 d_.double0 = in_dict("double", 0); 1329 d_.rational0 = in_dict("rational", 0); 1330 d_.real0 = in_dict("real", 0); 1331 d_.byte = in_dict("byte", 0); 1332 d_.compound0 = in_dict("compound", 0); 1333 d_.universally_quantified = in_dict("universally_quantified", 0); 1334 d_.suspending = in_dict("suspending", 0); 1335 d_.suspend_attr = in_dict("suspend", 3); 1336 d_.constrained = in_dict("constrained", 0); 1337 d_.meta0 = in_dict("meta", 0); 1338 d_.free = in_dict("free",0); 1339 1340 d_.stdin0 = in_dict("stdin", 0); 1341 d_.stdout0 = in_dict("stdout", 0); 1342 d_.stderr0 = in_dict("stderr", 0); 1343 1344 /* macros */ 1345 d_.top_only = in_dict("top_only", 0); 1346 d_.protect_arg = in_dict("protect_arg", 0); 1347 d_.clause0 = in_dict("clause", 0); 1348 d_.goal = in_dict("goal", 0); 1349 1350 d_.with2 = in_dict("with", 2); 1351 d_.with_attributes2 = in_dict("with attributes", 2); 1352 d_.apply2 = in_dict("apply", 2); 1353 1354 d_.some = in_dict("some", 0); 1355 d_.all = in_dict("all", 0); 1356 1357 /* compiler */ 1358 d_.compile_stream = in_dict("compile_stream", 1); 1359 d_.system_debug = in_dict("system_debug", 0); 1360 d_.file_query = in_dict("file_query_body", 3); 1361 d_.external = in_dict("external", 0); 1362 d_.term = in_dict("term", 0); 1363 d_.not_not = in_dict("not not", 1); 1364 d_.softcut = in_dict("*->", 2); 1365 d_.functor = in_dict("functor", 3); 1366 d_.integer = in_dict("integer", 1); 1367 d_.double1 = in_dict("double", 1); 1368 d_.atom = in_dict("atom", 1); 1369 d_.atomic = in_dict("atomic", 1); 1370 d_.nonvar = in_dict("nonvar", 1); 1371 d_.meta = in_dict("meta", 1); 1372 d_.number = in_dict("number", 1); 1373 d_.real = in_dict("real", 1); 1374 d_.breal = in_dict("breal", 1); 1375 d_.compound = in_dict("compound", 1); 1376 d_.free1 = in_dict("free", 1); 1377 d_.bignum = in_dict("bignum", 1); 1378 d_.is_event = in_dict("is_event", 1); 1379 d_.is_handle = in_dict("is_handle", 1); 1380 d_.is_list = in_dict("is_list", 1); 1381 d_.is_suspension = in_dict("is_suspension", 1); 1382 d_.pragma = in_dict("pragma", 1); 1383 d_.make_suspension = in_dict("make_suspension", 3); 1384 d_.wake = in_dict("wake", 0); 1385 d_.state = in_dict("state", 0); 1386 d_.priority = in_dict("priority", 0); 1387 d_.invoc = in_dict("invoc", 0); 1388 d_.module0 = in_dict("module", 0); 1389} 1390 1391 1392 1393/*-------------------------------------------------------------------- 1394 * Constant table for storing non-simple ground constants 1395 * other than strings and atoms. 1396 * Entries are made 1397 * - for constants occurring in code 1398 * - explicitly by calling canonical_copy/2 1399 * There is currently no garbage collection on this table. 1400 * Terms in this table are made persistent, which means that pointers 1401 * to these terms (and their subterms) can always be shared and never 1402 * need to be copied again. This is indicated by the PERSISTENT bit 1403 * being set in pointers (in)to these persistent heap term. 1404 * Also, DIDs within these terms are marked as permanent, 1405 * so the dictionary gc does not need to scan this table. 1406 *--------------------------------------------------------------------*/ 1407 1408#define CONSTANT_TABLE_MIN_SIZE 256 1409#define CONSTANT_TABLE_MAX_SIZE 1048576 1410#define CONSTANT_TABLE_EXPAND_FACTOR 2 1411 1412 1413typedef struct constant_entry { /* one table entry */ 1414 pword value; 1415 uword hash; 1416 struct constant_entry *next; 1417} t_constant_entry; 1418 1419static struct constant_table { /* the whole table */ 1420 uword size; 1421 uword nentries; 1422 uword nreuse; 1423 t_constant_entry **htable; 1424} *constant_table; 1425 1426 1427/* 1428 * Initialise the table 1429 */ 1430 1431static void 1432_constant_table_init(int flags) 1433{ 1434 if (flags & INIT_SHARED) 1435 { 1436 uword i; 1437 constant_table = (struct constant_table *) hg_alloc_size(sizeof(struct constant_table)); 1438 shared_data->constant_table = (void_ptr) constant_table; 1439 constant_table->size = CONSTANT_TABLE_MIN_SIZE; 1440 constant_table->nentries = 0; 1441 constant_table->nreuse = 0; 1442 constant_table->htable = (t_constant_entry **) 1443 hg_alloc_size(constant_table->size * sizeof(t_constant_entry *)); 1444 for (i=0; i< constant_table->size; i++) 1445 constant_table->htable[i] = NULL; 1446 } 1447 if (flags & INIT_PRIVATE) 1448 { 1449 constant_table = (struct constant_table *) shared_data->constant_table; 1450 } 1451} 1452 1453 1454/* 1455 * Grow the table 1456 */ 1457 1458static void 1459_constant_table_expand(struct constant_table *table) 1460{ 1461 uword new_size = table->size * CONSTANT_TABLE_EXPAND_FACTOR; 1462 t_constant_entry **new_htable; 1463 uword i; 1464 1465 /* make and initialize a larger table */ 1466 new_htable = (t_constant_entry **) 1467 hg_alloc_size(new_size * sizeof(t_constant_entry *)); 1468 for (i = 0; i < new_size; ++i) 1469 { 1470 new_htable[i] = NULL; 1471 } 1472 1473 /* redistribute the entries from the old table */ 1474 for (i = 0; i < table->size; ++i) 1475 { 1476 t_constant_entry *elem; 1477 for(elem = table->htable[i]; elem; ) 1478 { 1479 t_constant_entry **new_slot = &new_htable[elem->hash % new_size]; 1480 t_constant_entry *next_elem = elem->next; 1481 elem->next = *new_slot; 1482 *new_slot = elem; 1483 elem = next_elem; 1484 } 1485 } 1486 1487 /* free the old table */ 1488 hg_free_size(table->htable, table->size * sizeof(t_constant_entry *)); 1489 1490 /* assign the new one */ 1491 table->htable = new_htable; 1492 table->size = new_size; 1493} 1494 1495 1496/* 1497 * Lookup/Enter 1498 * 1499 * PSUCCEED: *presult contains the tabled copy of (v,t) 1500 * or (v,t) itself in case of simple terms 1501 * PFAIL: the term cannot be tabled in a meaningful way, 1502 * e.g. because it is a bounded real 1503 * (v,t) itself is returned as result anyway 1504 * INSTANTIATION_FAULT: the term was nonground 1505 * other: a serious problem occurred 1506 */ 1507 1508int 1509ec_constant_table_enter(value v, type t, pword *presult) 1510{ 1511 int res = PSUCCEED; /* initialise for ec_term_hash() */ 1512 t_constant_entry *pelem; 1513 t_constant_entry **pslot; 1514 uword hash; 1515 1516 /* no point tabling simple (single-pword) things */ 1517 if (IsSimple(t)) 1518 { 1519 presult->val.all = v.all; 1520 presult->tag.all = t.all; 1521 return PSUCCEED; 1522 } 1523 1524 /* 1525 * Bounded reals cannot be shared (when nonzero width) 1526 * because they must not arithmetically compare equal! 1527 */ 1528 if (IsInterval(t) && (IvlLwb(v.ptr) < IvlUpb(v.ptr))) 1529 { 1530 presult->val.all = v.all; 1531 presult->tag.all = t.all; 1532 return PFAIL; 1533 } 1534 1535 /* compute hash value */ 1536 hash = ec_term_hash(v, t, MAX_U_WORD, &res); 1537 if (res != PSUCCEED) 1538 { 1539 return res; 1540 } 1541 1542 /* lookup the entry */ 1543 pslot = &constant_table->htable[hash % constant_table->size]; 1544 for(pelem = *pslot; pelem; pslot = &pelem->next, pelem = *pslot) 1545 { 1546 if (pelem->hash == hash 1547 && ec_compare_terms(v, t, pelem->value.val, pelem->value.tag) == 0 1548 ) 1549 { 1550 break; 1551 } 1552 } 1553 1554 if (!pelem) 1555 { 1556 /* insert new entry */ 1557 pelem = (t_constant_entry *) hg_alloc_size(sizeof(t_constant_entry)); 1558 if ((res = create_heapterm(&pelem->value, v, t)) != PSUCCEED) 1559 { 1560 hg_free_size(pelem, sizeof(t_constant_entry)); 1561 return res; 1562 } 1563 1564 /* 1565 * Mark it as a persistent heap term. 1566 * This will also make any DIDs within the term permanent, 1567 * so dictionary gc does not need to mark persistent terms. 1568 */ 1569 make_heapterm_persistent(&pelem->value); 1570 1571 pelem->hash = hash; 1572 pelem->next = *pslot; 1573 *pslot = pelem; 1574 ++constant_table->nentries; 1575 1576 /* expand table if too full */ 1577 if (constant_table->nentries > constant_table->size 1578 && constant_table->size < CONSTANT_TABLE_MAX_SIZE) 1579 { 1580 _constant_table_expand(constant_table); 1581 } 1582 1583 } 1584 else 1585 { 1586 ++constant_table->nreuse; 1587 } 1588 1589 *presult = pelem->value; 1590 return PSUCCEED; 1591} 1592 1593 1594#ifdef PRINTAM 1595pr_constant_table(void) 1596{ 1597 uword entry_count = 0; 1598 uword max_chain = 0; 1599 uword used_slots = 0; 1600 uword i; 1601 1602 for(i = 0; i < constant_table->size; ++i) 1603 { 1604 uword chain_length = 0; 1605 t_constant_entry *pelem = constant_table->htable[i]; 1606 if (pelem) 1607 ++used_slots; 1608 for(; pelem; pelem = pelem->next) 1609 { 1610 writeq_term(pelem->value.val.all, pelem->value.tag.all); 1611 ++chain_length; 1612 } 1613 entry_count += chain_length; 1614 if (chain_length > max_chain) 1615 max_chain = chain_length; 1616 } 1617 1618 p_fprintf(current_output_, "GROUND CONSTANT TABLE\n"); 1619 p_fprintf(current_output_, "size = %d\n", constant_table->size); 1620 p_fprintf(current_output_, "entries = %d\n", constant_table->nentries); 1621 p_fprintf(current_output_, "reuse = %d\n", constant_table->nreuse); 1622 p_fprintf(current_output_, "max chain = %d\n", max_chain); 1623 p_fprintf(current_output_, "avg chain = %f\n", ((double) entry_count)/used_slots); 1624 if (entry_count != constant_table->nentries) 1625 p_fprintf(current_output_, "!!! Deviating entry count %d\n", entry_count); 1626 Succeed_; 1627} 1628#endif 1629