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

faster paths for parameter lookup

Browse Source 
Calling a parameter function (with no arguments) can be 2-3 times
as fast as before.
This commit is contained in:
Matthew Flatt 2013-08-16 08:33:56 -06:00
parent 8e20aa1cbf
commit f8a225f741
4 changed files with 128 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
racket/src/racket/src/fun.c
View File

@ -7296,7 +7296,7 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
cache = NULL;
if (cache) {
if (SCHEME_HASHTP(cache))
cache = scheme_hash_get((Scheme_Hash_Table *)cache, prompt_tag ? prompt_tag : scheme_false);
cache = scheme_eq_hash_get((Scheme_Hash_Table *)cache, prompt_tag ? prompt_tag : scheme_false);
else if (prompt_tag != scheme_default_prompt_tag)
cache = NULL;
}
@ -7347,7 +7347,7 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
if (cache && !SCHEME_FALSEP(cache)) {
if (SCHEME_HASHTP(cache)) {
Scheme_Hash_Table *ht = (Scheme_Hash_Table *)cache;
cache = scheme_hash_get(ht, prompt_tag ? prompt_tag : scheme_false);
cache = scheme_eq_hash_get(ht, prompt_tag ? prompt_tag : scheme_false);
if (!cache) {
scheme_hash_set(ht, prompt_tag ? prompt_tag : scheme_false, (Scheme_Object *)pr);
} else {
@ -7882,6 +7882,7 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
MZ_MARK_POS_TYPE *_vpos)
{
Scheme_Object *key = key_arg;
if (SCHEME_NP_CHAPERONEP(key)
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(key))) {
key = SCHEME_CHAPERONE_VAL(key);
@ -7948,7 +7949,7 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
} else {
cache = seg[pos].cache;
if (cache && SCHEME_HASHTP(cache))
cache = scheme_hash_get((Scheme_Hash_Table *)cache,
cache = scheme_eq_hash_get((Scheme_Hash_Table *)cache,
prompt_tag ? prompt_tag : scheme_false);
else if (prompt_tag)
cache = NULL;
@ -7964,7 +7965,7 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
} else {
Scheme_Hash_Table *ht;
ht = (Scheme_Hash_Table *)SCHEME_VEC_ELS(cache)[2];
val = scheme_hash_get(ht, key);
val = scheme_eq_hash_get(ht, key);
if (val) {
vpos = (MZ_MARK_POS_TYPE)SCHEME_CDR(val);
val = SCHEME_CAR(val);
@ -7997,7 +7998,7 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
Scheme_Hash_Table *cht;
if (cache && SCHEME_HASHTP(cache)) {
cht = (Scheme_Hash_Table *)cache;
cache = scheme_hash_get(cht, prompt_tag ? prompt_tag : scheme_false);
cache = scheme_eq_hash_get(cht, prompt_tag ? prompt_tag : scheme_false);
} else if (prompt_tag) {
cht = scheme_make_hash_table(SCHEME_hash_ptr);
if (cache) {
@ -8079,6 +8080,61 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
return NULL;
}
XFORM_NONGCING static Scheme_Object *
extract_one_cc_mark_fast(Scheme_Object *key)
/* A non-GCing fast path for scheme_extract_one_cc_mark_with_meta()
where there are no complications. */
{
intptr_t findpos, bottom, startpos, minbottom;
intptr_t pos;
Scheme_Object *val = NULL;
Scheme_Object *cache;
Scheme_Cont_Mark *seg;
Scheme_Thread *p = scheme_current_thread;
startpos = (intptr_t)MZ_CONT_MARK_STACK;
if (!p->cont_mark_stack_segments)
findpos = 0;
bottom = p->cont_mark_stack_bottom;
minbottom = findpos - 32;
if (bottom < minbottom)
bottom = minbottom;
findpos = startpos;
/* Search mark stack, checking caches along the way: */
while (findpos-- > bottom) {
seg = p->cont_mark_stack_segments[findpos >> SCHEME_LOG_MARK_SEGMENT_SIZE];
pos = findpos & SCHEME_MARK_SEGMENT_MASK;
if (SAME_OBJ(seg[pos].key, key))
return seg[pos].val;
else {
cache = seg[pos].cache;
if (cache && SCHEME_HASHTP(cache))
cache = scheme_eq_hash_get((Scheme_Hash_Table *)cache, scheme_false);
if (cache && SCHEME_VECTORP(cache)) {
/* If slot 1 has a key, this cache has just one key--value
pair. Otherwise, slot 2 is a hash table. */
if (SCHEME_VEC_ELS(cache)[1]) {
if (SAME_OBJ(SCHEME_VEC_ELS(cache)[1], key))
return SCHEME_VEC_ELS(cache)[2];
} else {
Scheme_Hash_Table *ht;
ht = (Scheme_Hash_Table *)SCHEME_VEC_ELS(cache)[2];
val = scheme_eq_hash_get(ht, key);
if (val) {
return SCHEME_CAR(val);
}
}
}
}
}
return NULL;
}
static Scheme_Object *get_set_cont_mark_by_pos(Scheme_Object *key,
Scheme_Thread *p,
Scheme_Meta_Continuation *mc,
@ -8145,6 +8201,13 @@ static Scheme_Object *get_set_cont_mark_by_pos(Scheme_Object *key,
Scheme_Object *
scheme_extract_one_cc_mark(Scheme_Object *mark_set, Scheme_Object *key)
{
Scheme_Object *v;
if (!mark_set) {
v = extract_one_cc_mark_fast(key);
if (v) return v;
}
return scheme_extract_one_cc_mark_with_meta(mark_set, key, NULL, NULL, NULL);
}

3
racket/src/racket/src/jitinline.c
View File

@ -76,9 +76,10 @@ static Scheme_Object *cont_mark_set_first_try_fast(Scheme_Object *cms, Scheme_Ob
Scheme_Object *nullableCms;
Scheme_Object *prompt_tag;
prompt_tag = SCHEME_PTR_VAL(scheme_default_prompt_tag);
if (key == scheme_parameterization_key || key == scheme_break_enabled_key)
prompt_tag = NULL;
else
prompt_tag = SCHEME_PTR_VAL(scheme_default_prompt_tag);
nullableCms = SCHEME_FALSEP(cms) ? NULL : cms;

78
racket/src/racket/src/thread.c
View File

@ -6869,7 +6869,7 @@ Scheme_Object *scheme_make_thread_cell(Scheme_Object *def_val, int inherited)
return (Scheme_Object *)c;
}
Scheme_Object *scheme_thread_cell_get(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells)
static Scheme_Object *do_thread_cell_get(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells)
{
Scheme_Object *v;
@ -6882,6 +6882,14 @@ Scheme_Object *scheme_thread_cell_get(Scheme_Object *cell, Scheme_Thread_Cell_Ta
return ((Thread_Cell *)cell)->def_val;
}
Scheme_Object *scheme_thread_cell_get(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells)
{
if (!((Thread_Cell *)cell)->assigned)
return ((Thread_Cell *)cell)->def_val;
else
return do_thread_cell_get(cell, cells);
}
void scheme_thread_cell_set(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells, Scheme_Object *v)
{
if (!((Thread_Cell *)cell)->assigned)
@ -6997,11 +7005,18 @@ static Scheme_Object *thread_cell_set(int argc, Scheme_Object *argv[])
/*========================================================================*/
SHARED_OK static int max_configs = __MZCONFIG_BUILTIN_COUNT__;
static Scheme_Object *do_param(void *data, int argc, Scheme_Object *argv[]);
static Scheme_Object *do_param(int argc, Scheme_Object *argv[], Scheme_Object *self);
static Scheme_Config *config_fail()
{
/* in a separate function to help xform */
scheme_longjmp(scheme_error_buf, 1);
return NULL;
}
Scheme_Config *scheme_current_config()
{
Scheme_Object *v;
GC_CAN_IGNORE Scheme_Object *v;
v = scheme_extract_one_cc_mark(NULL, scheme_parameterization_key);
@ -7010,7 +7025,7 @@ Scheme_Config *scheme_current_config()
and misused it.
Printing an error message requires consulting parameters,
so just escape. */
scheme_longjmp(scheme_error_buf, 1);
return config_fail();
}
return (Scheme_Config *)v;
@ -7050,7 +7065,7 @@ Scheme_Object *find_param_cell(Scheme_Config *c, Scheme_Object *k, int force_cel
Scheme_Object *v;
Scheme_Parameterization *p;
v = scheme_hash_tree_get(c->ht, k);
v = scheme_eq_hash_tree_get(c->ht, k);
if (v)
return v;
@ -7141,14 +7156,14 @@ static Scheme_Object *extend_parameterization(int argc, Scheme_Object *argv[])
a[0] = key;
a[1] = scheme_false;
while (1) {
if (SCHEME_PRIMP(param)) {
if (!(((Scheme_Primitive_Proc *)param)->pp.flags & SCHEME_PRIM_IS_CLOSURE)) {
Scheme_Prim *proc;
proc = (Scheme_Prim *)((Scheme_Primitive_Proc *)param)->prim_val;
key = proc(2, a); /* leads to scheme_param_config to set a[1] */
break;
} else {
/* sets a[1] */
key = do_param(((Scheme_Closed_Primitive_Proc *)param)->data, 2, a);
key = do_param(2, a, param);
if (SCHEME_PARAMETERP(key)) {
param = key;
a[0] = a[1];
@ -7210,10 +7225,10 @@ static Scheme_Object *parameter_p(int argc, Scheme_Object **argv)
: scheme_false);
}
static Scheme_Object *do_param(void *_data, int argc, Scheme_Object *argv[])
static Scheme_Object *do_param(int argc, Scheme_Object *argv[], Scheme_Object *self)
{
Scheme_Object *guard, **argv2, *pos[2];
ParamData *data = (ParamData *)_data;
ParamData *data = (ParamData *)SCHEME_PRIM_CLOSURE_ELS(self)[0];
if (argc && argv[0]) {
guard = data->guard;
@ -7260,9 +7275,33 @@ static Scheme_Object *do_param(void *_data, int argc, Scheme_Object *argv[])
-2, NULL, NULL, 0);
}
static Scheme_Object *extract_param(Scheme_Config *config, Scheme_Object *key, Scheme_Object *defcell)
{
Scheme_Object *cell;
cell = find_param_cell(config, key, 0);
if (!cell)
cell = defcell;
if (SCHEME_THREAD_CELLP(cell))
return scheme_thread_cell_get(cell, scheme_current_thread->cell_values);
else
return cell; /* it's really the value, instead of a cell */
}
static Scheme_Object *do_param_fast(int argc, Scheme_Object *argv[], Scheme_Object *self)
{
ParamData *data = (ParamData *)SCHEME_PRIM_CLOSURE_ELS(self)[0];
if (!argc && !data->is_derived)
return extract_param(scheme_current_config(), data->key, data->defcell);
return do_param(argc, argv, self);
}
static Scheme_Object *make_parameter(int argc, Scheme_Object **argv)
{
Scheme_Object *p, *cell;
Scheme_Object *p, *cell, *a[1];
ParamData *data;
void *k;
@ -7280,7 +7319,8 @@ static Scheme_Object *make_parameter(int argc, Scheme_Object **argv)
data->defcell = cell;
data->guard = ((argc > 1) ? argv[1] : NULL);
p = scheme_make_closed_prim_w_arity(do_param, (void *)data,
a[0] = (Scheme_Object *)data;
p = scheme_make_prim_closure_w_arity(do_param_fast, 1, a,
"parameter-procedure", 0, 1);
((Scheme_Primitive_Proc *)p)->pp.flags |= SCHEME_PRIM_TYPE_PARAMETER;
@ -7289,7 +7329,7 @@ static Scheme_Object *make_parameter(int argc, Scheme_Object **argv)
static Scheme_Object *make_derived_parameter(int argc, Scheme_Object **argv)
{
Scheme_Object *p;
Scheme_Object *p, *a[1];
ParamData *data;
if (!SCHEME_PARAMETERP(argv[0]))
@ -7307,7 +7347,8 @@ static Scheme_Object *make_derived_parameter(int argc, Scheme_Object **argv)
data->guard = argv[1];
data->extract_guard = argv[2];
p = scheme_make_closed_prim_w_arity(do_param, (void *)data,
a[0] = (Scheme_Object *)data;
p = scheme_make_prim_closure_w_arity(do_param, 1, a,
"parameter-procedure", 0, 1);
((Scheme_Primitive_Proc *)p)->pp.flags |= SCHEME_PRIM_TYPE_PARAMETER;
@ -7640,16 +7681,7 @@ static Scheme_Object *do_param_config(char *name, Scheme_Object *pos,
if (argc == 0) {
if (arity == -2) {
Scheme_Object *cell;
cell = find_param_cell(config, ((Scheme_Object **)pos)[0], 0);
if (!cell)
cell = ((Scheme_Object **)pos)[1];
if (SCHEME_THREAD_CELLP(cell))
return scheme_thread_cell_get(cell, scheme_current_thread->cell_values);
else
return cell; /* it's really the value, instead of a cell */
return extract_param(config, ((Scheme_Object **)pos)[0], ((Scheme_Object **)pos)[1]);
} else {
Scheme_Object *s;
s = scheme_get_param(config, SCHEME_INT_VAL(pos));