--- /dev/null
+/*
+ * 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.
+ *
+ * Serial functionality implemented by Rolf.Schroedter@dlr.de
+ */
+
+#include "tclWinInt.h"
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * The serialMutex locks around access to the initialized variable, and it is
+ * used to protect background threads from being terminated while they are
+ * using APIs that hold locks.
+ */
+
+TCL_DECLARE_MUTEX(serialMutex)
+
+/*
+ * 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. */
+#define SERIAL_ERROR (1<<4)
+
+/*
+ * Default time to block between checking status on the serial port.
+ */
+
+#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */
+
+/*
+ * Define Win32 read/write error masks returned by ClearCommError()
+ */
+
+#define SERIAL_READ_ERRORS \
+ (CE_RXOVER | CE_OVERRUN | CE_RXPARITY | CE_FRAME | CE_BREAK)
+#define SERIAL_WRITE_ERRORS \
+ (CE_TXFULL | CE_PTO)
+
+/*
+ * 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. */
+ int readable; /* Flag that the channel is readable. */
+ int writable; /* Flag that the channel is writable. */
+ int blockTime; /* Maximum blocktime in msec. */
+ unsigned int lastEventTime; /* Time in milliseconds since last readable
+ * event. */
+ /* Next readable event only after blockTime */
+ DWORD error; /* pending error code returned by
+ * ClearCommError() */
+ DWORD lastError; /* last error code, can be fetched with
+ * fconfigure chan -lasterror */
+ DWORD sysBufRead; /* Win32 system buffer size for read ops,
+ * default=4096 */
+ DWORD sysBufWrite; /* Win32 system buffer size for write ops,
+ * default=4096 */
+
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ OVERLAPPED osRead; /* OVERLAPPED structure for read operations. */
+ OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */
+ TclPipeThreadInfo *writeTI; /* Thread info structure of writer worker. */
+ HANDLE writeThread; /* Handle to writer thread. */
+ CRITICAL_SECTION csWrite; /* Writer thread synchronisation. */
+ HANDLE evWritable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for the
+ * current buffer to be written. */
+ 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 evWritable object. */
+ char *writeBuf; /* Current background output buffer. Access is
+ * synchronized with the evWritable object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the evWritable object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the evWritable object. */
+ int writeQueue; /* Number of bytes pending in output queue.
+ * Offset to DCB.cbInQue. Used to query
+ * [fconfigure -queue] */
+} 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;
+
+/*
+ * We don't use timeouts.
+ */
+
+static COMMTIMEOUTS no_timeout = {
+ 0, /* ReadIntervalTimeout */
+ 0, /* ReadTotalTimeoutMultiplier */
+ 0, /* ReadTotalTimeoutConstant */
+ 0, /* WriteTotalTimeoutMultiplier */
+ 0, /* WriteTotalTimeoutConstant */
+};
+
+/*
+ * 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 SerialClose2Proc(ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+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,
+ const char *buf, int toWrite, int *errorCode);
+static void SerialSetupProc(ClientData clientData, int flags);
+static void SerialWatchProc(ClientData instanceData, int mask);
+static void ProcExitHandler(ClientData clientData);
+static int SerialGetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static int SerialSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
+static DWORD WINAPI SerialWriterThread(LPVOID arg);
+static void SerialThreadActionProc(ClientData instanceData,
+ int action);
+static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
+ DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
+static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
+ DWORD bufSize, LPDWORD lpWritten,
+ LPOVERLAPPED osPtr);
+
+/*
+ * This structure describes the channel type structure for command serial
+ * based IO.
+ */
+
+static const Tcl_ChannelType serialChannelType = {
+ "serial", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ 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. */
+ SerialClose2Proc, /* close2proc. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ SerialThreadActionProc, /* thread action proc */
+ NULL /* truncate */
+};
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+SerialInit(void)
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Check the initialized flag first, then check it again in the mutex.
+ * This is a speed enhancement.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&serialMutex);
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&serialMutex);
+ }
+
+ 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ SerialInfo *infoPtr;
+
+ /*
+ * Clear all eventually pending output. Otherwise Tcl's exit could totally
+ * block, because it performs a blocking flush on all open channels. Note
+ * that serial write operations may be blocked due to handshake.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ PurgeComm(infoPtr->handle,
+ PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
+ }
+ Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(&serialMutex);
+ initialized = 0;
+ Tcl_MutexUnlock(&serialMutex);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockTime --
+ *
+ * Wrapper to set Tcl's block time in msec
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the maximum blocking time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialBlockTime(
+ int msec) /* milli-seconds */
+{
+ Tcl_Time blockTime;
+
+ blockTime.sec = msec / 1000;
+ blockTime.usec = (msec % 1000) * 1000;
+ Tcl_SetMaxBlockTime(&blockTime);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialGetMilliseconds --
+ *
+ * Get current time in milliseconds,ignoring integer overruns.
+ *
+ * Results:
+ * The current time.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+SerialGetMilliseconds(void)
+{
+ Tcl_Time time;
+
+ Tcl_GetTime(&time);
+
+ return (time.sec * 1000 + time.usec / 1000);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int block = 1;
+ int msec = INT_MAX; /* min. found block time */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Look to see if any events handlers installed. If they are, do not
+ * block.
+ */
+
+ for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ;
+ infoPtr=infoPtr->nextPtr) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ msec = min(msec, infoPtr->blockTime);
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ block = 0;
+ msec = min(msec, infoPtr->blockTime);
+ }
+ }
+
+ if (!block) {
+ SerialBlockTime(msec);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ COMSTAT cStat;
+ unsigned int time;
+
+ 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;
+ }
+
+ needEvent = 0;
+
+ /*
+ * If WRITABLE watch mask is set look for infoPtr->evWritable object.
+ */
+
+ if (infoPtr->watchMask & TCL_WRITABLE &&
+ WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ infoPtr->writable = 1;
+ needEvent = 1;
+ }
+
+ /*
+ * If READABLE watch mask is set call ClearCommError to poll cbInQue.
+ * Window errors are ignored here.
+ */
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
+ /*
+ * Look for characters already pending in windows queue. If
+ * they are, poll.
+ */
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ /*
+ * Force fileevent after serial read error.
+ */
+
+ if ((cStat.cbInQue > 0) ||
+ (infoPtr->error & SERIAL_READ_ERRORS)) {
+ infoPtr->readable = 1;
+ time = SerialGetMilliseconds();
+ if ((unsigned int) (time - infoPtr->lastEventTime)
+ >= (unsigned int) infoPtr->blockTime) {
+ needEvent = 1;
+ infoPtr->lastEventTime = time;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Queue an event if the serial is signaled for reading or writing.
+ */
+
+ if (needEvent) {
+ infoPtr->flags |= SERIAL_PENDING;
+ evPtr = ckalloc(sizeof(SerialEvent));
+ evPtr->header.proc = SerialEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ int errorCode = 0;
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ /*
+ * Only serial READ can be switched between blocking & nonblocking using
+ * COMMTIMEOUTS. Serial write emulates blocking & nonblocking by the
+ * SerialWriterThread.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= SERIAL_ASYNC;
+ } else {
+ infoPtr->flags &= ~(SERIAL_ASYNC);
+ }
+ return errorCode;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialCloseProc/SerialClose2Proc --
+ *
+ * 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 = 0;
+ SerialInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ errorCode = 0;
+
+ if (serialPtr->validMask & TCL_READABLE) {
+ PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
+ CloseHandle(serialPtr->osRead.hEvent);
+ }
+ serialPtr->validMask &= ~TCL_READABLE;
+
+ if (serialPtr->writeThread) {
+
+ TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
+
+ CloseHandle(serialPtr->osWrite.hEvent);
+ CloseHandle(serialPtr->evWritable);
+ CloseHandle(serialPtr->writeThread);
+ serialPtr->writeThread = NULL;
+
+ PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
+ }
+ serialPtr->validMask &= ~TCL_WRITABLE;
+
+ DeleteCriticalSection(&serialPtr->csWrite);
+
+ /*
+ * Don't close the Win32 handle if the handle is a standard channel during
+ * the thread exit process. Otherwise, one thread may kill the stdio of
+ * another.
+ */
+
+ if (!TclInThreadExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
+ 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(serialPtr);
+
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+static int
+SerialClose2Proc(
+ ClientData instanceData, /* Pointer to SerialInfo structure. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags)
+{
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
+ return SerialCloseProc(instanceData, interp);
+ }
+ return EINVAL;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockingRead --
+ *
+ * Perform a blocking read 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.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialBlockingRead(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The input buffer pointer */
+ DWORD bufSize, /* The number of bytes to read */
+ LPDWORD lpRead, /* Returns number of bytes read */
+ LPOVERLAPPED osPtr) /* OVERLAPPED structure */
+{
+ /*
+ * Perform overlapped blocking read.
+ * 1. Reset the overlapped event
+ * 2. Start overlapped read operation
+ * 3. Wait for completion
+ */
+
+ /*
+ * Set Offset to ZERO, otherwise NT4.0 may report an error.
+ */
+
+ osPtr->Offset = osPtr->OffsetHigh = 0;
+ ResetEvent(osPtr->hEvent);
+ if (!ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr)) {
+ if (GetLastError() != ERROR_IO_PENDING) {
+ /*
+ * ReadFile failed, but it isn't delayed. Report error.
+ */
+
+ return FALSE;
+ } else {
+ /*
+ * Read is pending, wait for completion, timeout?
+ */
+
+ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE)) {
+ return FALSE;
+ }
+ }
+ } else {
+ /*
+ * ReadFile completed immediately.
+ */
+ }
+ return TRUE;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockingWrite --
+ *
+ * Perform a blocking write from the buffer given. Returns count of how
+ * many bytes were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were written is returned and an error
+ * indication is returned.
+ *
+ * Side effects:
+ * Writes output to the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialBlockingWrite(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The output buffer pointer */
+ DWORD bufSize, /* The number of bytes to write */
+ LPDWORD lpWritten, /* Returns number of bytes written */
+ LPOVERLAPPED osPtr) /* OVERLAPPED structure */
+{
+ int result;
+
+ /*
+ * Perform overlapped blocking write.
+ * 1. Reset the overlapped event
+ * 2. Remove these bytes from the output queue counter
+ * 3. Start overlapped write operation
+ * 3. Remove these bytes from the output queue counter
+ * 4. Wait for completion
+ * 5. Adjust the output queue counter
+ */
+
+ ResetEvent(osPtr->hEvent);
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue -= bufSize;
+
+ /*
+ * Set Offset to ZERO, otherwise NT4.0 may report an error
+ */
+
+ osPtr->Offset = osPtr->OffsetHigh = 0;
+ result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ if (result == FALSE) {
+ int err = GetLastError();
+
+ switch (err) {
+ case ERROR_IO_PENDING:
+ /*
+ * Write is pending, wait for completion.
+ */
+
+ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpWritten,
+ TRUE)) {
+ return FALSE;
+ }
+ break;
+ case ERROR_COUNTER_TIMEOUT:
+ /*
+ * Write timeout handled in SerialOutputProc.
+ */
+
+ break;
+ default:
+ /*
+ * WriteFile failed, but it isn't delayed. Report error.
+ */
+
+ return FALSE;
+ }
+ } else {
+ /*
+ * WriteFile completed immediately.
+ */
+ }
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue += (*lpWritten - bufSize);
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ return TRUE;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ COMSTAT cStat;
+
+ *errorCode = 0;
+
+ /*
+ * Check if there is a CommError pending from SerialCheckProc
+ */
+
+ if (infoPtr->error & SERIAL_READ_ERRORS) {
+ goto commError;
+ }
+
+ /*
+ * Look for characters already pending in windows queue. This is the
+ * mainly restored good old code from Tcl8.0
+ */
+
+ if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
+ /*
+ * Check for errors here, but not in the evSetup/Check procedures.
+ */
+
+ if (infoPtr->error & SERIAL_READ_ERRORS) {
+ goto commError;
+ }
+ if (infoPtr->flags & SERIAL_ASYNC) {
+ /*
+ * NON_BLOCKING mode: Avoid blocking by reading more bytes than
+ * available in input buffer.
+ */
+
+ if (cStat.cbInQue > 0) {
+ if ((DWORD) bufSize > cStat.cbInQue) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ errno = *errorCode = EWOULDBLOCK;
+ return -1;
+ }
+ } else {
+ /*
+ * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
+ */
+
+ if (cStat.cbInQue > 0) {
+ if ((DWORD) bufSize > cStat.cbInQue) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ bufSize = 1;
+ }
+ }
+ }
+
+ if (bufSize == 0) {
+ return bytesRead = 0;
+ }
+
+ /*
+ * Perform blocking read. Doesn't block in non-blocking mode, because we
+ * checked the number of available bytes.
+ */
+
+ if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ &infoPtr->osRead) == FALSE) {
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
+ }
+ return bytesRead;
+
+ commError:
+ infoPtr->lastError = infoPtr->error;
+ /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ *errorCode = EIO; /* to return read-error only once */
+ return -1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ const 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;
+
+ *errorCode = 0;
+
+ /*
+ * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid
+ * blocking output after ExitProc or CloseHandler(chan) has been called by
+ * checking the corrresponding variables.
+ */
+
+ if (!initialized || TclInExit()) {
+ return toWrite;
+ }
+
+ /*
+ * Check if there is a CommError pending from SerialCheckProc
+ */
+
+ if (infoPtr->error & SERIAL_WRITE_ERRORS) {
+ infoPtr->lastError = infoPtr->error;
+ /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ errno = EIO;
+ goto error;
+ }
+
+ timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
+ if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The writer thread is blocked waiting for a write to complete and
+ * the channel is in non-blocking mode.
+ */
+
+ errno = EWOULDBLOCK;
+ goto error1;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ */
+
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error1;
+ }
+
+ /*
+ * Remember the number of bytes in output queue
+ */
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue += toWrite;
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ 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->evWritable);
+ TclPipeThreadSignal(&infoPtr->writeTI);
+ bytesWritten = (DWORD) toWrite;
+
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly. This
+ * avoids an unnecessary copy.
+ */
+
+ if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &infoPtr->osWrite)) {
+ goto writeError;
+ }
+ if (bytesWritten != (DWORD) toWrite) {
+ /*
+ * Write timeout.
+ */
+ infoPtr->lastError |= CE_PTO;
+ errno = EIO;
+ goto error;
+ }
+ }
+
+ return (int) bytesWritten;
+
+ writeError:
+ TclWinConvertError(GetLastError());
+
+ error:
+ /*
+ * Reset the output queue counter on error during blocking output
+ */
+
+ /*
+ * EnterCriticalSection(&infoPtr->csWrite);
+ * infoPtr->writeQueue = 0;
+ * LeaveCriticalSection(&infoPtr->csWrite);
+ */
+ error1:
+ *errorCode = errno;
+ return -1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 (infoPtr->writable) {
+ mask |= TCL_WRITABLE;
+ infoPtr->writable = 0;
+ }
+ }
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (infoPtr->readable) {
+ mask |= TCL_READABLE;
+ infoPtr->readable = 0;
+ }
+ }
+
+ /*
+ * Inform the channel of the events.
+ */
+
+ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
+ return 1;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 so we
+ * will poll.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstSerialPtr;
+ tsdPtr->firstSerialPtr = infoPtr;
+ }
+ SerialBlockTime(infoPtr->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;
+ }
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+ TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+ SerialInfo *infoPtr = NULL; /* access info only after success init/wait */
+ DWORD bytesWritten, toWrite;
+ char *buf;
+ OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+ if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+ /* exit */
+ break;
+ }
+ infoPtr = (SerialInfo *)pipeTI->clientData;
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ /*
+ * Check for pending writeError. Ignore all write operations until
+ * the user has been notified.
+ */
+
+ if (infoPtr->writeError) {
+ break;
+ }
+ if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &myWrite) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ break;
+ }
+ if (bytesWritten != toWrite) {
+ /*
+ * Write timeout.
+ */
+
+ infoPtr->writeError = ERROR_WRITE_FAULT;
+ break;
+ }
+ toWrite -= bytesWritten;
+ buf += bytesWritten;
+ }
+
+ CloseHandle(myWrite.hEvent);
+
+ /*
+ * Signal the main thread by signalling the evWritable event and then
+ * waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->evWritable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&serialMutex);
+ if (infoPtr->threadId != NULL) {
+ /*
+ * TIP #218: When in flight ignore the event, no one will receive
+ * it anyway.
+ */
+
+ Tcl_ThreadAlert(infoPtr->threadId);
+ }
+ Tcl_MutexUnlock(&serialMutex);
+ }
+
+ /* Worker exit, so inform the main thread or free TI-structure (if owned) */
+ TclPipeThreadExit(&pipeTI);
+
+ return 0;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinSerialOpen --
+ *
+ * Opens or Reopens the serial port with the OVERLAPPED FLAG set
+ *
+ * Results:
+ * Returns the new handle, or INVALID_HANDLE_VALUE.
+ * If an existing channel is specified it is closed and reopened.
+ *
+ * Side effects:
+ * May close/reopen the original handle
+ *
+ *----------------------------------------------------------------------
+ */
+
+HANDLE
+TclWinSerialOpen(
+ HANDLE handle,
+ const WCHAR *name,
+ DWORD access)
+{
+ SerialInit();
+
+ /*
+ * If an open channel is specified, close it
+ */
+
+ if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
+ return INVALID_HANDLE_VALUE;
+ }
+
+ /*
+ * Multithreaded I/O needs the overlapped flag set otherwise
+ * ClearCommError blocks under Windows NT/2000 until serial output is
+ * finished
+ */
+
+ handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING,
+ FILE_FLAG_OVERLAPPED, 0);
+
+ return handle;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenSerialChannel --
+ *
+ * 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 handle,
+ char *channelName,
+ int permissions)
+{
+ SerialInfo *infoPtr;
+
+ SerialInit();
+
+ infoPtr = ckalloc(sizeof(SerialInfo));
+ memset(infoPtr, 0, sizeof(SerialInfo));
+
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+ infoPtr->channel = (Tcl_Channel) NULL;
+ infoPtr->readable = 0;
+ infoPtr->writable = 1;
+ infoPtr->toWrite = infoPtr->writeQueue = 0;
+ infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
+ infoPtr->lastEventTime = 0;
+ infoPtr->lastError = infoPtr->error = 0;
+ infoPtr->threadId = Tcl_GetCurrentThread();
+ infoPtr->sysBufRead = 4096;
+ infoPtr->sysBufWrite = 4096;
+
+ /*
+ * Use the pointer to keep the channel names unique, in case the handles
+ * are shared between multiple channels (stdin/stdout).
+ */
+
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
+ infoPtr, permissions);
+
+
+ SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
+ PurgeComm(handle,
+ PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
+
+ /*
+ * Default is blocking.
+ */
+
+ SetCommTimeouts(handle, &no_timeout);
+
+ InitializeCriticalSection(&infoPtr->csWrite);
+ if (permissions & TCL_READABLE) {
+ infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
+ }
+ if (permissions & TCL_WRITABLE) {
+ /*
+ * Initially the channel is writable and the writeThread is idle.
+ */
+
+ infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
+ infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
+ TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
+ infoPtr->evWritable), 0, 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialErrorStr --
+ *
+ * Converts a Win32 serial error code to a list of readable errors.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates readable errors in the supplied DString.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialErrorStr(
+ DWORD error, /* Win32 serial error code. */
+ Tcl_DString *dsPtr) /* Where to store string. */
+{
+ if (error & CE_RXOVER) {
+ Tcl_DStringAppendElement(dsPtr, "RXOVER");
+ }
+ if (error & CE_OVERRUN) {
+ Tcl_DStringAppendElement(dsPtr, "OVERRUN");
+ }
+ if (error & CE_RXPARITY) {
+ Tcl_DStringAppendElement(dsPtr, "RXPARITY");
+ }
+ if (error & CE_FRAME) {
+ Tcl_DStringAppendElement(dsPtr, "FRAME");
+ }
+ if (error & CE_BREAK) {
+ Tcl_DStringAppendElement(dsPtr, "BREAK");
+ }
+ if (error & CE_TXFULL) {
+ Tcl_DStringAppendElement(dsPtr, "TXFULL");
+ }
+ if (error & CE_PTO) { /* PTO used to signal WRITE-TIMEOUT */
+ Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
+ }
+ if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) {
+ char buf[TCL_INTEGER_SPACE + 1];
+
+ wsprintfA(buf, "%d", error);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialModemStatusStr --
+ *
+ * Converts a Win32 modem status list of readable flags
+ *
+ * Result:
+ * None.
+ *
+ * Side effects:
+ * Appends modem status flag strings to the given DString.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialModemStatusStr(
+ DWORD status, /* Win32 modem status. */
+ Tcl_DString *dsPtr) /* Where to store string. */
+{
+ Tcl_DStringAppendElement(dsPtr, "CTS");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "DSR");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "RING");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "DCD");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0");
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ ClientData instanceData, /* File state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ const char *optionName, /* Which option to set? */
+ const char *value) /* New value for option. */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ BOOL result, flag;
+ size_t len, vlen;
+ Tcl_DString ds;
+ const WCHAR *native;
+ int argc;
+ const char **argv;
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ /*
+ * Parse options. This would be far easier if we had Tcl_Objs to work with
+ * as that would let us use Tcl_GetIndexFromObj()...
+ */
+
+ len = strlen(optionName);
+ vlen = strlen(value);
+
+ /*
+ * Option -mode baud,parity,databits,stopbits
+ */
+
+ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ goto getStateFailed;
+ }
+ native = (const WCHAR *)Tcl_WinUtfToTChar(value, -1, &ds);
+ result = BuildCommDCBW(native, &dcb);
+ Tcl_DStringFree(&ds);
+
+ if (result == FALSE) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -mode: should be baud,parity,data,stop",
+ value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Default settings for serial communications.
+ */
+
+ dcb.fBinary = TRUE;
+ dcb.fErrorChar = FALSE;
+ dcb.fNull = FALSE;
+ dcb.fAbortOnError = FALSE;
+
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ goto setStateFailed;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -handshake none|xonxoff|rtscts|dtrdsr
+ */
+
+ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ goto getStateFailed;
+ }
+
+ /*
+ * Reset all handshake options. DTR and RTS are ON by default.
+ */
+
+ dcb.fOutX = dcb.fInX = FALSE;
+ dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE;
+ dcb.fDtrControl = DTR_CONTROL_ENABLE;
+ dcb.fRtsControl = RTS_CONTROL_ENABLE;
+ dcb.fTXContinueOnXoff = FALSE;
+
+ /*
+ * Adjust the handshake limits. Yes, the XonXoff limits seem to
+ * influence even hardware handshake.
+ */
+
+ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
+ dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
+
+ if (strncasecmp(value, "NONE", vlen) == 0) {
+ /*
+ * Leave all handshake options disabled.
+ */
+ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
+ dcb.fOutX = dcb.fInX = TRUE;
+ } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
+ dcb.fOutxCtsFlow = TRUE;
+ dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
+ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
+ dcb.fOutxDsrFlow = TRUE;
+ dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -handshake: must be one of"
+ " xonxoff, rtscts, dtrdsr or none", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ goto setStateFailed;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -xchar {\x11 \x13}
+ */
+
+ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ goto getStateFailed;
+ }
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (argc != 2) {
+ badXchar:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -xchar: should be a list of"
+ " two elements with each a single character", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
+ }
+ ckfree(argv);
+ return TCL_ERROR;
+ }
+
+ /*
+ * These dereferences are safe, even in the zero-length string cases,
+ * because that just makes the xon/xoff character into NUL. When the
+ * character looks like it is UTF-8 encoded, decode it before casting
+ * into the format required for the Win guts. Note that this does not
+ * convert character sets; it is expected that when people set the
+ * control characters to something large and custom, they'll know the
+ * hex/octal value rather than the printable form.
+ */
+
+ dcb.XonChar = argv[0][0];
+ dcb.XoffChar = argv[1][0];
+ if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
+ int character;
+ int charLen;
+
+ charLen = TclUtfToUCS4(argv[0], &character);
+ if ((character & ~0xFF) || argv[0][charLen]) {
+ goto badXchar;
+ }
+ dcb.XonChar = (char) character;
+ charLen = TclUtfToUCS4(argv[1], &character);
+ if ((character & ~0xFF) || argv[1][charLen]) {
+ goto badXchar;
+ }
+ dcb.XoffChar = (char) character;
+ }
+ ckfree(argv);
+
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ goto setStateFailed;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
+ */
+
+ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
+ int i, res = TCL_OK;
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if ((argc % 2) == 1) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -ttycontrol: should be "
+ "a list of signal,value pairs", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
+ }
+ ckfree(argv);
+ return TCL_ERROR;
+ }
+
+ for (i = 0; i < argc - 1; i += 2) {
+ if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
+ res = TCL_ERROR;
+ break;
+ }
+ if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETDTR : CLRDTR))) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set DTR signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
+ }
+ res = TCL_ERROR;
+ break;
+ }
+ } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETRTS : CLRRTS))) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set RTS signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
+ }
+ res = TCL_ERROR;
+ break;
+ }
+ } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETBREAK : CLRBREAK))) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set BREAK signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
+ }
+ res = TCL_ERROR;
+ break;
+ }
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad signal name \"%s\" for -ttycontrol: must be"
+ " DTR, RTS or BREAK", argv[i]));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
+ NULL);
+ }
+ res = TCL_ERROR;
+ break;
+ }
+ }
+
+ ckfree(argv);
+ return res;
+ }
+
+ /*
+ * Option -sysbuffer {read_size write_size}
+ * Option -sysbuffer read_size
+ */
+
+ if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
+ /*
+ * -sysbuffer 4096 or -sysbuffer {64536 4096}
+ */
+
+ size_t inSize = (size_t) -1, outSize = (size_t) -1;
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (argc == 1) {
+ inSize = atoi(argv[0]);
+ outSize = infoPtr->sysBufWrite;
+ } else if (argc == 2) {
+ inSize = atoi(argv[0]);
+ outSize = atoi(argv[1]);
+ }
+ ckfree(argv);
+
+ if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -sysbuffer: should be "
+ "a list of one or two integers > 0", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (!SetupComm(infoPtr->handle, inSize, outSize)) {
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't setup comm buffers: %s",
+ Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+ infoPtr->sysBufRead = inSize;
+ infoPtr->sysBufWrite = outSize;
+
+ /*
+ * Adjust the handshake limits. Yes, the XonXoff limits seem to
+ * influence even hardware handshake.
+ */
+
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ goto getStateFailed;
+ }
+ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
+ dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ goto setStateFailed;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -pollinterval msec
+ */
+
+ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
+ if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -timeout msec
+ */
+
+ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
+ int msec;
+ COMMTIMEOUTS tout = {0,0,0,0,0};
+
+ if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tout.ReadTotalTimeoutConstant = msec;
+ if (!SetCommTimeouts(infoPtr->handle, &tout)) {
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm timeouts: %s",
+ Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+ }
+
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
+
+ getStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+
+ setStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ ClientData instanceData, /* File state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ const char *optionName, /* Option to get. */
+ Tcl_DString *dsPtr) /* Where to store value(s). */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ size_t len;
+ int valid = 0; /* Flag if valid option parsed. */
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ if (optionName == NULL) {
+ len = 0;
+ } else {
+ len = strlen(optionName);
+ }
+
+ /*
+ * Get option -mode
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ }
+ if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
+ char parity;
+ const char *stop;
+ char buf[2 * TCL_INTEGER_SPACE + 16];
+
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+
+ valid = 1;
+ 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);
+ }
+
+ /*
+ * Get option -pollinterval
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-pollinterval");
+ }
+ if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
+ char buf[TCL_INTEGER_SPACE + 1];
+
+ valid = 1;
+ wsprintfA(buf, "%d", infoPtr->blockTime);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+ /*
+ * Get option -sysbuffer
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
+ char buf[TCL_INTEGER_SPACE + 1];
+ valid = 1;
+
+ wsprintfA(buf, "%d", infoPtr->sysBufRead);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ wsprintfA(buf, "%d", infoPtr->sysBufWrite);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ }
+
+ /*
+ * Get option -xchar
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-xchar");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
+ char buf[4];
+ valid = 1;
+
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%c", dcb.XonChar);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ sprintf(buf, "%c", dcb.XoffChar);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ }
+
+ /*
+ * Get option -lasterror
+ *
+ * Option is readonly and returned by [fconfigure chan -lasterror] but not
+ * returned by unnamed [fconfigure chan].
+ */
+
+ if (len>1 && strncmp(optionName, "-lasterror", len)==0) {
+ valid = 1;
+ SerialErrorStr(infoPtr->lastError, dsPtr);
+ }
+
+ /*
+ * get option -queue
+ *
+ * Option is readonly and returned by [fconfigure chan -queue].
+ */
+
+ if (len>1 && strncmp(optionName, "-queue", len)==0) {
+ char buf[TCL_INTEGER_SPACE + 1];
+ COMSTAT cStat;
+ DWORD error;
+ int inBuffered, outBuffered, count;
+
+ valid = 1;
+
+ /*
+ * Query the pending data in Tcl's internal queues.
+ */
+
+ inBuffered = Tcl_InputBuffered(infoPtr->channel);
+ outBuffered = Tcl_OutputBuffered(infoPtr->channel);
+
+ /*
+ * Query the number of bytes in our output queue:
+ * 1. The bytes pending in the output thread
+ * 2. The bytes in the system drivers buffer
+ * The writer thread should not interfere this action.
+ */
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ ClearCommError(infoPtr->handle, &error, &cStat);
+ count = (int) cStat.cbOutQue + infoPtr->writeQueue;
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ wsprintfA(buf, "%d", outBuffered + count);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+ /*
+ * get option -ttystatus
+ *
+ * Option is readonly and returned by [fconfigure chan -ttystatus] but not
+ * returned by unnamed [fconfigure chan].
+ */
+
+ if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
+ DWORD status;
+
+ if (!GetCommModemStatus(infoPtr->handle, &status)) {
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get tty status: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+ valid = 1;
+ SerialModemStatusStr(status, dsPtr);
+ }
+
+ if (valid) {
+ return TCL_OK;
+ }
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialThreadActionProc --
+ *
+ * Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialThreadActionProc(
+ ClientData instanceData,
+ int action)
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ /*
+ * We do not access firstSerialPtr in the thread structures. This is not
+ * for all serials managed by the thread, but only those we are watching.
+ * Removal of the filevent handlers before transfer thus takes care of
+ * this structure.
+ */
+
+ Tcl_MutexLock(&serialMutex);
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ /*
+ * We can't copy the thread information from the channel when the
+ * channel is created. At this time the channel back pointer has not
+ * been set yet. However in that case the threadId has already been
+ * set by TclpCreateCommandChannel itself, so the structure is still
+ * good.
+ */
+
+ SerialInit();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
+ }
+ } else {
+ infoPtr->threadId = NULL;
+ }
+ Tcl_MutexUnlock(&serialMutex);
+}
+\f
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
OSDN Git Service
