make some internal equal-based hash table accesses atomic, just in case

svn: r5524

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

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

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

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

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;
+    v = scheme_hash_get_atomic(toplevels_ht, pr);
-    scheme_wait_sema(tl_ht->mutex, 0);
-    v = scheme_hash_get(tl_ht, pr);
-    scheme_post_sema(tl_ht->mutex);
     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_hash_set_atomic(toplevels_ht, pr, (Scheme_Object *)tl);
-    scheme_wait_sema(tl_ht->mutex, 0);
-    scheme_hash_set(tl_ht, pr, (Scheme_Object *)tl);
-    scheme_post_sema(tl_ht->mutex);
   }
 
   return (Scheme_Object *)tl;

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 segpos;
-    long pos = ((long)MZ_CONT_MARK_STACK) & SCHEME_MARK_SEGMENT_MASK;
+    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 = findpos + 1;
-    MZ_CONT_MARK_STACK++;
   }
 
   cm->key = key;

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;

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);

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);

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;

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)

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)) {