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

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

Browse Source 
svn: r5524
This commit is contained in:
Matthew Flatt 2007-02-01 01:37:25 +00:00
parent b6f6cf588b
commit ed07c57367
12 changed files with 48 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mzscheme/include/mzscheme.exp
View File

@ -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

2
src/mzscheme/include/mzscheme3m.exp
View File

@ -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

2
src/mzscheme/include/mzwin.def
View File

@ -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

2
src/mzscheme/include/mzwin3m.def
View File

@ -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

11
src/mzscheme/src/env.c
View File

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

11
src/mzscheme/src/eval.c
View File

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

21
src/mzscheme/src/hash.c
View File

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

2
src/mzscheme/src/schemef.h
View File

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

2
src/mzscheme/src/schemex.h
View File

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

2
src/mzscheme/src/schemex.inc
View File

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

2
src/mzscheme/src/schemexm.h
View File

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

4
src/mzscheme/src/stxobj.c
View File

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