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

Move packages to read/write locks

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-10-24 17:52:53 +02:00
parent 1e3eb5b62a
commit c86c8bd5c0
7 changed files with 94 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/alloc_2.d
View file

@ -559,6 +559,7 @@ ecl_alloc_object(cl_type t)
#ifdef ECL_THREADS
case t_process:
case t_lock:
case t_rwlock:
case t_condition_variable:
#endif
#ifdef ECL_SEMAPHORES
@ -833,6 +834,7 @@ init_alloc(void)
#ifdef ECL_THREADS
init_tm(t_process, "PROCESS", sizeof(struct ecl_process), 8);
init_tm(t_lock, "LOCK", sizeof(struct ecl_lock), 2);
init_tm(t_rwlock, "LOCK", sizeof(struct ecl_rwlock), 2);
init_tm(t_condition_variable, "CONDITION-VARIABLE",
sizeof(struct ecl_condition_variable), 0);
# ifdef ECL_SEMAPHORES

4
src/c/error.d
View file

@ -449,12 +449,14 @@ FElibc_error(const char *msg, int narg, ...)
{
cl_va_list args;
cl_object rest;
const char *error = strerror(errno);
cl_va_start(args, narg, narg, 0);
rest = cl_grab_rest_args(args);
printf("%s\n", error);
FEerror("~?~%Explanation: ~A.", 3, make_constant_base_string(msg), rest,
make_constant_base_string(strerror(errno)));
make_constant_base_string(error));
}
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)

6
src/c/main.d
View file

