summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorredman <redman>1999-02-26 02:19:23 (GMT)
committerredman <redman>1999-02-26 02:19:23 (GMT)
commit65176c976e848c0bef19cb4eec5aee790f5389aa (patch)
tree714f661cc32d66face3bc841bbc7b2dd2a156dd3 /win
parent46464da386cf7508e30a1ccf11bf5099b3eaa05f (diff)
downloadtcl-65176c976e848c0bef19cb4eec5aee790f5389aa.zip
tcl-65176c976e848c0bef19cb4eec5aee790f5389aa.tar.gz
tcl-65176c976e848c0bef19cb4eec5aee790f5389aa.tar.bz2
Added new code to properly deal with fileevents and nonblocking mode
on serial ports and consoles. Added code to check standard channels for types and create file, console, serial, or pipe channels correctly.
Diffstat (limited to 'win')
-rw-r--r--win/makefile.vc4
-rw-r--r--win/tclWinChan.c506
-rw-r--r--win/tclWinConsole.c1184
-rw-r--r--win/tclWinPipe.c48
-rw-r--r--win/tclWinPort.h13
-rw-r--r--win/tclWinSerial.c1316
6 files changed, 2729 insertions, 342 deletions
diff --git a/win/makefile.vc b/win/makefile.vc
index 86dc1c7..020a940 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -6,7 +6,7 @@
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# RCS: @(#) $Id: makefile.vc,v 1.1.2.14 1999/02/10 23:31:28 stanton Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.1.2.15 1999/02/26 02:19:23 redman Exp $
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -179,6 +179,8 @@ TCLOBJS = \
$(TMPDIR)\tclVar.obj \
$(TMPDIR)\tclWin32Dll.obj \
$(TMPDIR)\tclWinChan.obj \
+ $(TMPDIR)\tclWinConsole.obj \
+ $(TMPDIR)\tclWinSerial.obj \
$(TMPDIR)\tclWinError.obj \
$(TMPDIR)\tclWinFCmd.obj \
$(TMPDIR)\tclWinFile.obj \
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 2e67c14..a9bf113 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinChan.c,v 1.1.2.3 1998/12/01 22:39:36 stanton Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.1.2.4 1999/02/26 02:19:23 redman Exp $
*/
#include "tclWinInt.h"
@@ -22,6 +22,9 @@
#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */
#define FILE_APPEND (1<<2) /* File is in append mode. */
+#define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1)
+#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
+
/*
* The following structure contains per-instance data for a file based channel.
*/
@@ -67,14 +70,6 @@ typedef struct FileEvent {
* Static routines for this file:
*/
-static int ComGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- Tcl_DString *dsPtr));
-static int ComInputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCode));
-static int ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- char *value));
static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,
int mode));
static void FileChannelExitHandler _ANSI_ARGS_((
@@ -117,18 +112,6 @@ static Tcl_ChannelType fileChannelType = {
FileGetHandleProc, /* Get an OS handle from channel. */
};
-static Tcl_ChannelType comChannelType = {
- "com", /* Type name. */
- FileBlockProc, /* Set blocking or non-blocking mode.*/
- FileCloseProc, /* Close proc. */
- ComInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- ComSetOptionProc, /* Set option proc. */
- ComGetOptionProc, /* Get option proc. */
- FileWatchProc, /* Set up notifier to watch the channel. */
- FileGetHandleProc /* Get an OS handle from channel. */
-};
/*
*----------------------------------------------------------------------
@@ -638,204 +621,7 @@ FileGetHandleProc(instanceData, direction, handlePtr)
return TCL_ERROR;
}
}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComInputProc --
- *
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
- *
- * Results:
- * A count of how many bytes were read is returned and an error
- * indication is returned in an output argument.
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComInputProc(instanceData, buf, bufSize, errorCode)
- ClientData instanceData; /* File state. */
- char *buf; /* Where to store data read. */
- int bufSize; /* How much space is available
- * in the buffer? */
- int *errorCode; /* Where to store error code. */
-{
- FileInfo *infoPtr;
- DWORD bytesRead;
- DWORD dw;
- COMSTAT cs;
- *errorCode = 0;
- infoPtr = (FileInfo *) instanceData;
-
- if (ClearCommError(infoPtr->handle, &dw, &cs)) {
- if (dw != 0) {
- *errorCode = EIO;
- return -1;
- }
- if (cs.cbInQue != 0) {
- if ((DWORD) bufSize > cs.cbInQue) {
- bufSize = cs.cbInQue;
- }
- } else {
- if (infoPtr->flags & FILE_ASYNC) {
- errno = *errorCode = EAGAIN;
- return -1;
- } else {
- bufSize = 1;
- }
- }
- }
-
- if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- (LPOVERLAPPED) NULL) == FALSE) {
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- return -1;
- }
-
- return bytesRead;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComSetOptionProc --
- *
- * Sets an option on a channel.
- *
- * Results:
- * A standard Tcl result. Also sets the interp's result on error if
- * interp is not NULL.
- *
- * Side effects:
- * May modify an option on a device.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComSetOptionProc(instanceData, interp, optionName, value)
- ClientData instanceData; /* File state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Which option to set? */
- char *value; /* New value for option. */
-{
- FileInfo *infoPtr;
- DCB dcb;
- int len;
- BOOL result;
- Tcl_DString ds;
- TCHAR *native;
-
- infoPtr = (FileInfo *) instanceData;
-
- len = strlen(optionName);
- if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
- if (GetCommState(infoPtr->handle, &dcb)) {
- native = Tcl_WinUtfToTChar(value, -1, &ds);
- result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
- Tcl_DStringFree(&ds);
-
- if ((result == FALSE) ||
- (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
- /*
- * one should separate the 2 errors...
- */
-
- if (interp) {
- Tcl_AppendResult(interp, "bad value for -mode: should be ",
- "baud,parity,data,stop", NULL);
- }
- return TCL_ERROR;
- } else {
- return TCL_OK;
- }
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
- }
- } else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComGetOptionProc --
- *
- * Gets a mode associated with an IO channel. If the optionName arg
- * is non NULL, retrieves the value of that option. If the optionName
- * arg is NULL, retrieves a list of alternating option names and
- * values for the given channel.
- *
- * Results:
- * A standard Tcl result. Also sets the supplied DString to the
- * string value of the option(s) returned.
- *
- * Side effects:
- * The string returned by this function is in static storage and
- * may be reused at any time subsequent to the call.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData; /* File state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Option to get. */
- Tcl_DString *dsPtr; /* Where to store value(s). */
-{
- FileInfo *infoPtr;
- DCB dcb;
- int len;
-
- infoPtr = (FileInfo *) instanceData;
-
- if (optionName == NULL) {
- Tcl_DStringAppendElement(dsPtr, "-mode");
- len = 0;
- } else {
- len = strlen(optionName);
- }
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
- if (GetCommState(infoPtr->handle, &dcb) == 0) {
- /*
- * shouldn't we flag an error instead ?
- */
- Tcl_DStringAppendElement(dsPtr, "");
- } else {
- char parity;
- char *stop;
- char buf[2 * TCL_INTEGER_SPACE + 16];
-
- parity = 'n';
- if (dcb.Parity < 4) {
- parity = "noems"[dcb.Parity];
- }
-
- stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
- (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
-
- wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
- stop);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
- return TCL_OK;
- } else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
- }
-}
/*
*----------------------------------------------------------------------
@@ -866,18 +652,16 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- FileInfo *infoPtr;
+ Tcl_Channel channel = 0;
int seekFlag, mode, channelPermissions;
- DWORD accessMode, createMode, shareMode, flags;
+ DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
TCHAR *nativeName;
Tcl_DString ds, buffer;
DCB dcb;
- Tcl_ChannelType *channelTypePtr;
HANDLE handle;
char channelName[16 + TCL_INTEGER_SPACE];
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = FileInit();
+ TclFile readFile = NULL;
+ TclFile writeFile = NULL;
mode = TclGetOpenMode(interp, modeString, &seekFlag);
if (mode == -1) {
@@ -889,7 +673,6 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
}
nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds), &buffer);
- Tcl_DStringFree(&ds);
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
@@ -966,8 +749,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
-
- openerr:
+// openerr:
err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
@@ -975,84 +757,81 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), (char *) NULL);
}
Tcl_DStringFree(&buffer);
return NULL;
}
-
- channelTypePtr = &fileChannelType;
- if (GetFileType(handle) == FILE_TYPE_CHAR) {
+
+ type = GetFileType(handle);
+ if (type) {
dcb.DCBlength = sizeof( DCB ) ;
if (GetCommState(handle, &dcb)) {
- /*
- * This is a com port. Reopen it with the correct modes.
- */
+ type = FILE_TYPE_SERIAL;
+ } else if (GetConsoleMode(handle, &consoleParams)) {
+ type = FILE_TYPE_CONSOLE;
+ }
+ }
- COMMTIMEOUTS cto;
+ channel = NULL;
- CloseHandle(handle);
- handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
- 0, NULL, OPEN_EXISTING, flags, NULL);
- if (handle == INVALID_HANDLE_VALUE) {
- goto openerr;
- }
+ switch (type)
+ {
+ case FILE_TYPE_SERIAL:
+// CloseHandle(handle);
+// handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
+// 0, NULL, OPEN_EXISTING, flags, NULL);
- /*
- * FileInit the com port.
- */
-
- SetCommMask(handle, EV_RXCHAR);
- SetupComm(handle, 4096, 4096);
- PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
- | PURGE_RXCLEAR);
- cto.ReadIntervalTimeout = MAXDWORD;
- cto.ReadTotalTimeoutMultiplier = 0;
- cto.ReadTotalTimeoutConstant = 0;
- cto.WriteTotalTimeoutMultiplier = 0;
- cto.WriteTotalTimeoutConstant = 0;
- SetCommTimeouts(handle, &cto);
-
- GetCommState(handle, &dcb);
- SetCommState(handle, &dcb);
- channelTypePtr = &comChannelType;
+// if (handle == INVALID_HANDLE_VALUE) {
+// goto openerr;
+// }
+
+ channel = TclWinOpenSerialChannel(handle, channelName,
+ channelPermissions);
+ break;
+ case FILE_TYPE_CONSOLE:
+ channel = TclWinOpenConsoleChannel(handle, channelName,
+ channelPermissions);
+ break;
+ case FILE_TYPE_PIPE:
+ if (channelPermissions & TCL_READABLE)
+ {
+ readFile = TclWinMakeFile(handle);
}
+ if (channelPermissions & TCL_WRITABLE)
+ {
+ writeFile = TclWinMakeFile(handle);
+ }
+ channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
+ break;
+ case FILE_TYPE_CHAR:
+ default:
+ channel = TclWinOpenFileChannel(handle, channelName,
+ channelPermissions,
+ (mode & O_APPEND) ? FILE_APPEND : 0);
+ break;
+
}
+
Tcl_DStringFree(&buffer);
+ Tcl_DStringFree(&ds);
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
- infoPtr->validMask = channelPermissions;
- infoPtr->watchMask = 0;
- infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
- infoPtr->handle = handle;
-
- wsprintfA(channelName, "file%d", (int) handle);
-
- infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
- (ClientData) infoPtr, channelPermissions);
-
- if (seekFlag) {
- if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "could not seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- }
- Tcl_Close(NULL, infoPtr->channel);
- return NULL;
- }
+ if (channel != NULL)
+ {
+ if (seekFlag) {
+ if (Tcl_Seek(channel, 0, SEEK_END) < 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp,
+ "could not seek to end of file on \"",
+ channelName, "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ Tcl_Close(NULL, channel);
+ return NULL;
+ }
+ }
}
-
- /*
- * Files have default translation of AUTO and ^Z eof char, which
- * means that a ^Z will be accepted as EOF when reading.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- return infoPtr->channel;
+ return channel;
}
/*
@@ -1073,51 +852,63 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
*/
Tcl_Channel
-Tcl_MakeFileChannel(handle, mode)
- ClientData handle; /* OS level handle */
+Tcl_MakeFileChannel(rawHandle, mode)
+ ClientData rawHandle; /* OS level handle */
int mode; /* ORed combination of TCL_READABLE and
* TCL_WRITABLE to indicate file mode. */
{
char channelName[16 + TCL_INTEGER_SPACE];
- FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = FileInit();
+ Tcl_Channel channel = NULL;
+ HANDLE handle = (HANDLE) rawHandle;
+ DCB dcb;
+ DWORD consoleParams;
+ DWORD type;
+ TclFile readFile = NULL;
+ TclFile writeFile = NULL;
if (mode == 0) {
return NULL;
}
- wsprintfA(channelName, "file%d", (int) handle);
-
- /*
- * See if a channel with this handle already exists.
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->handle == (HANDLE) handle) {
- return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
+ type = GetFileType(handle);
+ if (type) {
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (GetCommState(handle, &dcb)) {
+ type = FILE_TYPE_SERIAL;
+ } else if (GetConsoleMode(handle, &consoleParams)) {
+ type = FILE_TYPE_CONSOLE;
}
}
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
- infoPtr->validMask = mode;
- infoPtr->watchMask = 0;
- infoPtr->flags = 0;
- infoPtr->handle = (HANDLE) handle;
- infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- (ClientData) infoPtr, mode);
+ switch (type)
+ {
+ case FILE_TYPE_SERIAL:
+ channel = TclWinOpenSerialChannel(handle, channelName, mode);
+ break;
+ case FILE_TYPE_CONSOLE:
+ channel = TclWinOpenConsoleChannel(handle, channelName, mode);
+ break;
+ case FILE_TYPE_PIPE:
+ if (mode & TCL_READABLE)
+ {
+ readFile = TclWinMakeFile(handle);
+ }
+ if (mode & TCL_WRITABLE)
+ {
+ writeFile = TclWinMakeFile(handle);
+ }
+ channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
+ break;
+ case FILE_TYPE_UNKNOWN:
+ break;
+ case FILE_TYPE_CHAR:
+ default:
+ channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
+ break;
- /*
- * Windows files have AUTO translation mode and ^Z eof char on input.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- return infoPtr->channel;
+ }
+
+ return channel;
}
/*
@@ -1199,3 +990,72 @@ TclpGetDefaultStdChannel(type)
}
return channel;
}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenFileChannel --
+ *
+ * Constructs a File channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel and may cause creation of a file on the
+ * file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+ int appendMode;
+{
+ FileInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+
+ tsdPtr = FileInit();
+
+ /*
+ * See if a channel with this handle already exists.
+ */
+
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->handle == (HANDLE) handle) {
+ return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
+ }
+ }
+
+ infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
+ infoPtr->validMask = permissions;
+ infoPtr->watchMask = 0;
+ infoPtr->flags = appendMode;
+ infoPtr->handle = handle;
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+
+ return infoPtr->channel;
+}
+
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
new file mode 100644
index 0000000..75377d4
--- /dev/null
+++ b/win/tclWinConsole.c
@@ -0,0 +1,1184 @@
+/*
+ * tclWinConsole.c --
+ *
+ * This file implements the Windows-specific console functions,
+ * and the "console" channel driver.
+ *
+ * Copyright (c) 1999 by Scriptics Corp.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclWinConsole.c,v 1.1.2.1 1999/02/26 02:19:23 redman Exp $
+ */
+
+#include "tclWinInt.h"
+
+#include <dos.h>
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+TCL_DECLARE_MUTEX(procMutex)
+
+
+/*
+ * Bit masks used in the flags field of the ConsoleInfo structure below.
+ */
+
+#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */
+#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */
+
+/*
+ * Bit masks used in the sharedFlags field of the ConsoleInfo structure below.
+ */
+
+#define CONSOLE_EOF (1<<2) /* Console has reached EOF. */
+
+/*
+ * This structure describes per-instance data for a console based channel.
+ */
+
+typedef struct ConsoleInfo {
+ HANDLE handle;
+ int type;
+ struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ 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 console. */
+ HANDLE startReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should attempt
+ * to read from the console. */
+ 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
+ * writer thread so access must be
+ * synchronized with the writable object.
+ */
+ char *writeBuf; /* Current background output buffer.
+ * Access is synchronized with the writable
+ * object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable
+ * object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the writable object. */
+ int readFlags; /* Flags that are shared with the reader
+ * thread. Access is synchronized with the
+ * readable object. */
+} ConsoleInfo;
+
+typedef struct ThreadSpecificData {
+ /*
+ * The following pointer refers to the head of the list of consoles
+ * that are being watched for file events.
+ */
+
+ ConsoleInfo *firstConsolePtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * console events are generated.
+ */
+
+typedef struct ConsoleEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note
+ * that we still have to verify that the
+ * console exists before dereferencing this
+ * pointer. */
+} ConsoleEvent;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int ApplicationType(Tcl_Interp *interp,
+ const char *fileName, char *fullName);
+static void BuildCommandLine(const char *executable, int argc,
+ char **argv, Tcl_DString *linePtr);
+static void CopyChannel(HANDLE dst, HANDLE src);
+static BOOL HasConsole(void);
+static TclFile MakeFile(HANDLE handle);
+static char * MakeTempFile(Tcl_DString *namePtr);
+static int ConsoleBlockModeProc(ClientData instanceData, int mode);
+static void ConsoleCheckProc(ClientData clientData, int flags);
+static int ConsoleCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int ConsoleEventProc(Tcl_Event *evPtr, int flags);
+static void ConsoleExitHandler(ClientData clientData);
+static int ConsoleGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static ThreadSpecificData *ConsoleInit(void);
+static int ConsoleInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int ConsoleOutputProc(ClientData instanceData, char *buf,
+ int toWrite, int *errorCode);
+static DWORD WINAPI ConsoleReaderThread(LPVOID arg);
+static void ConsoleSetupProc(ClientData clientData, int flags);
+static void ConsoleWatchProc(ClientData instanceData, int mask);
+static DWORD WINAPI ConsoleWriterThread(LPVOID arg);
+static void ProcExitHandler(ClientData clientData);
+static int TempFileName(WCHAR name[MAX_PATH]);
+static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
+
+/*
+ * This structure describes the channel type structure for command console
+ * based IO.
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
+ ConsoleCloseProc, /* Close proc. */
+ ConsoleInputProc, /* Input proc. */
+ ConsoleOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatchProc, /* Set up notifier to watch the channel. */
+ ConsoleGetHandleProc, /* Get an OS handle from channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+ConsoleInit()
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Check the initialized flag first, then check again in the mutex.
+ * This is a speed enhancement.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&procMutex);
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&procMutex);
+ }
+
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstConsolePtr = NULL;
+ Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleExitHandler --
+ *
+ * This function is called to cleanup the console module before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the console event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcExitHandler --
+ *
+ * This function is called to cleanup the process list before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the process list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_MutexLock(&procMutex);
+ initialized = 0;
+ Tcl_MutexUnlock(&procMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleSetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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->writable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ block = 0;
+ }
+ }
+ }
+ if (!block) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the console
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ ConsoleInfo *infoPtr;
+ ConsoleEvent *evPtr;
+ int needEvent;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Queue events for any ready consoles that don't already have events
+ * queued.
+ */
+
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->flags & CONSOLE_PENDING) {
+ continue;
+ }
+
+ /*
+ * Queue an event if the console is signaled for reading or writing.
+ */
+
+ needEvent = 0;
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ needEvent = 1;
+ }
+ }
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ needEvent = 1;
+ }
+ }
+
+ if (needEvent) {
+ infoPtr->flags |= CONSOLE_PENDING;
+ evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
+ evPtr->header.proc = ConsoleEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleBlockModeProc --
+ *
+ * Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleBlockModeProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+ /*
+ * Consoles on Windows can not be switched between blocking and nonblocking,
+ * hence we have to emulate the behavior. This is done in the input
+ * function by checking against a bit in the state. We set or unset the
+ * bit here to cause the input function to emulate the correct behavior.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= CONSOLE_ASYNC;
+ } else {
+ infoPtr->flags &= ~(CONSOLE_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCloseProc --
+ *
+ * Closes a console based IO channel.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the physical channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCloseProc(
+ ClientData instanceData, /* Pointer to ConsoleInfo structure. */
+ Tcl_Interp *interp) /* For error reporting. */
+{
+ ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
+ int errorCode, result;
+ ConsoleInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ 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) {
+ TerminateThread(consolePtr->readThread, 0);
+ CloseHandle(consolePtr->readThread);
+ CloseHandle(consolePtr->readable);
+ CloseHandle(consolePtr->startReader);
+ 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) {
+ WaitForSingleObject(consolePtr->writable, INFINITE);
+ TerminateThread(consolePtr->writeThread, 0);
+ CloseHandle(consolePtr->writeThread);
+ CloseHandle(consolePtr->writable);
+ CloseHandle(consolePtr->startWriter);
+ consolePtr->writeThread = NULL;
+ }
+ consolePtr->validMask &= ~TCL_WRITABLE;
+
+
+ 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);
+
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleInputProc(
+ ClientData instanceData, /* Console state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available
+ * in the buffer? */
+ int *errorCode) /* Where to store error code. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ DWORD count, bytesRead = 0;
+ int result;
+
+ *errorCode = 0;
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1);
+
+ /*
+ * If an error occurred, return immediately.
+ */
+
+ if (result == -1) {
+ *errorCode = errno;
+ return -1;
+ }
+
+ /*
+ * Attempt to read bufSize bytes. The read will return immediately
+ * if there is any data available. Otherwise it will block until
+ * at least one byte is available or an EOF occurs.
+ */
+
+ if (ReadConsole(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
+ (LPOVERLAPPED) NULL) == TRUE) {
+ return bytesRead + count;
+ } else if (bytesRead) {
+ /*
+ * Ignore errors if we have data to return.
+ */
+
+ return bytesRead;
+ }
+
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutputProc --
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleOutputProc(
+ ClientData instanceData, /* Console state. */
+ char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ DWORD bytesWritten, timeout;
+
+ *errorCode = 0;
+ timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 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;
+ goto error;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ */
+
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error;
+ }
+
+ if (infoPtr->flags & CONSOLE_ASYNC) {
+ /*
+ * The console is non-blocking, so copy the data into the output
+ * buffer and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc(toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->writable);
+ SetEvent(infoPtr->startWriter);
+ bytesWritten = toWrite;
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly.
+ * This avoids an unnecessary copy.
+ */
+
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ goto error;
+ }
+ }
+ return bytesWritten;
+
+ error:
+ *errorCode = errno;
+ return -1;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This function is invoked by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure invokes
+ * Tcl_NotifyChannel on the console.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatchProc --
+ *
+ * Called by the notifier to set up to watch for events on this
+ * channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleWatchProc(
+ ClientData instanceData, /* Console state. */
+ int mask) /* What events to watch for, OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ ConsoleInfo **nextPtrPtr, *ptr;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Since most of the work is handled by the background threads,
+ * we just need to update the watchMask and then force the notifier
+ * to poll once.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ Tcl_Time blockTime = { 0, 0 };
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstConsolePtr;
+ tsdPtr->firstConsolePtr = infoPtr;
+ }
+ Tcl_SetMaxBlockTime(&blockTime);
+ } else {
+ if (oldMask) {
+ /*
+ * Remove the console from the list of watched consoles.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr;
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
+ * inside a command consoleline based channel.
+ *
+ * Results:
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ * there is no handle for the specified direction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleGetHandleProc(
+ ClientData instanceData, /* The console state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForRead --
+ *
+ * Wait until some data is available, the console is at
+ * EOF or the reader thread is blocked waiting for data (if the
+ * channel is in non-blocking mode).
+ *
+ * Results:
+ * Returns 1 if console is readable. Returns 0 if there is no data
+ * on the console, but there is buffered data. Returns -1 if an
+ * error occurred. If an error occurred, the threads may not
+ * be synchronized.
+ *
+ * Side effects:
+ * Updates the shared state flags. If no error occurred,
+ * the reader thread is blocked waiting for a signal from the
+ * main thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForRead(
+ ConsoleInfo *infoPtr, /* Console state. */
+ int blocking) /* Indicates whether call should be
+ * blocking or not. */
+{
+ DWORD timeout, count, peekResult;
+ HANDLE *handle = infoPtr->handle;
+ INPUT_RECORD input;
+
+ while (1) {
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ timeout = blocking ? INFINITE : 0;
+ 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;
+ return -1;
+ }
+
+ /*
+ * At this point, the two threads are synchronized, so it is safe
+ * to access shared state.
+ */
+
+ /*
+ * If the console has hit EOF, it is always readable.
+ */
+
+ if (infoPtr->readFlags & CONSOLE_EOF) {
+ return 1;
+ }
+
+ /*
+ * Check to see if there is any data sitting in the console.
+ * But first, remove any non-key events.
+ */
+
+ while (peekResult = PeekConsoleInput(handle, &input, 1, &count)) {
+ if (count == 0) break;
+ if (input.EventType == KEY_EVENT) break;
+
+ ReadConsoleInput(handle, &input, 1, &count);
+ }
+
+ if (!peekResult) {
+ /*
+ * Check to see if the peek failed because of EOF.
+ */
+
+ TclWinConvertError(GetLastError());
+
+ if (errno == EOF) {
+ infoPtr->readFlags |= CONSOLE_EOF;
+ return 1;
+ }
+
+ return -1;
+ }
+
+ /*
+ * We found some data in the console, so it must be readable.
+ */
+
+ if (count > 0) {
+ return 1;
+ }
+
+ /*
+ * There wasn't any data available, so reset the thread and
+ * try again.
+ */
+
+ ResetEvent(infoPtr->readable);
+ SetEvent(infoPtr->startReader);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleReaderThread --
+ *
+ * This function runs in a separate thread and waits for input
+ * to become available on a console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the main thread when input become available. May
+ * cause the main thread to wake up by posting a message. May
+ * consume one byte from the console for each wait operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+ConsoleReaderThread(LPVOID arg)
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD count, peekResult;
+ INPUT_RECORD input;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to wait.
+ */
+
+ WaitForSingleObject(infoPtr->startReader, INFINITE);
+
+ /*
+ * Try waiting for an event on the console.
+ */
+
+ WaitForSingleObject(handle, INFINITE);
+
+ count = 0;
+
+ /*
+ * Look for data on the console, but first ignore any events
+ * that are not KEY_EVENTs
+ */
+
+ while (peekResult = PeekConsoleInput(handle, &input, 1, &count)) {
+ if (input.EventType == KEY_EVENT) break;
+ if (count == 0) break;
+
+ ReadConsoleInput(handle, &input, 1, &count);
+ }
+
+ if (!peekResult) {
+ /*
+ * The error is a result of an EOF condition, so set the
+ * EOF bit before signalling the main thread.
+ */
+
+ TclWinConvertError(GetLastError());
+
+ if (errno == EOF) {
+ infoPtr->readFlags |= CONSOLE_EOF;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the readable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->readable);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ }
+ return 0; /* NOT REACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWriterThread --
+ *
+ * This function runs in a separate thread and writes data
+ * onto a console.
+ *
+ * Results:
+ * Always returns 0.
+ *
+ * Side effects:
+ * Signals the main thread when an output operation is completed.
+ * May cause the main thread to wake up by posting a message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+ConsoleWriterThread(LPVOID arg)
+{
+
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD count, toWrite;
+ char *buf;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+
+ WaitForSingleObject(infoPtr->startWriter, INFINITE);
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ break;
+ } else {
+ toWrite -= count;
+ buf += count;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the writable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->writable);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ }
+ return 0; /* NOT REACHED */
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenConsoleChannel --
+ *
+ * Constructs a Console channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenConsoleChannel(handle, channelName, permissions)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+{
+ ConsoleInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+ DWORD id;
+
+ tsdPtr = ConsoleInit();
+
+ /*
+ * See if a channel with this handle already exists.
+ */
+
+ infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
+ memset(infoPtr, 0, sizeof(ConsoleInfo));
+
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+
+ /*
+ * Use the pointer for the name of the result channel.
+ * This keeps the channel names unique, since some may share
+ * handles (stdin/stdout/stderr for instance).
+ */
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+ infoPtr->threadId = Tcl_GetCurrentThread();
+
+ if (permissions & TCL_READABLE) {
+ infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 8000, ConsoleReaderThread,
+ infoPtr, 0, &id);
+ }
+
+ if (permissions & TCL_WRITABLE) {
+ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 8000, ConsoleWriterThread,
+ infoPtr, 0, &id);
+ }
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+
+ return infoPtr->channel;
+}
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index acc3c06..b48ba80 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinPipe.c,v 1.1.2.5 1998/12/12 01:37:05 lfb Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.1.2.6 1999/02/26 02:19:24 redman Exp $
*/
#include "tclWinInt.h"
@@ -206,7 +206,6 @@ static void BuildCommandLine(const char *executable, int argc,
char **argv, Tcl_DString *linePtr);
static void CopyChannel(HANDLE dst, HANDLE src);
static BOOL HasConsole(void);
-static TclFile MakeFile(HANDLE handle);
static char * MakeTempFile(Tcl_DString *namePtr);
static int PipeBlockModeProc(ClientData instanceData, int mode);
static void PipeCheckProc(ClientData clientData, int flags);
@@ -268,13 +267,21 @@ static void
PipeInit()
{
ThreadSpecificData *tsdPtr;
- Tcl_MutexLock(&procMutex);
+
+ /*
+ * Check the initialized flag first, then check again in the mutex.
+ * This is a speed enhancement.
+ */
+
if (!initialized) {
- initialized = 1;
- procList = NULL;
- Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ Tcl_MutexLock(&procMutex);
+ if (!initialized) {
+ initialized = 1;
+ procList = NULL;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&procMutex);
}
- Tcl_MutexUnlock(&procMutex);
tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
@@ -307,7 +314,6 @@ PipeExitHandler(
ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
- initialized = 0;
}
/*
@@ -473,7 +479,7 @@ PipeCheckProc(
/*
*----------------------------------------------------------------------
*
- * MakeFile --
+ * TclWinMakeFile --
*
* This function constructs a new TclFile from a given data and
* type value.
@@ -487,8 +493,8 @@ PipeCheckProc(
*----------------------------------------------------------------------
*/
-static TclFile
-MakeFile(
+TclFile
+TclWinMakeFile(
HANDLE handle) /* Type-specific data. */
{
WinFile *filePtr;
@@ -571,7 +577,7 @@ TclpMakeFile(channel, direction)
if (Tcl_GetChannelHandle(channel, direction,
(ClientData *) &handle) == TCL_OK) {
- return MakeFile(handle);
+ return TclWinMakeFile(handle);
} else {
return (TclFile) NULL;
}
@@ -694,7 +700,7 @@ TclpOpenFile(path, mode)
SetFilePointer(handle, 0, NULL, FILE_END);
}
- return MakeFile(handle);
+ return TclWinMakeFile(handle);
}
/*
@@ -778,7 +784,7 @@ TclpCreateTempFile(contents)
lstrcpyA(tmpFilePtr->name, (char *) name);
return (TclFile) tmpFilePtr;
} else {
- return MakeFile(handle);
+ return TclWinMakeFile(handle);
}
error:
@@ -815,8 +821,8 @@ TclpCreatePipe(
HANDLE readHandle, writeHandle;
if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
- *readPipe = MakeFile(readHandle);
- *writePipe = MakeFile(writeHandle);
+ *readPipe = TclWinMakeFile(readHandle);
+ *writePipe = TclWinMakeFile(writeHandle);
return 1;
}
@@ -1994,9 +2000,11 @@ TclpCreateCommandChannel(
* For backward compatibility with previous versions of Tcl, we
* use "file%d" as the base name for pipes even though it would
* be more natural to use "pipe%d".
+ * Use the pointer to keep the channel names unique, in case
+ * channels share handles (stdin/stdout).
*/
- wsprintfA(channelName, "file%d", channelId);
+ wsprintfA(channelName, "file%lx", infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
(ClientData) infoPtr, infoPtr->validMask);
@@ -2221,12 +2229,18 @@ PipeClose2Proc(
} else {
errChan = NULL;
}
+
result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
errChan);
+
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
}
+ if (pipePtr->writeBuf != NULL) {
+ ckfree(pipePtr->writeBuf);
+ }
+
ckfree((char*) pipePtr);
if (errorCode == 0) {
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index e6bac57..58d4946 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinPort.h,v 1.1.2.4 1998/12/24 00:14:02 rjohnson Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.1.2.5 1999/02/26 02:19:24 redman Exp $
*/
#ifndef _TCLWINPORT
@@ -440,6 +440,17 @@ EXTERN u_short PASCAL FAR
EXTERN int PASCAL FAR TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
int optname, const char FAR * optval, int optlen));
+EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions));
+
+EXTERN Tcl_Channel TclWinOpenConsoleChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions));
+
+EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions, int appendMode));
+
+EXTERN TclFile TclWinMakeFile _ANSI_ARGS_((HANDLE handle));
+
/*
* Platform specific mutex definition used by memory allocators.
* These mutexes are statically allocated and explicitly initialized.
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
new file mode 100644
index 0000000..6b99e91
--- /dev/null
+++ b/win/tclWinSerial.c
@@ -0,0 +1,1316 @@
+/*
+ * Tclwinserial.c --
+ *
+ * This file implements the Windows-specific serial port functions,
+ * and the "serial" channel driver.
+ *
+ * Copyright (c) 1999 by Scriptics Corp.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclWinSerial.c,v 1.1.2.1 1999/02/26 02:19:25 redman Exp $
+ */
+
+#include "tclWinInt.h"
+
+#include <dos.h>
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+TCL_DECLARE_MUTEX(procMutex)
+
+/*
+ * Bit masks used in the flags field of the SerialInfo structure below.
+ */
+
+#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */
+#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */
+
+/*
+ * Bit masks used in the sharedFlags field of the SerialInfo structure below.
+ */
+
+#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */
+
+/*
+ * This structure describes per-instance data for a serial based channel.
+ */
+
+typedef struct SerialInfo {
+ HANDLE handle;
+ struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ 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 serial. */
+ HANDLE startReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should attempt
+ * to read from the serial. */
+ 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
+ * writer thread so access must be
+ * synchronized with the writable object.
+ */
+ char *writeBuf; /* Current background output buffer.
+ * Access is synchronized with the writable
+ * object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable
+ * object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the writable object. */
+ int readFlags; /* Flags that are shared with the reader
+ * thread. Access is synchronized with the
+ * readable object. */
+ int writeFlags; /* Flags that are shared with the writer
+ * thread. Access is synchronized with the
+ * readable object. */
+ int readyMask; /* Events that need to be checked on. */
+} SerialInfo;
+
+typedef struct ThreadSpecificData {
+ /*
+ * The following pointer refers to the head of the list of serials
+ * that are being watched for file events.
+ */
+
+ SerialInfo *firstSerialPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * serial events are generated.
+ */
+
+typedef struct SerialEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ SerialInfo *infoPtr; /* Pointer to serial info structure. Note
+ * that we still have to verify that the
+ * serial exists before dereferencing this
+ * pointer. */
+} SerialEvent;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int SerialBlockProc(ClientData instanceData, int mode);
+static void SerialCheckProc(ClientData clientData, int flags);
+static int SerialCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int SerialEventProc(Tcl_Event *evPtr, int flags);
+static void SerialExitHandler(ClientData clientData);
+static int SerialGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static ThreadSpecificData *SerialInit(void);
+static int SerialInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int SerialOutputProc(ClientData instanceData, char *buf,
+ int toWrite, int *errorCode);
+static DWORD WINAPI SerialReaderThread(LPVOID arg);
+static void SerialSetupProc(ClientData clientData, int flags);
+static void SerialWatchProc(ClientData instanceData, int mask);
+static DWORD WINAPI SerialWriterThread(LPVOID arg);
+static void ProcExitHandler(ClientData clientData);
+static int WaitForRead(SerialInfo *infoPtr, int blocking);
+static int SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ Tcl_DString *dsPtr));
+static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ char *value));
+
+/*
+ * This structure describes the channel type structure for command serial
+ * based IO.
+ */
+
+static Tcl_ChannelType serialChannelType = {
+ "serial", /* Type name. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ SerialCloseProc, /* Close proc. */
+ SerialInputProc, /* Input proc. */
+ SerialOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ SerialSetOptionProc, /* Set option proc. */
+ SerialGetOptionProc, /* Get option proc. */
+ SerialWatchProc, /* Set up notifier to watch the channel. */
+ SerialGetHandleProc, /* Get an OS handle from channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+SerialInit()
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Check the initialized flag first, then check it again in the mutex.
+ * This is a speed enhancement.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&procMutex);
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&procMutex);
+ }
+
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstSerialPtr = NULL;
+ Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialExitHandler --
+ *
+ * This function is called to cleanup the serial module before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the serial event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcExitHandler --
+ *
+ * This function is called to cleanup the process list before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the process list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_MutexLock(&procMutex);
+ initialized = 0;
+ Tcl_MutexUnlock(&procMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialSetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+SerialSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ SerialInfo *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->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ block = 0;
+ }
+ }
+ }
+ if (!block) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialCheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the serial
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ SerialInfo *infoPtr;
+ SerialEvent *evPtr;
+ int needEvent;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Queue events for any ready serials that don't already have events
+ * queued.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->flags & SERIAL_PENDING) {
+ continue;
+ }
+
+ /*
+ * Queue an event if the serial is signaled for reading or writing.
+ */
+
+ needEvent = 0;
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ needEvent = 1;
+ }
+ }
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ needEvent = 1;
+ }
+ }
+
+ if (needEvent) {
+ infoPtr->flags |= SERIAL_PENDING;
+ evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+ evPtr->header.proc = SerialEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockProc --
+ *
+ * Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialBlockProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ /*
+ * Serial IO on Windows can not be switched between blocking & nonblocking,
+ * hence we have to emulate the behavior. This is done in the input
+ * function by checking against a bit in the state. We set or unset the
+ * bit here to cause the input function to emulate the correct behavior.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= SERIAL_ASYNC;
+ } else {
+ infoPtr->flags &= ~(SERIAL_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialCloseProc --
+ *
+ * Closes a serial based IO channel.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the physical channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialCloseProc(
+ ClientData instanceData, /* Pointer to SerialInfo structure. */
+ Tcl_Interp *interp) /* For error reporting. */
+{
+ SerialInfo *serialPtr = (SerialInfo *) instanceData;
+ int errorCode, result;
+ SerialInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ errorCode = 0;
+ if (serialPtr->readThread) {
+ TerminateThread(serialPtr->readThread, 0);
+ CloseHandle(serialPtr->readThread);
+ CloseHandle(serialPtr->readable);
+ CloseHandle(serialPtr->startReader);
+ serialPtr->readThread = NULL;
+ }
+ serialPtr->validMask &= ~TCL_READABLE;
+
+ if (serialPtr->writeThread) {
+ WaitForSingleObject(serialPtr->writable, INFINITE);
+ TerminateThread(serialPtr->writeThread, 0);
+ CloseHandle(serialPtr->writeThread);
+ CloseHandle(serialPtr->writable);
+ CloseHandle(serialPtr->startWriter);
+ serialPtr->writeThread = NULL;
+ }
+ serialPtr->validMask &= ~TCL_WRITABLE;
+
+ if (CloseHandle(serialPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
+
+ serialPtr->watchMask &= serialPtr->validMask;
+
+ /*
+ * Remove the file from the list of watched files.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstSerialPtr), infoPtr = *nextPtrPtr;
+ infoPtr != NULL;
+ nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+ if (infoPtr == (SerialInfo *)serialPtr) {
+ *nextPtrPtr = infoPtr->nextPtr;
+ break;
+ }
+ }
+
+ /*
+ * Wrap the error file into a channel and give it to the cleanup
+ * routine.
+ */
+
+ if (serialPtr->writeBuf != NULL) {
+ ckfree(serialPtr->writeBuf);
+ serialPtr->writeBuf = NULL;
+ }
+
+ ckfree((char*) serialPtr);
+
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialInputProc(
+ ClientData instanceData, /* Serial state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available
+ * in the buffer? */
+ int *errorCode) /* Where to store error code. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ DWORD bytesRead = 0;
+ int result;
+ DWORD errors, err;
+ DWORD mask = 0;
+ COMSTAT stat;
+
+ *errorCode = 0;
+
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ result = WaitForRead(infoPtr, (infoPtr->flags & SERIAL_ASYNC) ? 0 : 1);
+
+ /*
+ * If an error occurred, return immediately.
+ */
+
+ if (result == -1) {
+ *errorCode = errno;
+ return -1;
+ }
+
+ infoPtr->readyMask &= ~TCL_READABLE;
+
+ if (ClearCommError(infoPtr->handle, &errors, &stat)) {
+
+ /*
+ * If there are errors, then signal an I/O error.
+ */
+
+ if (errors != 0) {
+ *errorCode = EIO;
+ return -1;
+ }
+
+ /*
+ * Otherwise, it's not that fatal, so check the queue
+ */
+
+ if (stat.cbInQue != 0) {
+
+ /*
+ * If the buffer is bigger than the data in the queue,
+ * shrink the buffer size to match.
+ */
+
+ if ((DWORD) bufSize > stat.cbInQue) {
+ bufSize = stat.cbInQue;
+ }
+
+ } else {
+ if (infoPtr->flags & SERIAL_ASYNC) {
+ errno = *errorCode = EAGAIN;
+ return -1;
+ } else {
+ bufSize = 1;
+ }
+ }
+ }
+
+ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ NULL) == FALSE) {
+ err = GetLastError();
+ if (err != ERROR_IO_PENDING) {
+ goto error;
+ }
+ }
+
+ return bytesRead;
+
+ error:
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialOutputProc --
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialOutputProc(
+ ClientData instanceData, /* Serial state. */
+ char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ DWORD bytesWritten, timeout, err;
+
+ *errorCode = 0;
+ timeout = (infoPtr->flags & SERIAL_ASYNC) ? 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;
+ goto error;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ */
+
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error;
+ }
+
+ if (infoPtr->flags & SERIAL_ASYNC) {
+ /*
+ * The serial is non-blocking, so copy the data into the output
+ * buffer and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc(toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->writable);
+ SetEvent(infoPtr->startWriter);
+ bytesWritten = toWrite;
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly.
+ * This avoids an unnecessary copy.
+ */
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, NULL) == FALSE) {
+ err = GetLastError();
+ if (err != ERROR_IO_PENDING) {
+ TclWinConvertError(GetLastError());
+ goto error;
+ }
+ }
+ }
+ return bytesWritten;
+
+ error:
+ *errorCode = errno;
+ return -1;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialEventProc --
+ *
+ * This function is invoked by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure invokes
+ * Tcl_NotifyChannel on the serial.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
+ SerialInfo *infoPtr;
+ int mask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the list of watched serials for the one whose handle
+ * matches the event. We do this rather than simply dereferencing
+ * the handle in the event so that serials can be deleted while the
+ * event is in the queue.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (serialEvPtr->infoPtr == infoPtr) {
+ infoPtr->flags &= ~(SERIAL_PENDING);
+ break;
+ }
+ }
+ /*
+ * Remove stale events.
+ */
+
+ if (!infoPtr) {
+ return 1;
+ }
+
+ /*
+ * Check to see if the serial is readable. Note
+ * that we can't tell if a serial 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 & SERIAL_EOF) {
+ mask = TCL_READABLE;
+ } else {
+ mask |= TCL_READABLE;
+ }
+ }
+ }
+
+ /*
+ * Inform the channel of the events.
+ */
+
+ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialWatchProc --
+ *
+ * Called by the notifier to set up to watch for events on this
+ * channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialWatchProc(
+ ClientData instanceData, /* Serial state. */
+ int mask) /* What events to watch for, OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ SerialInfo **nextPtrPtr, *ptr;
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Since the file is always ready for events, we set the block time
+ * to zero so we will poll.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ Tcl_Time blockTime = { 0, 0 };
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstSerialPtr;
+ tsdPtr->firstSerialPtr = infoPtr;
+ }
+ Tcl_SetMaxBlockTime(&blockTime);
+ } else {
+ if (oldMask) {
+ /*
+ * Remove the serial port from the list of watched serial ports.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr;
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
+ * inside a command serial port based channel.
+ *
+ * Results:
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ * there is no handle for the specified direction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialGetHandleProc(
+ ClientData instanceData, /* The serial state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForRead --
+ *
+ * Wait until some data is available, the serial is at
+ * EOF or the reader thread is blocked waiting for data (if the
+ * channel is in non-blocking mode).
+ *
+ * Results:
+ * Returns 1 if serial is readable. Returns 0 if there is no data
+ * on the serial, but there is buffered data. Returns -1 if an
+ * error occurred. If an error occurred, the threads may not
+ * be synchronized.
+ *
+ * Side effects:
+ * Updates the shared state flags and may consume 1 byte of data
+ * from the serial. If no error occurred, the reader thread is
+ * blocked waiting for a signal from the main thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForRead(
+ SerialInfo *infoPtr, /* Serial state. */
+ int blocking) /* Indicates whether call should be
+ * blocking or not. */
+{
+ DWORD timeout, err, mask;
+ HANDLE *handle = infoPtr->handle;
+
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ timeout = blocking ? INFINITE : 0;
+ 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;
+ return -1;
+ }
+
+ /*
+ * At this point, the two threads are synchronized, so it is safe
+ * to access shared state. This code is not called in the ReaderThread
+ * in blocking mode, so it needs to be checked here.
+ */
+
+ while (1) {
+ if (WaitCommEvent(handle, &mask, NULL) == FALSE) {
+ err = GetLastError();
+ infoPtr->readFlags |= SERIAL_EOF;
+ break;
+ }
+ if (mask & EV_RXCHAR) {
+ break;
+ }
+ ResetEvent(infoPtr->readable);
+ SetEvent(infoPtr->startReader);
+ }
+
+ /*
+ * If the serial has hit EOF, it is always readable.
+ */
+
+ if (infoPtr->readFlags & SERIAL_EOF) {
+ return 1;
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialReaderThread --
+ *
+ * This function runs in a separate thread and waits for input
+ * to become available on a serial.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the main thread when input become available. May
+ * cause the main thread to wake up by posting a message. May
+ * consume one byte from the serial for each wait operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+SerialReaderThread(LPVOID arg)
+{
+ SerialInfo *infoPtr = (SerialInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD mask = EV_RXCHAR;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to wait.
+ */
+
+ WaitForSingleObject(infoPtr->startReader, INFINITE);
+
+ /*
+ * Try waiting for a Comm event.
+ */
+
+
+ while (1) {
+ if (WaitCommEvent(handle, &mask, NULL) == FALSE) {
+ /*
+ * There is an error, signal an EOF.
+ */
+
+ infoPtr->readFlags |= SERIAL_EOF;
+ break;
+ }
+
+ /*
+ * Signal the main thread by signalling the readable event and
+ * then waking up the notifier thread.
+ */
+
+ if (mask & EV_RXCHAR) {
+ SetEvent(infoPtr->readable);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ break;
+ }
+ }
+ }
+ return 0; /* NOT REACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialWriterThread --
+ *
+ * This function runs in a separate thread and writes data
+ * onto a serial.
+ *
+ * Results:
+ * Always returns 0.
+ *
+ * Side effects:
+ * Signals the main thread when an output operation is completed.
+ * May cause the main thread to wake up by posting a message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+SerialWriterThread(LPVOID arg)
+{
+
+ SerialInfo *infoPtr = (SerialInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD count, toWrite, err;
+ char *buf;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+
+ WaitForSingleObject(infoPtr->startWriter, INFINITE);
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ if (WriteFile(handle, (LPVOID) buf, (DWORD) toWrite,
+ &count, NULL) == FALSE) {
+ err = GetLastError();
+ if (err != ERROR_IO_PENDING) {
+ TclWinConvertError(GetLastError());
+ infoPtr->writeError = err;
+ break;
+ }
+ } else {
+ toWrite -= count;
+ buf += count;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the writable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->writable);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ }
+ return 0; /* NOT REACHED */
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenConsoleChannel --
+ *
+ * Constructs a Serial port channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenSerialChannel(handle, channelName, permissions)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+{
+ SerialInfo *infoPtr;
+ COMMTIMEOUTS cto;
+ ThreadSpecificData *tsdPtr;
+ DWORD id;
+
+ tsdPtr = SerialInit();
+
+ SetCommMask(handle, EV_RXCHAR);
+ SetupComm(handle, 4096, 4096);
+ PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+ | PURGE_RXCLEAR);
+ cto.ReadIntervalTimeout = MAXDWORD;
+ cto.ReadTotalTimeoutMultiplier = 0;
+ cto.ReadTotalTimeoutConstant = 0;
+ cto.WriteTotalTimeoutMultiplier = 0;
+ cto.WriteTotalTimeoutConstant = 0;
+ SetCommTimeouts(handle, &cto);
+
+ infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
+ memset(infoPtr, 0, sizeof(SerialInfo));
+
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+
+ /*
+ * Use the pointer to keep the channel names unique, in case
+ * the handles are shared between multiple channels (stdin/stdout).
+ */
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+
+ infoPtr->threadId = Tcl_GetCurrentThread();
+
+ if (permissions & TCL_READABLE) {
+ infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 8000, SerialReaderThread,
+ infoPtr, 0, &id);
+ }
+ if (permissions & TCL_WRITABLE) {
+ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 8000, SerialWriterThread,
+ infoPtr, 0, &id);
+ }
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+
+ return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialSetOptionProc --
+ *
+ * Sets an option on a channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets the interp's result on error if
+ * interp is not NULL.
+ *
+ * Side effects:
+ * May modify an option on a device.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialSetOptionProc(instanceData, interp, optionName, value)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Which option to set? */
+ char *value; /* New value for option. */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ int len;
+ BOOL result;
+ Tcl_DString ds;
+ TCHAR *native;
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ len = strlen(optionName);
+ if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+ if (GetCommState(infoPtr->handle, &dcb)) {
+ native = Tcl_WinUtfToTChar(value, -1, &ds);
+ result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
+ Tcl_DStringFree(&ds);
+
+ if ((result == FALSE) ||
+ (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
+ /*
+ * one should separate the 2 errors...
+ */
+
+ if (interp) {
+ Tcl_AppendResult(interp, "bad value for -mode: should be ",
+ "baud,parity,data,stop", NULL);
+ }
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialGetOptionProc --
+ *
+ * Gets a mode associated with an IO channel. If the optionName arg
+ * is non NULL, retrieves the value of that option. If the optionName
+ * arg is NULL, retrieves a list of alternating option names and
+ * values for the given channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets the supplied DString to the
+ * string value of the option(s) returned.
+ *
+ * Side effects:
+ * The string returned by this function is in static storage and
+ * may be reused at any time subsequent to the call.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Option to get. */
+ Tcl_DString *dsPtr; /* Where to store value(s). */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ int len;
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ len = 0;
+ } else {
+ len = strlen(optionName);
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+ if (GetCommState(infoPtr->handle, &dcb) == 0) {
+ /*
+ * shouldn't we flag an error instead ?
+ */
+
+ Tcl_DStringAppendElement(dsPtr, "");
+
+ } else {
+ char parity;
+ char *stop;
+ char buf[2 * TCL_INTEGER_SPACE + 16];
+
+ parity = 'n';
+ if (dcb.Parity < 4) {
+ parity = "noems"[dcb.Parity];
+ }
+
+ stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
+ (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+
+ wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
+ stop);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ return TCL_OK;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}