From e6bb812e38c7d04b32ada6c296a423ea82934fd4 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 31 Jul 2011 17:03:24 +0200 Subject: [PATCH] Protect the GET/SET-SYSPROP hash using the same global lock as packages, which is now called cl_core.global_env read/write-lock --- src/c/assignment.d | 27 ++++++++++++-------- src/c/main.d | 2 +- src/c/package.d | 56 ++++++++++++++++++++--------------------- src/c/threads/process.d | 2 +- src/h/external.h | 2 +- src/h/internal.h | 26 +++++++++---------- 6 files changed, 60 insertions(+), 55 deletions(-) diff --git a/src/c/assignment.d b/src/c/assignment.d index ddd18aed1..a449e56b7 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -15,8 +15,9 @@ See file '../Copyright' for full details. */ -#include #include +#include +#include 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); } diff --git a/src/c/main.d b/src/c/main.d index 54c7c6955..09c4d6da3 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -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 diff --git a/src/c/package.d b/src/c/package.d index 597aab804..e03c3830e 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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) } diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 83687daa3..9743ca8f5 100644 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -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); } diff --git a/src/h/external.h b/src/h/external.h index 5d0c070ad..a17941337 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -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; diff --git a/src/h/internal.h b/src/h/internal.h index 3fb211f3c..9fdd67d4e 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -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 */