summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorkjnash <k.j.nash@usa.net>2020-07-18 21:12:17 (GMT)
committerkjnash <k.j.nash@usa.net>2020-07-18 21:12:17 (GMT)
commitd91e1e6efbf64ebd8e820892a06b88882a49b0ed (patch)
tree39099d911aac17a065a5a67b34bb3c3d6e576066
parent2705cb22d65f0967365c9a9e16bf9bb50eaa2dbb (diff)
parentfb48c78e68e6318476a8076f01661aa0626eb6ee (diff)
downloadtcl-d91e1e6efbf64ebd8e820892a06b88882a49b0ed.zip
tcl-d91e1e6efbf64ebd8e820892a06b88882a49b0ed.tar.gz
tcl-d91e1e6efbf64ebd8e820892a06b88882a49b0ed.tar.bz2
Merge 8.7
-rw-r--r--doc/CrtAlias.38
-rw-r--r--doc/clock.n12
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclIntDecls.h8
-rw-r--r--generic/tclInterp.c18
-rw-r--r--generic/tclStubInit.c2
-rw-r--r--macosx/tclMacOSXNotify.c127
8 files changed, 113 insertions, 66 deletions
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index 72912bc..82ef122 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -158,12 +158,12 @@ If no such slave interpreter exists, \fBNULL\fR is returned.
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
-\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
-the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
-\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
+\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
+the relative path between \fIinterp\fR and \fIslaveInterp\fR;
+\fIslaveInterp\fR must be a slave of \fIinterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
-result of \fIaskingInterp\fR.
+result of \fIinterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
diff --git a/doc/clock.n b/doc/clock.n
index f30ad24..a3f934a 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -471,36 +471,36 @@ The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
\fB%a\fR
-On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
+On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%A\fR
-On output, receives the full name (\fIe.g.,\fR \fBMonday\fR) of the day
+On output, produces the full name (\fIe.g.,\fR \fBMonday\fR) of the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%b\fR
-On output, receives an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
+On output, produces an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%B\fR
-On output, receives the full name (\fIe.g.,\fR \fBJanuary\fR)
+On output, produces the full name (\fIe.g.,\fR \fBJanuary\fR)
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%c\fR
-On output, receives a localized representation of date and time of day;
+On output, produces a localized representation of date and time of day;
the localized representation is expected to use the Gregorian calendar.
On input, matches whatever \fB%c\fR produces.
.TP
\fB%C\fR
-On output, receives the number of the century in Indo-Arabic numerals.
+On output, produces the number of the century in Indo-Arabic numerals.
On input, matches one or two digits, possibly with leading whitespace,
that are expected to be the number of the century.
.TP
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6c14f45..566b980 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3796,7 +3796,7 @@ CancelEvalProc(
* interpreters belonging to this one.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr,
cancelInfo->flags | CANCELED, 0);
/*
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 8845359..0addf66 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -990,7 +990,7 @@ declare 249 {
}
# TIP #285: Script cancellation support.
declare 250 {
- void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
+ void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}
# Allow extensions for optimization
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 2426326..b698c08 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -623,7 +623,7 @@ EXTERN int TclCopyChannel(Tcl_Interp *interp,
EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
int *decpt, int *signum, char **endPtr);
/* 250 */
-EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
+EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags,
int force);
/* 251 */
EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes,
@@ -918,7 +918,7 @@ typedef struct TclIntStubs {
void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
- void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+ void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
@@ -1356,8 +1356,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCopyChannel) /* 248 */
#define TclDoubleDigits \
(tclIntStubsPtr->tclDoubleDigits) /* 249 */
-#define TclSetSlaveCancelFlags \
- (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclSetChildCancelFlags \
+ (tclIntStubsPtr->tclSetChildCancelFlags) /* 250 */
#define TclRegisterLiteral \
(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
#define TclPtrGetVar \
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1570837..de8cd32 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -2161,7 +2161,7 @@ Tcl_GetMaster(
/*
*----------------------------------------------------------------------
*
- * TclSetSlaveCancelFlags --
+ * TclSetChildCancelFlags --
*
* This function marks all slave interpreters belonging to a given
* interpreter as being canceled or not canceled, depending on the
@@ -2177,7 +2177,7 @@ Tcl_GetMaster(
*/
void
-TclSetSlaveCancelFlags(
+TclSetChildCancelFlags(
Tcl_Interp *interp, /* Set cancel flags of this interpreter. */
int flags, /* Collection of OR-ed bits that control
* the cancellation of the script. Only
@@ -2220,7 +2220,7 @@ TclSetSlaveCancelFlags(
* interpreter.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr, flags, force);
}
}
@@ -2250,23 +2250,23 @@ TclSetSlaveCancelFlags(
int
Tcl_GetInterpPath(
- Tcl_Interp *askingInterp, /* Interpreter to start search from. */
+ Tcl_Interp *interp, /* Interpreter to start search from. */
Tcl_Interp *targetInterp) /* Interpreter to find. */
{
InterpInfo *iiPtr;
- if (targetInterp == askingInterp) {
- Tcl_SetObjResult(askingInterp, Tcl_NewObj());
+ if (targetInterp == interp) {
+ Tcl_SetObjResult(interp, Tcl_NewObj());
return TCL_OK;
}
if (targetInterp == NULL) {
return TCL_ERROR;
}
iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
- if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
+ if (Tcl_GetInterpPath(interp, iiPtr->slave.masterInterp) != TCL_OK){
return TCL_ERROR;
}
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->master.slaveTable,
iiPtr->slave.slaveEntryPtr), -1));
return TCL_OK;
@@ -2874,7 +2874,7 @@ SlaveEval(
* function for that particular Tcl_Interp.
*/
- TclSetSlaveCancelFlags(slaveInterp, 0, 0);
+ TclSetChildCancelFlags(slaveInterp, 0, 0);
Tcl_Preserve(slaveInterp);
Tcl_AllowExceptions(slaveInterp);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2d2bc63..a4645b6 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -974,7 +974,7 @@ static const TclIntStubs tclIntStubs = {
TclResetRewriteEnsemble, /* 247 */
TclCopyChannel, /* 248 */
TclDoubleDigits, /* 249 */
- TclSetSlaveCancelFlags, /* 250 */
+ TclSetChildCancelFlags, /* 250 */
TclRegisterLiteral, /* 251 */
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index 8f1dbba..ee271e1 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -14,6 +14,18 @@
*/
#include "tclInt.h"
+
+/*
+ * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
+ * OSSpinLock, and the OSSpinLock was deprecated.
+ */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
+#define USE_OS_UNFAIR_LOCK
+#include <os/lock.h>
+#undef TCL_MAC_DEBUG_NOTIFIER
+#endif
+
#ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is
* in tclUnixNotfy.c */
#include <CoreFoundation/CoreFoundation.h>
@@ -21,6 +33,8 @@
/* #define TCL_MAC_DEBUG_NOTIFIER 1 */
+#if !defined(USE_OS_UNFAIR_LOCK)
+
/*
* We use the Darwin-native spinlock API rather than pthread mutexes for
* notifier locking: this radically simplifies the implementation and lowers
@@ -172,26 +186,45 @@ SpinLockTry(
#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
+#endif /* not using os_unfair_lock */
/*
- * These spinlocks lock access to the global notifier state.
+ * These locks control access to the global notifier state.
*/
+#if defined(USE_OS_UNFAIR_LOCK)
+static os_unfair_lock notifierInitLock = OS_UNFAIR_LOCK_INIT;
+static os_unfair_lock notifierLock = OS_UNFAIR_LOCK_INIT;
+#else
static OSSpinLock notifierInitLock = SPINLOCK_INIT;
static OSSpinLock notifierLock = SPINLOCK_INIT;
+#endif
/*
- * Macros abstracting notifier locking/unlocking
+ * Macros that abstract notifier locking/unlocking
*/
+#if defined(USE_OS_UNFAIR_LOCK)
+#define LOCK_NOTIFIER_INIT os_unfair_lock_lock(&notifierInitLock)
+#define UNLOCK_NOTIFIER_INIT os_unfair_lock_unlock(&notifierInitLock)
+#define LOCK_NOTIFIER os_unfair_lock_lock(&notifierLock)
+#define UNLOCK_NOTIFIER os_unfair_lock_unlock(&notifierLock)
+#define LOCK_NOTIFIER_TSD os_unfair_lock_lock(&tsdPtr->tsdLock)
+#define UNLOCK_NOTIFIER_TSD os_unfair_lock_unlock(&tsdPtr->tsdLock)
+#else
#define LOCK_NOTIFIER_INIT SpinLockLock(&notifierInitLock)
#define UNLOCK_NOTIFIER_INIT SpinLockUnlock(&notifierInitLock)
#define LOCK_NOTIFIER SpinLockLock(&notifierLock)
#define UNLOCK_NOTIFIER SpinLockUnlock(&notifierLock)
#define LOCK_NOTIFIER_TSD SpinLockLock(&tsdPtr->tsdLock)
#define UNLOCK_NOTIFIER_TSD SpinLockUnlock(&tsdPtr->tsdLock)
+#endif
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+/*
+ * The debug version of the Notifier only works if using OSSpinLock.
+ */
+
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
#define TclMacOSXNotifierDbgMsg(m, ...) \
do { \
fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
@@ -218,7 +251,7 @@ static OSSpinLock notifierLock = SPINLOCK_INIT;
#undef LOCK_NOTIFIER
#define LOCK_NOTIFIER SpinLockLockDbg(&notifierLock)
#undef LOCK_NOTIFIER_TSD
-#define LOCK_NOTIFIER_TSD SpinLockLockDbg(&tsdPtr->tsdLock)
+#define LOCK_NOTIFIER_TSD SpinLockLockDbg(tsdPtr->tsdLock)
#include <asl.h>
static FILE *notifierLog = NULL;
#ifndef NOTIFIER_LOG
@@ -325,8 +358,6 @@ typedef struct ThreadSpecificData {
int runLoopRunning; /* True if this thread's Tcl runLoop is
* running. */
int runLoopNestingLevel; /* Level of nested runLoop invocations. */
- int runLoopServicingEvents; /* True if this thread's runLoop is servicing
- * Tcl events. */
/* Must hold the notifierLock before accessing the following fields: */
/* Start notifierLock section */
@@ -339,9 +370,14 @@ typedef struct ThreadSpecificData {
* from these pointers. */
/* End notifierLock section */
+#if defined(USE_OS_UNFAIR_LOCK)
+ os_unfair_lock tsdLock;
+#else
OSSpinLock tsdLock; /* Must hold this lock before acessing the
* following fields from more than one
* thread. */
+#endif
+
/* Start tsdLock section */
SelectMasks checkMasks; /* This structure is used to build up the
* masks to be used in the next call to
@@ -526,7 +562,6 @@ Tcl_InitNotifier(void)
/*
* Initialize support for weakly imported spinlock API.
*/
-
if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
}
@@ -563,7 +598,7 @@ Tcl_InitNotifier(void)
bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
runLoopObserverContext.info = tsdPtr;
runLoopObserver = CFRunLoopObserverCreate(NULL,
- kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserver) {
@@ -581,7 +616,7 @@ Tcl_InitNotifier(void)
*/
runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
- kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserverTcl) {
@@ -597,7 +632,11 @@ Tcl_InitNotifier(void)
tsdPtr->runLoopObserverTcl = runLoopObserverTcl;
tsdPtr->runLoopTimer = NULL;
tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER;
+#if defined(USE_OS_UNFAIR_LOCK)
+ tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
tsdPtr->tsdLock = SPINLOCK_INIT;
+#endif
}
LOCK_NOTIFIER_INIT;
@@ -655,7 +694,6 @@ Tcl_InitNotifier(void)
ENABLE_ASL;
notifierCount++;
UNLOCK_NOTIFIER_INIT;
-
return tsdPtr;
}
@@ -1291,6 +1329,10 @@ Tcl_WaitForEvent(
Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
}
+ /*
+ * A NULL timePtr means wait forever.
+ */
+
if (timePtr) {
Tcl_Time vTime = *timePtr;
@@ -1304,14 +1346,23 @@ Tcl_WaitForEvent(
tclScaleTimeProcPtr(&vTime, tclTimeClientData);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
+
/*
- * Polling: pretend to wait for files and tell the notifier thread
- * what we are doing. The notifier thread makes sure it goes
- * through select with its select mask in the same state as ours
- * currently is. We block until that happens.
+ * The max block time was set to 0.
+ *
+ * If we set the waitTime to 0, then the call to CFRunLoopInMode
+ * may return without processing all of its sources. The Apple
+ * documentation says that if the waitTime is 0 "only one pass is
+ * made through the run loop before returning; if multiple sources
+ * or timers are ready to fire immediately, only one (possibly two
+ * if one is a version 0 source) will be fired, regardless of the
+ * value of returnAfterSourceHandled." This can cause some chanio
+ * tests to fail. So we use a small positive waitTime unless there
+ * is another RunLoop running.
*/
polling = 1;
+ waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001;
}
}
@@ -1324,18 +1375,18 @@ Tcl_WaitForEvent(
/*
* If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was
- * called recursively) or is servicing events via the runloop observer,
- * re-run it in a custom runloop mode containing only the source for the
- * notifier thread, otherwise wakeups from other sources added to the
- * common runloop modes might get lost or 3rd party event handlers might
- * get called when they do not expect to be.
+ * called recursively) start a new runloop in a custom runloop mode
+ * containing only the source for the notifier thread. Otherwise wakeups
+ * from other sources added to the common runloop mode might get lost or
+ * 3rd party event handlers might get called when they do not expect to
+ * be.
*/
runLoopRunning = tsdPtr->runLoopRunning;
tsdPtr->runLoopRunning = 1;
- runLoopStatus = CFRunLoopRunInMode(tsdPtr->runLoopServicingEvents ||
- runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
- waitTime, TRUE);
+ runLoopStatus = CFRunLoopRunInMode(
+ runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
+ waitTime, TRUE);
tsdPtr->runLoopRunning = runLoopRunning;
LOCK_NOTIFIER_TSD;
@@ -1453,7 +1504,6 @@ UpdateWaitingListAndServiceEvents(
void *info)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
-
if (tsdPtr->sleeping) {
return;
}
@@ -1476,19 +1526,6 @@ UpdateWaitingListAndServiceEvents(
}
tsdPtr->runLoopNestingLevel--;
break;
- case kCFRunLoopBeforeWaiting:
- if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
- (tsdPtr->runLoopNestingLevel > 1
- || !tsdPtr->runLoopRunning)) {
- tsdPtr->runLoopServicingEvents = 1;
- /*
- * This call seems to simply force event processing through and
- * prevents hangups that have long been observed with Tk-Cocoa.
- */
- Tcl_ServiceAll();
- tsdPtr->runLoopServicingEvents = 0;
- }
- break;
default:
break;
}
@@ -1521,7 +1558,7 @@ OnOffWaitingList(
{
int changeWaitingList;
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
if (SpinLockTry(&notifierLock)) {
Tcl_Panic("OnOffWaitingList: notifierLock unlocked");
}
@@ -2052,9 +2089,19 @@ AtForkChild(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- UNLOCK_NOTIFIER_TSD;
- UNLOCK_NOTIFIER;
- UNLOCK_NOTIFIER_INIT;
+ /*
+ * If a child process unlocks an os_unfair_lock that was created in its parent
+ * the child will exit with an illegal instruction error. So we reinitialize
+ * the lock in the child rather than attempt to unlock it.
+ */
+
+#if defined(USE_OS_UNFAIR_LOCK)
+ tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
+ UNLOCK_NOTIFIER_TSD;
+ UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_INIT;
+#endif
if (tsdPtr->runLoop) {
tsdPtr->runLoop = NULL;
if (!noCFafterFork) {