suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

restore needed forcing of hash codes

Browse Source
This commit is contained in:
Matthew Flatt 2011-04-20 08:21:10 -06:00
parent 82e6e9d19e
commit 714df5598c
1 changed files with 81 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
src/racket/src/places.c
View File

@ -38,7 +38,7 @@ static Scheme_Object *scheme_places_deep_copy_to_master(Scheme_Object *so);
/* Scheme_Object *scheme_places_deep_copy(Scheme_Object *so); */ /* Scheme_Object *scheme_places_deep_copy(Scheme_Object *so); */
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht); static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht, int copy);
#endif #endif
# ifdef MZ_PRECISE_GC # ifdef MZ_PRECISE_GC
@ -764,7 +764,7 @@ static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[])
Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) { Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) {
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
Scheme_Hash_Table *ht = NULL; Scheme_Hash_Table *ht = NULL;
return scheme_places_deep_copy_worker(so, &ht); return scheme_places_deep_copy_worker(so, &ht, 1);
#else #else
return so; return so;
#endif #endif
@ -799,7 +799,7 @@ static Scheme_Object *trivial_copy(Scheme_Object *so)
return NULL; return NULL;
} }
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht) Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht, int copy)
{ {
Scheme_Object *new_so = so; Scheme_Object *new_so = so;
int skip_hash; int skip_hash;
@ -825,7 +825,8 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
switch (SCHEME_TYPE(so)) { switch (SCHEME_TYPE(so)) {
case scheme_char_type: case scheme_char_type:
new_so = scheme_make_char(SCHEME_CHAR_VAL(so)); if (copy)
new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
break; break;
case scheme_rational_type: case scheme_rational_type:
{ {
@ -833,16 +834,19 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Object *d; Scheme_Object *d;
n = scheme_rational_numerator(so); n = scheme_rational_numerator(so);
d = scheme_rational_denominator(so); d = scheme_rational_denominator(so);
n = scheme_places_deep_copy_worker(n, ht); n = scheme_places_deep_copy_worker(n, ht, copy);
d = scheme_places_deep_copy_worker(d, ht); d = scheme_places_deep_copy_worker(d, ht, copy);
new_so = scheme_make_rational(n, d); if (copy)
new_so = scheme_make_rational(n, d);
} }
break; break;
case scheme_float_type: case scheme_float_type:
new_so = scheme_make_float(SCHEME_FLT_VAL(so)); if (copy)
new_so = scheme_make_float(SCHEME_FLT_VAL(so));
break; break;
case scheme_double_type: case scheme_double_type:
new_so = scheme_make_double(SCHEME_DBL_VAL(so)); if (copy)
new_so = scheme_make_double(SCHEME_DBL_VAL(so));
break; break;
case scheme_complex_type: case scheme_complex_type:
{ {
@ -850,32 +854,39 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Object *i; Scheme_Object *i;
r = scheme_complex_real_part(so); r = scheme_complex_real_part(so);
i = scheme_complex_imaginary_part(so); i = scheme_complex_imaginary_part(so);
r = scheme_places_deep_copy_worker(r, ht); r = scheme_places_deep_copy_worker(r, ht, copy);
i = scheme_places_deep_copy_worker(i, ht); i = scheme_places_deep_copy_worker(i, ht, copy);
new_so = scheme_make_complex(r, i); if (copy)
new_so = scheme_make_complex(r, i);
} }
break; break;
case scheme_char_string_type: case scheme_char_string_type:
new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1); if (copy)
new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1);
break; break;
case scheme_byte_string_type: case scheme_byte_string_type:
/* not allocated as shared, since that's covered above */ /* not allocated as shared, since that's covered above */
new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); if (copy)
new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
break; break;
case scheme_unix_path_type: case scheme_unix_path_type:
case scheme_windows_path_type: case scheme_windows_path_type:
new_so = scheme_make_sized_offset_kind_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1, if (copy)
SCHEME_TYPE(so)); new_so = scheme_make_sized_offset_kind_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1,
SCHEME_TYPE(so));
break; break;
case scheme_symbol_type: case scheme_symbol_type:
if (SCHEME_SYM_UNINTERNEDP(so)) { if (SCHEME_SYM_UNINTERNEDP(so)) {
bad_place_message(so); bad_place_message(so);
} else { } else {
new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1); if (copy) {
new_so->type = scheme_serialized_symbol_type; new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1);
new_so->type = scheme_serialized_symbol_type;
}
} }
break; break;
case scheme_serialized_symbol_type: case scheme_serialized_symbol_type:
if (copy)
new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so));
break; break;
case scheme_pair_type: case scheme_pair_type:
@ -885,16 +896,20 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Object *pair; Scheme_Object *pair;
/* handle cycles: */ /* handle cycles: */
pair = scheme_make_pair(scheme_false, scheme_false); if (copy)
pair = scheme_make_pair(scheme_false, scheme_false);
else
pair = so;
scheme_hash_set(*ht, so, pair); scheme_hash_set(*ht, so, pair);
skip_hash = 1; skip_hash = 1;
car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht); car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht, copy);
cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht); cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht, copy);
SCHEME_CAR(pair) = car; if (copy) {
SCHEME_CDR(pair) = cdr; SCHEME_CAR(pair) = car;
SCHEME_CDR(pair) = cdr;
new_so = pair; new_so = pair;
}
} }
break; break;
case scheme_vector_type: case scheme_vector_type:
@ -902,7 +917,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Object *vec; Scheme_Object *vec;
intptr_t i; intptr_t i;
intptr_t size = SCHEME_VEC_SIZE(so); intptr_t size = SCHEME_VEC_SIZE(so);
vec = scheme_make_vector(size, 0);
if (copy)
vec = scheme_make_vector(size, 0);
else
vec = so;
/* handle cycles: */ /* handle cycles: */
scheme_hash_set(*ht, so, vec); scheme_hash_set(*ht, so, vec);
@ -910,16 +929,19 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
for (i = 0; i <size ; i++) { for (i = 0; i <size ; i++) {
Scheme_Object *tmp; Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht); tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht, copy);
SCHEME_VEC_ELS(vec)[i] = tmp; if (copy)
SCHEME_VEC_ELS(vec)[i] = tmp;
}
if (copy) {
SCHEME_SET_IMMUTABLE(vec);
new_so = vec;
} }
SCHEME_SET_IMMUTABLE(vec);
new_so = vec;
} }
break; break;
case scheme_fxvector_type: case scheme_fxvector_type:
/* not allocated as shared, since that's covered above */ /* not allocated as shared, since that's covered above */
{ if (copy) {
Scheme_Vector *vec; Scheme_Vector *vec;
intptr_t i; intptr_t i;
intptr_t size = SCHEME_FXVEC_SIZE(so); intptr_t size = SCHEME_FXVEC_SIZE(so);
@ -933,7 +955,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
break; break;
case scheme_flvector_type: case scheme_flvector_type:
/* not allocated as shared, since that's covered above */ /* not allocated as shared, since that's covered above */
{ if (copy) {
Scheme_Double_Vector *vec; Scheme_Double_Vector *vec;
intptr_t i; intptr_t i;
intptr_t size = SCHEME_FLVEC_SIZE(so); intptr_t size = SCHEME_FLVEC_SIZE(so);
@ -964,19 +986,24 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
} }
} }
nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht); nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht, copy);
nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
if (copy) {
new_so = scheme_make_serialized_struct_instance(nprefab_key, size);
nst = (Scheme_Serialized_Structure*)new_so;
} else
nst = NULL;
/* handle cycles: */ /* handle cycles: */
scheme_hash_set(*ht, so, (Scheme_Object *)nst); scheme_hash_set(*ht, so, new_so);
skip_hash = 1; skip_hash = 1;
for (i = 0; i <size ; i++) { for (i = 0; i <size ; i++) {
Scheme_Object *tmp; Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht); tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht, copy);
nst->slots[i] = tmp; if (copy)
nst->slots[i] = tmp;
} }
new_so = (Scheme_Object*) nst;
} }
break; break;
@ -990,18 +1017,23 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
size = st->num_slots; size = st->num_slots;
stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size); stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
if (copy) {
new_so = scheme_make_blank_prefab_struct_instance(stype);
nst = (Scheme_Structure*)new_so;
} else
nst = NULL;
/* handle cycles: */ /* handle cycles: */
scheme_hash_set(*ht, so, (Scheme_Object *)nst); scheme_hash_set(*ht, so, new_so);
skip_hash = 1; skip_hash = 1;
for (i = 0; i <size ; i++) { for (i = 0; i <size ; i++) {
Scheme_Object *tmp; Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht); tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht, copy);
nst->slots[i] = tmp; if (copy)
nst->slots[i] = tmp;
} }
new_so = (Scheme_Object*)nst;
} }
break; break;
@ -1166,16 +1198,20 @@ Scheme_Object *scheme_places_deep_copy_to_master(Scheme_Object *so) {
Scheme_Object *o; Scheme_Object *o;
void *original_gc; void *original_gc;
/* forces hash codes: */
(void)scheme_places_deep_copy_worker(so, &ht, 0);
ht = NULL;
original_gc = GC_switch_to_master_gc(); original_gc = GC_switch_to_master_gc();
scheme_start_atomic(); scheme_start_atomic();
o = scheme_places_deep_copy_worker(so, &ht); o = scheme_places_deep_copy_worker(so, &ht, 1);
scheme_end_atomic_no_swap(); scheme_end_atomic_no_swap();
GC_switch_back_from_master(original_gc); GC_switch_back_from_master(original_gc);
return o; return o;
#else #else
return scheme_places_deep_copy_worker(so, &ht); return scheme_places_deep_copy_worker(so, &ht, 1);
#endif #endif
} }