From c86c8bd5c0835dd06eeee2ecc2008e5ee00dd167 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 24 Oct 2010 17:52:53 +0200 Subject: [PATCH] Move packages to read/write locks --- src/c/alloc_2.d | 2 ++ src/c/error.d | 4 ++- src/c/main.d | 6 ++--- src/c/package.d | 58 ++++++++++++++++++++++------------------- src/c/threads/process.d | 2 +- src/c/threads/rwlock.d | 51 +++++++++++++++++++++++++++--------- src/h/internal.h | 21 ++++++++++----- 7 files changed, 94 insertions(+), 50 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 0164fe90a..814f215b2 100755 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -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 diff --git a/src/c/error.d b/src/c/error.d index f9552ffe2..1200e8660 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -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) diff --git a/src/c/main.d b/src/c/main.d index 07e4fdad0..20e2c8abc 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -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 /* diff --git a/src/c/package.d b/src/c/package.d index 3add42f95..71477a70d 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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) } diff --git a/src/c/threads/process.d b/src/c/threads/process.d index cf588d5f9..fbcc36c89 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.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); } diff --git a/src/c/threads/rwlock.d b/src/c/threads/rwlock.d index 86139aa09..01859ee5a 100644 --- a/src/c/threads/rwlock.d +++ b/src/c/threads/rwlock.d @@ -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) } diff --git a/src/h/internal.h b/src/h/internal.h index 41b386d1a..26166ef3f 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -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 */