@ -499,10 +499,10 @@ cl_boot(int argc, char **argv)
init_alloc();
GC_disable();
env = _ecl_alloc_env();
#if !defined(ECL_THREADS) || defined(WITH__THREAD)
cl_env_p = env;
#ifdef ECL_THREADS
init_threads(env);
#else
init_threads(env);
cl_env_p = env;
#endif
/*

58
src/c/package.d
View file

@ -190,7 +190,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
for (l = use_list = cl_copy_list(use_list); !Null(l); l = ECL_CONS_CDR(l))
ECL_RPLACA(l, si_coerce_to_package(ECL_CONS_CAR(l)));
ECL_WITH_PACKAGE_LOCK_BEGIN(env) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(env) {
/* Find a similarly named package in the list of
* packages to be created and use it or try to build a
* new package */
@ -221,7 +221,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
cl_core.packages = CONS(x, cl_core.packages);
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (!Null(other)) {
CEpackage_error("A package with the name ~A already exists.",
"Return existing package",
@ -245,7 +245,7 @@ ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
if (Null(cl_list_length(nicknames))) {
FEtype_error_list(nicknames);
}
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
cl_object y = ecl_find_package_nolock(name);
if ((y != Cnil) && (y != x)) {
error = 1;
@ -261,7 +261,7 @@ ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
}
error = 0;
}
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error) {
FEpackage_error("A package with name ~S already exists.", x,
1, name);
@ -353,7 +353,7 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag)
FEwrong_type_nth_arg(@[intern], 1, name, @[string]);
p = si_coerce_to_package(p);
TRY_AGAIN:
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
s = find_symbol_inner(name, p, intern_flag);
if (*intern_flag) {
error = 0;
@ -374,7 +374,7 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag)
}
error = 0;
}
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error) {
CEpackage_error("Cannot intern symbol ~S in locked package ~S.",
"Ignore lock and proceed", p, 2, name, p);
@ -423,10 +423,14 @@ find_symbol_inner(cl_object name, cl_object p, int *intern_flag)
cl_object
ecl_find_symbol(cl_object n, cl_object p, int *intern_flag)
{
cl_object s;
if (ecl_unlikely(!ECL_STRINGP(n)))
FEwrong_type_nth_arg(@[find-symbol], 1, n, @[string]);
p = si_coerce_to_package(p);
return find_symbol_inner(n, p, intern_flag);
ECL_WITH_PACKAGE_RDLOCK_BEGIN(ecl_process_env()) {
s = find_symbol_inner(n, p, intern_flag);
} ECL_WITH_PACKAGE_RDLOCK_END;
return s;
}
static cl_object
@ -461,7 +465,7 @@ ecl_unintern(cl_object s, cl_object p)
"Ignore lock and proceed", p, 2, s, p);
}
conflict = Cnil;
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
cl_object hash = p->pack.internal;
cl_object x = ecl_gethash_safe(name, hash, OBJNULL);
if (x != s) {
@ -482,7 +486,7 @@ ecl_unintern(cl_object s, cl_object p)
output = TRUE;
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (conflict != Cnil) {
FEpackage_error("Cannot unintern the shadowing symbol ~S~%"
"from ~S,~%"
@ -520,7 +524,7 @@ cl_export2(cl_object s, cl_object p)
CEpackage_error("Cannot export symbol ~S from locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
TRY_AGAIN:
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (!intern_flag) {
error = 1;
@ -536,7 +540,7 @@ cl_export2(cl_object s, cl_object p)
p->pack.external = _ecl_sethash(name, p->pack.external, s);
error = 0;
}
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error == 1) {
CEpackage_error("The symbol ~S is not accessible from ~S "
"and cannot be exported.",
@ -589,7 +593,7 @@ cl_delete_package(cl_object p)
ecl_unuse_package(p, ECL_CONS_CAR(l));
}
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
for (hash = p->pack.internal, i = 0; i < hash->hash.size; i++)
if (hash->hash.data[i].key != OBJNULL) {
cl_object s = hash->hash.data[i].value;
@ -606,7 +610,7 @@ cl_delete_package(cl_object p)
p->pack.name = Cnil;
/* 2) Only at the end, remove the package from the list of packages. */
cl_core.packages = ecl_remove_eq(p, cl_core.packages);
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
@(return Ct)
}
@ -624,7 +628,7 @@ cl_unexport2(cl_object s, cl_object p)
CEpackage_error("Cannot unexport symbol ~S from locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
}
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
int intern_flag;
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag == 0 || x != s) {
@ -638,7 +642,7 @@ cl_unexport2(cl_object s, cl_object p)
p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
error = 0;
}
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error) {
FEpackage_error("Cannot unexport ~S because it does not "
"belong to package ~S.",
@ -656,7 +660,7 @@ cl_import2(cl_object s, cl_object p)
CEpackage_error("Cannot import symbol ~S into locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
}
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag) {
if (x != s && !ignore_error) {
@ -673,7 +677,7 @@ cl_import2(cl_object s, cl_object p)
error = 0;
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error) {
CEpackage_error("Cannot import the symbol ~S "
"from package ~A,~%"
@ -696,7 +700,7 @@ ecl_shadowing_import(cl_object s, cl_object p)
"locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag && intern_flag != INHERITED) {
if (x == s) {
@ -718,7 +722,7 @@ ecl_shadowing_import(cl_object s, cl_object p)
p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
}
void
@ -733,7 +737,7 @@ ecl_shadow(cl_object s, cl_object p)
if (p->pack.locked)
CEpackage_error("Cannot shadow symbol ~S in locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
x = find_symbol_inner(s, p, &intern_flag);
if (intern_flag != INTERNAL && intern_flag != EXTERNAL) {
x = cl_make_symbol(s);
@ -741,7 +745,7 @@ ecl_shadow(cl_object s, cl_object p)
x->symbol.hpack = p;
}
p->pack.shadowings = CONS(x, p->pack.shadowings);
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
}
void
@ -769,7 +773,7 @@ ecl_use_package(cl_object x, cl_object p)
"Ignore lock and proceed",
p, 2, x, p);
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
hash_entries = x->pack.external->hash.data;
hash_length = x->pack.external->hash.size;
for (i = 0, error = 0; i < hash_length; i++) {
@ -787,7 +791,7 @@ ecl_use_package(cl_object x, cl_object p)
p->pack.uses = CONS(x, p->pack.uses);
x->pack.usedby = CONS(p, x->pack.usedby);
}
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
if (error) {
FEpackage_error("Cannot use ~S~%"
"from ~S,~%"
@ -805,10 +809,10 @@ ecl_unuse_package(cl_object x, cl_object p)
CEpackage_error("Cannot unuse package ~S from locked package ~S.",
"Ignore lock and proceed",
p, 2, x, p);
ECL_WITH_PACKAGE_LOCK_BEGIN(ecl_process_env()) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
p->pack.uses = ecl_remove_eq(x, p->pack.uses);
x->pack.usedby = ecl_remove_eq(p, x->pack.usedby);
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
}
@(defun make_package (pack_name &key nicknames (use CONS(cl_core.lisp_package, Cnil)))
@ -1072,10 +1076,10 @@ si_package_hash_tables(cl_object p)
cl_object he, hi, u;
unlikely_if (!ECL_PACKAGEP(p))
FEwrong_type_only_arg(@[si::package-hash-tables], p, @[package]);
ECL_WITH_PACKAGE_LOCK_BEGIN(the_env) {
ECL_WITH_PACKAGE_WRLOCK_BEGIN(the_env) {
he = si_copy_hash_table(p->pack.external);
hi = si_copy_hash_table(p->pack.internal);
u = cl_copy_list(p->pack.uses);
} ECL_WITH_PACKAGE_LOCK_END;
} ECL_WITH_PACKAGE_WRLOCK_END;
@(return he hi u)
}

2
src/c/threads/process.d
View file

@ -654,6 +654,6 @@ init_threads(cl_env_ptr env)
cl_core.global_lock = ecl_make_lock(@'mp::global-lock', 1);
cl_core.error_lock = ecl_make_lock(@'mp::error-lock', 1);
cl_core.package_lock = ecl_make_lock(@'mp::package-lock', 1);
cl_core.package_lock = ecl_make_rwlock(@'mp::package-lock');
cl_core.processes = ecl_list1(process);
}

51
src/c/threads/rwlock.d
View file

@ -36,12 +36,31 @@ FEerror_not_a_rwlock(cl_object lock)
}
static void
FEunknown_rwlock_error(cl_object lock)
FEunknown_rwlock_error(cl_object lock, int rc)
{
#ifdef ECL_WINDOWS_THREADS
FEwin32_error("When acting on rwlock ~A, got an unexpected error.", 1, lock);
#else
FEerror("When acting on rwlock ~A, got an unexpected error.", 1, lock);
const char *msg = NULL;
switch (rc) {
case EINVAL:
msg = "The value specified by rwlock is invalid";
break;
case EPERM:
msg = "Read/write lock not owned by us";
break;
case EDEADLK:
msg = "Thread already owns this lock";
break;
case ENOMEM:
msg = "Out of memory";
break;
default:
FElibc_error("When acting on rwlock ~A, got an unexpected error.",
1, lock);
}
FEerror("When acting on rwlock ~A, got the following C library error:~%"
"~A", make_constant_base_string(msg));
#endif
}
@ -51,10 +70,14 @@ ecl_make_rwlock(cl_object name)
const cl_env_ptr the_env = ecl_process_env();
cl_object output = ecl_alloc_object(t_rwlock);
#ifdef ECL_RWLOCK
int rc;
ecl_disable_interrupts_env(the_env);
pthread_rwlock_init(&output->rwlock.mutex, NULL);
ecl_set_finalizer_unprotected(output, Ct);
rc = pthread_rwlock_init(&output->rwlock.mutex, NULL);
ecl_enable_interrupts_env(the_env);
if (rc) {
FEerror("Unable to create read/write lock", 0);
}
ecl_set_finalizer_unprotected(output, Ct);
#else
output->rwlock.mutex = ecl_make_lock(name, false);
#endif
@ -83,8 +106,12 @@ mp_giveup_rwlock_read(cl_object lock)
if (type_of(lock) != t_rwlock)
FEerror_not_a_rwlock(lock);
#ifdef ECL_RWLOCK
pthread_rwlock_unlock(&lock->rwlock.mutex);
@(return Ct)
{
int rc = pthread_rwlock_unlock(&lock->rwlock.mutex);
if (rc)
FEunknown_rwlock_error(lock, rc);
@(return Ct);
}
#else
return mp_giveup_lock(lock->rwlock.mutex);
#endif
@ -111,7 +138,7 @@ mp_get_rwlock_read_nowait(cl_object lock)
} else if (rc == EBUSY) {
output = Cnil;
} else {
FEunknown_rwlock_error(lock);
FEunknown_rwlock_error(lock, rc);
}
ecl_return1(env, output);
}
@ -130,7 +157,7 @@ mp_get_rwlock_read_wait(cl_object lock)
const cl_env_ptr env = ecl_process_env();
int rc = pthread_rwlock_rdlock(&lock->rwlock.mutex);
if (rc != 0) {
FEunknown_rwlock_error(lock);
FEunknown_rwlock_error(lock, rc);
}
ecl_return1(env, Ct);
}
@ -156,13 +183,13 @@ mp_get_rwlock_write_nowait(cl_object lock)
{
const cl_env_ptr env = ecl_process_env();
cl_object output = Ct;
int rc = pthread_rwlock_tryrdlock(&lock->rwlock.mutex);
int rc = pthread_rwlock_trywrlock(&lock->rwlock.mutex);
if (rc == 0) {
output = Ct;
} else if (rc == EBUSY) {
output = Cnil;
} else {
FEunknown_rwlock_error(lock);
FEunknown_rwlock_error(lock, rc);
}
ecl_return1(env, output);
}
@ -179,9 +206,9 @@ mp_get_rwlock_write_wait(cl_object lock)
FEerror_not_a_rwlock(lock);
#ifdef ECL_RWLOCK
{
int rc = pthread_rwlock_rdlock(&lock->rwlock.mutex);
int rc = pthread_rwlock_wrlock(&lock->rwlock.mutex);
if (rc != 0) {
FEunknown_rwlock_error(lock);
FEunknown_rwlock_error(lock, rc);
}
@(return Ct)
}

21
src/h/internal.h
View file

@ -313,12 +313,19 @@ extern void cl_write_object(cl_object x, cl_object stream);
ECL_WITH_LOCK_BEGIN(the_env, cl_core.global_lock)
# define ECL_WITH_GLOBAL_LOCK_END \
ECL_WITH_LOCK_END
# define ECL_WITH_PACKAGE_LOCK_BEGIN(the_env) { \
# define ECL_WITH_PACKAGE_RDLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
ecl_disable_interrupts_env(__ecl_pack_env); \
mp_get_lock_wait(cl_core.package_lock);
# define ECL_WITH_PACKAGE_LOCK_END \
mp_giveup_lock(cl_core.package_lock); \
mp_get_rwlock_read_wait(cl_core.package_lock);
# define ECL_WITH_PACKAGE_RDLOCK_END \
mp_giveup_rwlock_read(cl_core.package_lock); \
ecl_enable_interrupts_env(__ecl_pack_env); }
# define ECL_WITH_PACKAGE_WRLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
ecl_disable_interrupts_env(__ecl_pack_env); \
mp_get_rwlock_write_wait(cl_core.package_lock);
# define ECL_WITH_PACKAGE_WRLOCK_END \
mp_giveup_rwlock_write(cl_core.package_lock); \
ecl_enable_interrupts_env(__ecl_pack_env); }
# define ECL_WITH_LOCK_BEGIN(the_env,lock) { \
const cl_env_ptr __ecl_the_env = the_env; \
@ -336,8 +343,10 @@ extern void cl_write_object(cl_object x, cl_object stream);
# define HASH_TABLE_UNLOCK(h)
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)
# define ECL_WITH_GLOBAL_LOCK_END
# define ECL_WITH_PACKAGE_LOCK_BEGIN(the_env)
# define ECL_WITH_PACKAGE_LOCK_END
# define ECL_WITH_PACKAGE_RDLOCK_BEGIN(the_env)
# define ECL_WITH_PACKAGE_RDLOCK_END
# define ECL_WITH_PACKAGE_WRLOCK_BEGIN(the_env)
# define ECL_WITH_PACKAGE_WRLOCK_END
# define ECL_WITH_LOCK_BEGIN(the_env,lock)
# define ECL_WITH_LOCK_END
#endif /* ECL_THREADS */