From 0f96a6634b347f44c6d77d765bb0e499c5dae733 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 10 Jun 2013 21:04:06 -0700 Subject: [PATCH] fix `hash-copy' on weak hash tables Closes PR 13838 --- collects/tests/racket/basic.rktl | 19 ++++ src/racket/src/hash.c | 156 ++++++++++++++++++------------- 2 files changed, 109 insertions(+), 66 deletions(-) diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl index 544403a67a..877099314a 100644 --- a/collects/tests/racket/basic.rktl +++ b/collects/tests/racket/basic.rktl @@ -2231,6 +2231,25 @@ (check-hash-tables #t #f) (check-hash-tables #t #t) #t)) + + ;; Make sure copy doesn't share: + (for ([make-hash (list make-hash + make-weak-hash)]) + (when make-hash + (define c1 (make-hash)) + (hash-set! c1 'the-key1 'the-val1) + (hash-set! c1 'the-key2 'the-val2) + (hash-set! c1 'the-key3 'the-val3) + (hash-set! c1 'the-key4 'the-val4) + (define c2 (hash-copy c1)) + (hash-set! c1 'the-key3 'the-val5) + (hash-set! c2 'the-key4 'the-val6) + (hash-remove! c1 'the-key1) + (hash-remove! c2 'the-key2) + (test 'the-val1 hash-ref c2 'the-key1) + (test 'the-val2 hash-ref c1 'the-key2) + (test 'the-val3 hash-ref c2 'the-key3) + (test 'the-val4 hash-ref c1 'the-key4))) (save)) ; prevents gcing of the ht-registered values diff --git a/src/racket/src/hash.c b/src/racket/src/hash.c index c25a47ee53..394e3bb13f 100644 --- a/src/racket/src/hash.c +++ b/src/racket/src/hash.c @@ -578,33 +578,52 @@ scheme_make_bucket_table (intptr_t size, int type) return table; } -Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt) +static Scheme_Bucket * +allocate_bucket (Scheme_Bucket_Table *table, const char *key, void *val) { - Scheme_Bucket_Table *table; - size_t asize; + size_t bsize; + Scheme_Type type; + Scheme_Bucket *bucket; - table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); - table->so.type = scheme_bucket_table_type; - table->size = bt->size; - table->count = bt->count; - table->weak = bt->weak; - table->with_home = 0; - table->make_hash_indices = bt->make_hash_indices; - table->compare = bt->compare; - if (bt->mutex) { - Scheme_Object *sema; - sema = scheme_make_sema(1); - table->mutex = sema; - } - { - Scheme_Bucket **ba; - asize = (size_t)table->size * sizeof(Scheme_Bucket *); - ba = (Scheme_Bucket **)scheme_malloc(asize); - table->buckets = ba; - memcpy(ba, bt->buckets, asize); + if (table->with_home) { + bsize = sizeof(Scheme_Bucket_With_Home); + type = scheme_variable_type; + } else { + bsize = sizeof(Scheme_Bucket); + type = scheme_bucket_type; } - return table; + bucket = (Scheme_Bucket *)scheme_malloc_tagged(bsize); + + bucket->so.type = type; + + if (type == scheme_variable_type) + ((Scheme_Bucket_With_Flags *)bucket)->flags = GLOB_HAS_HOME_PTR; + + if (table->weak) { +#ifdef MZ_PRECISE_GC + void *kb; + kb = GC_malloc_weak_box((void *)key, (void **)bucket, (void **)&bucket->val - (void **)bucket, + (table->weak > 1)); + bucket->key = (char *)kb; +#else + char *kb; + kb = (char *)MALLOC_ONE_WEAK(void *); + bucket->key = kb; + *(void **)bucket->key = (void *)key; + if (table->weak > 1) { + scheme_late_weak_reference_indirect((void **)bucket->key, (void *)key); + scheme_late_weak_reference_indirect((void **)&bucket->val, (void *)key); + } else { + scheme_weak_reference_indirect((void **)bucket->key, (void *)key); + scheme_weak_reference_indirect((void **)&bucket->val, (void *)key); + } +#endif + } else + bucket->key = (char *)key; + bucket->val = val; + + return bucket; } static Scheme_Bucket * @@ -724,50 +743,10 @@ get_bucket (Scheme_Bucket_Table *table, const char *key, int add, Scheme_Bucket goto rehash_key; } - if (b) { + if (b) bucket = b; - } else { - size_t bsize; - Scheme_Type type; - - if (table->with_home) { - bsize = sizeof(Scheme_Bucket_With_Home); - type = scheme_variable_type; - } else { - bsize = sizeof(Scheme_Bucket); - type = scheme_bucket_type; - } - - bucket = (Scheme_Bucket *)scheme_malloc_tagged(bsize); - - bucket->so.type = type; - - if (type == scheme_variable_type) - ((Scheme_Bucket_With_Flags *)bucket)->flags = GLOB_HAS_HOME_PTR; - - if (table->weak) { -#ifdef MZ_PRECISE_GC - void *kb; - kb = GC_malloc_weak_box((void *)key, (void **)bucket, (void **)&bucket->val - (void **)bucket, - (table->weak > 1)); - bucket->key = (char *)kb; -#else - char *kb; - kb = (char *)MALLOC_ONE_WEAK(void *); - bucket->key = kb; - *(void **)bucket->key = (void *)key; - if (table->weak > 1) { - scheme_late_weak_reference_indirect((void **)bucket->key, (void *)key); - scheme_late_weak_reference_indirect((void **)&bucket->val, (void *)key); - } else { - scheme_weak_reference_indirect((void **)bucket->key, (void *)key); - scheme_weak_reference_indirect((void **)&bucket->val, (void *)key); - } -#endif - } else - bucket->key = (char *)key; - bucket->val = NULL; - } + else + bucket = allocate_bucket(table, key, NULL); table->buckets[h] = bucket; @@ -903,6 +882,51 @@ int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2) return scheme_equal((Scheme_Object *)t1, (Scheme_Object *)t2); } +Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt) +{ + Scheme_Bucket_Table *table; + size_t asize; + + table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); + table->so.type = scheme_bucket_table_type; + table->size = bt->size; + table->count = bt->count; + table->weak = bt->weak; + table->with_home = 0; + table->make_hash_indices = bt->make_hash_indices; + table->compare = bt->compare; + if (bt->mutex) { + Scheme_Object *sema; + sema = scheme_make_sema(1); + table->mutex = sema; + } + { + Scheme_Bucket **ba, *bucket; + int i; + asize = (size_t)table->size * sizeof(Scheme_Bucket *); + ba = (Scheme_Bucket **)scheme_malloc(asize); + table->buckets = ba; + memcpy(ba, bt->buckets, asize); + /* clone individual buckets */ + for (i = table->size; i--; ) { + bucket = ba[i]; + if (bucket) { + if (bucket->key) { + if (table->weak) { + void *hk = (void *)HT_EXTRACT_WEAK(bucket->key); + if (hk) + bucket = allocate_bucket(table, hk, bucket->val); + } else + bucket = allocate_bucket(table, bucket->key, bucket->val); + ba[i] = bucket; + } + } + } + } + + return table; +} + /*========================================================================*/ /* precise GC hashing */ /*========================================================================*/