summaryrefslogtreecommitdiffstats
path: root/win/tclWinPipe.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinPipe.c')
-rw-r--r--win/tclWinPipe.c1045
1 files changed, 708 insertions, 337 deletions
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index b5f035db..3e7e5eb 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -50,7 +50,7 @@ TCL_DECLARE_MUTEX(pipeMutex)
* used in a pipeline.
*/
-typedef struct WinFile {
+typedef struct {
int type; /* One of the file types defined above. */
HANDLE handle; /* Open file handle. */
} WinFile;
@@ -82,6 +82,12 @@ static ProcInfo *procList;
#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */
/*
+ * TODO: It appears the whole EXTRABYTE machinery is in place to support
+ * outdated Win 95 systems. If this can be confirmed, much code can be
+ * deleted.
+ */
+
+/*
* This structure describes per-instance data for a pipe based channel.
*/
@@ -103,24 +109,17 @@ typedef struct PipeInfo {
Tcl_ThreadId threadId; /* Thread to which events should be reported.
* This value is used by the reader/writer
* threads. */
+ TclPipeThreadInfo *writeTI; /* Thread info of writer and reader, this */
+ TclPipeThreadInfo *readTI; /* structure owned by corresponding thread. */
HANDLE writeThread; /* Handle to writer thread. */
HANDLE readThread; /* Handle to reader thread. */
+
HANDLE writable; /* Manual-reset event to signal when the
* writer thread has finished waiting for the
* current buffer to be written. */
HANDLE readable; /* Manual-reset event to signal when the
* reader thread has finished waiting for
* input. */
- HANDLE startWriter; /* Auto-reset event used by the main thread to
- * signal when the writer thread should
- * attempt to write to the pipe. */
- HANDLE stopWriter; /* Manual-reset event used to alert the reader
- * thread to fall-out and exit */
- HANDLE startReader; /* Auto-reset event used by the main thread to
- * signal when the reader thread should
- * attempt to read from the pipe. */
- HANDLE stopReader; /* Manual-reset event used to alert the reader
- * thread to fall-out and exit */
DWORD writeError; /* An error caused by the last background
* write. Set to 0 if no error has been
* detected. This word is shared with the
@@ -142,7 +141,7 @@ typedef struct PipeInfo {
* synchronized with the readable object. */
} PipeInfo;
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* The following pointer refers to the head of the list of pipes that are
* being watched for file events.
@@ -158,7 +157,7 @@ static Tcl_ThreadDataKey dataKey;
* events are generated.
*/
-typedef struct PipeEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that
@@ -192,7 +191,7 @@ static DWORD WINAPI PipeReaderThread(LPVOID arg);
static void PipeSetupProc(ClientData clientData, int flags);
static void PipeWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI PipeWriterThread(LPVOID arg);
-static int TempFileName(WCHAR name[MAX_PATH]);
+static int TempFileName(TCHAR name[MAX_PATH]);
static int WaitForRead(PipeInfo *infoPtr, int blocking);
static void PipeThreadActionProc(ClientData instanceData,
int action);
@@ -202,7 +201,7 @@ static void PipeThreadActionProc(ClientData instanceData,
* I/O.
*/
-static Tcl_ChannelType pipeChannelType = {
+static const Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TCL_CLOSE2PROC, /* Close proc. */
@@ -219,7 +218,7 @@ static Tcl_ChannelType pipeChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
PipeThreadActionProc, /* thread action proc */
- NULL, /* truncate */
+ NULL /* truncate */
};
/*
@@ -404,7 +403,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
+ evPtr = ckalloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -435,7 +434,7 @@ TclWinMakeFile(
{
WinFile *filePtr;
- filePtr = (WinFile *) ckalloc(sizeof(WinFile));
+ filePtr = ckalloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -464,27 +463,18 @@ TclWinMakeFile(
static int
TempFileName(
- WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
+ TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
* gets stored. */
{
- TCHAR *prefix;
-
- prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
- if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
- if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
- name) != 0) {
+ const TCHAR *prefix = TEXT("TCL");
+ if (GetTempPath(MAX_PATH, name) != 0) {
+ if (GetTempFileName(name, prefix, 0, name) != 0) {
return 1;
}
}
- if (tclWinProcs->useWide) {
- ((WCHAR *) name)[0] = '.';
- ((WCHAR *) name)[1] = '\0';
- } else {
- ((char *) name)[0] = '.';
- ((char *) name)[1] = '\0';
- }
- return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
- name);
+ name[0] = '.';
+ name[1] = '\0';
+ return GetTempFileName(name, prefix, 0, name);
}
/*
@@ -596,7 +586,7 @@ TclpOpenFile(
flags = 0;
if (!(mode & O_CREAT)) {
- flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ flags = GetFileAttributes(nativePath);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -612,8 +602,8 @@ TclpOpenFile(
* Now we get to create the file.
*/
- handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
- shareMode, NULL, createMode, flags, NULL);
+ handle = CreateFile(nativePath, accessMode, shareMode,
+ NULL, createMode, flags, NULL);
Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
@@ -660,7 +650,7 @@ TclFile
TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
- WCHAR name[MAX_PATH];
+ TCHAR name[MAX_PATH];
const char *native;
Tcl_DString dstring;
HANDLE handle;
@@ -669,7 +659,7 @@ TclpCreateTempFile(
return NULL;
}
- handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
+ handle = CreateFile(name,
GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
if (handle == INVALID_HANDLE_VALUE) {
@@ -731,7 +721,7 @@ TclpCreateTempFile(
TclWinConvertError(GetLastError());
CloseHandle(handle);
- (*tclWinProcs->deleteFileProc)((TCHAR *) name);
+ DeleteFile(name);
return NULL;
}
@@ -754,13 +744,13 @@ TclpCreateTempFile(
Tcl_Obj *
TclpTempFileName(void)
{
- WCHAR fileName[MAX_PATH];
+ TCHAR fileName[MAX_PATH];
if (TempFileName(fileName) == 0) {
return NULL;
}
- return TclpNativeToNormalized((ClientData) fileName);
+ return TclpNativeToNormalized(fileName);
}
/*
@@ -836,7 +826,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return -1;
}
}
@@ -846,7 +836,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return 0;
}
@@ -900,7 +890,7 @@ TclpGetPid(
*
* The complete Windows search path is searched to find the specified
* executable. If an executable by the given name is not found,
- * automatically tries appending ".com", ".exe", and ".bat" to the
+ * automatically tries appending standard extensions to the
* executable name.
*
* Results:
@@ -947,7 +937,7 @@ TclpCreateProcess(
{
int result, applType, createFlags;
Tcl_DString cmdLine; /* Complete command line (TCHAR). */
- STARTUPINFOA startInfo;
+ STARTUPINFO startInfo;
PROCESS_INFORMATION procInfo;
SECURITY_ATTRIBUTES secAtts;
HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
@@ -1037,8 +1027,9 @@ TclpCreateProcess(
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate input handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1057,23 +1048,17 @@ TclpCreateProcess(
* sink.
*/
- if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
- && (applType == APPL_DOS)) {
- if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
- CloseHandle(h);
- }
- } else {
- startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
- &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
- }
+ startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
+ &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, outputHandle, hProcess,
&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate output handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1083,7 +1068,7 @@ TclpCreateProcess(
* sink.
*/
- startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
+ startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
@@ -1091,8 +1076,9 @@ TclpCreateProcess(
}
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate error handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1124,7 +1110,7 @@ TclpCreateProcess(
startInfo.wShowWindow = SW_HIDE;
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
- Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
+ TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
} else {
createFlags = DETACHED_PROCESS;
}
@@ -1136,82 +1122,12 @@ TclpCreateProcess(
}
if (applType == APPL_DOS) {
- /*
- * Under Windows 95, 16-bit DOS applications do not work well with
- * pipes:
- *
- * 1. EOF on a pipe between a detached 16-bit DOS application and
- * another application is not seen at the other end of the pipe,
- * so the listening process blocks forever on reads. This inablity
- * to detect EOF happens when either a 16-bit app or the 32-bit
- * app is the listener.
- *
- * 2. If a 16-bit DOS application (detached or not) blocks when
- * writing to a pipe, it will never wake up again, and it
- * eventually brings the whole system down around it.
- *
- * The 16-bit application is run as a normal process inside of a
- * hidden helper console app, and this helper may be run as a
- * detached process. If any of the stdio handles is a pipe, the
- * helper application accumulates information into temp files and
- * forwards it to or from the DOS application as appropriate.
- * This means that DOS apps must receive EOF from a stdin pipe
- * before they will actually begin, and must finish generating
- * stdout or stderr before the data will be sent to the next stage
- * of the pipe.
- *
- * The helper app should be located in the same directory as the
- * tcl dll.
- */
- Tcl_Obj *tclExePtr, *pipeDllPtr;
- char *start, *end;
- int i, fileExists;
- Tcl_DString pipeDll;
-
- if (createFlags != 0) {
- startInfo.wShowWindow = SW_HIDE;
- startInfo.dwFlags |= STARTF_USESHOWWINDOW;
- createFlags = CREATE_NEW_CONSOLE;
- }
-
- Tcl_DStringInit(&pipeDll);
- Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
- tclExePtr = TclGetObjNameOfExecutable();
- Tcl_IncrRefCount(tclExePtr);
- start = Tcl_GetStringFromObj(tclExePtr, &i);
- for (end = start + (i-1); end > start; end--) {
- if (*end == '/') {
- break;
- }
- }
- if (*end != '/') {
- Tcl_AppendResult(interp, "no / in executable path name \"",
- start, "\"", (char *) NULL);
- Tcl_DecrRefCount(tclExePtr);
- Tcl_DStringFree(&pipeDll);
- goto end;
- }
- i = (end - start) + 1;
- pipeDllPtr = Tcl_NewStringObj(start, i);
- Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1);
- Tcl_IncrRefCount(pipeDllPtr);
- if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) {
- Tcl_Panic("Tcl_FSConvertToPathType failed");
- }
- fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
- if (!fileExists) {
- Tcl_AppendResult(interp, "Tcl pipe dll \"",
- Tcl_DStringValue(&pipeDll), "\" not found",
- (char *) NULL);
- Tcl_DecrRefCount(tclExePtr);
- Tcl_DecrRefCount(pipeDllPtr);
- Tcl_DStringFree(&pipeDll);
- goto end;
- }
- Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
- Tcl_DecrRefCount(tclExePtr);
- Tcl_DecrRefCount(pipeDllPtr);
- Tcl_DStringFree(&pipeDll);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "DOS application process not supported on this platform",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
+ NULL);
+ goto end;
}
}
@@ -1235,12 +1151,12 @@ TclpCreateProcess(
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if ((*tclWinProcs->createProcessProc)(NULL,
- (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
- (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
+ if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine),
+ NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
+ &procInfo) == 0) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ argv[0], Tcl_PosixError(interp)));
goto end;
}
@@ -1368,8 +1284,8 @@ ApplicationType(
IMAGE_DOS_HEADER header;
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
- WCHAR nativeFullPath[MAX_PATH];
- static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
+ TCHAR nativeFullPath[MAX_PATH];
+ static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};
/*
* Look for the program as an external program. First try the name as it
@@ -1394,8 +1310,8 @@ ApplicationType(
Tcl_DStringAppend(&nameBuf, extensions[i], -1);
nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
Tcl_DStringLength(&nameBuf), &ds);
- found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
- MAX_PATH, nativeFullPath, &rest);
+ found = SearchPath(NULL, nativeName, NULL, MAX_PATH,
+ nativeFullPath, &rest);
Tcl_DStringFree(&ds);
if (found == 0) {
continue;
@@ -1406,20 +1322,21 @@ ApplicationType(
* known type.
*/
- attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
+ attr = GetFileAttributes(nativeFullPath);
if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
continue;
}
- strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
- if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) {
+ if ((ext != NULL) &&
+ (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) {
applType = APPL_DOS;
break;
}
- hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
+ hFile = CreateFile(nativeFullPath,
GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -1486,8 +1403,8 @@ ApplicationType(
if (applType == APPL_NONE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", originalName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ originalName, Tcl_PosixError(interp)));
return APPL_NONE;
}
@@ -1499,9 +1416,8 @@ ApplicationType(
* application name from the arguments.
*/
- (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
- nativeFullPath, MAX_PATH);
- strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH);
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
}
return applType;
@@ -1545,9 +1461,9 @@ BuildCommandLine(
* Prime the path. Add a space separator if we were primed with something.
*/
- Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
+ TclDStringAppendDString(&ds, linePtr);
if (Tcl_DStringLength(linePtr) > 0) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
for (i = 0; i < argc; i++) {
@@ -1555,7 +1471,7 @@ BuildCommandLine(
arg = executable;
} else {
arg = argv[i];
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
quote = 0;
@@ -1564,6 +1480,7 @@ BuildCommandLine(
} else {
int count;
Tcl_UniChar ch;
+
for (start = arg; *start != '\0'; start += count) {
count = Tcl_UtfToUniChar(start, &ch);
if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
@@ -1573,7 +1490,7 @@ BuildCommandLine(
}
}
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
start = arg;
for (special = arg; ; ) {
@@ -1602,7 +1519,7 @@ BuildCommandLine(
}
if (*special == '"') {
Tcl_DStringAppend(&ds, start, (int) (special - start));
- Tcl_DStringAppend(&ds, "\\\"", 2);
+ TclDStringAppendLiteral(&ds, "\\\"");
start = special + 1;
}
if (*special == '\0') {
@@ -1612,7 +1529,7 @@ BuildCommandLine(
}
Tcl_DStringAppend(&ds, start, (int) (special - start));
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
}
Tcl_DStringFree(linePtr);
@@ -1647,8 +1564,7 @@ TclpCreateCommandChannel(
Tcl_Pid *pidPtr) /* An array of process identifiers. */
{
char channelName[16 + TCL_INTEGER_SPACE];
- DWORD id;
- PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
+ PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
PipeInit();
@@ -1663,7 +1579,7 @@ TclpCreateCommandChannel(
infoPtr->writeBuf = 0;
infoPtr->writeBufLen = 0;
infoPtr->writeError = 0;
- infoPtr->channel = (Tcl_Channel) NULL;
+ infoPtr->channel = NULL;
infoPtr->validMask = 0;
@@ -1675,13 +1591,13 @@ TclpCreateCommandChannel(
*/
infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
- infoPtr, 0, &id);
+ TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable),
+ 0, NULL);
SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_READABLE;
} else {
+ infoPtr->readTI = NULL;
infoPtr->readThread = 0;
}
if (writeFile != NULL) {
@@ -1690,12 +1606,14 @@ TclpCreateCommandChannel(
*/
infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
- infoPtr, 0, &id);
+ TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable),
+ 0, NULL);
SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_WRITABLE;
+ } else {
+ infoPtr->writeTI = NULL;
+ infoPtr->writeThread = 0;
}
/*
@@ -1705,9 +1623,9 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- (ClientData) infoPtr, infoPtr->validMask);
+ infoPtr, infoPtr->validMask);
/*
* Pipes have AUTO translation mode on Windows and ^Z eof char, which
@@ -1715,16 +1633,58 @@ TclpCreateCommandChannel(
* Windows programs that expect a ^Z at EOF.
*/
- Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
- "-translation", "auto");
- Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
- "-eofchar", "\032 {}");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_CreatePipe --
+ *
+ * System dependent interface to create a pipe for the [chan pipe]
+ * command. Stolen from TclX.
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreatePipe(
+ Tcl_Interp *interp, /* Errors returned in result.*/
+ Tcl_Channel *rchan, /* Where to return the read side. */
+ Tcl_Channel *wchan, /* Where to return the write side. */
+ int flags) /* Reserved for future use. */
+{
+ HANDLE readHandle, writeHandle;
+ SECURITY_ATTRIBUTES sec;
+
+ sec.nLength = sizeof(SECURITY_ATTRIBUTES);
+ sec.lpSecurityDescriptor = NULL;
+ sec.bInheritHandle = FALSE;
+
+ if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "pipe creation failed: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE);
+ Tcl_RegisterChannel(interp, *rchan);
+
+ *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE);
+ Tcl_RegisterChannel(interp, *wchan);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGetAndDetachPids --
*
* Stores a list of the command PIDs for a command channel in the
@@ -1746,8 +1706,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
+ Tcl_Obj *pidsObj;
int i;
- char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -1758,14 +1718,17 @@ TclGetAndDetachPids(
return;
}
- pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+ pipePtr = Tcl_GetChannelInstanceData(chan);
+ TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_AppendElement(interp, buf);
- Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, pidsObj,
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
+ Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
+ Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -1836,12 +1799,12 @@ PipeClose2Proc(
int errorCode, result;
PipeInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- DWORD exitCode;
+ int inExit = (TclInExit() || TclInThreadExit());
errorCode = 0;
result = 0;
- if ((!flags || flags == TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
+ if ((!flags || flags & TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
/*
* 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
@@ -1849,55 +1812,10 @@ PipeClose2Proc(
*/
if (pipePtr->readThread) {
- /*
- * The thread may already have closed on its own. Check its exit
- * code.
- */
-
- GetExitCodeThread(pipePtr->readThread, &exitCode);
-
- if (exitCode == STILL_ACTIVE) {
- /*
- * Set the stop event so that if the reader thread is blocked
- * in PipeReaderThread on WaitForMultipleEvents, it will exit
- * cleanly.
- */
-
- SetEvent(pipePtr->stopReader);
-
- /*
- * Wait at most 20 milliseconds for the reader thread to
- * close.
- */
-
- if (WaitForSingleObject(pipePtr->readThread,
- 20) == WAIT_TIMEOUT) {
- /*
- * The thread must be blocked waiting for the pipe to
- * become readable in ReadFile(). There isn't a clean way
- * to exit the thread from this condition. We should
- * terminate the child process instead to get the reader
- * thread to fall out of ReadFile with a FALSE. (below) is
- * not the correct way to do this, but will stay here
- * until a better solution is found.
- *
- * 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(&pipeMutex);
-
- /* BUG: this leaks memory */
- TerminateThread(pipePtr->readThread, 0);
- Tcl_MutexUnlock(&pipeMutex);
- }
- }
+ TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread);
CloseHandle(pipePtr->readThread);
CloseHandle(pipePtr->readable);
- CloseHandle(pipePtr->startReader);
- CloseHandle(pipePtr->stopReader);
pipePtr->readThread = NULL;
}
if (TclpCloseFile(pipePtr->readFile) != 0) {
@@ -1906,66 +1824,34 @@ PipeClose2Proc(
pipePtr->validMask &= ~TCL_READABLE;
pipePtr->readFile = NULL;
}
- if ((!flags || flags & TCL_CLOSE_WRITE)
- && (pipePtr->writeFile != NULL)) {
+ if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) {
if (pipePtr->writeThread) {
- /*
- * 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.
- */
-
- WaitForSingleObject(pipePtr->writable, INFINITE);
/*
- * The thread may already have closed on it's own. Check its exit
- * code.
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking or may block during exit, bail out since the worker
+ * thread is not interruptible and we want TIP#398-fast-exit.
*/
+ if ((pipePtr->flags & PIPE_ASYNC) && inExit) {
- GetExitCodeThread(pipePtr->writeThread, &exitCode);
+ /* give it a chance to leave honorably */
+ TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable);
- if (exitCode == STILL_ACTIVE) {
- /*
- * Set the stop event so that if the reader thread is blocked
- * in PipeReaderThread on WaitForMultipleEvents, it will exit
- * cleanly.
- */
-
- SetEvent(pipePtr->stopWriter);
-
- /*
- * Wait at most 20 milliseconds for the reader thread to
- * close.
- */
+ if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) {
+ return EWOULDBLOCK;
+ }
- if (WaitForSingleObject(pipePtr->writeThread,
- 20) == WAIT_TIMEOUT) {
- /*
- * The thread must be blocked waiting for the pipe to
- * consume input in WriteFile(). There isn't a clean way
- * to exit the thread from this condition. We should
- * terminate the child process instead to get the writer
- * thread to fall out of WriteFile with a FALSE. (below)
- * is not the correct way to do this, but will stay here
- * until a better solution is found.
- *
- * 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.
- */
+ } else {
- Tcl_MutexLock(&pipeMutex);
+ WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE);
- /* BUG: this leaks memory */
- TerminateThread(pipePtr->writeThread, 0);
- Tcl_MutexUnlock(&pipeMutex);
- }
}
- CloseHandle(pipePtr->writeThread);
+ TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread);
+
CloseHandle(pipePtr->writable);
- CloseHandle(pipePtr->startWriter);
- CloseHandle(pipePtr->stopWriter);
+ CloseHandle(pipePtr->writeThread);
pipePtr->writeThread = NULL;
}
if (TclpCloseFile(pipePtr->writeFile) != 0) {
@@ -2000,7 +1886,7 @@ PipeClose2Proc(
}
}
- if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
+ if ((pipePtr->flags & PIPE_ASYNC) || inExit) {
/*
* If the channel is non-blocking or Tcl is being cleaned up, just
* detach the children PIDs, reap them (important if we are in a
@@ -2025,12 +1911,11 @@ PipeClose2Proc(
*/
if (pipePtr->errorFile) {
- WinFile *filePtr;
+ WinFile *filePtr = (WinFile *) pipePtr->errorFile;
- filePtr = (WinFile*)pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
TCL_READABLE);
- ckfree((char *) filePtr);
+ ckfree(filePtr);
} else {
errChan = NULL;
}
@@ -2040,14 +1925,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
ckfree(pipePtr->writeBuf);
}
- ckfree((char*) pipePtr);
+ ckfree(pipePtr);
if (errorCode == 0) {
return result;
@@ -2179,14 +2064,17 @@ PipeOutputProc(
DWORD bytesWritten, timeout;
*errorCode = 0;
- timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
+
+ /* avoid blocking if pipe-thread exited */
+ timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI)
+ || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
/*
* The writer thread is blocked waiting for a write to complete and
* the channel is in non-blocking mode.
*/
- errno = EAGAIN;
+ errno = EWOULDBLOCK;
goto error;
}
@@ -2215,12 +2103,12 @@ PipeOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->writable);
- SetEvent(infoPtr->startWriter);
+ TclPipeThreadSignal(&infoPtr->writeTI);
bytesWritten = toWrite;
} else {
/*
@@ -2594,7 +2482,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree((char*)infoPtr);
+ ckfree(infoPtr);
return result;
}
@@ -2620,9 +2508,9 @@ Tcl_WaitPid(
void
TclWinAddProcess(
void *hProcess, /* Handle to process */
- unsigned long id) /* Global process identifier */
+ unsigned long id) /* Global process identifier */
{
- ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
PipeInit();
@@ -2664,17 +2552,15 @@ Tcl_PidObjCmd(
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
- char buf[TCL_INTEGER_SPACE];
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- wsprintfA(buf, "%lu", (unsigned long) getpid());
- Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -2687,9 +2573,9 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewStringObj(buf, -1));
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -2732,14 +2618,16 @@ WaitForRead(
* Synchronize with the reader thread.
*/
- timeout = blocking ? INFINITE : 0;
+ /* avoid blocking if pipe-thread exited */
+ timeout = (!blocking || !TclPipeThreadIsAlive(&infoPtr->readTI)
+ || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
/*
* The reader thread is blocked waiting for data and the channel
* is in non-blocking mode.
*/
- errno = EAGAIN;
+ errno = EWOULDBLOCK;
return -1;
}
@@ -2806,7 +2694,7 @@ WaitForRead(
*/
ResetEvent(infoPtr->readable);
- SetEvent(infoPtr->startReader);
+ TclPipeThreadSignal(&infoPtr->readTI);
}
}
@@ -2834,33 +2722,27 @@ static DWORD WINAPI
PipeReaderThread(
LPVOID arg)
{
- PipeInfo *infoPtr = (PipeInfo *)arg;
- HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
+ TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+ PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
+ HANDLE handle = NULL;
DWORD count, err;
int done = 0;
- HANDLE wEvents[2];
- DWORD waitResult;
-
- wEvents[0] = infoPtr->stopReader;
- wEvents[1] = infoPtr->startReader;
while (!done) {
/*
* Wait for the main thread to signal before attempting to wait on the
* pipe becoming readable.
*/
-
- waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
- if (waitResult != (WAIT_OBJECT_0 + 1)) {
- /*
- * The start event was not signaled. It might be the stop event or
- * an error, so exit.
- */
-
+ if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+ /* exit */
break;
}
+ if (!infoPtr) {
+ infoPtr = (PipeInfo *)pipeTI->clientData;
+ handle = ((WinFile *) infoPtr->readFile)->handle;
+ }
+
/*
* Try waiting for 0 bytes. This will block until some data is
* available on NT, but will return immediately on Win 95. So, if no
@@ -2880,7 +2762,7 @@ PipeReaderThread(
infoPtr->readFlags |= PIPE_EOF;
done = 1;
} else if (err == ERROR_INVALID_HANDLE) {
- break;
+ done = 1;
}
} else if (count == 0) {
if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
@@ -2902,12 +2784,11 @@ PipeReaderThread(
infoPtr->readFlags |= PIPE_EOF;
done = 1;
} else if (err == ERROR_INVALID_HANDLE) {
- break;
+ done = 1;
}
}
}
-
/*
* Signal the main thread by signalling the readable event and then
* waking up the notifier thread.
@@ -2933,6 +2814,12 @@ PipeReaderThread(
Tcl_MutexUnlock(&pipeMutex);
}
+ /*
+ * If state of thread was set to stop, we can sane free info structure,
+ * otherwise it is shared with main thread, so main thread will own it
+ */
+ TclPipeThreadExit(&pipeTI);
+
return 0;
}
@@ -2957,33 +2844,27 @@ static DWORD WINAPI
PipeWriterThread(
LPVOID arg)
{
- PipeInfo *infoPtr = (PipeInfo *)arg;
- HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
+ TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+ PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
+ HANDLE handle = NULL;
DWORD count, toWrite;
char *buf;
int done = 0;
- HANDLE wEvents[2];
- DWORD waitResult;
-
- wEvents[0] = infoPtr->stopWriter;
- wEvents[1] = infoPtr->startWriter;
while (!done) {
/*
* Wait for the main thread to signal before attempting to write.
*/
-
- waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
- if (waitResult != (WAIT_OBJECT_0 + 1)) {
- /*
- * The start event was not signaled. It might be the stop event or
- * an error, so exit.
- */
-
+ if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+ /* exit */
break;
}
+ if (!infoPtr) {
+ infoPtr = (PipeInfo *)pipeTI->clientData;
+ handle = ((WinFile *) infoPtr->writeFile)->handle;
+ }
+
buf = infoPtr->writeBuf;
toWrite = infoPtr->toWrite;
@@ -3027,6 +2908,12 @@ PipeWriterThread(
Tcl_MutexUnlock(&pipeMutex);
}
+ /*
+ * If state of thread was set to stop, we can sane free info structure,
+ * otherwise it is shared with main thread, so main thread will own it.
+ */
+ TclPipeThreadExit(&pipeTI);
+
return 0;
}
@@ -3081,6 +2968,490 @@ PipeThreadActionProc(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenTemporaryFile --
+ *
+ * Creates a temporary file, possibly based on the supplied bits and
+ * pieces of template supplied in the first three arguments. If the
+ * fourth argument is non-NULL, it contains a Tcl_Obj to store the name
+ * of the temporary file in (and it is caller's responsibility to clean
+ * up). If the fourth argument is NULL, try to arrange for the temporary
+ * file to go away once it is no longer needed.
+ *
+ * Results:
+ * A read-write Tcl Channel open on the file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenTemporaryFile(
+ Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj,
+ Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj)
+{
+ TCHAR name[MAX_PATH];
+ char *namePtr;
+ HANDLE handle;
+ DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
+ int length, counter, counter2;
+ Tcl_DString buf;
+
+ if (!resultingNameObj) {
+ flags |= FILE_FLAG_DELETE_ON_CLOSE;
+ }
+
+ namePtr = (char *) name;
+ length = GetTempPath(MAX_PATH, name);
+ if (length == 0) {
+ goto gotError;
+ }
+ namePtr += length * sizeof(TCHAR);
+ if (basenameObj) {
+ const char *string = Tcl_GetString(basenameObj);
+
+ Tcl_WinUtfToTChar(string, basenameObj->length, &buf);
+ memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
+ namePtr += Tcl_DStringLength(&buf);
+ Tcl_DStringFree(&buf);
+ } else {
+ const TCHAR *baseStr = TEXT("TCL");
+ int length = 3 * sizeof(TCHAR);
+
+ memcpy(namePtr, baseStr, length);
+ namePtr += length;
+ }
+ counter = TclpGetClicks() % 65533;
+ counter2 = 1024; /* Only try this many times! Prevents
+ * an infinite loop. */
+
+ do {
+ char number[TCL_INTEGER_SPACE + 4];
+
+ sprintf(number, "%d.TMP", counter);
+ counter = (unsigned short) (counter + 1);
+ Tcl_WinUtfToTChar(number, strlen(number), &buf);
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
+ memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
+ Tcl_DStringFree(&buf);
+
+ handle = CreateFile(name,
+ GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL);
+ } while (handle == INVALID_HANDLE_VALUE
+ && --counter2 > 0
+ && GetLastError() == ERROR_FILE_EXISTS);
+ if (handle == INVALID_HANDLE_VALUE) {
+ goto gotError;
+ }
+
+ if (resultingNameObj) {
+ Tcl_Obj *tmpObj = TclpNativeToNormalized(name);
+
+ Tcl_AppendObjToObj(resultingNameObj, tmpObj);
+ TclDecrRefCount(tmpObj);
+ }
+
+ return Tcl_MakeFileChannel((ClientData) handle,
+ TCL_READABLE|TCL_WRITABLE);
+
+ gotError:
+ TclWinConvertError(GetLastError());
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadCreateTI --
+ *
+ * Creates a thread info structure, can be owned by worker.
+ *
+ * Results:
+ * Pointer to created TI structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclPipeThreadInfo *
+TclPipeThreadCreateTI(
+ TclPipeThreadInfo **pipeTIPtr,
+ ClientData clientData,
+ HANDLE wakeEvent)
+{
+ TclPipeThreadInfo *pipeTI;
+#ifndef _PTI_USE_CKALLOC
+ pipeTI = malloc(sizeof(TclPipeThreadInfo));
+#else
+ pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
+#endif
+ pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
+ pipeTI->state = PTI_STATE_IDLE;
+ pipeTI->clientData = clientData;
+ pipeTI->evWakeUp = wakeEvent;
+ return (*pipeTIPtr = pipeTI);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadWaitForSignal --
+ *
+ * Wait for work/stop signals inside pipe worker.
+ *
+ * Results:
+ * 1 if signaled to work, 0 if signaled to stop.
+ *
+ * Side effects:
+ * If this function returns 0, TI-structure pointer given via pipeTIPtr
+ * may be NULL, so not accessible (can be owned by main thread).
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPipeThreadWaitForSignal(
+ TclPipeThreadInfo **pipeTIPtr)
+{
+ TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+ LONG state;
+ DWORD waitResult;
+ HANDLE wakeEvent;
+
+ if (!pipeTI) {
+ return 0;
+ }
+
+ wakeEvent = pipeTI->evWakeUp;
+ /*
+ * Wait for the main thread to signal before attempting to do the work.
+ */
+
+ /* reset work state of thread (idle/waiting) */
+ if ((state = InterlockedCompareExchange(&pipeTI->state,
+ PTI_STATE_IDLE, PTI_STATE_WORK)) & (PTI_STATE_STOP|PTI_STATE_END)) {
+ /* end of work, check the owner of structure */
+ goto end;
+ }
+ /* entering wait */
+ waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
+
+ if (waitResult != WAIT_OBJECT_0) {
+
+ /*
+ * The control event was not signaled, so end of work (unexpected
+ * behaviour, main thread can be dead?).
+ */
+ goto end;
+ }
+
+ /* try to set work state of thread */
+ if ((state = InterlockedCompareExchange(&pipeTI->state,
+ PTI_STATE_WORK, PTI_STATE_IDLE)) & (PTI_STATE_STOP|PTI_STATE_END)) {
+ /* end of work */
+ goto end;
+ }
+
+ /* signaled to work */
+ return 1;
+
+end:
+ /* end of work, check the owner of the TI structure */
+ if (state != PTI_STATE_STOP) {
+ *pipeTIPtr = NULL;
+ } else {
+ pipeTI->evWakeUp = NULL;
+ }
+ if (wakeEvent) {
+ SetEvent(wakeEvent);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadStopSignal --
+ *
+ * Send stop signal to the pipe worker (without waiting).
+ *
+ * After calling of this function, TI-structure pointer given via pipeTIPtr
+ * may be NULL.
+ *
+ * Results:
+ * 1 if signaled (or pipe-thread is down), 0 if pipe thread still working.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPipeThreadStopSignal(
+ TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent)
+{
+ TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+ HANDLE evControl;
+ int state;
+
+ if (!pipeTI) {
+ return 1;
+ }
+ evControl = pipeTI->evControl;
+ pipeTI->evWakeUp = wakeEvent;
+ switch (
+ (state = InterlockedCompareExchange(&pipeTI->state,
+ PTI_STATE_STOP, PTI_STATE_IDLE))
+ ) {
+
+ case PTI_STATE_IDLE:
+
+ /* Thread was idle/waiting, notify it goes teardown */
+ SetEvent(evControl);
+
+ *pipeTIPtr = NULL;
+
+ case PTI_STATE_DOWN:
+
+ return 1;
+
+ default:
+ /*
+ * Thread works currently, we should try to end it, own the TI structure
+ * (because of possible sharing the joint structures with thread)
+ */
+ InterlockedExchange(&pipeTI->state, PTI_STATE_END);
+ break;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadStop --
+ *
+ * Send stop signal to the pipe worker and wait for thread completion.
+ *
+ * May be combined with TclPipeThreadStopSignal.
+ *
+ * After calling of this function, TI-structure pointer given via pipeTIPtr
+ * is not accessible (owned by pipe worker or released here).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Can terminate pipe worker (and / or stop its synchronous operations).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPipeThreadStop(
+ TclPipeThreadInfo **pipeTIPtr,
+ HANDLE hThread)
+{
+ TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+ HANDLE evControl, wakeEvent;
+ int state;
+
+ if (!pipeTI) {
+ return;
+ }
+ pipeTI = *pipeTIPtr;
+ evControl = pipeTI->evControl;
+ wakeEvent = pipeTI->evWakeUp;
+ pipeTI->evWakeUp = NULL;
+ /*
+ * Try to sane stop the pipe worker, corresponding its current state
+ */
+ switch (
+ (state = InterlockedCompareExchange(&pipeTI->state,
+ PTI_STATE_STOP, PTI_STATE_IDLE))
+ ) {
+
+ case PTI_STATE_IDLE:
+
+ /* Thread was idle/waiting, notify it goes teardown */
+ SetEvent(evControl);
+
+ /* we don't need to wait for it at all, thread frees himself (owns the TI structure) */
+ pipeTI = NULL;
+ break;
+
+ case PTI_STATE_STOP:
+ /* already stopped, thread frees himself (owns the TI structure) */
+ pipeTI = NULL;
+ break;
+ case PTI_STATE_DOWN:
+ /* Thread already down (?), do nothing */
+
+ /* we don't need to wait for it, but we should free pipeTI */
+ hThread = NULL;
+ break;
+
+ /* case PTI_STATE_WORK: */
+ default:
+ /*
+ * Thread works currently, we should try to end it, own the TI structure
+ * (because of possible sharing the joint structures with thread)
+ */
+ if ((state = InterlockedCompareExchange(&pipeTI->state,
+ PTI_STATE_END, PTI_STATE_WORK)) == PTI_STATE_DOWN
+ ) {
+ /* we don't need to wait for it, but we should free pipeTI */
+ hThread = NULL;
+ };
+ break;
+ }
+
+ if (pipeTI && hThread) {
+ DWORD exitCode;
+
+ /*
+ * The thread may already have closed on its own. Check its exit
+ * code.
+ */
+
+ GetExitCodeThread(hThread, &exitCode);
+
+ if (exitCode == STILL_ACTIVE) {
+
+ int inExit = (TclInExit() || TclInThreadExit());
+ /*
+ * Set the stop event so that if the pipe thread is blocked
+ * somewhere, it may hereafter sane exit cleanly.
+ */
+
+ SetEvent(evControl);
+
+ /*
+ * Cancel all sync-IO of this thread (may be blocked there).
+ */
+ if (tclWinProcs.cancelSynchronousIo) {
+ tclWinProcs.cancelSynchronousIo(hThread);
+ }
+
+ /*
+ * Wait at most 20 milliseconds for the reader thread to
+ * close (regarding TIP#398-fast-exit).
+ */
+
+ /* if we want TIP#398-fast-exit. */
+ if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
+
+ /*
+ * The thread must be blocked waiting for the pipe to
+ * become readable in ReadFile(). There isn't a clean way
+ * to exit the thread from this condition. We should
+ * terminate the child process instead to get the reader
+ * thread to fall out of ReadFile with a FALSE. (below) is
+ * not the correct way to do this, but will stay here
+ * until a better solution is found.
+ *
+ * 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.
+ *
+ * Also note that terminating threads during their initialization or teardown phase
+ * may result in ntdll.dll's LoaderLock to remain locked indefinitely.
+ * This causes ntdll.dll's LdrpInitializeThread() to deadlock trying to acquire LoaderLock.
+ * LdrpInitializeThread() is executed within new threads to perform
+ * initialization and to execute DllMain() of all loaded dlls.
+ * As a result, all new threads are deadlocked in their initialization phase and never execute,
+ * even though CreateThread() reports successful thread creation.
+ * This results in a very weird process-wide behavior, which is extremely hard to debug.
+ *
+ * THREADS SHOULD NEVER BE TERMINATED. Period.
+ *
+ * But for now, check if thread is exiting, and if so, let it die peacefully.
+ *
+ * Also don't terminate if in exit (otherwise deadlocked in ntdll.dll's).
+ */
+
+ if ( pipeTI->state != PTI_STATE_DOWN
+ && WaitForSingleObject(hThread,
+ inExit ? 50 : 5000) != WAIT_OBJECT_0
+ ) {
+ /* BUG: this leaks memory */
+ if (inExit || !TerminateThread(hThread, 0)) {
+ /* in exit or terminate fails, just give thread a chance to exit */
+ if (InterlockedExchange(&pipeTI->state,
+ PTI_STATE_STOP) != PTI_STATE_DOWN) {
+ pipeTI = NULL;
+ }
+ };
+ }
+ }
+ }
+ }
+
+ *pipeTIPtr = NULL;
+ if (pipeTI) {
+ if (pipeTI->evWakeUp) {
+ SetEvent(pipeTI->evWakeUp);
+ }
+ CloseHandle(pipeTI->evControl);
+ #ifndef _PTI_USE_CKALLOC
+ free(pipeTI);
+ #else
+ ckfree(pipeTI);
+ #endif
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadExit --
+ *
+ * Clean-up for the pipe thread (removes owned TI-structure in worker).
+ *
+ * Should be executed on worker exit, to inform the main thread or
+ * free TI-structure (if owned).
+ *
+ * After calling of this function, TI-structure pointer given via pipeTIPtr
+ * is not accessible (owned by main thread or released here).
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPipeThreadExit(
+ TclPipeThreadInfo **pipeTIPtr)
+{
+ LONG state;
+ TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+ /*
+ * If state of thread was set to stop (exactly), we can sane free its info
+ * structure, otherwise it is shared with main thread, so main thread will
+ * own it.
+ */
+ if (!pipeTI) {
+ return;
+ }
+ *pipeTIPtr = NULL;
+ if ((state = InterlockedExchange(&pipeTI->state,
+ PTI_STATE_DOWN)) == PTI_STATE_STOP) {
+ CloseHandle(pipeTI->evControl);
+ if (pipeTI->evWakeUp) {
+ SetEvent(pipeTI->evWakeUp);
+ }
+ #ifndef _PTI_USE_CKALLOC
+ free(pipeTI);
+ #else
+ ckfree(pipeTI);
+ /* be sure all subsystems used are finalized */
+ Tcl_FinalizeThread();
+ #endif
+ }
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4