mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 06:12:25 -08:00
Code Issues Projects Releases Packages Wiki Activity

Split the CLOS cache code into a separate file, with some cleanup in the process.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-15 00:05:15 +01:00
parent 17ab9cecf0
commit 198ecd50c2
7 changed files with 320 additions and 229 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/c/Makefile.in
View file

@ -40,7 +40,8 @@ HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h\
$(HDIR)/number.h $(HDIR)/page.h $(HDIR)/unify.h
OBJS = main.o symbol.o package.o cons.o list.o\
apply.o eval.o interpreter.o compiler.o disassembler.o \
instance.o gfun.o reference.o character.o\
instance.o gfun.o clos/cache.o \
reference.o character.o\
file.o read.o print.o error.o string.o cfun.o\
reader/parse_integer.o reader/parse_number.o \
printer/float_to_digits.o printer/float_to_string.o \

230
src/c/clos/cache.d Normal file
View file

@ -0,0 +1,230 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
cache.d -- thread-local cache for a variety of operations
*/
/*
Copyright (c) 2011, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <ecl/cache.h>
#include <ecl/internal.h>
#include "newhash.h"
#define RECORD_KEY(e) ((e)[0])
#define RECORD_VALUE(e) ((e)[1])
#define RECORD_GEN(e) fix((e+2)[0])
#define RECORD_GEN_SET(e,v) ((e+2)[0]=MAKE_FIXNUM(v))
static void
empty_cache(ecl_cache_ptr cache)
{
cl_object table = cache->table;
cl_index i, total_size = table->vector.dim;
cache->generation = 0;
for (i = 0; i < total_size; i+=3) {
table->vector.self.t[i] = OBJNULL;
table->vector.self.t[i+1] = OBJNULL;
table->vector.self.fix[i+2] = 0;
}
#ifdef ECL_THREADS
cache->clear_list = Cnil;
#endif
}
static void
clear_one_from_cache(ecl_cache_ptr cache, cl_object target)
{
cl_object table = cache->table;
cl_index i, total_size = table->vector.dim;
for (i = 0; i < total_size; i+=3) {
cl_object key = table->vector.self.t[i];
if (key != OBJNULL) {
if (target == key->vector.self.t[0]) {
table->vector.self.t[i] = OBJNULL;
table->vector.self.fix[i+2] = 0;
}
}
}
}
#ifdef ECL_THREADS
static void
clear_list_from_cache(ecl_cache_ptr cache)
{
const cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
cl_object table = cache->table;
cl_index i, total_size = table->vector.dim;
cl_object list = cache->clear_list;
for (i = 0; i < total_size; i+=3) {
cl_object key = table->vector.self.t[i];
if (key != OBJNULL) {
if (ecl_member_eq(key->vector.self.t[0], list)) {
table->vector.self.t[i] = OBJNULL;
table->vector.self.fix[i+2] = 0;
}
}
}
cache->clear_list = Cnil;
} ECL_WITH_GLOBAL_LOCK_END;
}
#endif
ecl_cache_ptr
ecl_make_cache(cl_index key_size, cl_index cache_size)
{
ecl_cache_ptr cache = ecl_alloc(sizeof(struct ecl_cache));
cl_object table;
cache->keys =
si_make_vector(Ct, /* element type */
MAKE_FIXNUM(key_size), /* Maximum size */
Ct, /* adjustable */
MAKE_FIXNUM(0), /* fill pointer */
Cnil, /* displaced */
Cnil);
cache->table =
si_make_vector(Ct, /* element type */
MAKE_FIXNUM(3*cache_size), /* Maximum size */
Cnil, /* adjustable */
Cnil, /* fill pointer */
Cnil, /* displaced */
Cnil);
empty_cache(cache);
return cache;
}
void
ecl_cache_remove_one(ecl_cache_ptr cache, cl_object first_key)
{
#ifdef ECL_THREADS
const cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
cache->clear_list = CONS(first_key, cache->clear_list);
} ECL_WITH_GLOBAL_LOCK_END;
#else
clear_one_from_cache(cache, first_key);
#endif
}
static cl_index
vector_hash_key(cl_object keys)
{
cl_index c, n, a = GOLDEN_RATIO, b = GOLDEN_RATIO;
for (c = 0, n = keys->vector.fillp; n >= 3; ) {
c += keys->vector.self.index[--n];
b += keys->vector.self.index[--n];
a += keys->vector.self.index[--n];
mix(a, b, c);
}
switch (n) {
case 2: b += keys->vector.self.index[--n];
case 1: a += keys->vector.self.index[--n];
c += keys->vector.dim;
mix(a,b,c);
}
return c;
}
/*
* variation of ecl_gethash from hash.d, which takes an array of objects as key
* It also assumes that entries are never removed except by clrhash.
*/
ecl_cache_record_ptr
ecl_search_cache(ecl_cache_ptr cache)
{
#ifdef ECL_THREADS
if (!Null(cache->clear_list)) {
clear_list_from_cache(cache);
}
#endif
{
cl_object table = cache->table;
cl_object keys = cache->keys;
cl_index argno = keys->vector.fillp;
cl_index i = vector_hash_key(keys);
cl_index total_size = table->vector.dim;
cl_fixnum min_gen, gen;
cl_object *min_e;
int k;
i = i % total_size;
i = i - (i % 3);
min_gen = cache->generation;
min_e = 0;
for (k = 20; k--; ) {
cl_object *e = table->vector.self.t + i;
cl_object hkey = RECORD_KEY(e);
if (hkey == OBJNULL) {
min_gen = -1;
min_e = e;
if (RECORD_VALUE(e) == OBJNULL) {
/* This record is not only deleted but empty
* Hence we cannot find our method ahead */
break;
}
/* Else we only know that the record has been
* delete, but we might find our data ahead. */
} else if (argno == hkey->vector.fillp) {
cl_index n;
for (n = 0; n < argno; n++) {
if (keys->vector.self.t[n] !=
hkey->vector.self.t[n])
goto NO_MATCH;
}
min_e = e;
goto FOUND;
} else if (min_gen >= 0) {
NO_MATCH:
/* Unless we have found a deleted record, keep
* looking for the oldest record that we can
* overwrite with the new data. */
gen = RECORD_GEN(e);
if (gen < min_gen) {
min_gen = gen;
min_e = e;
}
}
i += 3;
if (i >= total_size) i = 0;
}
if (min_e == 0) {
ecl_internal_error("search_method_hash");
}
RECORD_KEY(min_e) = OBJNULL;
cache->generation++;
FOUND:
/*
* Once we have reached here, we set the new generation of
* this record and perform a global shift so that the total
* generation number does not become too large and we can
* expire some elements.
*/
gen = cache->generation;
RECORD_GEN_SET(min_e, gen);
if (gen >= total_size/2) {
cl_object *e = table->vector.self.t;
gen = 0.5*gen;
cache->generation -= gen;
for (i = table->vector.dim; i; i-= 3, e += 3) {
cl_fixnum g = RECORD_GEN(e) - gen;
if (g <= 0) {
RECORD_KEY(e) = OBJNULL;
RECORD_VALUE(e) = Cnil;
g = 0;
}
RECORD_GEN_SET(e, g);
}
}
return (ecl_cache_record_ptr)min_e;
}
}

