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

speed up `hash-ref'

Browse Source 
by trimming the common-case path through a combination of small
 JIT and function changes
This commit is contained in:
Matthew Flatt 2011-07-06 13:39:12 -06:00
parent 36e3679854
commit 8f6fd7060f
12 changed files with 132 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/racket/include/mzwin.def
View File

@ -237,6 +237,7 @@ EXPORTS
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get
scheme_eq_hash_tree_get
scheme_hash_tree_next
scheme_hash_tree_index
scheme_hash_tree_equal

1
src/racket/include/mzwin3m.def
View File

@ -252,6 +252,7 @@ EXPORTS
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get
scheme_eq_hash_tree_get
scheme_hash_tree_next
scheme_hash_tree_index
scheme_hash_tree_equal

1
src/racket/include/racket.exp
View File

@ -254,6 +254,7 @@ scheme_clone_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get
scheme_eq_hash_tree_get
scheme_hash_tree_next
scheme_hash_tree_index
scheme_hash_tree_equal

1
src/racket/include/racket3m.exp
View File

@ -260,6 +260,7 @@ scheme_clone_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get
scheme_eq_hash_tree_get
scheme_hash_tree_next
scheme_hash_tree_index
scheme_hash_tree_equal

59
src/racket/src/hash.c
View File

@ -1812,7 +1812,7 @@ static RBNode *recolor_rb(int red, RBNode *rb)
rb->right);
}
static RBNode *rb_find(uintptr_t code, RBNode *s)
XFORM_NONGCING static RBNode *rb_find(uintptr_t code, RBNode *s)
{
while (1) {
if (!s)
@ -2411,6 +2411,31 @@ Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *ke
return tree2;
}
Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key)
{
uintptr_t h;
RBNode *rb;
h = PTR_TO_LONG((Scheme_Object *)key);
rb = rb_find(h, tree->root);
if (rb) {
if (!rb->key) {
/* Have list of keys & vals: */
Scheme_Object *prs = rb->val, *a;
while (prs) {
a = SCHEME_CAR(prs);
if (SAME_OBJ(SCHEME_CAR(a), key))
return SCHEME_CDR(a);
prs = SCHEME_CDR(prs);
}
} else
return rb->val;
}
return NULL;
}
Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key)
{
uintptr_t h;
@ -2423,7 +2448,7 @@ Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key)
else
h = to_unsigned_hash(scheme_eqv_hash_key(key));
} else {
h = PTR_TO_LONG((Scheme_Object *)key);
return scheme_eq_hash_tree_get(tree, key);
}
rb = rb_find(h, tree->root);
@ -2433,31 +2458,23 @@ Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key)
Scheme_Object *prs = rb->val, *a;
while (prs) {
a = SCHEME_CAR(prs);
if (kind) {
if (kind == 1) {
if (scheme_equal(SCHEME_CAR(a), key))
return SCHEME_CDR(a);
} else {
if (scheme_eqv(SCHEME_CAR(a), key))
return SCHEME_CDR(a);
}
if (kind == 1) {
if (scheme_equal(SCHEME_CAR(a), key))
return SCHEME_CDR(a);
} else {
if (SAME_OBJ(SCHEME_CAR(a), key))
if (scheme_eqv(SCHEME_CAR(a), key))
return SCHEME_CDR(a);
}
prs = SCHEME_CDR(prs);
}
} else {
if (kind) {
if (kind == 1) {
if (scheme_equal(key, rb->key))
return rb->val;
} else {
if (scheme_eqv(key, rb->key))
return rb->val;
}
} else if (SAME_OBJ(key, rb->key))
return rb->val;
if (kind == 1) {
if (scheme_equal(key, rb->key))
return rb->val;
} else {
if (scheme_eqv(key, rb->key))
return rb->val;
}
}
}

15
src/racket/src/jitcall.c
View File

@ -1258,6 +1258,20 @@ static int can_direct_native(Scheme_Object *p, int num_rands, intptr_t *extract_
return 0;
}
static int is_noncm_hash_ref(Scheme_Object *rator, int num_rands, Scheme_App_Rec *app)
{
/* hash-ref acts like a non-cm prim if there's no procedure 3rd argument */
if (SAME_OBJ(rator, scheme_hash_ref_proc) && ((num_rands == 2) || (num_rands == 3))) {
if (num_rands == 3) {
if ((SCHEME_TYPE(app->args[3]) < _scheme_values_types_)
|| SCHEME_PROCP(app->args[3]))
return 0;
}
return 1;
}
return 0;
}
static jit_direct_arg *check_special_direct_args(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_rands,
int args_already_in_place)
@ -1353,6 +1367,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
&& ((num_rands <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)
|| (((Scheme_Primitive_Proc *)rator)->mina < 0))
&& (scheme_is_noncm(rator, jitter, 0, 0)
|| is_noncm_hash_ref(rator, num_rands, app)
/* It's also ok to directly call `values' if multiple values are ok: */
|| (multi_ok && SAME_OBJ(rator, scheme_values_func))))
direct_prim = 1;

