avoid thread swap in checking scope-propagation cache

Continuing with 2f25a1e2bd...

On further reflection, a GC is possible because a
thread swap is possible, and that's asking for trouble.
Disallow thread swaps (and, incidentally, GCs) whle
comparing scope propagations from the cache.

Merge to v6.3
This commit is contained in:
Matthew Flatt 2015-10-30 21:40:22 -04:00
parent 2f25a1e2bd
commit 352a5dd2d5
3 changed files with 30 additions and 7 deletions

View File

@ -2950,6 +2950,16 @@ static int hamt_equal_entries(int stype, void *eql_data,
#define HAMT_USE_FUEL(n) /* empty */
#include "hamt_subset.inc"
/* fast variant for eq-based dictionaries, where values are compared with `eq?` */
#define HAMT_NONGCING XFORM_NONGCING
#define HAMT_SUBSET_OF hamt_eq_subset_match_of
#define HAMT_ELEMENT_OF hamt_eq_element_match_of
#define HAMT_ELEMENT_OF_COLLISION hamt_eq_element_match_of_collision
#define HAMT_EQUAL_ENTRIES(stype, eql_data, k1, v1, k2, v2) (SAME_OBJ(k1, k2) && SAME_OBJ(v1, v2))
#define HAMT_IF_VAL(v, n) n
#define HAMT_USE_FUEL(n) /* empty */
#include "hamt_subset.inc"
static uintptr_t hamt_combine_key_hashes(Scheme_Hash_Tree *ht)
{
int popcount, i;
@ -3030,6 +3040,18 @@ int scheme_eq_hash_tree_subset_of(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2)
return hamt_eq_subset_of(t1, t2, 0, scheme_eq_hash_tree_type, NULL);
}
int scheme_eq_hash_tree_subset_match_of(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2)
/* assumes that `t1` and `t2` are sets, as opposed to maps */
{
t1 = resolve_placeholder(t1);
t2 = resolve_placeholder(t2);
if (t1->count > t2->count)
return 0;
return hamt_eq_subset_match_of(t1, t2, 0, scheme_eq_hash_tree_type, NULL);
}
intptr_t scheme_hash_tree_key_hash(Scheme_Hash_Tree *ht)
{
ht = resolve_placeholder(ht);

View File

@ -4236,6 +4236,7 @@ void scheme_hash_tree_tie_placeholder(Scheme_Hash_Tree *t, Scheme_Hash_Tree *bas
XFORM_NONGCING Scheme_Hash_Tree *scheme_hash_tree_resolve_placeholder(Scheme_Hash_Tree *t);
int scheme_hash_tree_kind(Scheme_Hash_Tree *t);
XFORM_NONGCING int scheme_eq_hash_tree_subset_of(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
XFORM_NONGCING int scheme_eq_hash_tree_subset_match_of(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
intptr_t scheme_hash_tree_key_hash(Scheme_Hash_Tree *t1);
void scheme_set_root_param(int p, Scheme_Object *v);

View File

@ -772,11 +772,11 @@ static int scopes_equal(Scheme_Scope_Set *a, Scheme_Scope_Set *b)
return (scope_set_count(a) == scope_set_count(b)) && scope_subset(a, b);
}
static int scope_props_equal(Scheme_Scope_Set *a, Scheme_Scope_Set *b)
XFORM_NONGCING static int scope_props_equal(Scheme_Scope_Set *a, Scheme_Scope_Set *b)
{
return scheme_hash_tree_equal_rec((Scheme_Hash_Tree *)a, (Scheme_Object *)a,
(Scheme_Hash_Tree *)b, (Scheme_Object *)b,
NULL);
return ((scope_set_count(a) == scope_set_count(b))
&& scheme_eq_hash_tree_subset_match_of((Scheme_Hash_Tree *)a,
(Scheme_Hash_Tree *)b));
}
static Scheme_Object *make_fallback_pair(Scheme_Object *a, Scheme_Object *b)
@ -1798,7 +1798,7 @@ int stx_shorts, stx_meds, stx_longs, stx_couldas;
# define COUNT_PROPAGATES(x) /* empty */
#endif
static void intern_scope_set(Scheme_Scope_Table *t, int prop_table)
XFORM_NONGCING static void intern_scope_set(Scheme_Scope_Table *t, int prop_table)
/* We don't realy intern, but approximate interning by checking
against a small set of recently allocated scope sets. That's good
enough to find sharing for a deeply nested sequence of `let`s from
@ -1818,8 +1818,8 @@ static void intern_scope_set(Scheme_Scope_Table *t, int prop_table)
if (s) {
if (s == t->simple_scopes)
return;
if (scopes_equal(s, t->simple_scopes)
&& (!prop_table || scope_props_equal(s, t->simple_scopes))) {
if ((!prop_table && scopes_equal(s, t->simple_scopes))
|| (prop_table && scope_props_equal(s, t->simple_scopes))) {
t->simple_scopes = s;
return;
}