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

Protect the GET/SET-SYSPROP hash using the same global lock as packages, which is now called cl_core.global_env read/write-lock

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-07-31 17:03:24 +02:00
parent cb6fc56fc4
commit e6bb812e38
6 changed files with 60 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

27
src/c/assignment.d
View file

@ -15,8 +15,9 @@
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <string.h>
#include <ecl/ecl.h>
#include <ecl/internal.h>
cl_object
cl_set(cl_object var, cl_object val)
@ -117,21 +118,25 @@ cl_object
si_get_sysprop(cl_object sym, cl_object prop)
{
cl_env_ptr the_env = ecl_process_env();
cl_object plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil);
prop = ecl_getf(plist, prop, OBJNULL);
if (prop == OBJNULL) {
@(return Cnil Cnil);
} else {
@(return prop Ct);
}
ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) {
cl_object plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil);
prop = ecl_getf(plist, prop, OBJNULL);
} ECL_WITH_GLOBAL_ENV_RDLOCK_END;
if (prop == OBJNULL) {
@(return Cnil Cnil);
} else {
@(return prop Ct);
}
}
cl_object
si_put_sysprop(cl_object sym, cl_object prop, cl_object value)
{
cl_object plist;
plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil);
ecl_sethash(sym, cl_core.system_properties, si_put_f(plist, value, prop));
cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env) {
cl_object plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil);
ecl_sethash(sym, cl_core.system_properties, si_put_f(plist, value, prop));
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
@(return value);
}

2
src/c/main.d
View file

