Further cleanup and enhancements.bug_57945b574a

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++;
     }