gpgscm: Optimize environment lookups and insertions.

* tests/gpgscm/scheme.c (pointercmp): New function.
(new_slot_spec_in_env): Add and use slot for insertions.
(find_slot_spec_in_env): New variant of 'find_slot_in_env' that
returns the slot on failures.
(find_slot_in_env): Express using the new function.
(new_slot_in_env): Update callsite.
(opexe_0): Optimize lookup-or-insert.
(opexe_1): Likewise.
(scheme_define): Likewise.
--
Optimize environment lookups by keeping the lists in the hash table or
the list sorted.  Optimize the insertions by passing the slot computed
by the lookup to the insertion.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2017-01-31 18:16:46 +01:00
parent 874424ee3c
commit b85d509a8f
1 changed files with 116 additions and 50 deletions

View File

@ -2612,6 +2612,22 @@ static int hash_fn(const char *key, int table_size)
}
#endif
/* Compares A and B. Returns an integer less than, equal to, or
* greater than zero if A is stored at a memory location that is
* numerical less than, equal to, or greater than that of B. */
static int
pointercmp(pointer a, pointer b)
{
uintptr_t a_n = (uintptr_t) a;
uintptr_t b_n = (uintptr_t) b;
if (a_n < b_n)
return -1;
if (a_n > b_n)
return 1;
return 0;
}
#ifndef USE_ALIST_ENV
/*
@ -2639,53 +2655,75 @@ static void new_frame_in_env(scheme *sc, pointer old_env)
setenvironment(sc->envir);
}
/* Insert (VARIABLE, VALUE) at SSLOT. SSLOT must be obtained using
* find_slot_spec_in_env, and no insertion must be done between
* obtaining SSLOT and the call to this function.
*
* If SSLOT is NULL, the new slot is put into the appropriate place in
* the environment vector. */
static INLINE void new_slot_spec_in_env(scheme *sc, pointer env,
pointer variable, pointer value)
pointer variable, pointer value,
pointer *sslot)
{
#define new_slot_spec_in_env_allocates 2
pointer slot;
gc_disable(sc, gc_reservations (new_slot_spec_in_env));
slot = immutable_cons(sc, variable, value);
if (is_vector(car(env))) {
int location = hash_fn(symname(variable), vector_length(car(env)));
if (sslot == NULL) {
int location;
assert(is_vector(car(env)));
location = hash_fn(symname(variable), vector_length(car(env)));
set_vector_elem(car(env), location,
immutable_cons(sc, slot, vector_elem(car(env), location)));
} else {
car(env) = immutable_cons(sc, slot, car(env));
*sslot = immutable_cons(sc, slot, *sslot);
}
gc_enable(sc);
}
static pointer find_slot_in_env(scheme *sc, pointer env, pointer hdl, int all)
/* Find the slot in ENV under the key HDL. If ALL is given, look in
* all environments enclosing ENV. If the lookup fails, and SSLOT is
* given, the position where the new slot has to be inserted is stored
* at SSLOT.
*
* SSLOT may be set to NULL if the new symbol should be placed at the
* appropriate place in the vector. */
static pointer
find_slot_spec_in_env(scheme *sc, pointer env, pointer hdl, int all, pointer **sslot)
{
pointer x,y;
int location;
pointer *sl;
int d;
assert(is_symbol(hdl));
for (x = env; x != sc->NIL; x = cdr(x)) {
if (is_vector(car(x))) {
location = hash_fn(symname(hdl), vector_length(car(x)));
sl = NULL;
y = vector_elem(car(x), location);
} else {
y = car(x);
sl = &car(x);
y = *sl;
}
for ( ; y != sc->NIL; y = cdr(y)) {
if (caar(y) == hdl) {
break;
}
}
if (y != sc->NIL) {
break;
}
if(!all) {
return sc->NIL;
}
for ( ; y != sc->NIL; sl = &cdr(y), y = *sl) {
d = pointercmp(caar(y), hdl);
if (d == 0)
return car(y); /* Hit. */
else if (d > 0)
break; /* Miss. */
}
if (x != sc->NIL) {
return car(y);
}
return sc->NIL;
if (x == env && sslot)
*sslot = sl; /* Insert here. */
if (!all)
return sc->NIL; /* Miss, and stop looking. */
}
return sc->NIL; /* Not found in any environment. */
}
#else /* USE_ALIST_ENV */
@ -2696,41 +2734,66 @@ static INLINE void new_frame_in_env(scheme *sc, pointer old_env)
setenvironment(sc->envir);
}
/* Insert (VARIABLE, VALUE) at SSLOT. SSLOT must be obtained using
* find_slot_spec_in_env, and no insertion must be done between
* obtaining SSLOT and the call to this function. */
static INLINE void new_slot_spec_in_env(scheme *sc, pointer env,
pointer variable, pointer value)
pointer variable, pointer value,
pointer *sslot)
{
#define new_slot_spec_in_env_allocates 2
car(env) = immutable_cons(sc, immutable_cons(sc, variable, value), car(env));
(void) env;
assert(is_symbol(variable));
*sslot = immutable_cons(sc, immutable_cons(sc, variable, value), *sslot);
}
static pointer find_slot_in_env(scheme *sc, pointer env, pointer hdl, int all)
/* Find the slot in ENV under the key HDL. If ALL is given, look in
* all environments enclosing ENV. If the lookup fails, and SSLOT is
* given, the position where the new slot has to be inserted is stored
* at SSLOT. */
static pointer
find_slot_spec_in_env(scheme *sc, pointer env, pointer hdl, int all, pointer **sslot)
{
pointer x,y;
pointer *sl;
int d;
assert(is_symbol(hdl));
for (x = env; x != sc->NIL; x = cdr(x)) {
for (y = car(x); y != sc->NIL; y = cdr(y)) {
if (caar(y) == hdl) {
break;
}
}
if (y != sc->NIL) {
break;
}
if(!all) {
return sc->NIL;
}
for (sl = &car(x), y = *sl; y != sc->NIL; sl = &cdr(y), y = *sl) {
d = pointercmp(caar(y), hdl);
if (d == 0)
return car(y); /* Hit. */
else if (d > 0)
break; /* Miss. */
}
if (x == env && sslot)
*sslot = sl; /* Insert here. */
if (!all)
return sc->NIL; /* Miss, and stop looking. */
}
if (x != sc->NIL) {
return car(y);
}
return sc->NIL;
return sc->NIL; /* Not found in any environment. */
}
#endif /* USE_ALIST_ENV else */
static pointer find_slot_in_env(scheme *sc, pointer env, pointer hdl, int all)
{
return find_slot_spec_in_env(sc, env, hdl, all, NULL);
}
static INLINE void new_slot_in_env(scheme *sc, pointer variable, pointer value)
{
#define new_slot_in_env_allocates new_slot_spec_in_env_allocates
new_slot_spec_in_env(sc, sc->envir, variable, value);
pointer slot;
pointer *sslot;
assert(is_symbol(variable));
slot = find_slot_spec_in_env(sc, sc->envir, variable, 0, &sslot);
assert(slot == sc->NIL);
new_slot_spec_in_env(sc, sc->envir, variable, value, sslot);
}
static INLINE void set_slot_in_env(scheme *sc, pointer slot, pointer value)
@ -3486,15 +3549,16 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_DEF1, sc->NIL, x);
s_thread_to(sc,OP_EVAL);
CASE(OP_DEF1): /* define */
x=find_slot_in_env(sc,sc->envir,sc->code,0);
CASE(OP_DEF1): { /* define */
pointer *sslot;
x = find_slot_spec_in_env(sc, sc->envir, sc->code, 0, &sslot);
if (x != sc->NIL) {
set_slot_in_env(sc, x, sc->value);
} else {
new_slot_in_env(sc, sc->code, sc->value);
new_slot_spec_in_env(sc, sc->envir, sc->code, sc->value, sslot);
}
s_return(sc,sc->code);
}
CASE(OP_DEFP): /* defined? */
x=sc->envir;
@ -3806,15 +3870,17 @@ static pointer opexe_1(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_MACRO1, sc->NIL, x);
s_goto(sc,OP_EVAL);
CASE(OP_MACRO1): /* macro */
CASE(OP_MACRO1): { /* macro */
pointer *sslot;
typeflag(sc->value) = T_MACRO;
x = find_slot_in_env(sc, sc->envir, sc->code, 0);
x = find_slot_spec_in_env(sc, sc->envir, sc->code, 0, &sslot);
if (x != sc->NIL) {
set_slot_in_env(sc, x, sc->value);
} else {
new_slot_in_env(sc, sc->code, sc->value);
new_slot_spec_in_env(sc, sc->envir, sc->code, sc->value, sslot);
}
s_return(sc,sc->code);
}
CASE(OP_CASE0): /* case */
s_save(sc,OP_CASE1, sc->NIL, cdr(sc->code));
@ -5769,12 +5835,12 @@ void scheme_load_string(scheme *sc, const char *cmd) {
void scheme_define(scheme *sc, pointer envir, pointer symbol, pointer value) {
pointer x;
x=find_slot_in_env(sc,envir,symbol,0);
pointer *sslot;
x = find_slot_spec_in_env(sc, envir, symbol, 0, &sslot);
if (x != sc->NIL) {
set_slot_in_env(sc, x, value);
} else {
new_slot_spec_in_env(sc, envir, symbol, value);
new_slot_spec_in_env(sc, envir, symbol, value, sslot);
}
}