summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclThread.c37
-rw-r--r--tests/thread.test26
-rwxr-xr-xunix/configure231
-rw-r--r--unix/configure.in6
-rw-r--r--unix/tcl.m442
-rw-r--r--unix/tclUnixNotfy.c10
-rw-r--r--unix/tclUnixThrd.c102
-rw-r--r--win/tclWinThrd.c83
9 files changed, 535 insertions, 5 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 356d250..54ecc0b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3059,6 +3059,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 198fa6a..c2112b7 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -284,6 +284,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 6032bae..cc4c871 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -1412,6 +1412,32 @@ test thread-7.37 {cancel: send async thread cancel nested catch inside pure insi
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
+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 0b42510..31758c3 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)
@@ -16728,6 +16730,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 c7b0edc..ce68391 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -545,6 +545,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 67c442c..d896d05 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -774,6 +774,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 b2bea45..17fdc95 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -1334,6 +1334,9 @@ NotifierThreadProc(
static void
AtForkPrepare(void)
{
+ Tcl_MutexLock(&notifierMutex);
+ TclpMasterLock();
+ TclpMutexLock();
}
/*
@@ -1355,6 +1358,9 @@ AtForkPrepare(void)
static void
AtForkParent(void)
{
+ TclpMutexUnlock();
+ TclpMasterUnlock();
+ Tcl_MutexUnlock(&notifierMutex);
}
/*
@@ -1376,7 +1382,9 @@ AtForkParent(void)
static void
AtForkChild(void)
{
- Tcl_MutexFinalize(&notifierMutex);
+ TclpMutexUnlock();
+ TclpMasterUnlock();
+ TclMutexUnlockAndFinalize(&notifierMutex);
Tcl_InitNotifier();
}
#endif /* HAVE_PTHREAD_ATFORK */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index d34bc88..02f18b8 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -22,6 +22,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.
@@ -45,6 +58,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.
*/
@@ -365,6 +385,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
@@ -421,6 +493,8 @@ Tcl_MutexLock(
{
pthread_mutex_t *pmutexPtr;
+retry:
+
if (*mutexPtr == NULL) {
MASTER_LOCK;
if (*mutexPtr == NULL) {
@@ -435,8 +509,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 1c9d483..7fd5ff5 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -24,6 +24,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.
*/
@@ -57,6 +67,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
@@ -369,6 +386,7 @@ TclpInitLock(void)
*/
init = 1;
+ InitializeCriticalSection(&mutexLock);
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
@@ -464,6 +482,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
@@ -516,6 +580,7 @@ void
TclFinalizeLock(void)
{
MASTER_LOCK;
+ DeleteCriticalSection(&mutexLock);
DeleteCriticalSection(&joinLock);
/*
@@ -569,6 +634,8 @@ Tcl_MutexLock(
{
CRITICAL_SECTION *csPtr;
+retry:
+
if (*mutexPtr == NULL) {
MASTER_LOCK;
@@ -584,8 +651,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);
+ }
}
/*