Add new public Tcl C API to allow a mutex to be unlocked and then finalized atomically. Candidate fix for bug [57945b574a].

6 files changed, 47 insertions, 1 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 1829249..8be7d32 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2326,6 +2326,11 @@ declare 630 {
 
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
+# TIP #XXX
+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/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..64e956a 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,38 @@ 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)
+{
+    TclpMasterLock();
+#ifdef TCL_THREADS
+    Tcl_MutexUnlock(mutexPtr);
+    TclpFinalizeMutex(mutexPtr);
+#endif
+    ForgetSyncObject(mutexPtr, &mutexRecord);
+    TclpMasterUnlock();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclRememberCondition
  *
  *	Keep a list of condition variables used during finalization.
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index b2bea45..aa32915 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -1376,7 +1376,7 @@ AtForkParent(void)
 static void
 AtForkChild(void)
 {
-    Tcl_MutexFinalize(&notifierMutex);
+    Tcl_MutexUnlockAndFinalize(&notifierMutex);
     Tcl_InitNotifier();
 }
 #endif /* HAVE_PTHREAD_ATFORK */