mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-28 07:22:27 -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

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)
}