diff options
| -rw-r--r-- | doc/Thread.3 | 20 | ||||
| -rw-r--r-- | generic/tcl.decls | 5 | ||||
| -rw-r--r-- | generic/tcl.h | 2 | ||||
| -rw-r--r-- | generic/tclDecls.h | 5 | ||||
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 1 | ||||
| -rw-r--r-- | generic/tclThread.c | 38 | ||||
| -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 | 10 | ||||
| -rw-r--r-- | unix/tclUnixThrd.c | 102 | ||||
| -rw-r--r--[-rwxr-xr-x] | win/tclWinFile.c | 0 | ||||
| -rw-r--r-- | win/tclWinThrd.c | 83 |
15 files changed, 562 insertions, 11 deletions
diff --git a/doc/Thread.3 b/doc/Thread.3 index ac5f2ba..c84dcb4 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support +Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_MutexUnlockAndFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -35,6 +35,9 @@ void void \fBTcl_MutexFinalize\fR(\fImutexPtr\fR) .sp +void +\fBTcl_MutexUnlockAndFinalize\fR(\fImutexPtr\fR) +.sp int \fBTcl_CreateThread\fR(\fIidPtr, proc, clientData, stackSize, flags\fR) .sp @@ -138,11 +141,16 @@ A mutex is a lock that is used to serialize all threads through a piece of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR. If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will block until \fBTcl_MutexUnlock\fR is called. -A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR. +A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR or +\fBTcl_MutexUnlockAndFinalize\fR. The \fBTcl_MutexFinalize\fR function may +only be used on unlocked mutexes; otherwise, its behavior is undefined. The +\fBTcl_MutexUnlockAndFinalize\fR function may only be used on locked mutexes; +otherwise, its behavior is undefined. The result of locking a mutex twice from the same thread is undefined. On some platforms it will result in a deadlock. -The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR -procedures are defined as empty macros if not compiling with threads enabled. +The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR, \fBTcl_MutexFinalize\fR, and +\fBTcl_MutexUnlockAndFinalize\fR procedures are defined as empty macros if +not compiling with threads enabled. For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used. This macro assures correct mutex handling even when the core is compiled without threads enabled. @@ -176,8 +184,8 @@ They are implemented as opaque pointers that should be NULL upon first use. The mutexes and condition variables are either cleaned up by process exit handlers (if living that long) or -explicitly by calls to \fBTcl_MutexFinalize\fR or -\fBTcl_ConditionFinalize\fR. +explicitly by calls to \fBTcl_MutexFinalize\fR (or +\fBTcl_MutexUnlockAndFinalize\fR) and \fBTcl_ConditionFinalize\fR. Thread local storage is reclaimed during \fBTcl_FinalizeThread\fR. .SH "SCRIPT-LEVEL ACCESS TO THREADS" .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 1829249..e80fe0f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2326,6 +2326,11 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # +# TIP #435 +declare 631 { + void Tcl_MutexUnlockAndFinalize(Tcl_Mutex *mutex) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tcl.h b/generic/tcl.h index 297b42c..80f924a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2592,6 +2592,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #define Tcl_MutexLock(mutexPtr) #undef Tcl_MutexUnlock #define Tcl_MutexUnlock(mutexPtr) +#undef Tcl_MutexUnlockAndFinalize +#define Tcl_MutexUnlockAndFinalize(mutexPtr) #undef Tcl_MutexFinalize #define Tcl_MutexFinalize(mutexPtr) #undef Tcl_ConditionNotify diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 91c0add..f4ebc53 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1815,6 +1815,8 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); +/* 631 */ +EXTERN void Tcl_MutexUnlockAndFinalize(Tcl_Mutex *mutex); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2481,6 +2483,7 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ + void (*tcl_MutexUnlockAndFinalize) (Tcl_Mutex *mutex); /* 631 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3773,6 +3776,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ #define Tcl_ZlibStreamSetCompressionDictionary \ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ +#define Tcl_MutexUnlockAndFinalize \ + (tclStubsPtr->tcl_MutexUnlockAndFinalize) /* 631 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInt.h b/generic/tclInt.h index c89f053..51d153b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3059,6 +3059,8 @@ 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 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/tclStubInit.c b/generic/tclStubInit.c index 7a84cba..f0d00ee 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1412,6 +1412,7 @@ const TclStubs tclStubs = { Tcl_FindSymbol, /* 628 */ Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ + Tcl_MutexUnlockAndFinalize, /* 631 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclThread.c b/generic/tclThread.c index 198fa6a..b46ddf5 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -50,6 +50,7 @@ static void RememberSyncObject(void *objPtr, #undef Tcl_MutexLock #undef Tcl_MutexUnlock #undef Tcl_MutexFinalize +#undef Tcl_MutexUnlockAndFinalize #undef Tcl_ConditionNotify #undef Tcl_ConditionWait #undef Tcl_ConditionFinalize @@ -284,6 +285,43 @@ Tcl_MutexFinalize( /* *---------------------------------------------------------------------- * + * Tcl_MutexUnlockAndFinalize -- + * + * 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 +Tcl_MutexUnlockAndFinalize( + 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..219dd75 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -1334,6 +1334,9 @@ NotifierThreadProc( static void AtForkPrepare(void) { + Tcl_MutexLock(¬ifierMutex); + TclpMasterLock(); + TclpMutexLock(); } /* @@ -1355,6 +1358,9 @@ AtForkPrepare(void) static void AtForkParent(void) { + TclpMutexUnlock(); + TclpMasterUnlock(); + Tcl_MutexUnlock(¬ifierMutex); } /* @@ -1376,7 +1382,9 @@ AtForkParent(void) static void AtForkChild(void) { - Tcl_MutexFinalize(¬ifierMutex); + TclpMutexUnlock(); + TclpMasterUnlock(); + Tcl_MutexUnlockAndFinalize(¬ifierMutex); Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index d34bc88..3963f84 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); +#else + Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME); +#endif + } } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index a5b14b4..a5b14b4 100755..100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c 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); + } } /* |