src/hash.c

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/hash.c - Hash table
   8
   9 =head1 DESCRIPTION
  10
  11 A hashtable contains an array of bucket indexes. Buckets are nodes in a
  12 linked list, each containing a C<void *> key and value. During hash
  13 creation, the types of key and value as well as appropriate compare and
  14 hashing functions can be set.
  15
  16 This hash implementation uses just one piece of malloced memory. The
  17 C<< hash->buckets >> bucket store points to this region.
  18
  19 =head2 Functions
  20
  21 =over 4
  22
  23 =cut
  24
  25 */
  26
  27 #include "parrot/parrot.h"
  28
  29 /* the number of entries above which it's faster to hash the hashval instead of
  30  * looping over the used HashBuckets directly */
  31 #define INITIAL_SIZE  8
  32
  33 /* HEADERIZER HFILE: include/parrot/hash.h */
  34
  35 /* HEADERIZER BEGIN: static */
  36 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  37
  38 static void expand_hash(PARROT_INTERP, ARGMOD(Hash *hash))
  39         __attribute__nonnull__(1)
  40         __attribute__nonnull__(2)
  41         FUNC_MODIFIES(*hash);
  42
  43 PARROT_CANNOT_RETURN_NULL
  44 static PMC* get_integer_pmc(PARROT_INTERP, INTVAL value)
  45         __attribute__nonnull__(1);
  46
  47 PARROT_CANNOT_RETURN_NULL
  48 static PMC* get_number_pmc(PARROT_INTERP, FLOATVAL value)
  49         __attribute__nonnull__(1);
  50
  51 PARROT_CANNOT_RETURN_NULL
  52 static PMC * get_string_pmc(PARROT_INTERP, ARGIN(STRING *value))
  53         __attribute__nonnull__(1)
  54         __attribute__nonnull__(2);
  55
  56 PARROT_WARN_UNUSED_RESULT
  57 PARROT_PURE_FUNCTION
  58 PARROT_INLINE
  59 static int hash_compare(PARROT_INTERP,
  60     ARGIN(const Hash *hash),
  61     ARGIN_NULLOK(void *a),
  62     ARGIN_NULLOK(void *b))
  63         __attribute__nonnull__(1)
  64         __attribute__nonnull__(2);
  65
  66 PARROT_WARN_UNUSED_RESULT
  67 PARROT_PURE_FUNCTION
  68 PARROT_INLINE
  69 static int hash_compare_cstring(SHIM_INTERP,
  70     ARGIN(const char *a),
  71     ARGIN(const char *b))
  72         __attribute__nonnull__(2)
  73         __attribute__nonnull__(3);
  74
  75 PARROT_WARN_UNUSED_RESULT
  76 PARROT_PURE_FUNCTION
  77 PARROT_INLINE
  78 static int hash_compare_int(SHIM_INTERP,
  79     ARGIN_NULLOK(const void *a),
  80     ARGIN_NULLOK(const void *b));
  81
  82 PARROT_WARN_UNUSED_RESULT
  83 PARROT_PURE_FUNCTION
  84 PARROT_INLINE
  85 static int hash_compare_pmc(PARROT_INTERP, ARGIN(PMC *a), ARGIN(PMC *b))
  86         __attribute__nonnull__(1)
  87         __attribute__nonnull__(2)
  88         __attribute__nonnull__(3);
  89
  90 PARROT_WARN_UNUSED_RESULT
  91 PARROT_PURE_FUNCTION
  92 PARROT_INLINE
  93 static int hash_compare_pointer(SHIM_INTERP,
  94     ARGIN_NULLOK(const void *a),
  95     ARGIN_NULLOK(const void *b));
  96
  97 PARROT_WARN_UNUSED_RESULT
  98 PARROT_PURE_FUNCTION
  99 PARROT_INLINE
 100 static int hash_compare_string(PARROT_INTERP,
 101     ARGIN(const void *search_key),
 102     ARGIN_NULLOK(const void *bucket_key))
 103         __attribute__nonnull__(1)
 104         __attribute__nonnull__(2);
 105
 106 PARROT_WARN_UNUSED_RESULT
 107 static int hash_compare_string_enc(PARROT_INTERP,
 108     ARGIN(const void *search_key),
 109     ARGIN(const void *bucket_key))
 110         __attribute__nonnull__(1)
 111         __attribute__nonnull__(2)
 112         __attribute__nonnull__(3);
 113
 114 PARROT_WARN_UNUSED_RESULT
 115 PARROT_PURE_FUNCTION
 116 PARROT_INLINE
 117 static size_t key_hash(PARROT_INTERP,
 118     ARGIN(const Hash *hash),
 119     ARGIN_NULLOK(void *key))
 120         __attribute__nonnull__(1)
 121         __attribute__nonnull__(2);
 122
 123 PARROT_WARN_UNUSED_RESULT
 124 PARROT_PURE_FUNCTION
 125 PARROT_INLINE
 126 static size_t key_hash_cstring(SHIM_INTERP,
 127     ARGIN(const void *value),
 128     size_t seed)
 129         __attribute__nonnull__(2);
 130
 131 PARROT_WARN_UNUSED_RESULT
 132 PARROT_PURE_FUNCTION
 133 PARROT_INLINE
 134 static size_t key_hash_int(SHIM_INTERP,
 135     ARGIN_NULLOK(const void *value),
 136     size_t seed);
 137
 138 PARROT_WARN_UNUSED_RESULT
 139 PARROT_PURE_FUNCTION
 140 PARROT_INLINE
 141 static size_t key_hash_PMC(PARROT_INTERP,
 142     ARGIN(PMC *value),
 143     SHIM(size_t seed))
 144         __attribute__nonnull__(1)
 145         __attribute__nonnull__(2);
 146
 147 PARROT_WARN_UNUSED_RESULT
 148 PARROT_PURE_FUNCTION
 149 PARROT_INLINE
 150 static size_t key_hash_pointer(SHIM_INTERP,
 151     ARGIN(const void *value),
 152     size_t seed)
 153         __attribute__nonnull__(2);
 154
 155 PARROT_WARN_UNUSED_RESULT
 156 PARROT_PURE_FUNCTION
 157 PARROT_INLINE
 158 static size_t key_hash_STRING(PARROT_INTERP, ARGMOD(STRING *s), size_t seed)
 159         __attribute__nonnull__(1)
 160         __attribute__nonnull__(2)
 161         FUNC_MODIFIES(*s);
 162
 163 static void parrot_mark_hash_both(PARROT_INTERP, ARGIN(Hash *hash))
 164         __attribute__nonnull__(1)
 165         __attribute__nonnull__(2);
 166
 167 static void parrot_mark_hash_keys(PARROT_INTERP, ARGIN(Hash *hash))
 168         __attribute__nonnull__(1)
 169         __attribute__nonnull__(2);
 170
 171 static void parrot_mark_hash_values(PARROT_INTERP, ARGIN(Hash *hash))
 172         __attribute__nonnull__(1)
 173         __attribute__nonnull__(2);
 174
 175 #define ASSERT_ARGS_expand_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 176        PARROT_ASSERT_ARG(interp) \
 177     , PARROT_ASSERT_ARG(hash))
 178 #define ASSERT_ARGS_get_integer_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 179        PARROT_ASSERT_ARG(interp))
 180 #define ASSERT_ARGS_get_number_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 181        PARROT_ASSERT_ARG(interp))
 182 #define ASSERT_ARGS_get_string_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 183        PARROT_ASSERT_ARG(interp) \
 184     , PARROT_ASSERT_ARG(value))
 185 #define ASSERT_ARGS_hash_compare __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 186        PARROT_ASSERT_ARG(interp) \
 187     , PARROT_ASSERT_ARG(hash))
 188 #define ASSERT_ARGS_hash_compare_cstring __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 189        PARROT_ASSERT_ARG(a) \
 190     , PARROT_ASSERT_ARG(b))
 191 #define ASSERT_ARGS_hash_compare_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 192 #define ASSERT_ARGS_hash_compare_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 193        PARROT_ASSERT_ARG(interp) \
 194     , PARROT_ASSERT_ARG(a) \
 195     , PARROT_ASSERT_ARG(b))
 196 #define ASSERT_ARGS_hash_compare_pointer __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 197 #define ASSERT_ARGS_hash_compare_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 198        PARROT_ASSERT_ARG(interp) \
 199     , PARROT_ASSERT_ARG(search_key))
 200 #define ASSERT_ARGS_hash_compare_string_enc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 201        PARROT_ASSERT_ARG(interp) \
 202     , PARROT_ASSERT_ARG(search_key) \
 203     , PARROT_ASSERT_ARG(bucket_key))
 204 #define ASSERT_ARGS_key_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 205        PARROT_ASSERT_ARG(interp) \
 206     , PARROT_ASSERT_ARG(hash))
 207 #define ASSERT_ARGS_key_hash_cstring __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 208        PARROT_ASSERT_ARG(value))
 209 #define ASSERT_ARGS_key_hash_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 210 #define ASSERT_ARGS_key_hash_PMC __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 211        PARROT_ASSERT_ARG(interp) \
 212     , PARROT_ASSERT_ARG(value))
 213 #define ASSERT_ARGS_key_hash_pointer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 214        PARROT_ASSERT_ARG(value))
 215 #define ASSERT_ARGS_key_hash_STRING __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 216        PARROT_ASSERT_ARG(interp) \
 217     , PARROT_ASSERT_ARG(s))
 218 #define ASSERT_ARGS_parrot_mark_hash_both __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 219        PARROT_ASSERT_ARG(interp) \
 220     , PARROT_ASSERT_ARG(hash))
 221 #define ASSERT_ARGS_parrot_mark_hash_keys __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 222        PARROT_ASSERT_ARG(interp) \
 223     , PARROT_ASSERT_ARG(hash))
 224 #define ASSERT_ARGS_parrot_mark_hash_values __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 225        PARROT_ASSERT_ARG(interp) \
 226     , PARROT_ASSERT_ARG(hash))
 227 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 228 /* HEADERIZER END: static */
 229
 230 /*
 231
 232 =item C<static size_t key_hash_STRING(PARROT_INTERP, STRING *s, size_t seed)>
 233
 234 Returns the hashed value of the key C<value>.  See also string.c.
 235
 236 =cut
 237
 238 */
 239
 240
 241 PARROT_WARN_UNUSED_RESULT
 242 PARROT_PURE_FUNCTION
 243 PARROT_INLINE
 244 static size_t
 245 key_hash_STRING(PARROT_INTERP, ARGMOD(STRING *s), size_t seed)
 246 {
 247     ASSERT_ARGS(key_hash_STRING)
 248
 249     if (s->hashval)
 250         return s->hashval;
 251
 252     return Parrot_str_to_hashval(interp, s);
 253 }
 254
 255
 256 /*
 257
 258 =item C<static int hash_compare_string(PARROT_INTERP, const void *search_key,
 259 const void *bucket_key)>
 260
 261 Compares the two strings, returning 0 if they are identical.
 262
 263 =cut
 264
 265 */
 266
 267 PARROT_WARN_UNUSED_RESULT
 268 PARROT_PURE_FUNCTION
 269 PARROT_INLINE
 270 static int
 271 hash_compare_string(PARROT_INTERP, ARGIN(const void *search_key),
 272         ARGIN_NULLOK(const void *bucket_key))
 273 {
 274     ASSERT_ARGS(hash_compare_string)
 275     STRING const *s1 = (STRING const *)search_key;
 276     STRING const *s2 = (STRING const *)bucket_key;
 277
 278     return STRING_equal(interp, s1, s2) == 0;
 279 }
 280
 281
 282 /*
 283
 284 =item C<static int hash_compare_string_enc(PARROT_INTERP, const void
 285 *search_key, const void *bucket_key)>
 286
 287 Compare two strings. Returns 0 if they are identical. Considers differing
 288 charset or encoding to be distinct.
 289
 290 */
 291
 292 PARROT_WARN_UNUSED_RESULT
 293 static int
 294 hash_compare_string_enc(PARROT_INTERP, ARGIN(const void *search_key),
 295                                        ARGIN(const void *bucket_key))
 296 {
 297     ASSERT_ARGS(hash_compare_string_enc)
 298     STRING const *s1 = (STRING const *)search_key;
 299     STRING const *s2 = (STRING const *)bucket_key;
 300
 301     if (s1->hashval != s2->hashval)
 302         return 1;
 303     if (s1 && s2 && s1->encoding != s2->encoding)
 304         return 1;
 305     else
 306         return memcmp(s1->strstart, s2->strstart, s1->bufused);
 307 }
 308
 309
 310 /*
 311
 312 =item C<static int hash_compare_pointer(PARROT_INTERP, const void *a, const void
 313 *b)>
 314
 315 Compares the two pointers, returning 0 if they are identical
 316
 317 =cut
 318
 319 */
 320
 321 PARROT_WARN_UNUSED_RESULT
 322 PARROT_PURE_FUNCTION
 323 PARROT_INLINE
 324 static int
 325 hash_compare_pointer(SHIM_INTERP, ARGIN_NULLOK(const void *a), ARGIN_NULLOK(const void *b))
 326 {
 327     ASSERT_ARGS(hash_compare_pointer)
 328     return a != b;
 329 }
 330
 331
 332 /*
 333
 334 =item C<static size_t key_hash_pointer(PARROT_INTERP, const void *value, size_t
 335 seed)>
 336
 337 Returns a hashvalue for a pointer.
 338
 339 =cut
 340
 341 */
 342
 343 PARROT_WARN_UNUSED_RESULT
 344 PARROT_PURE_FUNCTION
 345 PARROT_INLINE
 346 static size_t
 347 key_hash_pointer(SHIM_INTERP, ARGIN(const void *value), size_t seed)
 348 {
 349     ASSERT_ARGS(key_hash_pointer)
 350     return ((size_t) value) ^ seed;
 351 }
 352
 353
 354 /*
 355
 356 =item C<static size_t key_hash_cstring(PARROT_INTERP, const void *value, size_t
 357 seed)>
 358
 359 Creates and returns a hash value from a string.
 360
 361 Takes an interpreter, a pointer to a string, and a seed value.
 362 Returns the hash value.
 363
 364 Used by parrot_new_cstring_hash.
 365
 366 =cut
 367
 368 */
 369
 370 PARROT_WARN_UNUSED_RESULT
 371 PARROT_PURE_FUNCTION
 372 PARROT_INLINE
 373 static size_t
 374 key_hash_cstring(SHIM_INTERP, ARGIN(const void *value), size_t seed)
 375 {
 376     ASSERT_ARGS(key_hash_cstring)
 377     const unsigned char *p = (const unsigned char *) value;
 378     size_t h = seed;
 379     while (*p) {
 380         h += h << 5;
 381         h += *p++;
 382     }
 383     return h;
 384 }
 385
 386
 387 /*
 388
 389 =item C<static int hash_compare_cstring(PARROT_INTERP, const char *a, const char
 390 *b)>
 391
 392 Compares two C strings for equality, returning -1, 0, and 1 if the first string
 393 is less than, equal to, or greater than the second, respectively.
 394
 395 =cut
 396
 397 */
 398
 399 PARROT_WARN_UNUSED_RESULT
 400 PARROT_PURE_FUNCTION
 401 PARROT_INLINE
 402 static int
 403 hash_compare_cstring(SHIM_INTERP, ARGIN(const char *a), ARGIN(const char *b))
 404 {
 405     ASSERT_ARGS(hash_compare_cstring)
 406     return strcmp(a, b);
 407 }
 408
 409
 410 /*
 411
 412 =item C<static size_t key_hash_PMC(PARROT_INTERP, PMC *value, size_t seed)>
 413
 414 Returns a hashed value for an PMC key (passed as a void pointer, sadly).
 415
 416 =cut
 417
 418 */
 419
 420 PARROT_WARN_UNUSED_RESULT
 421 PARROT_PURE_FUNCTION
 422 PARROT_INLINE
 423 static size_t
 424 key_hash_PMC(PARROT_INTERP, ARGIN(PMC *value), SHIM(size_t seed))
 425 {
 426     ASSERT_ARGS(key_hash_PMC)
 427     return VTABLE_hashvalue(interp, value);
 428 }
 429
 430 /*
 431
 432 =item C<static int hash_compare_pmc(PARROT_INTERP, PMC *a, PMC *b)>
 433
 434 Compares two PMC for equality, returning 0 if the first is equal to second.
 435 Uses void pointers to store the PMC, sadly.
 436
 437 =cut
 438
 439 */
 440
 441 PARROT_WARN_UNUSED_RESULT
 442 PARROT_PURE_FUNCTION
 443 PARROT_INLINE
 444 static int
 445 hash_compare_pmc(PARROT_INTERP, ARGIN(PMC *a), ARGIN(PMC *b))
 446 {
 447     ASSERT_ARGS(hash_compare_pmc)
 448
 449     /* If pointers are same - PMCs are same */
 450     if (a == b)
 451         return 0;
 452
 453     /* PMCs of different types are different */
 454     if (a->vtable->base_type != b->vtable->base_type)
 455         return 1;
 456
 457     return !VTABLE_is_equal(interp, a, b);
 458 }
 459
 460 /*
 461
 462 =item C<static size_t key_hash_int(PARROT_INTERP, const void *value, size_t
 463 seed)>
 464
 465 Returns a hashed value for an integer key (passed as a void pointer, sadly).
 466
 467 =cut
 468
 469 */
 470
 471 PARROT_WARN_UNUSED_RESULT
 472 PARROT_PURE_FUNCTION
 473 PARROT_INLINE
 474 static size_t
 475 key_hash_int(SHIM_INTERP, ARGIN_NULLOK(const void *value), size_t seed)
 476 {
 477     ASSERT_ARGS(key_hash_int)
 478     return (size_t)value ^ seed;
 479 }
 480
 481 /*
 482
 483 =item C<static int hash_compare_int(PARROT_INTERP, const void *a, const void
 484 *b)>
 485
 486 Compares two integers for equality, returning -1, 0, and 1 if the first is less
 487 than, equal to, or greater than the second, respectively.  Uses void pointers
 488 to store the integers, sadly.
 489
 490 =cut
 491
 492 */
 493
 494 PARROT_WARN_UNUSED_RESULT
 495 PARROT_PURE_FUNCTION
 496 PARROT_INLINE
 497 static int
 498 hash_compare_int(SHIM_INTERP, ARGIN_NULLOK(const void *a), ARGIN_NULLOK(const void *b))
 499 {
 500     ASSERT_ARGS(hash_compare_int)
 501     return a != b;
 502 }
 503
 504 /*
 505
 506 =item C<static size_t key_hash(PARROT_INTERP, const Hash *hash, void *key)>
 507
 508 Generic function to get the hashvalue of a given key. It may dispatches to
 509 key_hash_STRING, key_hash_cstring, etc. depending on hash->key_type.
 510
 511 =cut
 512
 513 */
 514
 515
 516 PARROT_WARN_UNUSED_RESULT
 517 PARROT_PURE_FUNCTION
 518 PARROT_INLINE
 519 static size_t
 520 key_hash(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *key))
 521 {
 522     ASSERT_ARGS(key_hash)
 523
 524     if (hash->key_type == Hash_key_type_STRING
 525     ||  hash->key_type == Hash_key_type_STRING_enc)
 526         return key_hash_STRING(interp, (STRING *)key, hash->seed);
 527
 528     if (hash->key_type == Hash_key_type_cstring)
 529         return key_hash_cstring(interp, (char *)key, hash->seed);
 530
 531     if (hash->key_type == Hash_key_type_PMC)
 532         return VTABLE_hashvalue(interp, (PMC *)key);
 533
 534     return ((size_t) key) ^ hash->seed;
 535
 536 }
 537
 538 /*
 539
 540 =item C<static int hash_compare(PARROT_INTERP, const Hash *hash, void *a, void
 541 *b)>
 542
 543 Generic function to compare values. It may dispatches to
 544 hash_compare_string, hash_compare_cstring, etc. depending on hash->key_type.
 545
 546 =cut
 547
 548 */
 549
 550
 551 PARROT_WARN_UNUSED_RESULT
 552 PARROT_PURE_FUNCTION
 553 PARROT_INLINE
 554 static int
 555 hash_compare(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *a),
 556     ARGIN_NULLOK(void *b))
 557 {
 558     ASSERT_ARGS(hash_compare)
 559
 560     if (a == b)
 561         return 0;
 562
 563     if (hash->key_type == Hash_key_type_STRING)
 564         return hash_compare_string(interp, (STRING *)a, (STRING *)b);
 565
 566     if (hash->key_type == Hash_key_type_STRING_enc)
 567         return hash_compare_string_enc(interp, (STRING *)a, (STRING *)b);
 568
 569     if (hash->key_type == Hash_key_type_cstring)
 570         return strcmp((char *)a, (char *)b);
 571
 572     if (hash->key_type == Hash_key_type_PMC)
 573         return hash_compare_pmc(interp, (PMC *)a, (PMC *) b);
 574
 575     return 1;
 576 }
 577
 578 /*
 579
 580 =item C<void parrot_dump_hash(PARROT_INTERP, const Hash *hash)>
 581
 582 Prints out the hash in human-readable form, at least once someone implements
 583 this.
 584
 585 =cut
 586
 587 */
 588
 589 PARROT_EXPORT
 590 void
 591 parrot_dump_hash(SHIM_INTERP, SHIM(const Hash *hash))
 592 {
 593     ASSERT_ARGS(parrot_dump_hash)
 594 }
 595
 596
 597 /*
 598
 599 =item C<void parrot_mark_hash(PARROT_INTERP, Hash *hash)>
 600
 601 Marks the hash and its contents as live.  Assumes that key and value are
 602 non-null in all buckets.
 603
 604 =cut
 605
 606 */
 607
 608 PARROT_EXPORT
 609 void
 610 parrot_mark_hash(PARROT_INTERP, ARGMOD(Hash *hash))
 611 {
 612     ASSERT_ARGS(parrot_mark_hash)
 613     int mark_key   = 0;
 614     int mark_value = 0;
 615
 616     if (hash->entry_type == (PARROT_DATA_TYPE) enum_hash_string
 617     ||  hash->entry_type == (PARROT_DATA_TYPE) enum_hash_pmc)
 618         mark_value = 1;
 619
 620     if (hash->key_type == Hash_key_type_STRING
 621     ||  hash->key_type == Hash_key_type_STRING_enc
 622     ||  hash->key_type == Hash_key_type_PMC
 623     ||  hash->key_type == Hash_key_type_PMC_ptr)
 624         mark_key = 1;
 625
 626     if (mark_key) {
 627         if (mark_value)
 628             parrot_mark_hash_both(interp, hash);
 629         else
 630             parrot_mark_hash_keys(interp, hash);
 631     }
 632     else {
 633         if (mark_value)
 634             parrot_mark_hash_values(interp, hash);
 635     }
 636 }
 637
 638
 639 /*
 640
 641 =item C<static void parrot_mark_hash_keys(PARROT_INTERP, Hash *hash)>
 642
 643 Marks the hash and only its keys as live.
 644
 645 =cut
 646
 647 */
 648
 649 static void
 650 parrot_mark_hash_keys(PARROT_INTERP, ARGIN(Hash *hash))
 651 {
 652     ASSERT_ARGS(parrot_mark_hash_keys)
 653
 654     if (hash->key_type == Hash_key_type_STRING
 655      || hash->key_type == Hash_key_type_STRING_enc) {
 656         parrot_hash_iterate(hash,
 657             PARROT_ASSERT(_bucket->key);
 658             Parrot_gc_mark_STRING_alive(interp, (STRING *)_bucket->key););
 659     }
 660     else {
 661         parrot_hash_iterate(hash,
 662             PARROT_ASSERT(_bucket->key);
 663             Parrot_gc_mark_PMC_alive(interp, (PMC *)_bucket->key););
 664     }
 665 }
 666
 667
 668 /*
 669
 670 =item C<static void parrot_mark_hash_values(PARROT_INTERP, Hash *hash)>
 671
 672 Marks the hash and only its values as live.
 673
 674 =cut
 675
 676 */
 677
 678 static void
 679 parrot_mark_hash_values(PARROT_INTERP, ARGIN(Hash *hash))
 680 {
 681     ASSERT_ARGS(parrot_mark_hash_values)
 682
 683     if (hash->entry_type == (PARROT_DATA_TYPE) enum_hash_string) {
 684         parrot_hash_iterate(hash,
 685             PARROT_ASSERT(_bucket->value);
 686             Parrot_gc_mark_STRING_alive(interp, (STRING *)_bucket->value););
 687     }
 688     else if (hash->entry_type == (PARROT_DATA_TYPE) enum_hash_pmc) {
 689         parrot_hash_iterate(hash,
 690             PARROT_ASSERT(_bucket->value);
 691             Parrot_gc_mark_PMC_alive(interp, (PMC *)_bucket->value););
 692     }
 693 }
 694
 695
 696 /*
 697
 698 =item C<static void parrot_mark_hash_both(PARROT_INTERP, Hash *hash)>
 699
 700 Marks the hash and both its keys and values as live.
 701
 702 =cut
 703
 704 */
 705
 706 static void
 707 parrot_mark_hash_both(PARROT_INTERP, ARGIN(Hash *hash))
 708 {
 709     ASSERT_ARGS(parrot_mark_hash_both)
 710
 711     if ((hash->key_type == Hash_key_type_STRING
 712     ||   hash->key_type == Hash_key_type_STRING_enc)
 713     &&  hash->entry_type == (PARROT_DATA_TYPE) enum_hash_pmc) {
 714         parrot_hash_iterate(hash,
 715             PARROT_ASSERT(_bucket->key);
 716             Parrot_gc_mark_STRING_alive(interp, (STRING *)_bucket->key);
 717             PARROT_ASSERT(_bucket->value);
 718             Parrot_gc_mark_PMC_alive(interp, (PMC *)_bucket->value););
 719     }
 720     else {
 721         parrot_hash_iterate(hash,
 722             PARROT_ASSERT(_bucket->key);
 723             Parrot_gc_mark_PObj_alive(interp, (PObj *)_bucket->key);
 724             PARROT_ASSERT(_bucket->value);
 725             Parrot_gc_mark_PObj_alive(interp, (PObj *)_bucket->value););
 726     }
 727 }
 728
 729 /*
 730
 731 =item C<Hash * Parrot_hash_thaw(PARROT_INTERP, PMC *info)>
 732
 733 Visits the contents of a hash during freeze/thaw.
 734
 735 C<pinfo> is the visit info, (see include/parrot/pmc_freeze.h>).
 736
 737 =cut
 738
 739 */
 740
 741 PARROT_CANNOT_RETURN_NULL
 742 PARROT_WARN_UNUSED_RESULT
 743 PARROT_MALLOC
 744 Hash *
 745 Parrot_hash_thaw(PARROT_INTERP, ARGMOD(PMC *info))
 746 {
 747     ASSERT_ARGS(Parrot_hash_thaw)
 748
 749     const size_t            num_entries = VTABLE_shift_integer(interp, info);
 750     const Hash_key_type     key_type    = (Hash_key_type)VTABLE_shift_integer(interp, info);
 751     const PARROT_DATA_TYPE  entry_type  = (PARROT_DATA_TYPE)VTABLE_shift_integer(interp, info);
 752     size_t                  entry_index;
 753     Hash *hash = parrot_create_hash_sized(interp, entry_type, key_type, num_entries);
 754
 755     /* special case for great speed */
 756     if (key_type   == Hash_key_type_STRING
 757     &&  entry_type == enum_hash_int) {
 758         for (entry_index = 0; entry_index < num_entries; ++entry_index) {
 759             STRING * const key = VTABLE_shift_string(interp, info);
 760             const INTVAL   i   = VTABLE_shift_integer(interp, info);
 761             parrot_hash_put(interp, hash, (void *)key, (void *)i);
 762         }
 763
 764         return hash;
 765     }
 766
 767     for (entry_index = 0; entry_index < num_entries; ++entry_index) {
 768         void       *key;
 769
 770         switch (key_type) {
 771           case Hash_key_type_int:
 772             {
 773                 const INTVAL i_key = VTABLE_shift_integer(interp, info);
 774                 key                = (void *)i_key;
 775             }
 776             break;
 777           case Hash_key_type_STRING:
 778           case Hash_key_type_STRING_enc:
 779             {
 780                 STRING * const s_key = VTABLE_shift_string(interp, info);
 781                 key                  = (void *)s_key;
 782             }
 783             break;
 784           case Hash_key_type_PMC:
 785           case Hash_key_type_PMC_ptr:
 786             {
 787                 PMC * const p_key = VTABLE_shift_pmc(interp, info);
 788                 key               = (void *)p_key;
 789                 break;
 790             }
 791           default:
 792             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 793                     "unimplemented key type");
 794             break;
 795         }
 796
 797         switch (entry_type) {
 798           case enum_hash_int:
 799             {
 800                 const INTVAL i = VTABLE_shift_integer(interp, info);
 801                 parrot_hash_put(interp, hash, key, (void *)i);
 802                 break;
 803             }
 804           case enum_hash_string:
 805             {
 806                 STRING * const s = VTABLE_shift_string(interp, info);
 807                 parrot_hash_put(interp, hash, key, (void *)s);
 808                 break;
 809             }
 810           case enum_hash_pmc:
 811             {
 812                 PMC * const p = VTABLE_shift_pmc(interp, info);
 813                 parrot_hash_put(interp, hash, key, (void *)p);
 814                 break;
 815             }
 816           default:
 817             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 818                     "unimplemented value type");
 819             break;
 820         }
 821     }
 822
 823     return hash;
 824 }
 825
 826
 827 /*
 828
 829 =item C<void Parrot_hash_freeze(PARROT_INTERP, const Hash *hash, PMC *info)>
 830
 831 Freezes hash into a string.
 832
 833 Takes an interpreter, a pointer to the hash, and a pointer to the structure
 834 containing the string start location.
 835
 836 =cut
 837
 838 */
 839
 840 void
 841 Parrot_hash_freeze(PARROT_INTERP, ARGIN(const Hash *hash), ARGMOD(PMC *info))
 842 {
 843     ASSERT_ARGS(Parrot_hash_freeze)
 844     const Hash_key_type    key_type   = hash->key_type;
 845     const PARROT_DATA_TYPE entry_type = hash->entry_type;
 846     const size_t           entries    = hash->entries;
 847     size_t                 i;
 848
 849     VTABLE_push_integer(interp, info, entries);
 850     VTABLE_push_integer(interp, info, key_type);
 851     VTABLE_push_integer(interp, info, entry_type);
 852
 853     parrot_hash_iterate(hash,
 854         switch (key_type) {
 855           case Hash_key_type_int:
 856             VTABLE_push_integer(interp, info, (INTVAL)_bucket->key);
 857             break;
 858           case Hash_key_type_STRING:
 859           case Hash_key_type_STRING_enc:
 860             VTABLE_push_string(interp, info, (STRING *)_bucket->key);
 861             break;
 862           case Hash_key_type_PMC:
 863           case Hash_key_type_PMC_ptr:
 864             VTABLE_push_pmc(interp, info, (PMC *)_bucket->key);
 865             break;
 866           default:
 867             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 868                     "unimplemented key type");
 869             break;
 870         }
 871         switch (entry_type) {
 872           case enum_hash_int:
 873             VTABLE_push_integer(interp, info, (INTVAL)_bucket->value);
 874             break;
 875           case enum_hash_string:
 876             VTABLE_push_string(interp, info, (STRING *)_bucket->value);
 877             break;
 878           case enum_hash_pmc:
 879             VTABLE_push_pmc(interp, info, (PMC *)_bucket->value);
 880             break;
 881           default:
 882             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 883                     "unimplemented value type");
 884             break;
 885         });
 886 }
 887
 888
 889 /*
 890
 891 =item C<static void expand_hash(PARROT_INTERP, Hash *hash)>
 892
 893 Expands a hash when necessary.
 894
 895 For a hashtable of size N, we use C<MAXFULL_PERCENT> % of N as the
 896 number of buckets. This way, as soon as we run out of buckets on the
 897 free list, we know that it's time to resize the hashtable.
 898
 899 Algorithm for expansion: We exactly double the size of the hashtable.
 900 Keys are assigned to buckets with the formula
 901
 902     bucket_index = hash(key) % parrot_hash_size
 903
 904 When doubling the size of the hashtable, we know that every key is either
 905 already in the correct bucket, or belongs in the current bucket plus
 906 C<parrot_hash_size> (the old C<parrot_hash_size>). In fact, because the
 907 hashtable is always a power of two in size, it depends only on the next bit
 908 in the hash value, after the ones previously used.
 909
 910 We scan through all the buckets in order, moving the buckets that need to be
 911 moved. No bucket will be scanned twice, and the cache should be reasonably
 912 happy because the hashtable accesses will be two parallel sequential scans.
 913 (Of course, this also mucks with the C<< ->next >> pointers, and they'll be
 914 all over memory.)
 915
 916 =cut
 917
 918 */
 919
 920 static void
 921 expand_hash(PARROT_INTERP, ARGMOD(Hash *hash))
 922 {
 923     ASSERT_ARGS(expand_hash)
 924     HashBucket  **new_index,  **index;
 925     HashBucket   *new_buckets, *bucket;
 926
 927     HashBucket * const initial_offset = (HashBucket *)((char *)hash + sizeof (Hash));
 928
 929     void *        new_mem;
 930     void * const  old_mem    = hash->buckets;
 931     const UINTVAL old_size   = hash->mask + 1;
 932     const UINTVAL new_size   = old_size  << 1; /* Double. Right-shift is 2x */
 933     const UINTVAL new_mask   = new_size   - 1;
 934     size_t        offset, i;
 935
 936     /*
 937        allocate some less buckets
 938        e.g. 3 buckets, 4 pointers:
 939
 940          +---+---+---+-+-+-+-+
 941          | --> buckets |     |
 942          +---+---+---+-+-+-+-+
 943          ^             ^
 944          | old_mem     | hash->index
 945     */
 946
 947     /* resize mem */
 948     if (initial_offset != old_mem) {
 949         /* This buffer has been reallocated at least once before. */
 950         new_mem   = Parrot_gc_reallocate_memory_chunk_with_interior_pointers(
 951                 interp, old_mem,
 952                 HASH_ALLOC_SIZE(new_size),
 953                 HASH_ALLOC_SIZE(old_size));
 954
 955         new_buckets = (HashBucket *)  new_mem;
 956         new_index   = (HashBucket **)(new_buckets + N_BUCKETS(new_size));
 957
 958         offset = (char *)new_mem - (char *)old_mem;
 959
 960         /* old index is here */
 961         index  = (HashBucket **)(new_buckets + N_BUCKETS(old_size));
 962         /* reallocate index */
 963         mem_sys_memcopy(new_index, index, sizeof (HashBucket *) * old_size);
 964
 965         /* clear second half of the buckets, freed by old the index */
 966         memset(new_buckets + N_BUCKETS(old_size), 0,
 967                 sizeof (HashBucket *) * old_size);
 968     }
 969     else {
 970         /* Allocate a new buffer. */
 971         new_mem = Parrot_gc_allocate_memory_chunk_with_interior_pointers(
 972                 interp, HASH_ALLOC_SIZE(new_size));
 973
 974         new_buckets = (HashBucket *)  new_mem;
 975         new_index   = (HashBucket **)(new_buckets + N_BUCKETS(new_size));
 976
 977         offset = (char *)new_buckets - (char *)hash->buckets;
 978
 979         mem_sys_memcopy(new_buckets, hash->buckets ,
 980                 N_BUCKETS(old_size) * sizeof (HashBucket));
 981         mem_sys_memcopy(new_index,   hash->index,
 982                 sizeof (HashBucket *) * old_size);
 983     }
 984
 985
 986     /*
 987          +---+---+---+---+---+---+-+-+-+-+-+-+-+-+
 988          |  buckets  | old_index |  new_index    |
 989          +---+---+---+---+---+---+-+-+-+-+-+-+-+-+
 990          ^                       ^
 991          | new_mem               | hash->index
 992     */
 993
 994     /* update hash data */
 995     hash->index     = new_index;
 996     hash->buckets   = new_buckets;
 997     hash->mask      = new_mask;
 998
 999     /* reloc pointers and recalc bucket indices */
1000     for (i = 0; i < old_size; ++i) {
1001         index = new_index + i;
1002
1003         while (*index != NULL) {
1004             size_t new_loc;
1005             size_t hashval;
1006
1007             bucket = (HashBucket *)((char *)*index + offset);
1008
1009             /* rehash the bucket */
1010             if (hash->key_type == Hash_key_type_STRING
1011             ||  hash->key_type == Hash_key_type_STRING_enc) {
1012                 STRING *s = (STRING *)bucket->key;
1013                 hashval   = s->hashval;
1014             }
1015             else {
1016                 hashval = key_hash(interp, hash, bucket->key);
1017             }
1018
1019             new_loc = hashval & new_mask;
1020
1021             if (i != new_loc) {
1022                 *index              = bucket->next;
1023                 bucket->next        = new_index[new_loc];
1024                 new_index[new_loc]  = bucket;
1025             }
1026             else {
1027                 *index = bucket;
1028                 index  = &bucket->next;
1029             }
1030         }
1031     }
1032
1033     /* add new buckets to free_list
1034      * lowest bucket is top on free list and will be used first */
1035
1036     bucket = new_buckets + N_BUCKETS(old_size);
1037
1038     for (; bucket < new_buckets + N_BUCKETS(new_size) - 1; ++bucket) {
1039         bucket->next = bucket + 1;
1040         bucket->key  = bucket->value = NULL;
1041     }
1042
1043     hash->free_list = new_buckets + N_BUCKETS(old_size);
1044     bucket->next = NULL;
1045 }
1046
1047
1048 /*
1049
1050 =item C<Hash* parrot_new_hash(PARROT_INTERP)>
1051
1052 Creates a new Parrot STRING hash.
1053
1054 =cut
1055
1056 */
1057
1058 PARROT_EXPORT
1059 PARROT_CANNOT_RETURN_NULL
1060 Hash*
1061 parrot_new_hash(PARROT_INTERP)
1062 {
1063     ASSERT_ARGS(parrot_new_hash)
1064     return parrot_create_hash(interp,
1065             enum_type_PMC,
1066             Hash_key_type_STRING);
1067 }
1068
1069
1070 /*
1071
1072 =item C<Hash* parrot_new_cstring_hash(PARROT_INTERP)>
1073
1074 Creates a new C string hash in C<hptr>.
1075
1076 =cut
1077
1078 */
1079
1080 PARROT_EXPORT
1081 PARROT_CANNOT_RETURN_NULL
1082 Hash*
1083 parrot_new_cstring_hash(PARROT_INTERP)
1084 {
1085     ASSERT_ARGS(parrot_new_cstring_hash)
1086     return parrot_create_hash(interp,
1087             enum_type_PMC,
1088             Hash_key_type_cstring);
1089 }
1090
1091
1092 /*
1093
1094 =item C<Hash * parrot_new_pointer_hash(PARROT_INTERP)>
1095
1096 Create and return a new hash with void * keys and values.
1097
1098 =cut
1099
1100 */
1101
1102 PARROT_EXPORT
1103 PARROT_CANNOT_RETURN_NULL
1104 Hash *
1105 parrot_new_pointer_hash(PARROT_INTERP)
1106 {
1107     ASSERT_ARGS(parrot_new_pointer_hash)
1108     return parrot_create_hash(interp,
1109             enum_type_ptr,
1110             Hash_key_type_ptr);
1111 }
1112
1113
1114 /*
1115
1116 =item C<Hash* parrot_new_intval_hash(PARROT_INTERP)>
1117
1118 Creates and returns new Hash PMC with INTVAL keys and values. C<flags> can be
1119 C<PObj_constant_FLAG> or 0.
1120
1121 =cut
1122
1123 */
1124
1125
1126 PARROT_EXPORT
1127 PARROT_WARN_UNUSED_RESULT
1128 PARROT_CANNOT_RETURN_NULL
1129 Hash*
1130 parrot_new_intval_hash(PARROT_INTERP)
1131 {
1132     ASSERT_ARGS(parrot_new_intval_hash)
1133     return parrot_create_hash(interp,
1134             enum_type_INTVAL,
1135             Hash_key_type_int);
1136 }
1137
1138 /*
1139
1140 =item C<Hash * parrot_create_hash(PARROT_INTERP, PARROT_DATA_TYPE val_type,
1141 Hash_key_type hkey_type)>
1142
1143 Creates and initializes a hash.  Function pointers determine its behaviors.
1144
1145 Memory from this function must be freed.
1146
1147 =cut
1148
1149 */
1150
1151 PARROT_CANNOT_RETURN_NULL
1152 PARROT_WARN_UNUSED_RESULT
1153 PARROT_MALLOC
1154 Hash *
1155 parrot_create_hash(PARROT_INTERP, PARROT_DATA_TYPE val_type, Hash_key_type hkey_type)
1156 {
1157     ASSERT_ARGS(parrot_create_hash)
1158     return parrot_create_hash_sized(interp, val_type, hkey_type, INITIAL_SIZE);
1159 }
1160
1161
1162 /*
1163
1164 =item C<static UINTVAL round_up_pow2(UINTVAL x)>
1165
1166 Round a value up to the nearest power of 2.
1167
1168 =cut
1169
1170 */
1171
1172 PARROT_INLINE
1173 static UINTVAL
1174 round_up_pow2(UINTVAL x) {
1175     UINTVAL y = 1;
1176     while (y < x)
1177         y <<= 1;
1178     return y;
1179 }
1180
1181
1182 /*
1183
1184 =item C<Hash * parrot_create_hash_sized(PARROT_INTERP, PARROT_DATA_TYPE
1185 val_type, Hash_key_type hkey_type, UINTVAL size)>
1186
1187 Creates and initializes a hash, similar to C<parrot_create_hash>.
1188
1189 Preallocates at least C<size> buckets.
1190
1191 =cut
1192
1193 */
1194
1195 PARROT_CANNOT_RETURN_NULL
1196 PARROT_WARN_UNUSED_RESULT
1197 PARROT_MALLOC
1198 Hash *
1199 parrot_create_hash_sized(PARROT_INTERP, PARROT_DATA_TYPE val_type, Hash_key_type hkey_type,
1200         UINTVAL size)
1201 {
1202     ASSERT_ARGS(parrot_create_hash_sized)
1203     UINTVAL      initial_buckets = size > INITIAL_SIZE ? round_up_pow2(size) : INITIAL_SIZE;
1204     HashBucket  *bp;
1205     void        *alloc = Parrot_gc_allocate_memory_chunk_with_interior_pointers(
1206                             interp, sizeof (Hash) + HASH_ALLOC_SIZE(initial_buckets));
1207     Hash * const hash  = (Hash*)alloc;
1208     size_t       i;
1209
1210     PARROT_ASSERT(initial_buckets % 4 == 0);
1211
1212     hash->entry_type = val_type;
1213     hash->key_type   = hkey_type;
1214     hash->seed       = interp->hash_seed;
1215     hash->mask       = initial_buckets - 1;
1216     hash->entries    = 0;
1217
1218     bp = (HashBucket *)((char *)alloc + sizeof (Hash));
1219     hash->free_list = NULL;
1220
1221     /* fill free_list from hi addresses so that we can use
1222      * buckets[i] directly in an OrderedHash, *if* nothing
1223      * was deleted */
1224
1225     hash->buckets = bp;
1226     bp += N_BUCKETS(initial_buckets);
1227     hash->index = (HashBucket **)bp;
1228
1229     for (i = 0, --bp; i < N_BUCKETS(initial_buckets); ++i, --bp) {
1230         bp->next        = hash->free_list;
1231         hash->free_list = bp;
1232     }
1233
1234     return hash;
1235 }
1236
1237 /*
1238
1239 =item C<void parrot_hash_destroy(PARROT_INTERP, Hash *hash)>
1240
1241 Frees the memory allocated to the specified hash and its bucket store.  Used by
1242 parrot_chash_destroy.
1243
1244 Unlike the C library function free(), the hash function must not be NULL.
1245
1246 =cut
1247
1248 */
1249
1250 PARROT_EXPORT
1251 void
1252 parrot_hash_destroy(PARROT_INTERP, ARGFREE_NOTNULL(Hash *hash))
1253 {
1254     ASSERT_ARGS(parrot_hash_destroy)
1255     HashBucket * const bp = (HashBucket*)((char*)hash + sizeof (Hash));
1256     if (bp != hash->buckets)
1257         mem_gc_free(interp, hash->buckets);
1258     mem_gc_free(interp, hash);
1259 }
1260
1261
1262 /*
1263
1264 =item C<void parrot_chash_destroy(PARROT_INTERP, Hash *hash)>
1265
1266 Deletes the specified hash by freeing the memory allocated to all the key-value
1267 pairs, and finally the hash itself.
1268
1269 =cut
1270
1271 */
1272
1273 void
1274 parrot_chash_destroy(PARROT_INTERP, ARGMOD(Hash *hash))
1275 {
1276     ASSERT_ARGS(parrot_chash_destroy)
1277     parrot_hash_iterate(hash,
1278         mem_gc_free(interp, _bucket->key);
1279         mem_gc_free(interp, _bucket->value););
1280     parrot_hash_destroy(interp, hash);
1281 }
1282
1283
1284 /*
1285
1286 =item C<void parrot_chash_destroy_values(PARROT_INTERP, Hash *hash, value_free
1287 func)>
1288
1289 Deletes the specified hash by freeing the memory allocated to all the key-value
1290 pairs, calling the provided callback to free the values, and finally the hash
1291 itself.
1292
1293 The callback returns C<void> and takes a C<void *>.
1294
1295 =cut
1296
1297 */
1298
1299 void
1300 parrot_chash_destroy_values(PARROT_INTERP, ARGMOD(Hash *hash), NOTNULL(value_free func))
1301 {
1302     ASSERT_ARGS(parrot_chash_destroy_values)
1303     UINTVAL i;
1304
1305     parrot_hash_iterate(hash,
1306         mem_gc_free(interp, _bucket->key);
1307         func(_bucket->value););
1308
1309     parrot_hash_destroy(interp, hash);
1310 }
1311
1312
1313 /*
1314
1315 =item C<INTVAL parrot_hash_size(PARROT_INTERP, const Hash *hash)>
1316
1317 Returns the number of used entries in the hash.
1318
1319 =cut
1320
1321 */
1322
1323 PARROT_EXPORT
1324 PARROT_WARN_UNUSED_RESULT
1325 PARROT_PURE_FUNCTION
1326 INTVAL
1327 parrot_hash_size(SHIM_INTERP, ARGIN(const Hash *hash))
1328 {
1329     ASSERT_ARGS(parrot_hash_size)
1330
1331     return hash->entries;
1332 }
1333
1334
1335 /*
1336
1337 =item C<HashBucket * parrot_hash_get_bucket(PARROT_INTERP, const Hash *hash,
1338 const void *key)>
1339
1340 Returns the bucket for C<key>, if found, and NULL otherwise.
1341
1342 =cut
1343
1344 */
1345
1346 PARROT_EXPORT
1347 PARROT_WARN_UNUSED_RESULT
1348 PARROT_CAN_RETURN_NULL
1349 HashBucket *
1350 parrot_hash_get_bucket(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(const void *key))
1351 {
1352     ASSERT_ARGS(parrot_hash_get_bucket)
1353     DECL_CONST_CAST;
1354     HashBucket *bucket;
1355
1356     if (hash->entries <= 0)
1357         return NULL;
1358
1359     if (hash->key_type == Hash_key_type_STRING) {
1360         STRING * const s       = (STRING *)PARROT_const_cast(void *, key);
1361         const size_t   hashval = key_hash_STRING(interp, s, hash->seed);
1362
1363         bucket                 = hash->index[hashval & hash->mask];
1364
1365         while (bucket) {
1366             const STRING *s2 = (const STRING *)bucket->key;
1367
1368             if (s == s2)
1369                 break;
1370             /* manually inline part of string_equal  */
1371             if (hashval == s2->hashval) {
1372                 if (s->encoding == s2->encoding){
1373                     if ((STRING_byte_length(s) == STRING_byte_length(s2))
1374                     && (memcmp(s->strstart, s2->strstart, STRING_byte_length(s)) == 0))
1375                         break;
1376                 } else if (STRING_equal(interp, s, s2))
1377                         break;
1378             }
1379
1380             bucket = bucket->next;
1381         }
1382     }
1383     else {
1384         const size_t hashval = key_hash(interp, hash,
1385                                     PARROT_const_cast(void *, key));
1386         bucket               = hash->index[hashval & hash->mask];
1387
1388         while (bucket) {
1389             if (hash_compare(interp, hash,
1390                     PARROT_const_cast(void *, key),
1391                     bucket->key) == 0)
1392                 break;
1393             bucket = bucket->next;
1394         }
1395     }
1396
1397     return bucket;
1398 }
1399
1400 /*
1401
1402 =item C<void * parrot_hash_get(PARROT_INTERP, const Hash *hash, const void
1403 *key)>
1404
1405 Returns the value keyed by C<key>, or C<NULL> if no bucket is found.
1406
1407 =cut
1408
1409 */
1410
1411 PARROT_EXPORT
1412 PARROT_WARN_UNUSED_RESULT
1413 PARROT_CAN_RETURN_NULL
1414 void *
1415 parrot_hash_get(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN(const void *key))
1416 {
1417     ASSERT_ARGS(parrot_hash_get)
1418     const HashBucket * const bucket = parrot_hash_get_bucket(interp, hash, key);
1419     return bucket ? bucket->value : NULL;
1420 }
1421
1422
1423 /*
1424
1425 =item C<INTVAL parrot_hash_exists(PARROT_INTERP, const Hash *hash, void *key)>
1426
1427 Returns whether the key exists in the hash.
1428
1429 =cut
1430
1431 */
1432
1433 PARROT_EXPORT
1434 PARROT_WARN_UNUSED_RESULT
1435 INTVAL
1436 parrot_hash_exists(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN(void *key))
1437 {
1438     ASSERT_ARGS(parrot_hash_exists)
1439     const HashBucket * const bucket = parrot_hash_get_bucket(interp, hash, key);
1440     return bucket ? 1 : 0;
1441 }
1442
1443
1444 /*
1445
1446 =item C<HashBucket* parrot_hash_put(PARROT_INTERP, Hash *hash, void *key, void
1447 *value)>
1448
1449 Puts the key and value into the hash. Note that C<key> is B<not> copied.
1450
1451 =cut
1452
1453 */
1454
1455 PARROT_EXPORT
1456 PARROT_IGNORABLE_RESULT
1457 PARROT_CANNOT_RETURN_NULL
1458 HashBucket*
1459 parrot_hash_put(PARROT_INTERP, ARGMOD(Hash *hash),
1460         ARGIN_NULLOK(void *key), ARGIN_NULLOK(void *value))
1461 {
1462     ASSERT_ARGS(parrot_hash_put)
1463     HashBucket *bucket;
1464     size_t      hashval;
1465
1466     if (hash->key_type == Hash_key_type_STRING) {
1467         const STRING * const s = (STRING *)key;
1468         hashval                = key_hash_STRING(interp, (STRING *)key, hash->seed);
1469         bucket                 = hash->index[hashval & hash->mask];
1470
1471         while (bucket) {
1472             const STRING *s2 = (const STRING *)bucket->key;
1473             if (s == s2)
1474                 break;
1475             /* manually inline part of string_equal  */
1476             if (hashval == s2->hashval) {
1477                 if (s->encoding == s2->encoding) {
1478                     if ((STRING_byte_length(s) == STRING_byte_length(s2))
1479                     && (memcmp(s->strstart, s2->strstart, STRING_byte_length(s)) == 0))
1480                         break;
1481                 } else if (STRING_equal(interp, s, s2))
1482                         break;
1483             }
1484             bucket = bucket->next;
1485         }
1486     }
1487     else {
1488         hashval = key_hash(interp, hash, key);
1489         bucket  = hash->index[hashval & hash->mask];
1490
1491         while (bucket) {
1492             if (hash_compare(interp, hash, key, bucket->key) == 0)
1493                 break;
1494             bucket = bucket->next;
1495         }
1496     }
1497
1498     /* If we have a bucket already, put the value in it. Otherwise, we need
1499        to get a new bucket */
1500     if (bucket)
1501         bucket->value = value;
1502     else {
1503         /* Get a new bucket off the free list. If the free list is empty, we
1504            expand the hash so we get more items on the free list */
1505         if (!hash->free_list)
1506             expand_hash(interp, hash);
1507
1508         bucket = hash->free_list;
1509
1510         /* Add the value to the new bucket, increasing the count of elements */
1511         ++hash->entries;
1512         hash->free_list                   = bucket->next;
1513         bucket->key                       = key;
1514         bucket->value                     = value;
1515         bucket->next                      = hash->index[hashval & hash->mask];
1516         hash->index[hashval & hash->mask] = bucket;
1517     }
1518
1519     return bucket;
1520 }
1521
1522
1523 /*
1524
1525 =item C<void parrot_hash_delete(PARROT_INTERP, Hash *hash, void *key)>
1526
1527 Deletes the key from the hash.
1528
1529 =cut
1530
1531 */
1532
1533 PARROT_EXPORT
1534 void
1535 parrot_hash_delete(PARROT_INTERP, ARGMOD(Hash *hash), ARGIN(void *key))
1536 {
1537     ASSERT_ARGS(parrot_hash_delete)
1538     const UINTVAL hashval = key_hash(interp, hash, key) & hash->mask;
1539     HashBucket   **prev   = &hash->index[hashval];
1540     if (*prev) {
1541         for (; *prev; prev = &(*prev)->next) {
1542             HashBucket *current = *prev;
1543             if (hash_compare(interp, hash, key, current->key) == 0) {
1544                 *prev = current->next;
1545                 --hash->entries;
1546                 current->next    = hash->free_list;
1547                 current->key     = NULL;
1548                 hash->free_list = current;
1549                 return;
1550             }
1551         }
1552     }
1553 }
1554
1555
1556 /*
1557
1558 =item C<void parrot_hash_clone(PARROT_INTERP, const Hash *hash, Hash *dest)>
1559
1560 Clones C<hash> to C<dest>.
1561
1562 =cut
1563
1564 */
1565
1566 PARROT_EXPORT
1567 void
1568 parrot_hash_clone(PARROT_INTERP, ARGIN(const Hash *hash), ARGOUT(Hash *dest))
1569 {
1570     ASSERT_ARGS(parrot_hash_clone)
1571     parrot_hash_clone_prunable(interp, hash, dest, 1);
1572 }
1573
1574 /*
1575
1576 =item C<void parrot_hash_clone_prunable(PARROT_INTERP, const Hash *hash, Hash
1577 *dest, int deep)>
1578
1579 helper function to Clone C<hash> to C<dest>
1580
1581 allows deep cloning of PMC types if deep set
1582
1583 =cut
1584
1585 */
1586
1587 void
1588 parrot_hash_clone_prunable(PARROT_INTERP, ARGIN(const Hash *hash),
1589     ARGOUT(Hash *dest), int deep)
1590 {
1591     ASSERT_ARGS(parrot_hash_clone_prunable)
1592
1593     parrot_hash_iterate(hash,
1594         void         *valtmp;
1595         void * const  key = _bucket->key;
1596
1597         switch (hash->entry_type) {
1598           case enum_type_STRING:
1599             valtmp = _bucket->value;
1600             break;
1601
1602           case enum_type_PMC:
1603             if (PMC_IS_NULL((PMC *)_bucket->value))
1604                 valtmp = (void *)PMCNULL;
1605             else
1606                 if (deep)
1607                     valtmp = (void *)VTABLE_clone(interp, (PMC*)_bucket->value);
1608                 else
1609                     valtmp = _bucket->value;
1610             break;
1611
1612           case enum_type_undef:
1613           case enum_type_ptr:
1614           case enum_type_INTVAL:
1615             valtmp = (void *)_bucket->value;
1616             break;
1617
1618           default:
1619             valtmp = NULL; /* avoid warning */
1620             Parrot_ex_throw_from_c_args(interp, NULL, -1,
1621                     "hash corruption: type = %d\n", hash->entry_type);
1622         };
1623         if (key)
1624             parrot_hash_put(interp, dest, key, valtmp););
1625 }
1626
1627 /*
1628
1629 =item C<static PMC* get_integer_pmc(PARROT_INTERP, INTVAL value)>
1630
1631 Lookup the PMC type which is used for storing native integers.
1632
1633 =cut
1634
1635 */
1636
1637 PARROT_CANNOT_RETURN_NULL
1638 static PMC*
1639 get_integer_pmc(PARROT_INTERP, INTVAL value)
1640 {
1641     ASSERT_ARGS(get_integer_pmc)
1642     PMC * const ret = Parrot_pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer));
1643     VTABLE_set_integer_native(interp, ret, value);
1644     return ret;
1645 }
1646
1647
1648 /*
1649
1650 =item C<static PMC* get_number_pmc(PARROT_INTERP, FLOATVAL value)>
1651
1652 Lookup the PMC type which is used for floating point numbers.
1653
1654 =cut
1655
1656 */
1657
1658 PARROT_CANNOT_RETURN_NULL
1659 static PMC*
1660 get_number_pmc(PARROT_INTERP, FLOATVAL value)
1661 {
1662     ASSERT_ARGS(get_number_pmc)
1663     PMC * const ret = Parrot_pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float));
1664     VTABLE_set_number_native(interp, ret, value);
1665     return ret;
1666 }
1667
1668 /*
1669
1670 =item C<static PMC * get_string_pmc(PARROT_INTERP, STRING *value)>
1671
1672 Lookup the PMC type which is used for storing strings.
1673
1674 =cut
1675
1676 */
1677
1678 PARROT_CANNOT_RETURN_NULL
1679 static PMC *
1680 get_string_pmc(PARROT_INTERP, ARGIN(STRING *value))
1681 {
1682     ASSERT_ARGS(get_string_pmc)
1683     PMC * const ret = Parrot_pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_String));
1684     VTABLE_set_string_native(interp, ret, value);
1685     return ret;
1686 }
1687
1688
1689 /*
1690
1691 Poor-man polymorphic functions to convert something to something.
1692
1693 There is bunch of functions to convert from passed value to stored keys type and to/from
1694 stored values type.
1695
1696 void *hash_key_from_TYPE convert to keys type.
1697 TYPE hash_key_to_TYPE convert from keys type.
1698 void *hash_value_from_TYPE convert to values type.
1699 TYPE hash_value_to_TYPE convert from values type.
1700
1701 */
1702
1703 /*
1704
1705 =item C<void* hash_key_from_int(PARROT_INTERP, const Hash *hash, INTVAL key)>
1706
1707 Cast INTVAL to hash key.
1708
1709 =cut
1710
1711 */
1712
1713 PARROT_CAN_RETURN_NULL
1714 void*
1715 hash_key_from_int(PARROT_INTERP, ARGIN(const Hash *hash), INTVAL key)
1716 {
1717     ASSERT_ARGS(hash_key_from_int)
1718     void *ret;
1719     switch (hash->key_type) {
1720       case Hash_key_type_int:
1721         ret = (void *)key;
1722         break;
1723         /* Currently PMCs are stringified */
1724       case Hash_key_type_PMC:
1725       case Hash_key_type_PMC_ptr:
1726         ret = (void *)get_integer_pmc(interp, key);
1727         break;
1728       case Hash_key_type_STRING:
1729       case Hash_key_type_STRING_enc:
1730         ret = (void *)Parrot_str_from_int(interp, key);
1731         break;
1732       default:
1733         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1734                     "Hash: unsupported key_type");
1735     }
1736     return ret;
1737 }
1738
1739 /*
1740
1741 =item C<void* hash_key_from_string(PARROT_INTERP, const Hash *hash, STRING
1742 *key)>
1743
1744 Cast STRING to hash key.
1745
1746 =cut
1747
1748 */
1749
1750 PARROT_CAN_RETURN_NULL
1751 void*
1752 hash_key_from_string(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN(STRING *key))
1753 {
1754     ASSERT_ARGS(hash_key_from_string)
1755     void *ret;
1756     switch (hash->key_type) {
1757       case Hash_key_type_int:
1758       {
1759         /* Pacify compiler about casting INVTAL to void */
1760         const INTVAL int_key = Parrot_str_to_int(interp, key);
1761         ret                  = INTVAL2PTR(void *, int_key);
1762         break;
1763       }
1764
1765       case Hash_key_type_PMC:
1766       case Hash_key_type_PMC_ptr:
1767         ret = get_string_pmc(interp, key);
1768         break;
1769
1770       case Hash_key_type_STRING:
1771       case Hash_key_type_STRING_enc:
1772         ret = key;
1773         break;
1774
1775       default:
1776         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1777                     "Hash: unsupported key_type");
1778     }
1779     return ret;
1780 }
1781
1782 /*
1783
1784 =item C<void* hash_key_from_pmc(PARROT_INTERP, const Hash *hash, PMC *key)>
1785
1786 Cast PMC* to hash key.
1787
1788 =cut
1789
1790 */
1791
1792 PARROT_CAN_RETURN_NULL
1793 void*
1794 hash_key_from_pmc(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN(PMC *key))
1795 {
1796     ASSERT_ARGS(hash_key_from_pmc)
1797     void *ret;
1798     switch (hash->key_type) {
1799       case Hash_key_type_int:
1800         {
1801             const INTVAL int_key = VTABLE_get_integer(interp, key);
1802             ret                  = INTVAL2PTR(void *, int_key);
1803             break;
1804         }
1805       case Hash_key_type_PMC:
1806       case Hash_key_type_PMC_ptr:
1807         {
1808             /* Extract real value from Key (and box it if nessary) */
1809             if (key->vtable->base_type == enum_class_Key)
1810                 switch (key_type(interp, key)) {
1811                   case KEY_integer_FLAG:
1812                     key = get_integer_pmc(interp, key_integer(interp, key));
1813                     break;
1814                   case KEY_string_FLAG:
1815                     key = get_string_pmc(interp, key_string(interp, key));
1816                     break;
1817                   case KEY_number_FLAG:
1818                     key = get_number_pmc(interp, key_number(interp, key));
1819                     break;
1820                   case KEY_pmc_FLAG:
1821                     key = key_pmc(interp, key);
1822                     break;
1823                   default:
1824                     /* It's impossible if Keys are same (and they are not) */
1825                     /* So throw exception */
1826                     Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1827                                 "hash: unexpected type of Key");
1828                     break;
1829                 }
1830
1831             ret = key;
1832             break;
1833         }
1834       case Hash_key_type_STRING:
1835       case Hash_key_type_STRING_enc:
1836         {
1837             STRING * const tmp = VTABLE_get_string(interp, key);
1838             if (STRING_IS_NULL(tmp))
1839                 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNEXPECTED_NULL,
1840                             "hash: can't use null as key");
1841             ret = (void *)tmp;
1842         }
1843         break;
1844       default:
1845         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1846                     "Hash: unsupported key_type");
1847     }
1848     return ret;
1849 }
1850
1851 /*
1852
1853 =item C<INTVAL hash_key_to_int(PARROT_INTERP, const Hash *hash, void *key)>
1854
1855 Cast hash key to INTVAL.
1856
1857 =cut
1858
1859 */
1860
1861 INTVAL
1862 hash_key_to_int(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *key))
1863 {
1864     ASSERT_ARGS(hash_key_to_int)
1865     INTVAL ret;
1866     switch (hash->key_type) {
1867       case Hash_key_type_int:
1868         ret = (INTVAL)key;
1869         break;
1870       case Hash_key_type_PMC:
1871       case Hash_key_type_PMC_ptr:
1872         ret = VTABLE_get_integer(interp, (PMC *)key);
1873         break;
1874       case Hash_key_type_STRING:
1875       case Hash_key_type_STRING_enc:
1876         ret = Parrot_str_to_int(interp, (STRING *)key);
1877         break;
1878       default:
1879         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1880                     "Hash: unsupported key_type");
1881     }
1882     return ret;
1883 }
1884
1885 /*
1886
1887 =item C<STRING* hash_key_to_string(PARROT_INTERP, const Hash *hash, void *key)>
1888
1889 Cast hash key to STRING.
1890
1891 =cut
1892
1893 */
1894
1895 PARROT_CANNOT_RETURN_NULL
1896 STRING*
1897 hash_key_to_string(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *key))
1898 {
1899     ASSERT_ARGS(hash_key_to_string)
1900     STRING *ret;
1901     switch (hash->key_type) {
1902       case Hash_key_type_int:
1903         ret = Parrot_str_from_int(interp, (INTVAL)key);
1904         break;
1905
1906       case Hash_key_type_PMC:
1907       case Hash_key_type_PMC_ptr:
1908         ret = VTABLE_get_string(interp, (PMC *)key);
1909         break;
1910
1911       case Hash_key_type_STRING:
1912       case Hash_key_type_STRING_enc:
1913         ret = (STRING *)key;
1914         break;
1915
1916       default:
1917         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1918                     "Hash: unsupported key_type");
1919     }
1920     return ret;
1921 }
1922
1923 /*
1924
1925 =item C<PMC* hash_key_to_pmc(PARROT_INTERP, const Hash * const hash, void *key)>
1926
1927 Cast hash key to PMC*.
1928
1929 =cut
1930
1931 */
1932
1933 PARROT_CANNOT_RETURN_NULL
1934 PMC*
1935 hash_key_to_pmc(PARROT_INTERP, ARGIN(const Hash * const hash), ARGIN(void *key))
1936 {
1937     ASSERT_ARGS(hash_key_to_pmc)
1938     PMC *ret;
1939     switch (hash->key_type) {
1940       case Hash_key_type_int:
1941         ret = get_integer_pmc(interp, (INTVAL)key);
1942         break;
1943       case Hash_key_type_PMC:
1944       case Hash_key_type_PMC_ptr:
1945         ret = (PMC*)key;
1946         break;
1947       case Hash_key_type_STRING:
1948       case Hash_key_type_STRING_enc:
1949         ret = get_string_pmc(interp, (STRING*)key);
1950         break;
1951       default:
1952         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1953                     "Hash: unsupported key_type");
1954     }
1955     return ret;
1956 }
1957
1958 /* Second part - convert from stored void* to real type */
1959 /* TODO: FLOATVALs converted into Float PMC for now */
1960
1961 /*
1962
1963 =item C<void* hash_value_from_int(PARROT_INTERP, const Hash *hash, INTVAL
1964 value)>
1965
1966 Cast INTVAL to hash value.
1967
1968 =cut
1969
1970 */
1971
1972 PARROT_CAN_RETURN_NULL
1973 void*
1974 hash_value_from_int(PARROT_INTERP, ARGIN(const Hash *hash), INTVAL value)
1975 {
1976     ASSERT_ARGS(hash_value_from_int)
1977     void *ret;
1978     switch (hash->entry_type) {
1979       case enum_type_INTVAL:
1980         ret = INTVAL2PTR(void *, value);
1981         break;
1982       case enum_type_PMC:
1983         {
1984             PMC * const tmp = get_integer_pmc(interp, value);
1985             ret = (void *)tmp;
1986         }
1987         break;
1988       case enum_type_STRING:
1989         ret = (void *)Parrot_str_from_int(interp, value);
1990         break;
1991       default:
1992         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1993                     "Hash: unsupported entry_type");
1994     }
1995     return ret;
1996 }
1997
1998 /*
1999
2000 =item C<void* hash_value_from_string(PARROT_INTERP, const Hash *hash, STRING
2001 *value)>
2002
2003 Cast STRING to hash value.
2004
2005 =cut
2006
2007 */
2008
2009 PARROT_CAN_RETURN_NULL
2010 void*
2011 hash_value_from_string(PARROT_INTERP, ARGIN(const Hash *hash),
2012         ARGIN_NULLOK(STRING *value))
2013 {
2014     ASSERT_ARGS(hash_value_from_string)
2015     void *ret;
2016     switch (hash->entry_type) {
2017       case enum_type_INTVAL:
2018         {
2019             const INTVAL int_val = STRING_IS_NULL(value) ?
2020                     (INTVAL) 0 : Parrot_str_to_int(interp, value);
2021             ret = INTVAL2PTR(void *, int_val);
2022         }
2023         break;
2024       case enum_type_STRING:
2025         ret = (void *)value;
2026         break;
2027       case enum_type_PMC:
2028         {
2029             PMC * const s = STRING_IS_NULL(value) ?
2030                    PMCNULL : get_string_pmc(interp, value);
2031             ret = (void *)s;
2032         }
2033         break;
2034       default:
2035         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2036                     "Hash: unsupported entry_type");
2037     }
2038     return ret;
2039 }
2040
2041 /*
2042
2043 =item C<void* hash_value_from_pmc(PARROT_INTERP, const Hash *hash, PMC *value)>
2044
2045 Cast PMC to hash value.
2046
2047 =cut
2048
2049 */
2050
2051 PARROT_CAN_RETURN_NULL
2052 void*
2053 hash_value_from_pmc(PARROT_INTERP, ARGIN(const Hash *hash),
2054     ARGIN_NULLOK(PMC *value))
2055 {
2056     ASSERT_ARGS(hash_value_from_pmc)
2057     void *ret;
2058     switch (hash->entry_type) {
2059       case enum_type_INTVAL:
2060         {
2061             const INTVAL int_val = PMC_IS_NULL(value) ?
2062                     (INTVAL) 0 : VTABLE_get_integer(interp, value);
2063             ret                  = INTVAL2PTR(void *, int_val);
2064         }
2065         break;
2066       case enum_type_STRING:
2067         ret = PMC_IS_NULL(value) ?
2068                 PMCNULL : (void *)VTABLE_get_string(interp, value);
2069         break;
2070       case enum_type_PMC:
2071         ret = (void *)value;
2072         break;
2073       default:
2074         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2075                     "Hash: unsupported entry_type");
2076     }
2077     return ret;
2078 }
2079
2080 /*
2081
2082 =item C<void* hash_value_from_number(PARROT_INTERP, const Hash *hash, FLOATVAL
2083 value)>
2084
2085 Cast FLOATVAL to hash value.
2086
2087 =cut
2088
2089 */
2090
2091 PARROT_CAN_RETURN_NULL
2092 void*
2093 hash_value_from_number(PARROT_INTERP, ARGIN(const Hash *hash), FLOATVAL value)
2094 {
2095     ASSERT_ARGS(hash_value_from_number)
2096     void *ret;
2097     switch (hash->entry_type) {
2098       case enum_type_INTVAL:
2099         {
2100             const INTVAL tmp = value;
2101             ret = (void*)tmp;
2102         }
2103         break;
2104       case enum_type_STRING:
2105         ret = (void *)Parrot_str_from_num(interp, value);
2106         break;
2107       case enum_type_PMC:
2108         {
2109             PMC * const tmp = get_number_pmc(interp, value);
2110             ret = (void *)tmp;
2111         }
2112         break;
2113       default:
2114         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2115                     "Hash: unsupported entry_type");
2116     }
2117     return ret;
2118 }
2119
2120 /*
2121
2122 =item C<INTVAL hash_value_to_int(PARROT_INTERP, const Hash *hash, void *value)>
2123
2124 Cast hash value to INTVAL.
2125
2126 =cut
2127
2128 */
2129
2130 INTVAL
2131 hash_value_to_int(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *value))
2132 {
2133     ASSERT_ARGS(hash_value_to_int)
2134     INTVAL ret;
2135     switch (hash->entry_type) {
2136       case enum_type_ptr:
2137       case enum_type_INTVAL:
2138         ret = (INTVAL)value;
2139         break;
2140       case enum_type_STRING:
2141         ret = Parrot_str_to_int(interp, (STRING*)value);
2142         break;
2143       case enum_type_PMC:
2144         ret = VTABLE_get_integer(interp, (PMC*)value);
2145         break;
2146       default:
2147         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2148                     "Hash: unsupported entry_type");
2149     }
2150     return ret;
2151 }
2152
2153 /*
2154
2155 =item C<STRING* hash_value_to_string(PARROT_INTERP, const Hash *hash, void
2156 *value)>
2157
2158 Cast hash value to STRING.
2159
2160 =cut
2161
2162 */
2163
2164 PARROT_CANNOT_RETURN_NULL
2165 STRING*
2166 hash_value_to_string(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *value))
2167 {
2168     ASSERT_ARGS(hash_value_to_string)
2169     STRING *ret;
2170     switch (hash->entry_type) {
2171       case enum_type_INTVAL:
2172         ret = Parrot_str_from_int(interp, (INTVAL)value);
2173         break;
2174       case enum_type_STRING:
2175         ret = (STRING *)value;
2176         break;
2177       case enum_type_PMC:
2178         ret = VTABLE_get_string(interp, (PMC *)value);
2179         break;
2180       default:
2181         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2182                     "Hash: unsupported entry_type");
2183     }
2184     return ret;
2185 }
2186
2187 /*
2188
2189 =item C<PMC* hash_value_to_pmc(PARROT_INTERP, const Hash *hash, void *value)>
2190
2191 Cast hash value to PMC.
2192
2193 =cut
2194
2195 */
2196
2197 PARROT_CANNOT_RETURN_NULL
2198 PMC*
2199 hash_value_to_pmc(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *value))
2200 {
2201     ASSERT_ARGS(hash_value_to_pmc)
2202     PMC *ret;
2203     switch (hash->entry_type) {
2204       case enum_type_INTVAL:
2205         ret = get_integer_pmc(interp, (INTVAL)value);
2206         break;
2207       case enum_type_STRING:
2208         ret = get_string_pmc(interp, (STRING*)value);
2209         break;
2210       case enum_type_PMC:
2211         ret = (PMC *)value;
2212         break;
2213       default:
2214         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2215                     "Hash: unsupported entry_type");
2216     }
2217     return ret;
2218 }
2219
2220 /*
2221
2222 =item C<FLOATVAL hash_value_to_number(PARROT_INTERP, const Hash *hash, void
2223 *value)>
2224
2225 Cast hash value to FLOATVAL.
2226
2227 =cut
2228
2229 */
2230
2231 FLOATVAL
2232 hash_value_to_number(PARROT_INTERP, ARGIN(const Hash *hash), ARGIN_NULLOK(void *value))
2233 {
2234     ASSERT_ARGS(hash_value_to_number)
2235     FLOATVAL ret;
2236     switch (hash->entry_type) {
2237       case enum_type_INTVAL:
2238         {
2239             /* Pacify compiler about casting */
2240             const INTVAL tmp = (INTVAL)value;
2241             ret = tmp;
2242         }
2243         break;
2244       case enum_type_STRING:
2245         ret = Parrot_str_to_num(interp, (STRING*)value);
2246         break;
2247       case enum_type_PMC:
2248         ret = VTABLE_get_number(interp, (PMC*)value);
2249         break;
2250       default:
2251         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
2252                     "Hash: unsupported entry_type");
2253     }
2254     return ret;
2255 }
2256
2257 /*
2258
2259 =back
2260
2261 =head1 SEE ALSO
2262
2263 F<docs/pdds/pdd08_keys.pod>.
2264
2265 =head1 TODO
2266
2267 Future optimizations:
2268
2269 =over 4
2270
2271 =item * Stop reallocating the bucket pool, and instead add chunks on.
2272 (Saves pointer fixups and copying during C<realloc>.)
2273
2274 =item * Hash contraction (don't if it's worth it)
2275
2276 =back
2277
2278 =cut
2279
2280 */
2281
2282
2283 /*
2284  * Local variables:
2285  *   c-file-style: "parrot"
2286  * End:
2287  * vim: expandtab shiftwidth=4:
2288  */