104
src/racket/src/list.c
View File

@ -33,6 +33,7 @@ READ_ONLY Scheme_Object *scheme_mcons_proc;
READ_ONLY Scheme_Object *scheme_list_proc;
READ_ONLY Scheme_Object *scheme_list_star_proc;
READ_ONLY Scheme_Object *scheme_box_proc;
READ_ONLY Scheme_Object *scheme_hash_ref_proc;
/* read only locals */
ROSYM static Scheme_Object *weak_symbol;
ROSYM static Scheme_Object *equal_symbol;
@ -582,11 +583,9 @@ scheme_init_list (Scheme_Env *env)
"hash-set",
3, 3),
env);
scheme_add_global_constant("hash-ref",
scheme_make_prim_w_arity(hash_table_get,
"hash-ref",
2, 3),
env);
REGISTER_SO(scheme_hash_ref_proc);
scheme_hash_ref_proc = scheme_make_prim_w_arity(hash_table_get, "hash-ref", 2, 3);
scheme_add_global_constant("hash-ref", scheme_hash_ref_proc, env);
scheme_add_global_constant("hash-remove!",
scheme_make_noncm_prim(hash_table_remove_bang,
"hash-remove!",
@ -2217,38 +2216,11 @@ static Scheme_Object *hash_table_put(int argc, Scheme_Object *argv[])
return (Scheme_Object *)scheme_hash_tree_set((Scheme_Hash_Tree *)v, argv[1], argv[2]);
}
static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[])
static Scheme_Object *hash_failed(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
v = argv[0];
if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v))))
v = scheme_chaperone_hash_get(v, argv[1]);
else if (SCHEME_BUCKTP(v)) {
Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)v;
if (t->mutex) scheme_wait_sema(t->mutex, 0);
v = (Scheme_Object *)scheme_lookup_in_table(t, (char *)argv[1]);
if (t->mutex) scheme_post_sema(t->mutex);
} else if (SCHEME_HASHTRP(v)) {
v = scheme_hash_tree_get((Scheme_Hash_Tree *)v, argv[1]);
} else if (!SCHEME_HASHTP(v)) {
scheme_wrong_type("hash-ref", "hash", 0, argc, argv);
return NULL;
} else if (((Scheme_Hash_Table *)v)->mutex) {
Scheme_Hash_Table *t = (Scheme_Hash_Table *)v;
scheme_wait_sema(t->mutex, 0);
v = scheme_hash_get(t, argv[1]);
scheme_post_sema(t->mutex);
} else {
v = scheme_hash_get((Scheme_Hash_Table *)v, argv[1]);
}
if (v)
return v;
else if (argc == 3) {
if (argc == 3) {
v = argv[2];
if (SCHEME_PROCP(v))
return _scheme_tail_apply(v, 0, NULL);
@ -2262,6 +2234,70 @@ static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[])
}
}
static Scheme_Object *gen_hash_table_get(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
v = argv[0];
if (SCHEME_HASHTP(v)) {
if (((Scheme_Hash_Table *)v)->mutex) {
Scheme_Hash_Table *t = (Scheme_Hash_Table *)v;
scheme_wait_sema(t->mutex, 0);
v = scheme_hash_get(t, argv[1]);
scheme_post_sema(t->mutex);
} else {
v = scheme_hash_get((Scheme_Hash_Table *)v, argv[1]);
}
} else if (SCHEME_HASHTRP(v)) {
v = scheme_hash_tree_get((Scheme_Hash_Tree *)v, argv[1]);
} else if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v))))
v = scheme_chaperone_hash_get(v, argv[1]);
else if (SCHEME_BUCKTP(v)) {
Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)v;
if (t->mutex) scheme_wait_sema(t->mutex, 0);
v = (Scheme_Object *)scheme_lookup_in_table(t, (char *)argv[1]);
if (t->mutex) scheme_post_sema(t->mutex);
} else {
scheme_wrong_type("hash-ref", "hash", 0, argc, argv);
return NULL;
}
if (v)
return v;
else
return hash_failed(argc, argv);
}
static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
/* fast path is designed to avoid need for XFORM */
v = argv[0];
if (SCHEME_HASHTP(v)) {
if (!((Scheme_Hash_Table *)v)->make_hash_indices) {
v = scheme_eq_hash_get((Scheme_Hash_Table *)v, argv[1]);
if (v)
return v;
else
return hash_failed(argc, argv);
}
} else if (SCHEME_HASHTRP(v)) {
if (!(SCHEME_HASHTR_FLAGS(((Scheme_Hash_Tree *)v)) & 0x3)) {
v = scheme_eq_hash_tree_get((Scheme_Hash_Tree *)v, argv[1]);
if (v)
return v;
else
return hash_failed(argc, argv);
}
}
return gen_hash_table_get(argc, argv);
}
static Scheme_Object *hash_table_remove_bang(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;

1
src/racket/src/schemef.h
View File

@ -487,6 +487,7 @@ MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *bt);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
MZ_EXTERN Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
MZ_EXTERN intptr_t scheme_hash_tree_next(Scheme_Hash_Tree *tree, intptr_t pos);
MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, intptr_t pos, Scheme_Object **_key, Scheme_Object **_val);
MZ_EXTERN int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);

