static void
FinalizeRegexp(
ClientData clientData) /* Not used. */
{
int i;
TclRegexp *regexpPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
regexpPtr = tsdPtr->regexps[i];
if (--(regexpPtr->refCount) <= 0) {
FreeRegexp(regexpPtr);
}
ckfree(tsdPtr->patterns[i]);
tsdPtr->patterns[i] = NULL;
}
/*
* We may find ourselves reinitialized if another finalization routine
* invokes regexps.
*/
tsdPtr->initialized = 0;
}
void
ConsoleSetupProc(
ClientData data, /* Not used. */
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
int block = 1;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Look to see if any events are already pending. If they are, poll.
*/
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writer.readyEvent,
0) != WAIT_TIMEOUT) {
block = 0;
}
}
if (infoPtr->watchMask & TCL_READABLE) {
if (WaitForRead(infoPtr, 0) >= 0) {
block = 0;
}
}
}
if (!block) {
Tcl_SetMaxBlockTime(&blockTime);
}
}
/* ARGSUSED */
int
Tcl_PutsObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
Tcl_Obj *string; /* String to write. */
Tcl_Obj *chanObjPtr = NULL; /* channel object. */
int newline; /* Add a newline at end? */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
ThreadSpecificData *tsdPtr;
switch (objc) {
case 2: /* [puts $x] */
string = objv[1];
newline = 1;
break;
case 3: /* [puts -nonewline $x] or [puts $chan $x] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
} else {
newline = 1;
chanObjPtr = objv[1];
}
string = objv[2];
break;
case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
string = objv[3];
} else {
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
* documented.
*/
char *arg;
int length;
arg = TclGetStringFromObj(objv[3], &length);
if ((length != 9)
|| (strncmp(arg, "nonewline", (size_t) length) != 0)) {
Tcl_AppendResult(interp, "bad argument \"", arg,
"\": should be \"nonewline\"", NULL);
return TCL_ERROR;
}
chanObjPtr = objv[1];
string = objv[2];
}
newline = 0;
break;
default:
/* [puts] or [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
if (chanObjPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->initialized) {
tsdPtr->initialized = 1;
TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout");
Tcl_IncrRefCount(tsdPtr->stdoutObjPtr);
Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL);
}
chanObjPtr = tsdPtr->stdoutObjPtr;
}
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
}
if (newline != 0) {
result = Tcl_WriteChars(chan, "\n", 1);
if (result < 0) {
goto error;
}
}
return TCL_OK;
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result. Fall back to the regular
* message if nothing was found in the bypass.
*/
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error writing \"",
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
ClientData
Tcl_InitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->eventReady = 0;
/*
* Initialize CFRunLoopSource and add it to CFRunLoop of this thread
*/
if (!tsdPtr->runLoop) {
CFRunLoopRef runLoop = CFRunLoopGetCurrent();
CFRunLoopSourceRef runLoopSource;
CFRunLoopSourceContext runLoopSourceContext;
bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
runLoopSourceContext.info = tsdPtr;
runLoopSource = CFRunLoopSourceCreate(NULL, 0, &runLoopSourceContext);
if (!runLoopSource) {
Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource.");
}
CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
tsdPtr->runLoopSource = runLoopSource;
tsdPtr->runLoop = runLoop;
}
/*
* Initialize trigger pipe and start the Notifier thread if necessary.
*/
LOCK_NOTIFIER_INIT;
if (notifierCount == 0) {
int fds[2], status, result;
pthread_attr_t attr;
if (pipe(fds) != 0) {
Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe.");
}
status = fcntl(fds[0], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[0], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non blocking.");
}
status = fcntl(fds[1], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[1], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non blocking.");
}
receivePipe = fds[0];
triggerPipe = fds[1];
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(¬ifierThread, &attr,
(void * (*)(void *))NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result) {
Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread.");
}
}
notifierCount++;
UNLOCK_NOTIFIER_INIT;
return (ClientData) tsdPtr;
}
int
Tcl_WaitForEvent(
Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
FileHandler *filePtr;
FileHandlerEvent *fileEvPtr;
int mask;
int waitForFiles;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
return tclStubs.tcl_WaitForEvent(timePtr);
}
/*
* Start notifier thread if necessary.
*/
LOCK_NOTIFIER_INIT;
if (!notifierCount) {
Tcl_Panic("Tcl_WaitForEvent: notifier not initialized");
}
if (!notifierThread) {
int result;
pthread_attr_t attr;
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(¬ifierThread, &attr,
(void * (*)(void *))NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result || !notifierThread) {
Tcl_Panic("Tcl_WaitForEvent: unable to start notifier thread");
}
}
UNLOCK_NOTIFIER_INIT;
/*
* Place this thread on the list of interested threads, signal the
* notifier thread, and wait for a response or a timeout.
*/
LOCK_NOTIFIER;
if (!tsdPtr->runLoop) {
Tcl_Panic("Tcl_WaitForEvent: CFRunLoop not initialized");
}
waitForFiles = (tsdPtr->numFdBits > 0);
if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) {
/*
* Cannot emulate a polling select with a polling condition variable.
* Instead, 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.
*/
waitForFiles = 1;
tsdPtr->pollState = POLL_WANT;
timePtr = NULL;
} else {
tsdPtr->pollState = 0;
}
if (waitForFiles) {
/*
* Add the ThreadSpecificData structure of this thread to the list of
* ThreadSpecificData structures of all threads that are waiting on
* file events.
*/
tsdPtr->nextPtr = waitingListPtr;
if (waitingListPtr) {
waitingListPtr->prevPtr = tsdPtr;
}
tsdPtr->prevPtr = 0;
waitingListPtr = tsdPtr;
tsdPtr->onList = 1;
write(triggerPipe, "", 1);
}
FD_ZERO(&(tsdPtr->readyMasks.readable));
FD_ZERO(&(tsdPtr->readyMasks.writable));
FD_ZERO(&(tsdPtr->readyMasks.exceptional));
if (!tsdPtr->eventReady) {
CFTimeInterval waitTime;
CFStringRef runLoopMode;
if (timePtr == NULL) {
waitTime = 1.0e10; /* Wait forever, as per CFRunLoop.c */
} else {
waitTime = timePtr->sec + 1.0e-6 * timePtr->usec;
}
/*
* If the run loop is already running (e.g. if Tcl_WaitForEvent was
* called recursively), re-run it in a custom run loop mode containing
* only the source for the notifier thread, otherwise wakeups from other
* sources added to the common run loop modes might get lost.
*/
if ((runLoopMode = CFRunLoopCopyCurrentMode(tsdPtr->runLoop))) {
CFRelease(runLoopMode);
runLoopMode = tclEventsOnlyRunLoopMode;
} else {
runLoopMode = kCFRunLoopDefaultMode;
}
UNLOCK_NOTIFIER;
CFRunLoopRunInMode(runLoopMode, waitTime, TRUE);
LOCK_NOTIFIER;
}
tsdPtr->eventReady = 0;
if (waitForFiles && tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
* waiting list. Alert the notifier thread to recompute its select
* masks - skipping this caused a hang when trying to close a pipe
* which the notifier thread was still doing a select on.
*/
if (tsdPtr->prevPtr) {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
} else {
waitingListPtr = tsdPtr->nextPtr;
}
if (tsdPtr->nextPtr) {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
write(triggerPipe, "", 1);
}
/*
* Queue all detected file events before returning.
*/
for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
filePtr = filePtr->nextPtr) {
mask = 0;
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) {
mask |= TCL_READABLE;
}
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) {
mask |= TCL_WRITABLE;
}
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) {
mask |= TCL_EXCEPTION;
}
if (!mask) {
continue;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask = mask;
}
UNLOCK_NOTIFIER;
return 0;
}
void
Tcl_DeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
FileHandler *filePtr, *prevPtr;
int i;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tclStubs.tcl_DeleteFileHandler !=
tclOriginalNotifier.deleteFileHandlerProc) {
tclStubs.tcl_DeleteFileHandler(fd);
return;
}
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
if (filePtr->fd == fd) {
break;
}
}
/*
* Update the check masks for this file.
*/
if (filePtr->mask & TCL_READABLE) {
FD_CLR(fd, &(tsdPtr->checkMasks.readable));
}
if (filePtr->mask & TCL_WRITABLE) {
FD_CLR(fd, &(tsdPtr->checkMasks.writable));
}
if (filePtr->mask & TCL_EXCEPTION) {
FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
}
/*
* Find current max fd.
*/
if (fd+1 == tsdPtr->numFdBits) {
tsdPtr->numFdBits = 0;
for (i = fd-1; i >= 0; i--) {
if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
|| FD_ISSET(i, &(tsdPtr->checkMasks.writable))
|| FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
tsdPtr->numFdBits = i+1;
break;
}
}
}
/*
* Clean up information in the callback record.
*/
if (prevPtr == NULL) {
tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
ckfree((char *) filePtr);
}
int *
TclGetAsyncReadyPtr(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return &(tsdPtr->asyncReady);
}
static int
ConsoleEventProc(
Tcl_Event *evPtr, /* Event to service. */
int flags) /* Flags that indicate what events to handle,
* such as TCL_FILE_EVENTS. */
{
ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
ConsoleInfo *infoPtr;
int mask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
}
/*
* Search through the list of watched consoles for the one whose handle
* matches the event. We do this rather than simply dereferencing the
* handle in the event so that consoles can be deleted while the event is
* in the queue.
*/
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (consoleEvPtr->infoPtr == infoPtr) {
infoPtr->flags &= ~(CONSOLE_PENDING);
break;
}
}
/*
* Remove stale events.
*/
if (!infoPtr) {
return 1;
}
/*
* Check to see if the console is readable. Note that we can't tell if a
* console is writable, so we always report it as being writable unless we
* have detected EOF.
*/
mask = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
mask = TCL_WRITABLE;
}
}
if (infoPtr->watchMask & TCL_READABLE) {
if (WaitForRead(infoPtr, 0) >= 0) {
if (infoPtr->readFlags & CONSOLE_EOF) {
mask = TCL_READABLE;
} else {
mask |= TCL_READABLE;
}
}
}
/*
* Inform the channel of the events.
*/
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
return 1;
}
int
TclThreadSend(
Tcl_Interp *interp, /* The current interpreter. */
Tcl_ThreadId id, /* Thread Id of other interpreter. */
char *script, /* The script to evaluate. */
int wait) /* If 1, we block for the result. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadEvent *threadEventPtr;
ThreadEventResult *resultPtr;
int found, code;
Tcl_ThreadId threadId = (Tcl_ThreadId) id;
/*
* Verify the thread exists.
*/
Tcl_MutexLock(&threadMutex);
found = 0;
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
if (tsdPtr->threadId == threadId) {
found = 1;
break;
}
}
if (!found) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "invalid thread id", NULL);
return TCL_ERROR;
}
/*
* Short circut sends to ourself. Ought to do something with -async, like
* run in an idle handler.
*/
if (threadId == Tcl_GetCurrentThread()) {
Tcl_MutexUnlock(&threadMutex);
return Tcl_GlobalEval(interp, script);
}
/*
* Create the event for its event queue.
*/
threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
threadEventPtr->script = ckalloc(strlen(script) + 1);
strcpy(threadEventPtr->script, script);
if (!wait) {
resultPtr = threadEventPtr->resultPtr = NULL;
} else {
resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
threadEventPtr->resultPtr = resultPtr;
/*
* Initialize the result fields.
*/
resultPtr->done = NULL;
resultPtr->code = 0;
resultPtr->result = NULL;
resultPtr->errorInfo = NULL;
resultPtr->errorCode = NULL;
/*
* Maintain the cleanup list.
*/
resultPtr->srcThreadId = Tcl_GetCurrentThread();
resultPtr->dstThreadId = threadId;
resultPtr->eventPtr = threadEventPtr;
resultPtr->nextPtr = resultList;
if (resultList) {
resultList->prevPtr = resultPtr;
}
resultPtr->prevPtr = NULL;
resultList = resultPtr;
}
/*
* Queue the event and poke the other thread's notifier.
*/
threadEventPtr->event.proc = ThreadEventProc;
Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
TCL_QUEUE_TAIL);
Tcl_ThreadAlert(threadId);
if (!wait) {
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
/*
* Block on the results and then get them.
*/
Tcl_ResetResult(interp);
while (resultPtr->result == NULL) {
Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
}
/*
* Unlink result from the result list.
*/
if (resultPtr->prevPtr) {
resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
} else {
resultList = resultPtr->nextPtr;
}
if (resultPtr->nextPtr) {
resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
}
resultPtr->eventPtr = NULL;
resultPtr->nextPtr = NULL;
resultPtr->prevPtr = NULL;
Tcl_MutexUnlock(&threadMutex);
if (resultPtr->code != TCL_OK) {
if (resultPtr->errorCode) {
Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
ckfree(resultPtr->errorCode);
}
if (resultPtr->errorInfo) {
Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
ckfree(resultPtr->errorInfo);
}
}
Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
ckfree((char *) resultPtr);
return code;
}
Tcl_ThreadCreateType
NewTestThread(
ClientData clientData)
{
ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int result;
char *threadEvalScript;
/*
* Initialize the interpreter. This should be more general.
*/
tsdPtr->interp = Tcl_CreateInterp();
result = Tcl_Init(tsdPtr->interp);
result = TclThread_Init(tsdPtr->interp);
/*
* This is part of the test facility. Initialize _ALL_ test commands for
* use by the new thread.
*/
result = Tcltest_Init(tsdPtr->interp);
/*
* Update the list of threads.
*/
Tcl_MutexLock(&threadMutex);
ListUpdateInner(tsdPtr);
/*
* We need to keep a pointer to the alloc'ed mem of the script we are
* eval'ing, for the case that we exit during evaluation
*/
threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
/*
* Notify the parent we are alive.
*/
Tcl_ConditionNotify(&ctrlPtr->condWait);
Tcl_MutexUnlock(&threadMutex);
/*
* Run the script.
*/
Tcl_Preserve((ClientData) tsdPtr->interp);
result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
/*
* Clean up.
*/
ListRemove(tsdPtr);
Tcl_Release((ClientData) tsdPtr->interp);
Tcl_DeleteInterp(tsdPtr->interp);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
}
/* ARGSUSED */
int
Tcl_ThreadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
static const char *threadOptions[] = {
"create", "exit", "id", "join", "names",
"send", "wait", "errorproc", NULL
};
enum options {
THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
&option) != TCL_OK) {
return TCL_ERROR;
}
/*
* Make sure the initial thread is on the list before doing anything.
*/
if (tsdPtr->interp == NULL) {
Tcl_MutexLock(&threadMutex);
tsdPtr->interp = interp;
ListUpdateInner(tsdPtr);
Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
Tcl_MutexUnlock(&threadMutex);
}
switch ((enum options)option) {
case THREAD_CREATE: {
char *script;
int joinable, len;
if (objc == 2) {
/*
* Neither joinable nor special script
*/
joinable = 0;
script = "testthread wait"; /* Just enter event loop */
} else if (objc == 3) {
/*
* Possibly -joinable, then no special script, no joinable, then
* its a script.
*/
script = Tcl_GetStringFromObj(objv[2], &len);
if ((len > 1) &&
(script [0] == '-') && (script [1] == 'j') &&
(0 == strncmp (script, "-joinable", (size_t) len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
/*
* Remember the script
*/
joinable = 0;
}
} else if (objc == 4) {
/*
* Definitely a script available, but is the flag -joinable?
*/
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) &&
(script [0] == '-') && (script [1] == 'j') &&
(0 == strncmp(script, "-joinable", (size_t) len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
return TCL_ERROR;
}
return TclCreateThread(interp, script, joinable);
}
case THREAD_EXIT:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
ListRemove(NULL);
Tcl_ExitThread(0);
return TCL_OK;
case THREAD_ID:
if (objc == 2) {
Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
case THREAD_JOIN: {
long id;
int result, status;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
if (result == TCL_OK) {
Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
} else {
char buf [20];
sprintf(buf, "%ld", id);
Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
}
return result;
}
case THREAD_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
return TclThreadList(interp);
case THREAD_SEND: {
long id;
char *script;
int wait, arg;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
if (objc == 5) {
if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
wait = 0;
arg = 3;
} else {
wait = 1;
arg = 2;
}
if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
script = Tcl_GetString(objv[arg]);
return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
}
case THREAD_ERRORPROC: {
/*
* Arrange for this proc to handle thread death errors.
*/
char *proc;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "proc");
return TCL_ERROR;
}
Tcl_MutexLock(&threadMutex);
errorThreadId = Tcl_GetCurrentThread();
if (errorProcString) {
ckfree(errorProcString);
}
proc = Tcl_GetString(objv[2]);
errorProcString = ckalloc(strlen(proc)+1);
strcpy(errorProcString, proc);
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
case THREAD_WAIT:
while (1) {
(void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
}
}
return TCL_OK;
}
Disable gethostbyname_r/gethostbyaddr_r on NetBSD.
--- src/other/tcl/unix/tclUnixCompat.c.orig 2016-08-09 06:47:10.000000000 +0000
+++ src/other/tcl/unix/tclUnixCompat.c
@@ -101,7 +101,7 @@ static Tcl_ThreadDataKey dataKey;
(!defined(HAVE_MTSAFE_GETHOSTBYNAME) || \
!defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \
!defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \
- !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R)
+ !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) || defined(__NetBSD__)
/*
* Mutex to lock access to MT-unsafe calls. This is just to protect our own
* usage. It does not protect us from others calling the same functions
@@ -382,13 +382,13 @@ TclpGetHostByName(
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-#if defined(HAVE_GETHOSTBYNAME_R_5)
+#if defined(HAVE_GETHOSTBYNAME_R_5) && !defined(__NetBSD__)
int h_errno;
return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
sizeof(tsdPtr->hbuf), &h_errno);
-#elif defined(HAVE_GETHOSTBYNAME_R_6)
+#elif defined(HAVE_GETHOSTBYNAME_R_6) && !defined(__NetBSD__)
struct hostent *hePtr = NULL;
int h_errno, result;
@@ -396,7 +396,7 @@ TclpGetHostByName(
sizeof(tsdPtr->hbuf), &hePtr, &h_errno);
static TclRegexp *
CompileRegexp(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
const char *string, /* The regexp to compile (UTF-8). */
int length, /* The length of the string in bytes. */
int flags) /* Compilation flags. */
{
TclRegexp *regexpPtr;
const Tcl_UniChar *uniString;
int numChars, status, i, exact;
Tcl_DString stringBuf;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->initialized) {
tsdPtr->initialized = 1;
Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
}
/*
* This routine maintains a second-level regular expression cache in
* addition to the per-object regexp cache. The per-thread cache is needed
* to handle the case where for various reasons the object is lost between
* invocations of the regexp command, but the literal pattern is the same.
*/
/*
* Check the per-thread compiled regexp cache. We can only reuse a regexp
* if it has the same pattern and the same flags.
*/
for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
if ((length == tsdPtr->patLengths[i])
&& (tsdPtr->regexps[i]->flags == flags)
&& (strcmp(string, tsdPtr->patterns[i]) == 0)) {
/*
* Move the matched pattern to the first slot in the cache and
* shift the other patterns down one position.
*/
if (i != 0) {
int j;
char *cachedString;
cachedString = tsdPtr->patterns[i];
regexpPtr = tsdPtr->regexps[i];
for (j = i-1; j >= 0; j--) {
tsdPtr->patterns[j+1] = tsdPtr->patterns[j];
tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j];
tsdPtr->regexps[j+1] = tsdPtr->regexps[j];
}
tsdPtr->patterns[0] = cachedString;
tsdPtr->patLengths[0] = length;
tsdPtr->regexps[0] = regexpPtr;
}
return tsdPtr->regexps[0];
}
}
/*
* This is a new expression, so compile it and add it to the cache.
*/
regexpPtr = ckalloc(sizeof(TclRegexp));
regexpPtr->objPtr = NULL;
regexpPtr->string = NULL;
regexpPtr->details.rm_extend.rm_so = -1;
regexpPtr->details.rm_extend.rm_eo = -1;
/*
* Get the up-to-date string representation and map to unicode.
*/
Tcl_DStringInit(&stringBuf);
uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf);
numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);
/*
* Compile the string and check for errors.
*/
regexpPtr->flags = flags;
status = TclReComp(®expPtr->re, uniString, (size_t) numChars, flags);
Tcl_DStringFree(&stringBuf);
if (status != REG_OKAY) {
/*
* Clean up and report errors in the interpreter, if possible.
*/
ckfree(regexpPtr);
if (interp) {
TclRegError(interp,
"couldn't compile regular expression pattern: ", status);
}
return NULL;
}
/*
* Convert RE to a glob pattern equivalent, if any, and cache it. If this
* is not possible, then globObjPtr will be NULL. This is used by
* Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
*/
if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
Tcl_IncrRefCount(regexpPtr->globObjPtr);
} else {
regexpPtr->globObjPtr = NULL;
}
/*
* Allocate enough space for all of the subexpressions, plus one extra for
* the entire pattern.
*/
regexpPtr->matches =
ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
/*
* Initialize the refcount to one initially, since it is in the cache.
*/
regexpPtr->refCount = 1;
/*
* Free the last regexp, if necessary, and make room at the head of the
* list for the new regexp.
*/
if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
if (--(oldRegexpPtr->refCount) <= 0) {
FreeRegexp(oldRegexpPtr);
}
ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
}
for (i = NUM_REGEXPS - 2; i >= 0; i--) {
tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
}
tsdPtr->patterns[0] = ckalloc(length + 1);
memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
tsdPtr->patLengths[0] = length;
tsdPtr->regexps[0] = regexpPtr;
return regexpPtr;
}
void
Tcl_ConditionWait(
Tcl_Condition *condPtr, /* Really (WinCondition **) */
Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */
const Tcl_Time *timePtr) /* Timeout on waiting period */
{
WinCondition *winCondPtr; /* Per-condition queue head */
CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
DWORD wtime; /* Windows time value */
int timeout; /* True if we got a timeout */
int doExit = 0; /* True if we need to do exit setup */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Self initialize the two parts of the condition. The per-condition and
* per-thread parts need to be handled independently.
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
TclpMasterLock();
/*
* Create the per-thread event and queue pointers.
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
FALSE /* non signaled */, NULL);
tsdPtr->nextPtr = NULL;
tsdPtr->prevPtr = NULL;
tsdPtr->flags = WIN_THREAD_RUNNING;
doExit = 1;
}
TclpMasterUnlock();
if (doExit) {
/*
* Create a per-thread exit handler to clean up the condEvent. We
* must be careful to do this outside the Master Lock because
* Tcl_CreateThreadExitHandler uses its own ThreadSpecificData,
* and initializing that may drop back into the Master Lock.
*/
Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
}
}
if (*condPtr == NULL) {
TclpMasterLock();
/*
* Initialize the per-condition queue pointers and Mutex.
*/
if (*condPtr == NULL) {
winCondPtr = ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
*condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
TclpMasterUnlock();
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
winCondPtr = *((WinCondition **)condPtr);
if (timePtr == NULL) {
wtime = INFINITE;
} else {
wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
}
/*
* Queue the thread on the condition, using the per-condition lock for
* serialization.
*/
tsdPtr->flags = WIN_THREAD_BLOCKED;
tsdPtr->nextPtr = NULL;
EnterCriticalSection(&winCondPtr->condLock);
tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */
winCondPtr->lastPtr = tsdPtr;
if (tsdPtr->prevPtr != NULL) {
tsdPtr->prevPtr->nextPtr = tsdPtr;
}
if (winCondPtr->firstPtr == NULL) {
winCondPtr->firstPtr = tsdPtr;
}
/*
* Unlock the caller's mutex and wait for the condition, or a timeout.
* There is a minor issue here in that we don't count down the timeout if
* we get notified, but another thread grabs the condition before we do.
* In that race condition we'll wait again for the full timeout. Timed
* waits are dubious anyway. Either you have the locking protocol wrong
* and are masking a deadlock, or you are using conditions to pause your
* thread.
*/
LeaveCriticalSection(csPtr);
timeout = 0;
while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
ResetEvent(tsdPtr->condEvent);
LeaveCriticalSection(&winCondPtr->condLock);
if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime,
TRUE) == WAIT_TIMEOUT) {
timeout = 1;
}
EnterCriticalSection(&winCondPtr->condLock);
}
/*
* Be careful on timeouts because the signal might arrive right around the
* time limit and someone else could have taken us off the queue.
*/
if (timeout) {
if (tsdPtr->flags & WIN_THREAD_RUNNING) {
timeout = 0;
} else {
/*
* When dequeuing, we can leave the tsdPtr->nextPtr and
* tsdPtr->prevPtr with dangling pointers because they are
* reinitialilzed w/out reading them when the thread is enqueued
* later.
*/
if (winCondPtr->firstPtr == tsdPtr) {
winCondPtr->firstPtr = tsdPtr->nextPtr;
} else {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
}
if (winCondPtr->lastPtr == tsdPtr) {
winCondPtr->lastPtr = tsdPtr->prevPtr;
} else {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->flags = WIN_THREAD_RUNNING;
}
}
LeaveCriticalSection(&winCondPtr->condLock);
EnterCriticalSection(csPtr);
}
static int
ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
Tcl_Interp *interp) /* For error reporting. */
{
ConsoleInfo *consolePtr = instanceData;
int errorCode = 0;
ConsoleInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Clean up the background thread if necessary. Note that this must be
* done before we can close the file, since the thread may be blocking
* trying to read from the console.
*/
if (consolePtr->reader.thread) {
StopChannelThread(&consolePtr->reader);
}
consolePtr->validMask &= ~TCL_READABLE;
/*
* Wait for the writer thread to finish the current buffer, then terminate
* the thread and close the handles. If the channel is nonblocking, there
* should be no pending write operations.
*/
if (consolePtr->writer.thread) {
if (consolePtr->toWrite) {
/*
* We only need to wait if there is something to write. This may
* prevent infinite wait on exit. [Python Bug 216289]
*/
WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE);
}
StopChannelThread(&consolePtr->writer);
}
consolePtr->validMask &= ~TCL_WRITABLE;
/*
* Don't close the Win32 handle if the handle is a standard channel during
* the thread exit process. Otherwise, one thread may kill the stdio of
* another.
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
if (CloseHandle(consolePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
}
}
consolePtr->watchMask &= consolePtr->validMask;
/*
* Remove the file from the list of watched files.
*/
for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
infoPtr != NULL;
nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
if (infoPtr == (ConsoleInfo *) consolePtr) {
*nextPtrPtr = infoPtr->nextPtr;
break;
}
}
if (consolePtr->writeBuf != NULL) {
ckfree(consolePtr->writeBuf);
consolePtr->writeBuf = 0;
}
ckfree(consolePtr);
return errorCode;
}
static int
ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
Tcl_Interp *interp) /* For error reporting. */
{
ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
int errorCode;
ConsoleInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
DWORD exitCode;
errorCode = 0;
/*
* Clean up the background thread if necessary. Note that this must be
* done before we can close the file, since the thread may be blocking
* trying to read from the console.
*/
if (consolePtr->readThread) {
/*
* The thread may already have closed on it's own. Check it's exit
* code.
*/
GetExitCodeThread(consolePtr->readThread, &exitCode);
if (exitCode == STILL_ACTIVE) {
/*
* Set the stop event so that if the reader thread is blocked in
* ConsoleReaderThread on WaitForMultipleEvents, it will exit
* cleanly.
*/
SetEvent(consolePtr->stopReader);
/*
* Wait at most 20 milliseconds for the reader thread to close.
*/
if (WaitForSingleObject(consolePtr->readThread, 20)
== WAIT_TIMEOUT) {
/*
* Forcibly terminate the background thread as a last resort.
* Note that we need to guard against terminating the thread
* while it is in the middle of Tcl_ThreadAlert because it
* won't be able to release the notifier lock.
*/
Tcl_MutexLock(&consoleMutex);
/* BUG: this leaks memory. */
TerminateThread(consolePtr->readThread, 0);
Tcl_MutexUnlock(&consoleMutex);
}
}
CloseHandle(consolePtr->readThread);
CloseHandle(consolePtr->readable);
CloseHandle(consolePtr->startReader);
CloseHandle(consolePtr->stopReader);
consolePtr->readThread = NULL;
}
consolePtr->validMask &= ~TCL_READABLE;
/*
* Wait for the writer thread to finish the current buffer, then terminate
* the thread and close the handles. If the channel is nonblocking, there
* should be no pending write operations.
*/
if (consolePtr->writeThread) {
if (consolePtr->toWrite) {
/*
* We only need to wait if there is something to write. This may
* prevent infinite wait on exit. [python bug 216289]
*/
WaitForSingleObject(consolePtr->writable, INFINITE);
}
/*
* The thread may already have closed on it's own. Check it's exit
* code.
*/
GetExitCodeThread(consolePtr->writeThread, &exitCode);
if (exitCode == STILL_ACTIVE) {
/*
* Set the stop event so that if the reader thread is blocked in
* ConsoleWriterThread on WaitForMultipleEvents, it will exit
* cleanly.
*/
SetEvent(consolePtr->stopWriter);
/*
* Wait at most 20 milliseconds for the writer thread to close.
*/
if (WaitForSingleObject(consolePtr->writeThread, 20)
== WAIT_TIMEOUT) {
/*
* Forcibly terminate the background thread as a last resort.
* Note that we need to guard against terminating the thread
* while it is in the middle of Tcl_ThreadAlert because it
* won't be able to release the notifier lock.
*/
Tcl_MutexLock(&consoleMutex);
/* BUG: this leaks memory. */
TerminateThread(consolePtr->writeThread, 0);
Tcl_MutexUnlock(&consoleMutex);
}
}
CloseHandle(consolePtr->writeThread);
CloseHandle(consolePtr->writable);
CloseHandle(consolePtr->startWriter);
CloseHandle(consolePtr->stopWriter);
consolePtr->writeThread = NULL;
}
consolePtr->validMask &= ~TCL_WRITABLE;
/*
* Don't close the Win32 handle if the handle is a standard channel during
* the thread exit process. Otherwise, one thread may kill the stdio of
* another.
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
if (CloseHandle(consolePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
}
}
consolePtr->watchMask &= consolePtr->validMask;
/*
* Remove the file from the list of watched files.
*/
for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
infoPtr != NULL;
nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
if (infoPtr == (ConsoleInfo *)consolePtr) {
*nextPtrPtr = infoPtr->nextPtr;
break;
}
}
if (consolePtr->writeBuf != NULL) {
ckfree(consolePtr->writeBuf);
consolePtr->writeBuf = 0;
}
ckfree((char*) consolePtr);
return errorCode;
}
ClientData
Tcl_InitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->eventReady = 0;
#ifdef WEAK_IMPORT_SPINLOCKLOCK
/*
* Initialize support for weakly imported spinlock API.
*/
if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
}
#endif
#ifndef __CONSTANT_CFSTRINGS__
if (!tclEventsOnlyRunLoopMode) {
tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE);
}
#endif
/*
* Initialize CFRunLoopSource and add it to CFRunLoop of this thread.
*/
if (!tsdPtr->runLoop) {
CFRunLoopRef runLoop = CFRunLoopGetCurrent();
CFRunLoopSourceRef runLoopSource;
CFRunLoopSourceContext runLoopSourceContext;
bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
runLoopSourceContext.info = tsdPtr;
runLoopSource = CFRunLoopSourceCreate(NULL, 0, &runLoopSourceContext);
if (!runLoopSource) {
Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource");
}
CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode);
tsdPtr->runLoopSource = runLoopSource;
tsdPtr->runLoop = runLoop;
}
LOCK_NOTIFIER_INIT;
#ifdef HAVE_PTHREAD_ATFORK
/*
* Install pthread_atfork handlers to reinitialize the notifier in the
* child of a fork.
*/
if (
#ifdef WEAK_IMPORT_PTHREAD_ATFORK
pthread_atfork != NULL &&
#endif
!atForkInit) {
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
if (result) {
Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
}
atForkInit = 1;
}
#endif
if (notifierCount == 0) {
int fds[2], status;
/*
* Initialize trigger pipe.
*/
if (pipe(fds) != 0) {
Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe");
}
status = fcntl(fds[0], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[0], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non blocking");
}
status = fcntl(fds[1], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[1], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non blocking");
}
receivePipe = fds[0];
triggerPipe = fds[1];
/*
* Create notifier thread lazily in Tcl_WaitForEvent() to avoid
* interfering with fork() followed immediately by execve()
* (cannot execve() when more than one thread is present).
*/
notifierThread = 0;
}
notifierCount++;
UNLOCK_NOTIFIER_INIT;
return (ClientData) tsdPtr;
}
int
Tcl_AsyncReady(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return tsdPtr->asyncReady;
}
void
Tcl_FinalizeNotifier(
ClientData clientData) /* Not used. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
LOCK_NOTIFIER_INIT;
notifierCount--;
/*
* If this is the last thread to use the notifier, close the notifier pipe
* and wait for the background thread to terminate.
*/
if (notifierCount == 0) {
int result;
if (triggerPipe < 0) {
Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
}
/*
* Send "q" message to the notifier thread so that it will terminate.
* The notifier will return from its call to select() and notice that
* a "q" message has arrived, it will then close its side of the pipe
* and terminate its thread. Note the we can not just close the pipe
* and check for EOF in the notifier thread because if a background
* child process was created with exec, select() would not register
* the EOF on the pipe until the child processes had terminated. [Bug:
* 4139] [Bug: 1222872]
*/
write(triggerPipe, "q", 1);
close(triggerPipe);
if (notifierThread) {
result = pthread_join(notifierThread, NULL);
if (result) {
Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread");
}
notifierThread = 0;
}
close(receivePipe);
triggerPipe = -1;
}
UNLOCK_NOTIFIER_INIT;
LOCK_NOTIFIER; /* for concurrency with Tcl_AlertNotifier */
if (tsdPtr->runLoop) {
tsdPtr->runLoop = NULL;
/*
* Remove runLoopSource from all CFRunLoops and release it.
*/
CFRunLoopSourceInvalidate(tsdPtr->runLoopSource);
CFRelease(tsdPtr->runLoopSource);
tsdPtr->runLoopSource = NULL;
}
UNLOCK_NOTIFIER;
}
int
TclpGetCStackParams(
int **stackBoundPtr)
{
int result = TCL_OK;
size_t stackSize = 0; /* The size of the current stack. */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/* Most variables are actually in a
* thread-specific data block to minimise the
* impact on the stack. */
#ifdef TCL_CROSS_COMPILE
if (stackGrowsDown == -1) {
/*
* Not initialised!
*/
stackGrowsDown = StackGrowsDown(&result);
}
#endif
/*
* The first time through in a thread: record the "outermost" stack
* frame and inquire with the OS about the stack size.
*/
if (tsdPtr->outerVarPtr == NULL) {
tsdPtr->outerVarPtr = &result;
result = GetStackSize(&stackSize);
if (result != TCL_OK) {
/* Can't check, assume it always succeeds */
#ifdef TCL_CROSS_COMPILE
stackGrowsDown = 1;
#endif
tsdPtr->stackBound = NULL;
goto done;
}
}
if (stackSize || (tsdPtr->stackBound &&
((stackGrowsDown && (&result < tsdPtr->stackBound)) ||
(!stackGrowsDown && (&result > tsdPtr->stackBound))))) {
/*
* Either the thread's first pass or stack failure: set the params
*/
if (!stackSize) {
/*
* Stack failure: if we didn't already blow up, we are within the
* safety area. Recheck with the OS in case the stack was grown.
*/
result = GetStackSize(&stackSize);
if (result != TCL_OK) {
/* Can't check, assume it always succeeds */
#ifdef TCL_CROSS_COMPILE
stackGrowsDown = 1;
#endif
tsdPtr->stackBound = NULL;
goto done;
}
}
if (stackGrowsDown) {
tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr -
stackSize);
} else {
tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr +
stackSize);
}
}
done:
*stackBoundPtr = tsdPtr->stackBound;
return stackGrowsDown;
}
ClientData
Tcl_InitNotifier(void)
{
if (tclNotifierHooks.initNotifierProc) {
return tclNotifierHooks.initNotifierProc();
} else {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#if TCL_THREADS
tsdPtr->eventReady = 0;
/*
* Initialize thread specific condition variable for this thread.
*/
if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
WNDCLASS class;
class.style = 0;
class.cbClsExtra = 0;
class.cbWndExtra = 0;
class.hInstance = TclWinGetTclInstance();
class.hbrBackground = NULL;
class.lpszMenuName = NULL;
class.lpszClassName = className;
class.lpfnWndProc = NotifierProc;
class.hIcon = NULL;
class.hCursor = NULL;
RegisterClassW(&class);
tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
TclWinGetTclInstance(), NULL);
tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
0 /* !signaled */, NULL);
#else
pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
tsdPtr->waitCVinitialized = 1;
}
pthread_mutex_lock(¬ifierInitMutex);
#if defined(HAVE_PTHREAD_ATFORK)
/*
* Install pthread_atfork handlers to clean up the notifier in the
* child of a fork.
*/
if (!atForkInit) {
int result = pthread_atfork(NULL, NULL, AtForkChild);
if (result) {
Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
}
atForkInit = 1;
}
#endif /* HAVE_PTHREAD_ATFORK */
notifierCount++;
pthread_mutex_unlock(¬ifierInitMutex);
#endif /* TCL_THREADS */
return tsdPtr;
}
