diff options
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclThread.c | 37 | ||||
| -rw-r--r-- | tests/thread.test | 26 | ||||
| -rwxr-xr-x | unix/configure | 231 | ||||
| -rw-r--r-- | unix/configure.in | 6 | ||||
| -rw-r--r-- | unix/tcl.m4 | 42 | ||||
| -rw-r--r-- | unix/tclUnixNotfy.c | 16 | ||||
| -rw-r--r-- | unix/tclUnixThrd.c | 111 | ||||
| -rw-r--r-- | win/tclWinThrd.c | 83 |
9 files changed, 543 insertions, 12 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index 18574c3..f39e77d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2681,6 +2681,9 @@ MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); MODULE_SCOPE void TclpMasterLock(void); MODULE_SCOPE void TclpMasterUnlock(void); +MODULE_SCOPE void TclpMutexLock(void); +MODULE_SCOPE void TclpMutexUnlock(void); +MODULE_SCOPE void TclMutexUnlockAndFinalize(Tcl_Mutex *mutex); MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators, Tcl_DString *dirPtr, char *pattern, char *tail); MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp, diff --git a/generic/tclThread.c b/generic/tclThread.c index d6b5bcb..087d735 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -283,6 +283,43 @@ Tcl_MutexFinalize( /* *---------------------------------------------------------------------- * + * TclMutexUnlockAndFinalize -- + * + * This procedure is invoked to unlock and then finalize a mutex. + * The mutex must have been locked by Tcl_MutexLock. It is also + * removed from the list of remembered objects. The mutex can no + * longer be used after calling this procedure. + * + * Results: + * None. + * + * Side effects: + * Remove the mutex from the list. + * + *---------------------------------------------------------------------- + */ + +void +TclMutexUnlockAndFinalize( + Tcl_Mutex *mutexPtr) +{ + Tcl_Mutex mutex; + TclpMasterLock(); + TclpMutexLock(); +#ifdef TCL_THREADS + mutex = *mutexPtr; + *mutexPtr = NULL; /* Force it to be created again. */ + Tcl_MutexUnlock(&mutex); + TclpFinalizeMutex(&mutex); +#endif + ForgetSyncObject(mutexPtr, &mutexRecord); + TclpMutexUnlock(); + TclpMasterUnlock(); +} + +/* + *---------------------------------------------------------------------- + * * TclRememberCondition * * Keep a list of condition variables used during finalization. diff --git a/tests/thread.test b/tests/thread.test index bfef91c..3c0a1e1 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -254,6 +254,32 @@ test thread-6.1 {freeing very large object trees in a thread} testthread { set res } {0} +test thread-8.1 {threaded fork stress} -constraints {thread} -setup { + unset -nocomplain ::threadCount ::execCount ::threads ::thread + set ::threadCount 10 + set ::execCount 10 +} -body { + set ::threads [list] + for {set i 0} {$i < $::threadCount} {incr i} { + lappend ::threads [thread::create -joinable [string map \ + [list %execCount% $::execCount] { + proc execLs {} { + if {$::tcl_platform(platform) eq "windows"} then { + return [exec $::env(COMSPEC) /c DIR] + } else { + return [exec /bin/ls] + } + } + set j {%execCount%}; while {[incr j -1]} {execLs} + }]] + } + foreach ::thread $::threads { + thread::join $::thread + } +} -cleanup { + unset -nocomplain ::threadCount ::execCount ::threads ::thread +} -result {} + # cleanup ::tcltest::cleanupTests return diff --git a/unix/configure b/unix/configure index 7a1ab59..1899aa3 100755 --- a/unix/configure +++ b/unix/configure @@ -857,6 +857,8 @@ Optional Features: --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) + --enable-usleep use usleep if possible to sleep, otherwise use + Tcl_Sleep (default: on) --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) @@ -16432,6 +16434,235 @@ _ACEOF fi #-------------------------------------------------------------------- +# Check for support of usleep function +#-------------------------------------------------------------------- + + + # Check whether --enable-usleep or --disable-usleep was given. +if test "${enable_usleep+set}" = set; then + enableval="$enable_usleep" + usleep_ok=$enableval +else + usleep_ok=yes +fi; + + HAVE_USLEEP=0 + if test "$usleep_ok" = "yes"; then + if test "${ac_cv_header_unistd_h+set}" = set; then + echo "$as_me:$LINENO: checking for unistd.h" >&5 +echo $ECHO_N "checking for unistd.h... $ECHO_C" >&6 +if test "${ac_cv_header_unistd_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_unistd_h" >&5 +echo "${ECHO_T}$ac_cv_header_unistd_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking unistd.h usability" >&5 +echo $ECHO_N "checking unistd.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <unistd.h> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking unistd.h presence" >&5 +echo $ECHO_N "checking unistd.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <unistd.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: unistd.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: unistd.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: unistd.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: unistd.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: unistd.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: unistd.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: unistd.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: unistd.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: unistd.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: unistd.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: unistd.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for unistd.h" >&5 +echo $ECHO_N "checking for unistd.h... $ECHO_C" >&6 +if test "${ac_cv_header_unistd_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_unistd_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_unistd_h" >&5 +echo "${ECHO_T}$ac_cv_header_unistd_h" >&6 + +fi +if test $ac_cv_header_unistd_h = yes; then + usleep_ok=yes +else + usleep_ok=no +fi + + + fi + echo "$as_me:$LINENO: checking whether to use usleep" >&5 +echo $ECHO_N "checking whether to use usleep... $ECHO_C" >&6 + if test "$usleep_ok" = "yes"; then + if test "${tcl_cv_usleep_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <unistd.h> +int +main () +{ +usleep(0); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_usleep_h=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_usleep_h=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + echo "$as_me:$LINENO: result: $tcl_cv_usleep_h" >&5 +echo "${ECHO_T}$tcl_cv_usleep_h" >&6 + if test $tcl_cv_usleep_h = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_USLEEP 1 +_ACEOF + + fi + else + echo "$as_me:$LINENO: result: $usleep_ok" >&5 +echo "${ECHO_T}$usleep_ok" >&6 + fi + + +#-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- diff --git a/unix/configure.in b/unix/configure.in index 6c7cc09..9c93024 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -479,6 +479,12 @@ if test $tcl_cv_putenv_copy = yes; then fi #-------------------------------------------------------------------- +# Check for support of usleep function +#-------------------------------------------------------------------- + +SC_ENABLE_USLEEP + +#-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- diff --git a/unix/tcl.m4 b/unix/tcl.m4 index c4e4675..3db997a 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -808,6 +808,48 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ ]) #------------------------------------------------------------------------ +# SC_ENABLE_USLEEP -- +# +# Allows use of usleep function. +# This is only relevant for Unix. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-usleep=yes|no (default is yes) +# +# Defines the following vars: +# HAVE_USLEEP Triggers use of usleep if defined. +#------------------------------------------------------------------------ + +AC_DEFUN([SC_ENABLE_USLEEP], [ + AC_ARG_ENABLE(usleep, + AC_HELP_STRING([--enable-usleep], + [use usleep if possible to sleep, otherwise use Tcl_Sleep (default: on)]), + [usleep_ok=$enableval], [usleep_ok=yes]) + + HAVE_USLEEP=0 + if test "$usleep_ok" = "yes"; then + AC_CHECK_HEADER(unistd.h,[usleep_ok=yes],[usleep_ok=no]) + fi + AC_MSG_CHECKING([whether to use usleep]) + if test "$usleep_ok" = "yes"; then + AC_CACHE_VAL(tcl_cv_usleep_h, [ + AC_TRY_COMPILE([#include <unistd.h>], [usleep(0);], + [tcl_cv_usleep_h=yes],[tcl_cv_usleep_h=no])]) + AC_MSG_RESULT([$tcl_cv_usleep_h]) + if test $tcl_cv_usleep_h = yes; then + AC_DEFINE(HAVE_USLEEP, 1, [Do we have usleep()?]) + fi + else + AC_MSG_RESULT([$usleep_ok]) + fi +]) + +#------------------------------------------------------------------------ # SC_ENABLE_LANGINFO -- # # Allows use of modern nl_langinfo check for better l10n. diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 8e59044..52f6b55 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -303,6 +303,7 @@ Tcl_InitNotifier(void) * pipe to the original notifier thread */ if (notifierCount > 0 && processIDInitialized != getpid()) { + Tcl_ConditionFinalize(¬ifierCV); notifierCount = 0; processIDInitialized = 0; close(triggerPipe); @@ -1270,7 +1271,7 @@ NotifierThreadProc( Tcl_ConditionNotify(¬ifierCV); Tcl_MutexUnlock(¬ifierMutex); - TclpThreadExit (0); + TclpThreadExit(0); } #if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) @@ -1293,6 +1294,9 @@ NotifierThreadProc( static void AtForkPrepare(void) { + Tcl_MutexLock(¬ifierMutex); + TclpMasterLock(); + TclpMutexLock(); } /* @@ -1314,6 +1318,9 @@ AtForkPrepare(void) static void AtForkParent(void) { + TclpMutexUnlock(); + TclpMasterUnlock(); + Tcl_MutexUnlock(¬ifierMutex); } /* @@ -1335,15 +1342,16 @@ AtForkParent(void) static void AtForkChild(void) { - notifierMutex = NULL; - notifierCV = NULL; + TclpMutexUnlock(); + TclpMasterUnlock(); + TclMutexUnlockAndFinalize(¬ifierMutex); Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ #endif /* TCL_THREADS */ -#endif /* HAVE_COREFOUNDATION */ +#endif /* !HAVE_COREFOUNDATION */ /* * Local Variables: diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index d30791d..18b419f 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -21,6 +21,19 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* + * This is the number of milliseconds to wait between internal retries in + * the Tcl_MutexLock function. This value must be greater than zero and + * should be a suitable value for the given platform. + * + * TODO: This may need to be dynamically determined, based on the relative + * performance of the running process. + */ + +#ifndef TCL_MUTEX_LOCK_SLEEP_TIME +# define TCL_MUTEX_LOCK_SLEEP_TIME (25) +#endif + +/* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. @@ -44,6 +57,13 @@ static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t *allocLockPtr = &allocLock; /* + * The mutexLock serializes Tcl_MutexLock. This is necessary to prevent + * races when finalizing a mutex that some other thread may want to lock. + */ + +static pthread_mutex_t mutexLock = PTHREAD_MUTEX_INITIALIZER; + +/* * These are for the critical sections inside this file. */ @@ -219,13 +239,13 @@ TclpThreadGetStackSize(void) #if defined(HAVE_PTHREAD_ATTR_SETSTACKSIZE) && defined(TclpPthreadGetAttrs) pthread_attr_t threadAttr; /* This will hold the thread attributes for * the current thread. */ -#ifdef __GLIBC__ +#ifdef __GLIBC__ /* * Fix for [Bug 1815573] * * DESCRIPTION: * On linux TclpPthreadGetAttrs (which is pthread_attr_get_np) may return - * bogus values on the initial thread. + * bogus values on the initial thread. * * ASSUMPTIONS: * There seems to be no api to determine if we are on the initial @@ -263,7 +283,7 @@ TclpThreadGetStackSize(void) } } - + if (pthread_attr_getstacksize(&threadAttr, &stackSize) != 0) { pthread_attr_destroy(&threadAttr); return (size_t)-1; @@ -274,7 +294,7 @@ TclpThreadGetStackSize(void) /* * On Darwin, the API below does not return the correct stack size for the * main thread (which is not a real pthread), so fallback to getrlimit(). - */ + */ if (!pthread_main_np()) #endif stackSize = pthread_get_stacksize_np(pthread_self()); @@ -457,6 +477,58 @@ TclpMasterUnlock(void) /* *---------------------------------------------------------------------- * + * TclpMutexLock + * + * This procedure is used to grab a lock that serializes locking + * another mutex. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexLock(void) +{ +#ifdef TCL_THREADS + pthread_mutex_lock(&mutexLock); +#endif +} + + +/* + *---------------------------------------------------------------------- + * + * TclpMutexUnlock + * + * This procedure is used to release a lock that serializes locking + * another mutex. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexUnlock(void) +{ +#ifdef TCL_THREADS + pthread_mutex_unlock(&mutexLock); +#endif +} + + +/* + *---------------------------------------------------------------------- + * * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for @@ -512,6 +584,9 @@ Tcl_MutexLock( Tcl_Mutex *mutexPtr) /* Really (pthread_mutex_t **) */ { pthread_mutex_t *pmutexPtr; + +retry: + if (*mutexPtr == NULL) { MASTER_LOCK; if (*mutexPtr == NULL) { @@ -526,8 +601,32 @@ Tcl_MutexLock( } MASTER_UNLOCK; } - pmutexPtr = *((pthread_mutex_t **)mutexPtr); - pthread_mutex_lock(pmutexPtr); + while (1) { + TclpMutexLock(); + pmutexPtr = *((pthread_mutex_t **)mutexPtr); + if (pmutexPtr == NULL) { + TclpMutexUnlock(); + goto retry; + } + if (pthread_mutex_trylock(pmutexPtr) == 0) { + TclpMutexUnlock(); + return; + } + TclpMutexUnlock(); + /* + * BUGBUG: All core and Thread package tests pass when usleep() + * is used; however, the Thread package tests hang at + * various places when Tcl_Sleep() is used, typically + * while running test "thread-17.8", "thread-17.9", or + * "thread-17.11a". Really, what we want here is just + * to yield to other threads for a while. + */ +#ifdef HAVE_USLEEP + usleep(TCL_MUTEX_LOCK_SLEEP_TIME * 1000); +#else + Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME); +#endif + } } /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 2413a78..2f2825f 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -23,6 +23,16 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask #endif /* + * This is the number of milliseconds to wait between internal retries in + * the Tcl_MutexLock function. This value must be greater than or equal + * to zero and should be a suitable value for the given platform. + */ + +#ifndef TCL_MUTEX_LOCK_SLEEP_TIME +# define TCL_MUTEX_LOCK_SLEEP_TIME (0) +#endif + +/* * This is the master lock used to serialize access to other serialization * data structures. */ @@ -56,6 +66,13 @@ static int allocOnce = 0; #endif /* TCL_THREADS */ /* + * The mutexLock serializes Tcl_MutexLock. This is necessary to prevent + * races when finalizing a mutex that some other thread may want to lock. + */ + +static CRITICAL_SECTION mutexLock; + +/* * The joinLock serializes Create- and ExitThread. This is necessary to * prevent a race where a new joinable thread exits before the creating thread * had the time to create the necessary data structures in the emulation @@ -368,6 +385,7 @@ TclpInitLock(void) */ init = 1; + InitializeCriticalSection(&mutexLock); InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); @@ -463,6 +481,52 @@ TclpMasterUnlock(void) /* *---------------------------------------------------------------------- * + * TclpMutexLock + * + * This procedure is used to grab a lock that serializes locking + * another mutex. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexLock(void) +{ + EnterCriticalSection(&mutexLock); +} + +/* + *---------------------------------------------------------------------- + * + * TclpMutexUnlock + * + * This procedure is used to release a lock that serializes locking + * another mutex. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexUnlock(void) +{ + LeaveCriticalSection(&mutexLock); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for @@ -515,6 +579,7 @@ void TclFinalizeLock(void) { MASTER_LOCK; + DeleteCriticalSection(&mutexLock); DeleteCriticalSection(&joinLock); /* @@ -568,6 +633,8 @@ Tcl_MutexLock( { CRITICAL_SECTION *csPtr; +retry: + if (*mutexPtr == NULL) { MASTER_LOCK; @@ -583,8 +650,20 @@ Tcl_MutexLock( } MASTER_UNLOCK; } - csPtr = *((CRITICAL_SECTION **)mutexPtr); - EnterCriticalSection(csPtr); + while (1) { + TclpMutexLock(); + csPtr = *((CRITICAL_SECTION **)mutexPtr); + if (csPtr == NULL) { + TclpMutexUnlock(); + goto retry; + } + if (TryEnterCriticalSection(csPtr)) { + TclpMutexUnlock(); + return; + } + TclpMutexUnlock(); + Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME); + } } /* |