249
src/c/gfun.d
View file

@ -17,7 +17,7 @@
#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include "newhash.h"
#include <ecl/cache.h>
static cl_object generic_function_dispatch_vararg(cl_narg, ...);
@ -101,203 +101,12 @@ si_generic_function_p(cl_object x)
@(return ((ECL_INSTANCEP(x) && (x->instance.isgf))? Ct : Cnil))
}
/**********************************************************************
* METHOD HASH
*/
#define RECORD_KEY(e) ((e)[0])
#define RECORD_VALUE(e) ((e)[1])
#define RECORD_GEN(e) fix((e+2)[0])
#define RECORD_GEN_SET(e,v) ((e+2)[0]=MAKE_FIXNUM(v))
static void
do_clear_method_hash(struct cl_env_struct *env, cl_object target)
{
cl_object table = env->method_hash;
cl_index i, total_size = table->vector.dim;
if (target == Ct) {
env->method_generation = 0;
for (i = 0; i < total_size; i+=3) {
table->vector.self.t[i] = OBJNULL;
table->vector.self.t[i+1] = OBJNULL;
table->vector.self.fix[i+2] = 0;
}
#ifdef ECL_THREADS
env->method_hash_clear_list = Cnil;
#endif
} else {
for (i = 0; i < total_size; i+=3) {
cl_object key = table->vector.self.t[i];
if (key != OBJNULL) {
if (target == key->vector.self.t[0]) {
table->vector.self.t[i] = OBJNULL;
table->vector.self.fix[i+2] = 0;
}
}
}
}
}
void
_ecl_set_method_hash_size(struct cl_env_struct *env, cl_index size)
{
env->method_spec_vector =
si_make_vector(Ct, /* element type */
MAKE_FIXNUM(64), /* Maximum size */
Ct, /* adjustable */
MAKE_FIXNUM(0), /* fill pointer */
Cnil, /* displaced */
Cnil);
env->method_hash =
si_make_vector(Ct, /* element type */
MAKE_FIXNUM(3*size), /* Maximum size */
Cnil, /* adjustable */
Cnil, /* fill pointer */
Cnil, /* displaced */
Cnil);
do_clear_method_hash(env, Ct);
}
cl_object
si_clear_gfun_hash(cl_object what)
{
/*
* This function clears the generic function call hashes selectively.
* what = Ct means clear the hash completely
* what = generic function, means cleans only these entries
* If we work on a multithreaded environment, we simply enqueue these
* operations and wait for the destination thread to update its own hash.
*/
#ifdef ECL_THREADS
const cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
cl_object list = cl_core.processes;
loop_for_on_unsafe(list) {
cl_object process = ECL_CONS_CAR(list);
struct cl_env_struct *env = process->process.env;
env->method_hash_clear_list =
CONS(what, env->method_hash_clear_list);
} end_loop_for_on_unsafe(list);
} ECL_WITH_GLOBAL_LOCK_END;
#else
do_clear_method_hash(&cl_env, what);
#endif
return0();
}
static cl_index
vector_hash_key(cl_object keys)
{
cl_index c, n, a = GOLDEN_RATIO, b = GOLDEN_RATIO;
for (c = 0, n = keys->vector.fillp; n >= 3; ) {
c += keys->vector.self.index[--n];
b += keys->vector.self.index[--n];
a += keys->vector.self.index[--n];
mix(a, b, c);
}
switch (n) {
case 2: b += keys->vector.self.index[--n];
case 1: a += keys->vector.self.index[--n];
c += keys->vector.dim;
mix(a,b,c);
}
return c;
}
/*
* variation of ecl_gethash from hash.d, which takes an array of objects as key
* It also assumes that entries are never removed except by clrhash.
*/
static cl_object *
search_method_hash(cl_env_ptr env, cl_object keys)
{
cl_object table = env->method_hash;
cl_index argno = keys->vector.fillp;
cl_index i = vector_hash_key(keys);
cl_index total_size = table->vector.dim;
cl_fixnum min_gen, gen;
cl_object *min_e;
int k;
i = i % total_size;
i = i - (i % 3);
min_gen = env->method_generation;
min_e = 0;
for (k = 20; k--; ) {
cl_object *e = table->vector.self.t + i;
cl_object hkey = RECORD_KEY(e);
if (hkey == OBJNULL) {
min_gen = -1;
min_e = e;
if (RECORD_VALUE(e) == OBJNULL) {
/* This record is not only deleted but empty
* Hence we cannot find our method ahead */
break;
}
/* Else we only know that the record has been
* delete, but we might find our data ahead. */
} else if (argno == hkey->vector.fillp) {
cl_index n;
for (n = 0; n < argno; n++) {
if (keys->vector.self.t[n] !=
hkey->vector.self.t[n])
goto NO_MATCH;
}
min_e = e;
goto FOUND;
} else if (min_gen >= 0) {
NO_MATCH:
/* Unless we have found a deleted record, keep
* looking for the oldest record that we can
* overwrite with the new data. */
gen = RECORD_GEN(e);
if (gen < min_gen) {
min_gen = gen;
min_e = e;
}
}
i += 3;
if (i >= total_size) i = 0;
}
if (min_e == 0) {
ecl_internal_error("search_method_hash");
}
RECORD_KEY(min_e) = OBJNULL;
env->method_generation++;
FOUND:
/*
* Once we have reached here, we set the new generation of
* this record and perform a global shift so that the total
* generation number does not become too large and we can
* expire some elements.
*/
gen = env->method_generation;
RECORD_GEN_SET(min_e, gen);
if (gen >= total_size/2) {
cl_object *e = table->vector.self.t;
gen = 0.5*gen;
env->method_generation -= gen;
for (i = table->vector.dim; i; i-= 3, e += 3) {
cl_fixnum g = RECORD_GEN(e) - gen;
if (g <= 0) {
RECORD_KEY(e) = OBJNULL;
RECORD_VALUE(e) = Cnil;
g = 0;
}
RECORD_GEN_SET(e, g);
}
}
return min_e;
}
static cl_object
get_spec_vector(cl_env_ptr env, cl_object frame, cl_object gf)
fill_spec_vector(cl_object vector, cl_object frame, cl_object gf)
{
cl_object *args = frame->frame.base;
cl_index narg = frame->frame.size;
cl_object spec_how_list = GFUN_SPEC(gf);
cl_object vector = env->method_spec_vector;
cl_object *argtype = vector->vector.self.t;
int spec_no = 1;
argtype[0] = gf;
@ -345,6 +154,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
{
cl_object func, vector;
const cl_env_ptr env = frame->frame.env;
ecl_cache_ptr cache = env->method_cache;
/*
* We have to copy the frame because it might be stored in cl_env.values
* which will be wiped out by the next function call. However this only
@ -359,35 +169,23 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
}
#endif
#ifdef ECL_THREADS
/* See whether we have to clear the hash from some generic functions right now. */
if (env->method_hash_clear_list != Cnil) {
ECL_WITH_GLOBAL_LOCK_BEGIN(env) {
cl_object clear_list = env->method_hash_clear_list;
loop_for_on_unsafe(clear_list) {
do_clear_method_hash(&cl_env, ECL_CONS_CAR(clear_list));
} end_loop_for_on_unsafe(clear_list);
env->method_hash_clear_list = Cnil;
} ECL_WITH_GLOBAL_LOCK_END;
}
#endif
vector = get_spec_vector(env, frame, gf);
vector = fill_spec_vector(cache->keys, frame, gf);
if (vector == OBJNULL) {
func = compute_applicable_method(frame, gf);
} else {
cl_object *e = search_method_hash(env, vector);
if (RECORD_KEY(e) != OBJNULL) {
func = RECORD_VALUE(e);
ecl_cache_record_ptr e = ecl_search_cache(cache);
if (e->key != OBJNULL) {
func = e->value;
} else {
cl_object keys = cl_copy_seq(vector);
func = compute_applicable_method(frame, gf);
if (RECORD_KEY(e) != OBJNULL) {
if (e->key != OBJNULL) {
/* The cache might have changed while we
* computed applicable methods */
e = search_method_hash(env, vector);
e = ecl_search_cache(cache);
}
RECORD_KEY(e) = keys;
RECORD_VALUE(e) = func;
e->key = keys;
e->value = func;
}
}
func = cl_funcall(3, func, frame, Cnil);
@ -408,3 +206,28 @@ generic_function_dispatch_vararg(cl_narg narg, ...)
ECL_STACK_FRAME_VARARGS_END(frame);
return output;
}
cl_object
si_clear_gfun_hash(cl_object what)
{
/*
* This function clears the generic function call hashes selectively.
* what = Ct means clear the hash completely
* what = generic function, means cleans only these entries
* If we work on a multithreaded environment, we simply enqueue these
* operations and wait for the destination thread to update its own hash.
*/
cl_env_ptr the_env = ecl_process_env();
#ifdef ECL_THREADS
cl_object list;
for (list = mp_all_processes(); !Null(list); list = ECL_CONS_CDR(list)) {
cl_object process = ECL_CONS_CAR(list);
struct cl_env_struct *env = process->process.env;
if (the_env != env)
ecl_cache_remove_one(env->method_cache, what);
}
#endif
ecl_cache_remove_one(the_env->method_cache, what);
return0();
}

9
src/c/main.d
View file

@ -40,6 +40,7 @@
#endif
#include <stdio.h>
#include <stdlib.h>
#include <ecl/cache.h>
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
extern int GC_dont_gc;
@ -153,13 +154,7 @@ ecl_init_env(cl_env_ptr env)
#endif
#ifdef CLOS
env->method_hash = Cnil;
env->method_spec_vector = Cnil;
env->method_generation = 0;
_ecl_set_method_hash_size(env, 4096);
#ifdef ECL_THREADS
env->method_hash_clear_list = Cnil;
#endif
env->method_cache = ecl_make_cache(64, 4096);
#endif
env->pending_interrupt = Cnil;

47
src/h/cache.h Normal file
View file

@ -0,0 +1,47 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
cache.h -- thread-local cache for a variety of operations
*/
/*
Copyright (c) 2011, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#ifndef ECL_CACHE_H
#define ECL_CACHE_H
#ifdef __cplusplus
extern "C" {
#endif
typedef struct ecl_cache {
cl_object keys;
cl_object table;
cl_index generation;
#ifdef ECL_THREADS
cl_object clear_list;
#endif
} *ecl_cache_ptr;
typedef struct ecl_cache_record {
cl_object key; /* vector[ndx] */
cl_object value; /* vector[ndx+1] */
cl_object gen; /* vector[ndx+2] */
} *ecl_cache_record_ptr;
extern ecl_cache_ptr ecl_make_cache(cl_index key_size, cl_index cache_size);
extern ecl_cache_record_ptr ecl_search_cache(ecl_cache_ptr cache);
extern void ecl_cache_remove_one(ecl_cache_ptr cache, cl_object first_key);
#ifdef __cplusplus
}
#endif
#endif /* !ECL_CACHE_H */

7
src/h/external.h
View file

@ -105,12 +105,7 @@ struct cl_env_struct {
queue operations in which the hash is cleared from updated
generic functions. */
#ifdef CLOS
#ifdef ECL_THREADS
cl_object method_hash_clear_list;
#endif
cl_object method_hash;
cl_object method_spec_vector;
cl_fixnum method_generation;
struct ecl_cache *method_cache;
#endif
/* foreign function interface */

4
src/h/internal.h
View file

@ -370,11 +370,11 @@ extern void cl_write_object(cl_object x, cl_object stream);
const cl_object __ecl_the_lock = lock; \
ecl_disable_interrupts_env(the_env); \
mp_get_lock_wait(__ecl_the_lock); \
CL_UNWIND_PROTECT_BEGIN(__ecl_the_env)
CL_UNWIND_PROTECT_BEGIN(__ecl_the_env); \
ecl_enable_interrupts_env(__ecl_the_env);
# define ECL_WITH_LOCK_END \
CL_UNWIND_PROTECT_EXIT { \
mp_giveup_lock(__ecl_the_lock); \
ecl_enable_interrupts_env(__ecl_the_env); \
} CL_UNWIND_PROTECT_END; }
#else
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)