diff options
-rw-r--r-- | doc/Thread.3 | 6 | ||||
-rw-r--r-- | generic/tcl.h | 2 | ||||
-rw-r--r-- | generic/tclInt.h | 2 | ||||
-rw-r--r-- | generic/tclThread.c | 4 | ||||
-rw-r--r-- | unix/tclUnixThrd.c | 62 | ||||
-rw-r--r-- | win/tclWinThrd.c | 38 |
6 files changed, 88 insertions, 26 deletions
diff --git a/doc/Thread.3 b/doc/Thread.3 index eeace43..74ed2f0 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -87,6 +87,10 @@ thread, or (for \fBTcl_SetMutexWaitProc\fR) NULL to uninstall the current mutex wait procedure. The special value \fBTCL_MUTEX_WAIT_NONE\fR can be used to indicate that the default mutex wait handling should be disabled and no wait procedure should be called. +.AP int *retry in/out +The number of times the current mutex lock operation has been retried. +Initially, this value will be zero. This value may be modified by the +current mutex wait procedure. .BE .SH INTRODUCTION Beginning with the 8.1 release, the Tcl core is thread safe, which @@ -160,7 +164,7 @@ The \fIProc\fR passed to Tcl_SetMutexWaitProc should match the type .CS typedef void \fBTcl_MutexWaitProc\fR( Tcl_Mutex *\fImutexPtr\fR, - int \fIretry\fR, + int *\fIretry\fR, ClientData \fIclientData\fR); .CE .PP diff --git a/generic/tcl.h b/generic/tcl.h index 0fddc99..b989b4e 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -746,7 +746,7 @@ typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); typedef void (Tcl_ExitProc) (ClientData clientData); -typedef void (Tcl_MutexWaitProc) (Tcl_Mutex *mutexPtr, int retry, +typedef void (Tcl_MutexWaitProc) (Tcl_Mutex *mutexPtr, int *retry, ClientData clientData); typedef void (Tcl_FileProc) (ClientData clientData, int mask); typedef void (Tcl_FileFreeProc) (ClientData clientData); diff --git a/generic/tclInt.h b/generic/tclInt.h index b11ef05..2a65d4b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3062,6 +3062,8 @@ MODULE_SCOPE void TclpMasterLock(void); MODULE_SCOPE void TclpMasterUnlock(void); MODULE_SCOPE void TclpMutexLock(void); MODULE_SCOPE void TclpMutexUnlock(void); +MODULE_SCOPE void TclpMutexWait(Tcl_Mutex *mutexPtr, int *retry, + ClientData clientData); 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 c621182..83d969f 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -51,7 +51,7 @@ static void RememberSyncObject(void *objPtr, * This is a mutex wait procedure that does nothing. */ -static void MutexWaitNone(Tcl_Mutex *mutexPtr, int retry, +static void MutexWaitNone(Tcl_Mutex *mutexPtr, int *retry, ClientData clientData); /* @@ -479,7 +479,7 @@ Tcl_MutexWaitProc *TclGetMutexWaitProc(void) static void MutexWaitNone( Tcl_Mutex *mutexPtr, /* Mutex passed to Tcl_MutexLock. */ - int retry, /* The number of retries so far. */ + int *retry, /* The number of retries so far. */ ClientData clientData) /* The extra data, if any. */ { /* Do nothing. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 1a12e24..10ba856 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -481,6 +481,49 @@ Tcl_GetAllocMutex(void) /* *---------------------------------------------------------------------- * + * TclpMutexWait + * + * This procedure is used to delay for a short interval while + * waiting for a mutex to be unlocked by another thread. + * + * Results: + * None. + * + * Side effects: + * The value of the retry parameter is changed. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexWait( + Tcl_Mutex *mutexPtr, /* Mutex passed to Tcl_MutexLock. */ + int *retry, /* The number of retries so far. */ + ClientData clientData) /* The extra data, if any. */ +{ + int nRetry = (retry != NULL) ? *retry : 0; + if (nRetry > TCL_MUTEX_LOCK_RESET_LIMIT) { + nRetry = 0; + } + /* + * 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 * nRetry); +#else + Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME * nRetry); +#endif + if (retry != NULL) *retry = nRetry; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_MutexLock -- * * This procedure is invoked to lock a mutex. This procedure handles @@ -537,24 +580,9 @@ retry: TclpMutexUnlock(); mutexWaitProc = TclGetMutexWaitProc(); if (mutexWaitProc != NULL) { - mutexWaitProc(mutexPtr, nRetry, NULL); + mutexWaitProc(mutexPtr, &nRetry, NULL); } else { - if (nRetry > TCL_MUTEX_LOCK_RESET_LIMIT) { - nRetry = 0; - } - /* - * 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 * nRetry); -#else - Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME * nRetry); -#endif + TclpMutexWait(mutexPtr, &nRetry, NULL); } nRetry++; } diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index ed30879..4922cc6 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -626,6 +626,37 @@ static void FinalizeConditionEvent(ClientData data); /* *---------------------------------------------------------------------- * + * TclpMutexWait + * + * This procedure is used to delay for a short interval while + * waiting for a mutex to be unlocked by another thread. + * + * Results: + * None. + * + * Side effects: + * The value of the retry parameter is changed. + * + *---------------------------------------------------------------------- + */ + +void +TclpMutexWait( + Tcl_Mutex *mutexPtr, /* Mutex passed to Tcl_MutexLock. */ + int *retry, /* The number of retries so far. */ + ClientData clientData) /* The extra data, if any. */ +{ + int nRetry = (retry != NULL) ? *retry : 0; + if (nRetry > TCL_MUTEX_LOCK_RESET_LIMIT) { + nRetry = 0; + } + Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME * nRetry); + if (retry != NULL) *retry = nRetry; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_MutexLock -- * * This procedure is invoked to lock a mutex. This is a self initializing @@ -679,12 +710,9 @@ retry: TclpMutexUnlock(); mutexWaitProc = TclGetMutexWaitProc(); if (mutexWaitProc != NULL) { - mutexWaitProc(mutexPtr, nRetry, NULL); + mutexWaitProc(mutexPtr, &nRetry, NULL); } else { - if (nRetry > TCL_MUTEX_LOCK_RESET_LIMIT) { - nRetry = 0; - } - Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME * nRetry); + TclpMutexWait(mutexPtr, &nRetry, NULL); } nRetry++; } |