1
src/racket/src/schemex.h
View File

@ -381,6 +381,7 @@ Scheme_Hash_Table *(*scheme_clone_hash_table)(Scheme_Hash_Table *bt);
Scheme_Hash_Tree *(*scheme_make_hash_tree)(int kind);
Scheme_Hash_Tree *(*scheme_hash_tree_set)(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
Scheme_Object *(*scheme_hash_tree_get)(Scheme_Hash_Tree *tree, Scheme_Object *key);
Scheme_Object *(*scheme_eq_hash_tree_get)(Scheme_Hash_Tree *tree, Scheme_Object *key);
intptr_t (*scheme_hash_tree_next)(Scheme_Hash_Tree *tree, intptr_t pos);
int (*scheme_hash_tree_index)(Scheme_Hash_Tree *tree, intptr_t pos, Scheme_Object **_key, Scheme_Object **_val);
int (*scheme_hash_tree_equal)(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);

1
src/racket/src/schemex.inc
View File

@ -285,6 +285,7 @@
scheme_extension_table->scheme_make_hash_tree = scheme_make_hash_tree;
scheme_extension_table->scheme_hash_tree_set = scheme_hash_tree_set;
scheme_extension_table->scheme_hash_tree_get = scheme_hash_tree_get;
scheme_extension_table->scheme_eq_hash_tree_get = scheme_eq_hash_tree_get;
scheme_extension_table->scheme_hash_tree_next = scheme_hash_tree_next;
scheme_extension_table->scheme_hash_tree_index = scheme_hash_tree_index;
scheme_extension_table->scheme_hash_tree_equal = scheme_hash_tree_equal;

1
src/racket/src/schemexm.h
View File

@ -285,6 +285,7 @@
#define scheme_make_hash_tree (scheme_extension_table->scheme_make_hash_tree)
#define scheme_hash_tree_set (scheme_extension_table->scheme_hash_tree_set)
#define scheme_hash_tree_get (scheme_extension_table->scheme_hash_tree_get)
#define scheme_eq_hash_tree_get (scheme_extension_table->scheme_eq_hash_tree_get)
#define scheme_hash_tree_next (scheme_extension_table->scheme_hash_tree_next)
#define scheme_hash_tree_index (scheme_extension_table->scheme_hash_tree_index)
#define scheme_hash_tree_equal (scheme_extension_table->scheme_hash_tree_equal)

1
src/racket/src/schpriv.h
View File

@ -354,6 +354,7 @@ extern Scheme_Object *scheme_vector_proc;
extern Scheme_Object *scheme_vector_immutable_proc;
extern Scheme_Object *scheme_vector_ref_proc;
extern Scheme_Object *scheme_vector_set_proc;
extern Scheme_Object *scheme_hash_ref_proc;
extern Scheme_Object *scheme_box_proc;
extern Scheme_Object *scheme_call_with_values_proc;
extern Scheme_Object *scheme_make_struct_type_proc;