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