@ -383,7 +383,7 @@ struct cl_core_struct cl_core = {
Cnil, /* processes */
Cnil, /* global_lock */
Cnil, /* error_lock */
Cnil, /* package_lock */
Cnil, /* global_env_lock */
#endif
/* LIBRARIES is an adjustable vector of objects. It behaves as
a vector of weak pointers thanks to the magic in

56
src/c/package.d
View file

@ -202,7 +202,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
nicknames = process_nicknames(nicknames);
use_list = process_package_list(use_list);
ECL_WITH_PACKAGE_WRLOCK_BEGIN(env) {
ECL_WITH_GLOBAL_ENV_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 */
@ -233,7 +233,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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (!Null(other)) {
CEpackage_error("A package with the name ~A already exists.",
"Return existing package",
@ -257,7 +257,7 @@ ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
}
nicknames = ecl_cons(name, nicknames);
error = 0;
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
cl_object l;
for (l = nicknames; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object nick = ECL_CONS_CAR(l);
@ -272,7 +272,7 @@ ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
x->pack.name = name;
x->pack.nicknames = ECL_CONS_CDR(nicknames);
}
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error) {
FEpackage_error("A package with name ~S already exists.", x,
1, name);
@ -364,7 +364,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);
AGAIN:
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
s = find_symbol_inner(name, p, intern_flag);
if (*intern_flag) {
error = 0;
@ -385,7 +385,7 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag)
}
error = 0;
}
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error) {
CEpackage_error("Cannot intern symbol ~S in locked package ~S.",
"Ignore lock and proceed", p, 2, name, p);
@ -438,9 +438,9 @@ ecl_find_symbol(cl_object n, cl_object p, int *intern_flag)
if (ecl_unlikely(!ECL_STRINGP(n)))
FEwrong_type_nth_arg(@[find-symbol], 1, n, @[string]);
p = si_coerce_to_package(p);
ECL_WITH_PACKAGE_RDLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(ecl_process_env()) {
s = find_symbol_inner(n, p, intern_flag);
} ECL_WITH_PACKAGE_RDLOCK_END;
} ECL_WITH_GLOBAL_ENV_RDLOCK_END;
return s;
}
@ -476,7 +476,7 @@ ecl_unintern(cl_object s, cl_object p)
"Ignore lock and proceed", p, 2, s, p);
}
conflict = Cnil;
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
cl_object hash = p->pack.internal;
cl_object x = ecl_gethash_safe(name, hash, OBJNULL);
if (x != s) {
@ -497,7 +497,7 @@ ecl_unintern(cl_object s, cl_object p)
output = TRUE;
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (conflict != Cnil) {
FEpackage_error("Cannot unintern the shadowing symbol ~S~%"
"from ~S,~%"
@ -535,7 +535,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);
AGAIN:
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (!intern_flag) {
error = 1;
@ -551,7 +551,7 @@ cl_export2(cl_object s, cl_object p)
p->pack.external = _ecl_sethash(name, p->pack.external, s);
error = 0;
}
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error == 1) {
CEpackage_error("The symbol ~S is not accessible from ~S "
"and cannot be exported.",
@ -604,7 +604,7 @@ cl_delete_package(cl_object p)
ecl_unuse_package(p, ECL_CONS_CAR(l));
}
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_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;
@ -621,7 +621,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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
@(return Ct)
}
@ -639,7 +639,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_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
int intern_flag;
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag == 0 || x != s) {
@ -653,7 +653,7 @@ cl_unexport2(cl_object s, cl_object p)
p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
error = 0;
}
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error) {
FEpackage_error("Cannot unexport ~S because it does not "
"belong to package ~S.",
@ -671,7 +671,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_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
cl_object x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag) {
if (x != s && !ignore_error) {
@ -688,7 +688,7 @@ cl_import2(cl_object s, cl_object p)
error = 0;
OUTPUT:
(void)0;
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error) {
CEpackage_error("Cannot import the symbol ~S "
"from package ~A,~%"
@ -711,7 +711,7 @@ ecl_shadowing_import(cl_object s, cl_object p)
"locked package ~S.",
"Ignore lock and proceed", p, 2, s, p);
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
x = find_symbol_inner(name, p, &intern_flag);
if (intern_flag && intern_flag != INHERITED) {
if (x == s) {
@ -733,7 +733,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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}
void
@ -748,7 +748,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_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_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);
@ -756,7 +756,7 @@ ecl_shadow(cl_object s, cl_object p)
x->symbol.hpack = p;
}
p->pack.shadowings = CONS(x, p->pack.shadowings);
} ECL_WITH_PACKAGE_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}
void
@ -784,7 +784,7 @@ ecl_use_package(cl_object x, cl_object p)
"Ignore lock and proceed",
p, 2, x, p);
ECL_WITH_PACKAGE_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_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++) {
@ -803,7 +803,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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
if (error) {
FEpackage_error("Cannot use ~S~%"
"from ~S,~%"
@ -821,10 +821,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_WRLOCK_BEGIN(ecl_process_env()) {
ECL_WITH_GLOBAL_ENV_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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}
@(defun make_package (pack_name &key nicknames (use CONS(cl_core.lisp_package, Cnil)))
@ -1088,10 +1088,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_WRLOCK_BEGIN(the_env) {
ECL_WITH_GLOBAL_ENV_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_WRLOCK_END;
} ECL_WITH_GLOBAL_ENV_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.external_processes_lock = ecl_make_lock(@'ext::run-program', 1);
cl_core.error_lock = ecl_make_lock(@'mp::error-lock', 1);
cl_core.package_lock = ecl_make_rwlock(@'ext::package-lock');
cl_core.global_env_lock = ecl_make_rwlock(@'ext::package-lock');
cl_core.processes = ecl_list1(process);
}

2
src/h/external.h
View file

@ -215,7 +215,7 @@ struct cl_core_struct {
cl_object processes;
cl_object global_lock;
cl_object error_lock;
cl_object package_lock;
cl_object global_env_lock;
#endif
cl_object libraries;

26
src/h/internal.h
View file

@ -341,23 +341,23 @@ extern void cl_write_object(cl_object x, cl_object stream);
/* global locks */
#ifdef ECL_THREADS
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
ECL_WITH_LOCK_BEGIN(the_env, cl_core.global_lock)
# define ECL_WITH_GLOBAL_LOCK_END \
ECL_WITH_LOCK_END
# define ECL_WITH_PACKAGE_RDLOCK_BEGIN(the_env) { \
# define ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
ecl_disable_interrupts_env(__ecl_pack_env); \
mp_get_rwlock_read_wait(cl_core.package_lock);
# define ECL_WITH_PACKAGE_RDLOCK_END \
mp_giveup_rwlock_read(cl_core.package_lock); \
mp_get_rwlock_read_wait(cl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END \
mp_giveup_rwlock_read(cl_core.global_env_lock); \
ecl_enable_interrupts_env(__ecl_pack_env); }
# define ECL_WITH_PACKAGE_WRLOCK_BEGIN(the_env) { \
# define ECL_WITH_GLOBAL_ENV_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); \
mp_get_rwlock_write_wait(cl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END \
mp_giveup_rwlock_write(cl_core.global_env_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; \
@ -373,10 +373,10 @@ extern void cl_write_object(cl_object x, cl_object stream);
#else
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)
# define ECL_WITH_GLOBAL_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_GLOBAL_ENV_RDLOCK_BEGIN(the_env)
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END
# define ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env)
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END
# define ECL_WITH_LOCK_BEGIN(the_env,lock)
# define ECL_WITH_LOCK_END
#endif /* ECL_THREADS */