comparison src/elhash.c @ 450:98528da0b7fc r21-2-40

Import from CVS: tag r21-2-40
author cvs
date Mon, 13 Aug 2007 11:39:20 +0200
parents 576fb035e263
children 3d3049ae1304
comparison
equal deleted inserted replaced
449:c83749d23eb5 450:98528da0b7fc
432 ht->golden_ratio = (size_t) 432 ht->golden_ratio = (size_t)
433 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); 433 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object)));
434 } 434 }
435 435
436 Lisp_Object 436 Lisp_Object
437 make_general_lisp_hash_table (enum hash_table_test test, 437 make_standard_lisp_hash_table (enum hash_table_test test,
438 size_t size,
439 double rehash_size,
440 double rehash_threshold,
441 enum hash_table_weakness weakness)
442 {
443 hash_table_hash_function_t hash_function = 0;
444 hash_table_test_function_t test_function = 0;
445
446 switch (test)
447 {
448 case HASH_TABLE_EQ:
449 test_function = 0;
450 hash_function = 0;
451 break;
452
453 case HASH_TABLE_EQL:
454 test_function = lisp_object_eql_equal;
455 hash_function = lisp_object_eql_hash;
456 break;
457
458 case HASH_TABLE_EQUAL:
459 test_function = lisp_object_equal_equal;
460 hash_function = lisp_object_equal_hash;
461 break;
462
463 default:
464 abort ();
465 }
466
467 return make_general_lisp_hash_table (hash_function, test_function,
468 size, rehash_size, rehash_threshold,
469 weakness);
470 }
471
472 Lisp_Object
473 make_general_lisp_hash_table (hash_table_hash_function_t hash_function,
474 hash_table_test_function_t test_function,
438 size_t size, 475 size_t size,
439 double rehash_size, 476 double rehash_size,
440 double rehash_threshold, 477 double rehash_threshold,
441 enum hash_table_weakness weakness) 478 enum hash_table_weakness weakness)
442 { 479 {
443 Lisp_Object hash_table; 480 Lisp_Object hash_table;
444 Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); 481 Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
445 482
446 switch (test) 483 ht->test_function = test_function;
447 { 484 ht->hash_function = hash_function;
448 case HASH_TABLE_EQ:
449 ht->test_function = 0;
450 ht->hash_function = 0;
451 break;
452
453 case HASH_TABLE_EQL:
454 ht->test_function = lisp_object_eql_equal;
455 ht->hash_function = lisp_object_eql_hash;
456 break;
457
458 case HASH_TABLE_EQUAL:
459 ht->test_function = lisp_object_equal_equal;
460 ht->hash_function = lisp_object_equal_hash;
461 break;
462
463 default:
464 abort ();
465 }
466
467 ht->weakness = weakness; 485 ht->weakness = weakness;
468 486
469 ht->rehash_size = 487 ht->rehash_size =
470 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE; 488 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE;
471 489
503 Lisp_Object 521 Lisp_Object
504 make_lisp_hash_table (size_t size, 522 make_lisp_hash_table (size_t size,
505 enum hash_table_weakness weakness, 523 enum hash_table_weakness weakness,
506 enum hash_table_test test) 524 enum hash_table_test test)
507 { 525 {
508 return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness); 526 return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness);
509 } 527 }
510 528
511 /* Pretty reading of hash tables. 529 /* Pretty reading of hash tables.
512 530
513 Here we use the existing structures mechanism (which is, 531 Here we use the existing structures mechanism (which is,
720 else 738 else
721 abort (); 739 abort ();
722 } 740 }
723 741
724 /* Create the hash table. */ 742 /* Create the hash table. */
725 hash_table = make_general_lisp_hash_table 743 hash_table = make_standard_lisp_hash_table
726 (decode_hash_table_test (test), 744 (decode_hash_table_test (test),
727 decode_hash_table_size (size), 745 decode_hash_table_size (size),
728 decode_hash_table_rehash_size (rehash_size), 746 decode_hash_table_rehash_size (rehash_size),
729 decode_hash_table_rehash_threshold (rehash_threshold), 747 decode_hash_table_rehash_threshold (rehash_threshold),
730 decode_hash_table_weakness (weakness)); 748 decode_hash_table_weakness (weakness));
870 VALIDATE_VAR (size); 888 VALIDATE_VAR (size);
871 VALIDATE_VAR (rehash_size); 889 VALIDATE_VAR (rehash_size);
872 VALIDATE_VAR (rehash_threshold); 890 VALIDATE_VAR (rehash_threshold);
873 VALIDATE_VAR (weakness); 891 VALIDATE_VAR (weakness);
874 892
875 return make_general_lisp_hash_table 893 return make_standard_lisp_hash_table
876 (decode_hash_table_test (test), 894 (decode_hash_table_test (test),
877 decode_hash_table_size (size), 895 decode_hash_table_size (size),
878 decode_hash_table_rehash_size (rehash_size), 896 decode_hash_table_rehash_size (rehash_size),
879 decode_hash_table_rehash_threshold (rehash_threshold), 897 decode_hash_table_rehash_threshold (rehash_threshold),
880 decode_hash_table_weakness (weakness)); 898 decode_hash_table_weakness (weakness));
1301 if (!CONSP (e->key) || marked_p (XCAR (e->key))) 1319 if (!CONSP (e->key) || marked_p (XCAR (e->key)))
1302 { 1320 {
1303 MARK_OBJ (e->key); 1321 MARK_OBJ (e->key);
1304 MARK_OBJ (e->value); 1322 MARK_OBJ (e->value);
1305 } 1323 }
1324 break;
1325
1326 /* We seem to be sprouting new weakness types at an alarming
1327 rate. At least this is not externally visible - and in
1328 fact all of these KEY_CAR_* types are only used by the
1329 glyph code. */
1330 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
1331 for (; e < sentinel; e++)
1332 if (!HENTRY_CLEAR_P (e))
1333 {
1334 if (!CONSP (e->key) || marked_p (XCAR (e->key)))
1335 {
1336 MARK_OBJ (e->key);
1337 MARK_OBJ (e->value);
1338 }
1339 else if (marked_p (e->value))
1340 MARK_OBJ (e->key);
1341 }
1306 break; 1342 break;
1307 1343
1308 case HASH_TABLE_VALUE_CAR_WEAK: 1344 case HASH_TABLE_VALUE_CAR_WEAK:
1309 for (; e < sentinel; e++) 1345 for (; e < sentinel; e++)
1310 if (!HENTRY_CLEAR_P (e)) 1346 if (!HENTRY_CLEAR_P (e))