diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index cc00f5b42d..3658e6c5dc 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -193,6 +193,8 @@ scheme_make_hash_table_equal scheme_hash_set scheme_hash_get scheme_eq_hash_get +scheme_hash_set_atomic +scheme_hash_get_atomic scheme_hash_table_equal scheme_is_hash_table_equal scheme_clone_hash_table diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index 4e0e107397..39444cf9d7 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -200,6 +200,8 @@ scheme_make_hash_table_equal scheme_hash_set scheme_hash_get scheme_eq_hash_get +scheme_hash_set_atomic +scheme_hash_get_atomic scheme_hash_table_equal scheme_is_hash_table_equal scheme_clone_hash_table diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index a1dff25748..20da038312 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -181,6 +181,8 @@ EXPORTS scheme_hash_set scheme_hash_get scheme_eq_hash_get + scheme_hash_set_atomic + scheme_hash_get_atomic scheme_hash_table_equal scheme_is_hash_table_equal scheme_clone_hash_table diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 3cd3814de2..2afb3f6e96 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -192,6 +192,8 @@ EXPORTS scheme_hash_set scheme_hash_get scheme_eq_hash_get + scheme_hash_set_atomic + scheme_hash_get_atomic scheme_hash_table_equal scheme_is_hash_table_equal scheme_clone_hash_table diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index f3a6084d4c..a15a13e305 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -1356,7 +1356,6 @@ static Scheme_Object *make_toplevel(mzshort depth, int position, int resolved, i { Scheme_Toplevel *tl; Scheme_Object *v, *pr; - Scheme_Hash_Table *tl_ht; /* Important: non-resolved can't be cached, because the ISCONST field is modified to track mutated module-level variables. But @@ -1373,10 +1372,7 @@ static Scheme_Object *make_toplevel(mzshort depth, int position, int resolved, i scheme_make_integer(flags)) : scheme_make_integer(position)); pr = scheme_make_pair(scheme_make_integer(depth), pr); - tl_ht = toplevels_ht; - scheme_wait_sema(tl_ht->mutex, 0); - v = scheme_hash_get(tl_ht, pr); - scheme_post_sema(tl_ht->mutex); + v = scheme_hash_get_atomic(toplevels_ht, pr); if (v) return v; } else @@ -1392,10 +1388,7 @@ static Scheme_Object *make_toplevel(mzshort depth, int position, int resolved, i if (toplevels_ht->count > TABLE_CACHE_MAX_SIZE) { toplevels_ht = scheme_make_hash_table_equal(); } - tl_ht = toplevels_ht; - scheme_wait_sema(tl_ht->mutex, 0); - scheme_hash_set(tl_ht, pr, (Scheme_Object *)tl); - scheme_post_sema(tl_ht->mutex); + scheme_hash_set_atomic(toplevels_ht, pr, (Scheme_Object *)tl); } return (Scheme_Object *)tl; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 5db8733007..a5a1ed57b7 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -5460,10 +5460,14 @@ MZ_MARK_STACK_TYPE scheme_set_cont_mark(Scheme_Object *key, Scheme_Object *val) if (!cm) { /* Allocate a new mark record: */ - long segpos = ((long)MZ_CONT_MARK_STACK) >> SCHEME_LOG_MARK_SEGMENT_SIZE; - long pos = ((long)MZ_CONT_MARK_STACK) & SCHEME_MARK_SEGMENT_MASK; + long segpos; + long pos; Scheme_Cont_Mark *seg; + findpos = MZ_CONT_MARK_STACK; + segpos = ((long)findpos) >> SCHEME_LOG_MARK_SEGMENT_SIZE; + pos = ((long)findpos) & SCHEME_MARK_SEGMENT_MASK; + if (segpos >= p->cont_mark_seg_count) { /* Need a new segment */ return new_segment_set_mark(segpos, pos, key, val); @@ -5471,8 +5475,7 @@ MZ_MARK_STACK_TYPE scheme_set_cont_mark(Scheme_Object *key, Scheme_Object *val) seg = p->cont_mark_stack_segments[segpos]; cm = seg + pos; - findpos = MZ_CONT_MARK_STACK; - MZ_CONT_MARK_STACK++; + MZ_CONT_MARK_STACK = findpos + 1; } cm->key = key; diff --git a/src/mzscheme/src/hash.c b/src/mzscheme/src/hash.c index c83349b4bd..c4444d063e 100644 --- a/src/mzscheme/src/hash.c +++ b/src/mzscheme/src/hash.c @@ -377,6 +377,27 @@ Scheme_Object *scheme_eq_hash_get(Scheme_Hash_Table *table, Scheme_Object *key) return do_hash_get(table, key); } +Scheme_Object *scheme_hash_get_atomic(Scheme_Hash_Table *table, Scheme_Object *key) +/* Mostly useful for acessing equal-based hash table when you don't want + thread switches (such as in stx object manipulations). Simply grabbing the + table's lock would be enough to make access to the table single-threaded, + but sometimes you don't want any thread switches at all. */ +{ + Scheme_Object *r; + scheme_start_atomic(); + r = scheme_hash_get(table, key); + scheme_end_atomic_no_swap(); + return r; +} + +void scheme_hash_set_atomic(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val) +/* See rationale with scheme_hash_get_atomic. */ +{ + scheme_start_atomic(); + scheme_hash_set(table, key, val); + scheme_end_atomic_no_swap(); +} + int scheme_hash_table_equal(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2) { Scheme_Object **vals, **keys, *v; diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 585899b05d..bf745bf346 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -399,6 +399,8 @@ MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table_equal(); MZ_EXTERN void scheme_hash_set(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val); MZ_EXTERN Scheme_Object *scheme_hash_get(Scheme_Hash_Table *table, Scheme_Object *key); XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_get(Scheme_Hash_Table *table, Scheme_Object *key); +MZ_EXTERN void scheme_hash_set_atomic(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val); +MZ_EXTERN Scheme_Object *scheme_hash_get_atomic(Scheme_Hash_Table *table, Scheme_Object *key); MZ_EXTERN int scheme_hash_table_equal(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2); MZ_EXTERN int scheme_is_hash_table_equal(Scheme_Object *o); MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *bt); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index df715a3b2c..265cac2461 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -324,6 +324,8 @@ Scheme_Hash_Table *(*scheme_make_hash_table_equal)(); void (*scheme_hash_set)(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val); Scheme_Object *(*scheme_hash_get)(Scheme_Hash_Table *table, Scheme_Object *key); Scheme_Object *(*scheme_eq_hash_get)(Scheme_Hash_Table *table, Scheme_Object *key); +void (*scheme_hash_set_atomic)(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val); +Scheme_Object *(*scheme_hash_get_atomic)(Scheme_Hash_Table *table, Scheme_Object *key); int (*scheme_hash_table_equal)(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2); int (*scheme_is_hash_table_equal)(Scheme_Object *o); Scheme_Hash_Table *(*scheme_clone_hash_table)(Scheme_Hash_Table *bt); diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index f0a70176fc..aa80969783 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -221,6 +221,8 @@ scheme_extension_table->scheme_hash_set = scheme_hash_set; scheme_extension_table->scheme_hash_get = scheme_hash_get; scheme_extension_table->scheme_eq_hash_get = scheme_eq_hash_get; + scheme_extension_table->scheme_hash_set_atomic = scheme_hash_set_atomic; + scheme_extension_table->scheme_hash_get_atomic = scheme_hash_get_atomic; scheme_extension_table->scheme_hash_table_equal = scheme_hash_table_equal; scheme_extension_table->scheme_is_hash_table_equal = scheme_is_hash_table_equal; scheme_extension_table->scheme_clone_hash_table = scheme_clone_hash_table; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index eaffe40eb6..e03c9018b1 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -221,6 +221,8 @@ #define scheme_hash_set (scheme_extension_table->scheme_hash_set) #define scheme_hash_get (scheme_extension_table->scheme_hash_get) #define scheme_eq_hash_get (scheme_extension_table->scheme_eq_hash_get) +#define scheme_hash_set_atomic (scheme_extension_table->scheme_hash_set_atomic) +#define scheme_hash_get_atomic (scheme_extension_table->scheme_hash_get_atomic) #define scheme_hash_table_equal (scheme_extension_table->scheme_hash_table_equal) #define scheme_is_hash_table_equal (scheme_extension_table->scheme_is_hash_table_equal) #define scheme_clone_hash_table (scheme_extension_table->scheme_clone_hash_table) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 1302c2a3f2..33194897bd 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -1905,7 +1905,7 @@ static void make_mapped(Scheme_Cert *cert) pr = scheme_make_pair(cert->mark, cert->key); else pr = cert->mark; - scheme_hash_set(ht, pr, scheme_true); + scheme_hash_set_atomic(ht, pr, scheme_true); } } @@ -1924,7 +1924,7 @@ static int cert_in_chain(Scheme_Object *mark, Scheme_Object *key, Scheme_Cert *c if (!hkey) hkey = scheme_make_pair(mark, key); - if (scheme_hash_get(ht, hkey)) + if (scheme_hash_get_atomic(ht, hkey)) return 1; } else if (SAME_OBJ(cert->mark, mark) && SAME_OBJ(cert->key, key)) {