util/src/TclTk/tcl8.6.12/win/tclWinSerial.c

   1 /*
   2  * tclWinSerial.c --
   3  *
   4  *      This file implements the Windows-specific serial port functions, and
   5  *      the "serial" channel driver.
   6  *
   7  * Copyright (c) 1999 by Scriptics Corp.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution of
  10  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  *
  12  * Serial functionality implemented by Rolf.Schroedter@dlr.de
  13  */
  14
  15 #include "tclWinInt.h"
  16
  17 /*
  18  * The following variable is used to tell whether this module has been
  19  * initialized.
  20  */
  21
  22 static int initialized = 0;
  23
  24 /*
  25  * The serialMutex locks around access to the initialized variable, and it is
  26  * used to protect background threads from being terminated while they are
  27  * using APIs that hold locks.
  28  */
  29
  30 TCL_DECLARE_MUTEX(serialMutex)
  31
  32 /*
  33  * Bit masks used in the flags field of the SerialInfo structure below.
  34  */
  35
  36 #define SERIAL_PENDING  (1<<0)  /* Message is pending in the queue. */
  37 #define SERIAL_ASYNC    (1<<1)  /* Channel is non-blocking. */
  38
  39 /*
  40  * Bit masks used in the sharedFlags field of the SerialInfo structure below.
  41  */
  42
  43 #define SERIAL_EOF      (1<<2)  /* Serial has reached EOF. */
  44 #define SERIAL_ERROR    (1<<4)
  45
  46 /*
  47  * Default time to block between checking status on the serial port.
  48  */
  49
  50 #define SERIAL_DEFAULT_BLOCKTIME 10     /* 10 msec */
  51
  52 /*
  53  * Define Win32 read/write error masks returned by ClearCommError()
  54  */
  55
  56 #define SERIAL_READ_ERRORS \
  57         (CE_RXOVER | CE_OVERRUN | CE_RXPARITY | CE_FRAME  | CE_BREAK)
  58 #define SERIAL_WRITE_ERRORS \
  59         (CE_TXFULL | CE_PTO)
  60
  61 /*
  62  * This structure describes per-instance data for a serial based channel.
  63  */
  64
  65 typedef struct SerialInfo {
  66     HANDLE handle;
  67     struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
  68     Tcl_Channel channel;        /* Pointer to channel structure. */
  69     int validMask;              /* OR'ed combination of TCL_READABLE,
  70                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  71                                  * which operations are valid on the file. */
  72     int watchMask;              /* OR'ed combination of TCL_READABLE,
  73                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  74                                  * which events should be reported. */
  75     int flags;                  /* State flags, see above for a list. */
  76     int readable;               /* Flag that the channel is readable. */
  77     int writable;               /* Flag that the channel is writable. */
  78     int blockTime;              /* Maximum blocktime in msec. */
  79     unsigned int lastEventTime; /* Time in milliseconds since last readable
  80                                  * event. */
  81                                 /* Next readable event only after blockTime */
  82     DWORD error;                /* pending error code returned by
  83                                  * ClearCommError() */
  84     DWORD lastError;            /* last error code, can be fetched with
  85                                  * fconfigure chan -lasterror */
  86     DWORD sysBufRead;           /* Win32 system buffer size for read ops,
  87                                  * default=4096 */
  88     DWORD sysBufWrite;          /* Win32 system buffer size for write ops,
  89                                  * default=4096 */
  90
  91     Tcl_ThreadId threadId;      /* Thread to which events should be reported.
  92                                  * This value is used by the reader/writer
  93                                  * threads. */
  94     OVERLAPPED osRead;          /* OVERLAPPED structure for read operations. */
  95     OVERLAPPED osWrite;         /* OVERLAPPED structure for write operations */
  96     TclPipeThreadInfo *writeTI; /* Thread info structure of writer worker. */
  97     HANDLE writeThread;         /* Handle to writer thread. */
  98     CRITICAL_SECTION csWrite;   /* Writer thread synchronisation. */
  99     HANDLE evWritable;          /* Manual-reset event to signal when the
 100                                  * writer thread has finished waiting for the
 101                                  * current buffer to be written. */
 102     DWORD writeError;           /* An error caused by the last background
 103                                  * write. Set to 0 if no error has been
 104                                  * detected. This word is shared with the
 105                                  * writer thread so access must be
 106                                  * synchronized with the evWritable object. */
 107     char *writeBuf;             /* Current background output buffer. Access is
 108                                  * synchronized with the evWritable object. */
 109     int writeBufLen;            /* Size of write buffer. Access is
 110                                  * synchronized with the evWritable object. */
 111     int toWrite;                /* Current amount to be written. Access is
 112                                  * synchronized with the evWritable object. */
 113     int writeQueue;             /* Number of bytes pending in output queue.
 114                                  * Offset to DCB.cbInQue. Used to query
 115                                  * [fconfigure -queue] */
 116 } SerialInfo;
 117
 118 typedef struct ThreadSpecificData {
 119     /*
 120      * The following pointer refers to the head of the list of serials that
 121      * are being watched for file events.
 122      */
 123
 124     SerialInfo *firstSerialPtr;
 125 } ThreadSpecificData;
 126
 127 static Tcl_ThreadDataKey dataKey;
 128
 129 /*
 130  * The following structure is what is added to the Tcl event queue when serial
 131  * events are generated.
 132  */
 133
 134 typedef struct SerialEvent {
 135     Tcl_Event header;           /* Information that is standard for all
 136                                  * events. */
 137     SerialInfo *infoPtr;        /* Pointer to serial info structure. Note that
 138                                  * we still have to verify that the serial
 139                                  * exists before dereferencing this
 140                                  * pointer. */
 141 } SerialEvent;
 142
 143 /*
 144  * We don't use timeouts.
 145  */
 146
 147 static COMMTIMEOUTS no_timeout = {
 148     0,                  /* ReadIntervalTimeout */
 149     0,                  /* ReadTotalTimeoutMultiplier */
 150     0,                  /* ReadTotalTimeoutConstant */
 151     0,                  /* WriteTotalTimeoutMultiplier */
 152     0,                  /* WriteTotalTimeoutConstant */
 153 };
 154
 155 /*
 156  * Declarations for functions used only in this file.
 157  */
 158
 159 static int              SerialBlockProc(ClientData instanceData, int mode);
 160 static void             SerialCheckProc(ClientData clientData, int flags);
 161 static int              SerialCloseProc(ClientData instanceData,
 162                             Tcl_Interp *interp);
 163 static int              SerialClose2Proc(ClientData instanceData,
 164                             Tcl_Interp *interp, int flags);
 165 static int              SerialEventProc(Tcl_Event *evPtr, int flags);
 166 static void             SerialExitHandler(ClientData clientData);
 167 static int              SerialGetHandleProc(ClientData instanceData,
 168                             int direction, ClientData *handlePtr);
 169 static ThreadSpecificData *SerialInit(void);
 170 static int              SerialInputProc(ClientData instanceData, char *buf,
 171                             int toRead, int *errorCode);
 172 static int              SerialOutputProc(ClientData instanceData,
 173                             const char *buf, int toWrite, int *errorCode);
 174 static void             SerialSetupProc(ClientData clientData, int flags);
 175 static void             SerialWatchProc(ClientData instanceData, int mask);
 176 static void             ProcExitHandler(ClientData clientData);
 177 static int              SerialGetOptionProc(ClientData instanceData,
 178                             Tcl_Interp *interp, const char *optionName,
 179                             Tcl_DString *dsPtr);
 180 static int              SerialSetOptionProc(ClientData instanceData,
 181                             Tcl_Interp *interp, const char *optionName,
 182                             const char *value);
 183 static DWORD WINAPI     SerialWriterThread(LPVOID arg);
 184 static void             SerialThreadActionProc(ClientData instanceData,
 185                             int action);
 186 static int              SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
 187                             DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
 188 static int              SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
 189                             DWORD bufSize, LPDWORD lpWritten,
 190                             LPOVERLAPPED osPtr);
 191
 192 /*
 193  * This structure describes the channel type structure for command serial
 194  * based IO.
 195  */
 196
 197 static const Tcl_ChannelType serialChannelType = {
 198     "serial",                   /* Type name. */
 199     TCL_CHANNEL_VERSION_5,      /* v5 channel */
 200     SerialCloseProc,            /* Close proc. */
 201     SerialInputProc,            /* Input proc. */
 202     SerialOutputProc,           /* Output proc. */
 203     NULL,                       /* Seek proc. */
 204     SerialSetOptionProc,        /* Set option proc. */
 205     SerialGetOptionProc,        /* Get option proc. */
 206     SerialWatchProc,            /* Set up notifier to watch the channel. */
 207     SerialGetHandleProc,        /* Get an OS handle from channel. */
 208     SerialClose2Proc,                   /* close2proc. */
 209     SerialBlockProc,            /* Set blocking or non-blocking mode.*/
 210     NULL,                       /* flush proc. */
 211     NULL,                       /* handler proc. */
 212     NULL,                       /* wide seek proc */
 213     SerialThreadActionProc,     /* thread action proc */
 214     NULL                       /* truncate */
 215 };
 216 \f
 217 /*
 218  *----------------------------------------------------------------------
 219  *
 220  * SerialInit --
 221  *
 222  *      This function initializes the static variables for this file.
 223  *
 224  * Results:
 225  *      None.
 226  *
 227  * Side effects:
 228  *      Creates a new event source.
 229  *
 230  *----------------------------------------------------------------------
 231  */
 232
 233 static ThreadSpecificData *
 234 SerialInit(void)
 235 {
 236     ThreadSpecificData *tsdPtr;
 237
 238     /*
 239      * Check the initialized flag first, then check it again in the mutex.
 240      * This is a speed enhancement.
 241      */
 242
 243     if (!initialized) {
 244         Tcl_MutexLock(&serialMutex);
 245         if (!initialized) {
 246             initialized = 1;
 247             Tcl_CreateExitHandler(ProcExitHandler, NULL);
 248         }
 249         Tcl_MutexUnlock(&serialMutex);
 250     }
 251
 252     tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
 253     if (tsdPtr == NULL) {
 254         tsdPtr = TCL_TSD_INIT(&dataKey);
 255         tsdPtr->firstSerialPtr = NULL;
 256         Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
 257         Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
 258     }
 259     return tsdPtr;
 260 }
 261 \f
 262 /*
 263  *----------------------------------------------------------------------
 264  *
 265  * SerialExitHandler --
 266  *
 267  *      This function is called to cleanup the serial module before Tcl is
 268  *      unloaded.
 269  *
 270  * Results:
 271  *      None.
 272  *
 273  * Side effects:
 274  *      Removes the serial event source.
 275  *
 276  *----------------------------------------------------------------------
 277  */
 278
 279 static void
 280 SerialExitHandler(
 281     ClientData clientData)      /* Old window proc */
 282 {
 283     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 284     SerialInfo *infoPtr;
 285
 286     /*
 287      * Clear all eventually pending output. Otherwise Tcl's exit could totally
 288      * block, because it performs a blocking flush on all open channels. Note
 289      * that serial write operations may be blocked due to handshake.
 290      */
 291
 292     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
 293             infoPtr = infoPtr->nextPtr) {
 294         PurgeComm(infoPtr->handle,
 295                 PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
 296     }
 297     Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
 298 }
 299 \f
 300 /*
 301  *----------------------------------------------------------------------
 302  *
 303  * ProcExitHandler --
 304  *
 305  *      This function is called to cleanup the process list before Tcl is
 306  *      unloaded.
 307  *
 308  * Results:
 309  *      None.
 310  *
 311  * Side effects:
 312  *      Resets the process list.
 313  *
 314  *----------------------------------------------------------------------
 315  */
 316
 317 static void
 318 ProcExitHandler(
 319     ClientData clientData)      /* Old window proc */
 320 {
 321     Tcl_MutexLock(&serialMutex);
 322     initialized = 0;
 323     Tcl_MutexUnlock(&serialMutex);
 324 }
 325 \f
 326 /*
 327  *----------------------------------------------------------------------
 328  *
 329  * SerialBlockTime --
 330  *
 331  *      Wrapper to set Tcl's block time in msec
 332  *
 333  * Results:
 334  *      None.
 335  *
 336  * Side effects:
 337  *      Updates the maximum blocking time.
 338  *
 339  *----------------------------------------------------------------------
 340  */
 341
 342 static void
 343 SerialBlockTime(
 344     int msec)                   /* milli-seconds */
 345 {
 346     Tcl_Time blockTime;
 347
 348     blockTime.sec  =  msec / 1000;
 349     blockTime.usec = (msec % 1000) * 1000;
 350     Tcl_SetMaxBlockTime(&blockTime);
 351 }
 352 \f
 353 /*
 354  *----------------------------------------------------------------------
 355  *
 356  * SerialGetMilliseconds --
 357  *
 358  *      Get current time in milliseconds,ignoring integer overruns.
 359  *
 360  * Results:
 361  *      The current time.
 362  *
 363  * Side effects:
 364  *      None.
 365  *
 366  *----------------------------------------------------------------------
 367  */
 368
 369 static unsigned int
 370 SerialGetMilliseconds(void)
 371 {
 372     Tcl_Time time;
 373
 374     Tcl_GetTime(&time);
 375
 376     return (time.sec * 1000 + time.usec / 1000);
 377 }
 378 \f
 379 /*
 380  *----------------------------------------------------------------------
 381  *
 382  * SerialSetupProc --
 383  *
 384  *      This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
 385  *      event.
 386  *
 387  * Results:
 388  *      None.
 389  *
 390  * Side effects:
 391  *      Adjusts the block time if needed.
 392  *
 393  *----------------------------------------------------------------------
 394  */
 395
 396 void
 397 SerialSetupProc(
 398     ClientData data,            /* Not used. */
 399     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 400 {
 401     SerialInfo *infoPtr;
 402     int block = 1;
 403     int msec = INT_MAX;         /* min. found block time */
 404     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 405
 406     if (!(flags & TCL_FILE_EVENTS)) {
 407         return;
 408     }
 409
 410     /*
 411      * Look to see if any events handlers installed. If they are, do not
 412      * block.
 413      */
 414
 415     for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ;
 416             infoPtr=infoPtr->nextPtr) {
 417         if (infoPtr->watchMask & TCL_WRITABLE) {
 418             if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
 419                 block = 0;
 420                 msec = min(msec, infoPtr->blockTime);
 421             }
 422         }
 423         if (infoPtr->watchMask & TCL_READABLE) {
 424             block = 0;
 425             msec = min(msec, infoPtr->blockTime);
 426         }
 427     }
 428
 429     if (!block) {
 430         SerialBlockTime(msec);
 431     }
 432 }
 433 \f
 434 /*
 435  *----------------------------------------------------------------------
 436  *
 437  * SerialCheckProc --
 438  *
 439  *      This procedure is called by Tcl_DoOneEvent to check the serial event
 440  *      source for events.
 441  *
 442  * Results:
 443  *      None.
 444  *
 445  * Side effects:
 446  *      May queue an event.
 447  *
 448  *----------------------------------------------------------------------
 449  */
 450
 451 static void
 452 SerialCheckProc(
 453     ClientData data,            /* Not used. */
 454     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
 455 {
 456     SerialInfo *infoPtr;
 457     SerialEvent *evPtr;
 458     int needEvent;
 459     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 460     COMSTAT cStat;
 461     unsigned int time;
 462
 463     if (!(flags & TCL_FILE_EVENTS)) {
 464         return;
 465     }
 466
 467     /*
 468      * Queue events for any ready serials that don't already have events
 469      * queued.
 470      */
 471
 472     for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ;
 473             infoPtr=infoPtr->nextPtr) {
 474         if (infoPtr->flags & SERIAL_PENDING) {
 475             continue;
 476         }
 477
 478         needEvent = 0;
 479
 480         /*
 481          * If WRITABLE watch mask is set look for infoPtr->evWritable object.
 482          */
 483
 484         if (infoPtr->watchMask & TCL_WRITABLE &&
 485                 WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
 486             infoPtr->writable = 1;
 487             needEvent = 1;
 488         }
 489
 490         /*
 491          * If READABLE watch mask is set call ClearCommError to poll cbInQue.
 492          * Window errors are ignored here.
 493          */
 494
 495         if (infoPtr->watchMask & TCL_READABLE) {
 496             if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
 497                 /*
 498                  * Look for characters already pending in windows queue. If
 499                  * they are, poll.
 500                  */
 501
 502                 if (infoPtr->watchMask & TCL_READABLE) {
 503                     /*
 504                      * Force fileevent after serial read error.
 505                      */
 506
 507                     if ((cStat.cbInQue > 0) ||
 508                             (infoPtr->error & SERIAL_READ_ERRORS)) {
 509                         infoPtr->readable = 1;
 510                         time = SerialGetMilliseconds();
 511                         if ((unsigned int) (time - infoPtr->lastEventTime)
 512                                 >= (unsigned int) infoPtr->blockTime) {
 513                             needEvent = 1;
 514                             infoPtr->lastEventTime = time;
 515                         }
 516                     }
 517                 }
 518             }
 519         }
 520
 521         /*
 522          * Queue an event if the serial is signaled for reading or writing.
 523          */
 524
 525         if (needEvent) {
 526             infoPtr->flags |= SERIAL_PENDING;
 527             evPtr = ckalloc(sizeof(SerialEvent));
 528             evPtr->header.proc = SerialEventProc;
 529             evPtr->infoPtr = infoPtr;
 530             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 531         }
 532     }
 533 }
 534 \f
 535 /*
 536  *----------------------------------------------------------------------
 537  *
 538  * SerialBlockProc --
 539  *
 540  *      Set blocking or non-blocking mode on channel.
 541  *
 542  * Results:
 543  *      0 if successful, errno when failed.
 544  *
 545  * Side effects:
 546  *      Sets the device into blocking or non-blocking mode.
 547  *
 548  *----------------------------------------------------------------------
 549  */
 550
 551 static int
 552 SerialBlockProc(
 553     ClientData instanceData,    /* Instance data for channel. */
 554     int mode)                   /* TCL_MODE_BLOCKING or
 555                                  * TCL_MODE_NONBLOCKING. */
 556 {
 557     int errorCode = 0;
 558     SerialInfo *infoPtr = (SerialInfo *) instanceData;
 559
 560     /*
 561      * Only serial READ can be switched between blocking & nonblocking using
 562      * COMMTIMEOUTS. Serial write emulates blocking & nonblocking by the
 563      * SerialWriterThread.
 564      */
 565
 566     if (mode == TCL_MODE_NONBLOCKING) {
 567         infoPtr->flags |= SERIAL_ASYNC;
 568     } else {
 569         infoPtr->flags &= ~(SERIAL_ASYNC);
 570     }
 571     return errorCode;
 572 }
 573 \f
 574 /*
 575  *----------------------------------------------------------------------
 576  *
 577  * SerialCloseProc/SerialClose2Proc --
 578  *
 579  *      Closes a serial based IO channel.
 580  *
 581  * Results:
 582  *      0 on success, errno otherwise.
 583  *
 584  * Side effects:
 585  *      Closes the physical channel.
 586  *
 587  *----------------------------------------------------------------------
 588  */
 589
 590 static int
 591 SerialCloseProc(
 592     ClientData instanceData,    /* Pointer to SerialInfo structure. */
 593     Tcl_Interp *interp)         /* For error reporting. */
 594 {
 595     SerialInfo *serialPtr = (SerialInfo *) instanceData;
 596     int errorCode, result = 0;
 597     SerialInfo *infoPtr, **nextPtrPtr;
 598     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 599
 600     errorCode = 0;
 601
 602     if (serialPtr->validMask & TCL_READABLE) {
 603         PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
 604         CloseHandle(serialPtr->osRead.hEvent);
 605     }
 606     serialPtr->validMask &= ~TCL_READABLE;
 607
 608     if (serialPtr->writeThread) {
 609
 610         TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
 611
 612         CloseHandle(serialPtr->osWrite.hEvent);
 613         CloseHandle(serialPtr->evWritable);
 614         CloseHandle(serialPtr->writeThread);
 615         serialPtr->writeThread = NULL;
 616
 617         PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
 618     }
 619     serialPtr->validMask &= ~TCL_WRITABLE;
 620
 621     DeleteCriticalSection(&serialPtr->csWrite);
 622
 623     /*
 624      * Don't close the Win32 handle if the handle is a standard channel during
 625      * the thread exit process. Otherwise, one thread may kill the stdio of
 626      * another.
 627      */
 628
 629     if (!TclInThreadExit()
 630             || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
 631             && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
 632             && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
 633         if (CloseHandle(serialPtr->handle) == FALSE) {
 634             TclWinConvertError(GetLastError());
 635             errorCode = errno;
 636         }
 637     }
 638
 639     serialPtr->watchMask &= serialPtr->validMask;
 640
 641     /*
 642      * Remove the file from the list of watched files.
 643      */
 644
 645     for (nextPtrPtr=&(tsdPtr->firstSerialPtr), infoPtr=*nextPtrPtr;
 646             infoPtr!=NULL;
 647             nextPtrPtr=&infoPtr->nextPtr, infoPtr=*nextPtrPtr) {
 648         if (infoPtr == (SerialInfo *)serialPtr) {
 649             *nextPtrPtr = infoPtr->nextPtr;
 650             break;
 651         }
 652     }
 653
 654     /*
 655      * Wrap the error file into a channel and give it to the cleanup routine.
 656      */
 657
 658     if (serialPtr->writeBuf != NULL) {
 659         ckfree(serialPtr->writeBuf);
 660         serialPtr->writeBuf = NULL;
 661     }
 662     ckfree(serialPtr);
 663
 664     if (errorCode == 0) {
 665         return result;
 666     }
 667     return errorCode;
 668 }
 669
 670 static int
 671 SerialClose2Proc(
 672     ClientData instanceData,    /* Pointer to SerialInfo structure. */
 673     Tcl_Interp *interp,         /* For error reporting. */
 674         int flags)
 675 {
 676     if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
 677         return SerialCloseProc(instanceData, interp);
 678     }
 679     return EINVAL;
 680 }
 681 \f
 682 /*
 683  *----------------------------------------------------------------------
 684  *
 685  * SerialBlockingRead --
 686  *
 687  *      Perform a blocking read into the buffer given. Returns count of how
 688  *      many bytes were actually read, and an error indication.
 689  *
 690  * Results:
 691  *      A count of how many bytes were read is returned and an error
 692  *      indication is returned.
 693  *
 694  * Side effects:
 695  *      Reads input from the actual channel.
 696  *
 697  *----------------------------------------------------------------------
 698  */
 699
 700 static int
 701 SerialBlockingRead(
 702     SerialInfo *infoPtr,        /* Serial info structure */
 703     LPVOID buf,                 /* The input buffer pointer */
 704     DWORD bufSize,              /* The number of bytes to read */
 705     LPDWORD lpRead,             /* Returns number of bytes read */
 706     LPOVERLAPPED osPtr)         /* OVERLAPPED structure */
 707 {
 708     /*
 709      *  Perform overlapped blocking read.
 710      *  1. Reset the overlapped event
 711      *  2. Start overlapped read operation
 712      *  3. Wait for completion
 713      */
 714
 715     /*
 716      * Set Offset to ZERO, otherwise NT4.0 may report an error.
 717      */
 718
 719     osPtr->Offset = osPtr->OffsetHigh = 0;
 720     ResetEvent(osPtr->hEvent);
 721     if (!ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr)) {
 722         if (GetLastError() != ERROR_IO_PENDING) {
 723             /*
 724              * ReadFile failed, but it isn't delayed. Report error.
 725              */
 726
 727             return FALSE;
 728         } else {
 729             /*
 730              * Read is pending, wait for completion, timeout?
 731              */
 732
 733             if (!GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE)) {
 734                 return FALSE;
 735             }
 736         }
 737     } else {
 738         /*
 739          * ReadFile completed immediately.
 740          */
 741     }
 742     return TRUE;
 743 }
 744 \f
 745 /*
 746  *----------------------------------------------------------------------
 747  *
 748  * SerialBlockingWrite --
 749  *
 750  *      Perform a blocking write from the buffer given. Returns count of how
 751  *      many bytes were actually written, and an error indication.
 752  *
 753  * Results:
 754  *      A count of how many bytes were written is returned and an error
 755  *      indication is returned.
 756  *
 757  * Side effects:
 758  *      Writes output to the actual channel.
 759  *
 760  *----------------------------------------------------------------------
 761  */
 762
 763 static int
 764 SerialBlockingWrite(
 765     SerialInfo *infoPtr,        /* Serial info structure */
 766     LPVOID buf,                 /* The output buffer pointer */
 767     DWORD bufSize,              /* The number of bytes to write */
 768     LPDWORD lpWritten,          /* Returns number of bytes written */
 769     LPOVERLAPPED osPtr)         /* OVERLAPPED structure */
 770 {
 771     int result;
 772
 773     /*
 774      * Perform overlapped blocking write.
 775      *  1. Reset the overlapped event
 776      *  2. Remove these bytes from the output queue counter
 777      *  3. Start overlapped write operation
 778      *  3. Remove these bytes from the output queue counter
 779      *  4. Wait for completion
 780      *  5. Adjust the output queue counter
 781      */
 782
 783     ResetEvent(osPtr->hEvent);
 784
 785     EnterCriticalSection(&infoPtr->csWrite);
 786     infoPtr->writeQueue -= bufSize;
 787
 788     /*
 789      * Set Offset to ZERO, otherwise NT4.0 may report an error
 790      */
 791
 792     osPtr->Offset = osPtr->OffsetHigh = 0;
 793     result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
 794     LeaveCriticalSection(&infoPtr->csWrite);
 795
 796     if (result == FALSE) {
 797         int err = GetLastError();
 798
 799         switch (err) {
 800         case ERROR_IO_PENDING:
 801             /*
 802              * Write is pending, wait for completion.
 803              */
 804
 805             if (!GetOverlappedResult(infoPtr->handle, osPtr, lpWritten,
 806                     TRUE)) {
 807                 return FALSE;
 808             }
 809             break;
 810         case ERROR_COUNTER_TIMEOUT:
 811             /*
 812              * Write timeout handled in SerialOutputProc.
 813              */
 814
 815             break;
 816         default:
 817             /*
 818              * WriteFile failed, but it isn't delayed. Report error.
 819              */
 820
 821             return FALSE;
 822         }
 823     } else {
 824         /*
 825          * WriteFile completed immediately.
 826          */
 827     }
 828
 829     EnterCriticalSection(&infoPtr->csWrite);
 830     infoPtr->writeQueue += (*lpWritten - bufSize);
 831     LeaveCriticalSection(&infoPtr->csWrite);
 832
 833     return TRUE;
 834 }
 835 \f
 836 /*
 837  *----------------------------------------------------------------------
 838  *
 839  * SerialInputProc --
 840  *
 841  *      Reads input from the IO channel into the buffer given. Returns count
 842  *      of how many bytes were actually read, and an error indication.
 843  *
 844  * Results:
 845  *      A count of how many bytes were read is returned and an error
 846  *      indication is returned in an output argument.
 847  *
 848  * Side effects:
 849  *      Reads input from the actual channel.
 850  *
 851  *----------------------------------------------------------------------
 852  */
 853
 854 static int
 855 SerialInputProc(
 856     ClientData instanceData,    /* Serial state. */
 857     char *buf,                  /* Where to store data read. */
 858     int bufSize,                /* How much space is available in the
 859                                  * buffer? */
 860     int *errorCode)             /* Where to store error code. */
 861 {
 862     SerialInfo *infoPtr = (SerialInfo *) instanceData;
 863     DWORD bytesRead = 0;
 864     COMSTAT cStat;
 865
 866     *errorCode = 0;
 867
 868     /*
 869      * Check if there is a CommError pending from SerialCheckProc
 870      */
 871
 872     if (infoPtr->error & SERIAL_READ_ERRORS) {
 873         goto commError;
 874     }
 875
 876     /*
 877      * Look for characters already pending in windows queue. This is the
 878      * mainly restored good old code from Tcl8.0
 879      */
 880
 881     if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
 882         /*
 883          * Check for errors here, but not in the evSetup/Check procedures.
 884          */
 885
 886         if (infoPtr->error & SERIAL_READ_ERRORS) {
 887             goto commError;
 888         }
 889         if (infoPtr->flags & SERIAL_ASYNC) {
 890             /*
 891              * NON_BLOCKING mode: Avoid blocking by reading more bytes than
 892              * available in input buffer.
 893              */
 894
 895             if (cStat.cbInQue > 0) {
 896                 if ((DWORD) bufSize > cStat.cbInQue) {
 897                     bufSize = cStat.cbInQue;
 898                 }
 899             } else {
 900                 errno = *errorCode = EWOULDBLOCK;
 901                 return -1;
 902             }
 903         } else {
 904             /*
 905              * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
 906              */
 907
 908             if (cStat.cbInQue > 0) {
 909                 if ((DWORD) bufSize > cStat.cbInQue) {
 910                     bufSize = cStat.cbInQue;
 911                 }
 912             } else {
 913                 bufSize = 1;
 914             }
 915         }
 916     }
 917
 918     if (bufSize == 0) {
 919         return bytesRead = 0;
 920     }
 921
 922     /*
 923      * Perform blocking read. Doesn't block in non-blocking mode, because we
 924      * checked the number of available bytes.
 925      */
 926
 927     if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 928             &infoPtr->osRead) == FALSE) {
 929         TclWinConvertError(GetLastError());
 930         *errorCode = errno;
 931         return -1;
 932     }
 933     return bytesRead;
 934
 935   commError:
 936     infoPtr->lastError = infoPtr->error;
 937                                 /* save last error code */
 938     infoPtr->error = 0;         /* reset error code */
 939     *errorCode = EIO;           /* to return read-error only once */
 940     return -1;
 941 }
 942 \f
 943 /*
 944  *----------------------------------------------------------------------
 945  *
 946  * SerialOutputProc --
 947  *
 948  *      Writes the given output on the IO channel. Returns count of how many
 949  *      characters were actually written, and an error indication.
 950  *
 951  * Results:
 952  *      A count of how many characters were written is returned and an error
 953  *      indication is returned in an output argument.
 954  *
 955  * Side effects:
 956  *      Writes output on the actual channel.
 957  *
 958  *----------------------------------------------------------------------
 959  */
 960
 961 static int
 962 SerialOutputProc(
 963     ClientData instanceData,    /* Serial state. */
 964     const char *buf,            /* The data buffer. */
 965     int toWrite,                /* How many bytes to write? */
 966     int *errorCode)             /* Where to store error code. */
 967 {
 968     SerialInfo *infoPtr = (SerialInfo *) instanceData;
 969     DWORD bytesWritten, timeout;
 970
 971     *errorCode = 0;
 972
 973     /*
 974      * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid
 975      * blocking output after ExitProc or CloseHandler(chan) has been called by
 976      * checking the corrresponding variables.
 977      */
 978
 979     if (!initialized || TclInExit()) {
 980         return toWrite;
 981     }
 982
 983     /*
 984      * Check if there is a CommError pending from SerialCheckProc
 985      */
 986
 987     if (infoPtr->error & SERIAL_WRITE_ERRORS) {
 988         infoPtr->lastError = infoPtr->error;
 989                                 /* save last error code */
 990         infoPtr->error = 0;     /* reset error code */
 991         errno = EIO;
 992         goto error;
 993     }
 994
 995     timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
 996     if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
 997         /*
 998          * The writer thread is blocked waiting for a write to complete and
 999          * the channel is in non-blocking mode.
1000          */
1001
1002         errno = EWOULDBLOCK;
1003         goto error1;
1004     }
1005
1006     /*
1007      * Check for a background error on the last write.
1008      */
1009
1010     if (infoPtr->writeError) {
1011         TclWinConvertError(infoPtr->writeError);
1012         infoPtr->writeError = 0;
1013         goto error1;
1014     }
1015
1016     /*
1017      * Remember the number of bytes in output queue
1018      */
1019
1020     EnterCriticalSection(&infoPtr->csWrite);
1021     infoPtr->writeQueue += toWrite;
1022     LeaveCriticalSection(&infoPtr->csWrite);
1023
1024     if (infoPtr->flags & SERIAL_ASYNC) {
1025         /*
1026          * The serial is non-blocking, so copy the data into the output buffer
1027          * and restart the writer thread.
1028          */
1029
1030         if (toWrite > infoPtr->writeBufLen) {
1031             /*
1032              * Reallocate the buffer to be large enough to hold the data.
1033              */
1034
1035             if (infoPtr->writeBuf) {
1036                 ckfree(infoPtr->writeBuf);
1037             }
1038             infoPtr->writeBufLen = toWrite;
1039             infoPtr->writeBuf = ckalloc(toWrite);
1040         }
1041         memcpy(infoPtr->writeBuf, buf, toWrite);
1042         infoPtr->toWrite = toWrite;
1043         ResetEvent(infoPtr->evWritable);
1044         TclPipeThreadSignal(&infoPtr->writeTI);
1045         bytesWritten = (DWORD) toWrite;
1046
1047     } else {
1048         /*
1049          * In the blocking case, just try to write the buffer directly. This
1050          * avoids an unnecessary copy.
1051          */
1052
1053         if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
1054                 &bytesWritten, &infoPtr->osWrite)) {
1055             goto writeError;
1056         }
1057         if (bytesWritten != (DWORD) toWrite) {
1058             /*
1059              * Write timeout.
1060              */
1061             infoPtr->lastError |= CE_PTO;
1062             errno = EIO;
1063             goto error;
1064         }
1065     }
1066
1067     return (int) bytesWritten;
1068
1069   writeError:
1070     TclWinConvertError(GetLastError());
1071
1072   error:
1073     /*
1074      * Reset the output queue counter on error during blocking output
1075      */
1076
1077     /*
1078      * EnterCriticalSection(&infoPtr->csWrite);
1079      * infoPtr->writeQueue = 0;
1080      * LeaveCriticalSection(&infoPtr->csWrite);
1081      */
1082   error1:
1083     *errorCode = errno;
1084     return -1;
1085 }
1086 \f
1087 /*
1088  *----------------------------------------------------------------------
1089  *
1090  * SerialEventProc --
1091  *
1092  *      This function is invoked by Tcl_ServiceEvent when a file event reaches
1093  *      the front of the event queue. This procedure invokes Tcl_NotifyChannel
1094  *      on the serial.
1095  *
1096  * Results:
1097  *      Returns 1 if the event was handled, meaning it should be removed from
1098  *      the queue. Returns 0 if the event was not handled, meaning it should
1099  *      stay on the queue. The only time the event isn't handled is if the
1100  *      TCL_FILE_EVENTS flag bit isn't set.
1101  *
1102  * Side effects:
1103  *      Whatever the notifier callback does.
1104  *
1105  *----------------------------------------------------------------------
1106  */
1107
1108 static int
1109 SerialEventProc(
1110     Tcl_Event *evPtr,           /* Event to service. */
1111     int flags)                  /* Flags that indicate what events to handle,
1112                                  * such as TCL_FILE_EVENTS. */
1113 {
1114     SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
1115     SerialInfo *infoPtr;
1116     int mask;
1117     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1118
1119     if (!(flags & TCL_FILE_EVENTS)) {
1120         return 0;
1121     }
1122
1123     /*
1124      * Search through the list of watched serials for the one whose handle
1125      * matches the event. We do this rather than simply dereferencing the
1126      * handle in the event so that serials can be deleted while the event is
1127      * in the queue.
1128      */
1129
1130     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
1131             infoPtr = infoPtr->nextPtr) {
1132         if (serialEvPtr->infoPtr == infoPtr) {
1133             infoPtr->flags &= ~(SERIAL_PENDING);
1134             break;
1135         }
1136     }
1137
1138     /*
1139      * Remove stale events.
1140      */
1141
1142     if (!infoPtr) {
1143         return 1;
1144     }
1145
1146     /*
1147      * Check to see if the serial is readable. Note that we can't tell if a
1148      * serial is writable, so we always report it as being writable unless we
1149      * have detected EOF.
1150      */
1151
1152     mask = 0;
1153     if (infoPtr->watchMask & TCL_WRITABLE) {
1154         if (infoPtr->writable) {
1155             mask |= TCL_WRITABLE;
1156             infoPtr->writable = 0;
1157         }
1158     }
1159
1160     if (infoPtr->watchMask & TCL_READABLE) {
1161         if (infoPtr->readable) {
1162             mask |= TCL_READABLE;
1163             infoPtr->readable = 0;
1164         }
1165     }
1166
1167     /*
1168      * Inform the channel of the events.
1169      */
1170
1171     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
1172     return 1;
1173 }
1174 \f
1175 /*
1176  *----------------------------------------------------------------------
1177  *
1178  * SerialWatchProc --
1179  *
1180  *      Called by the notifier to set up to watch for events on this channel.
1181  *
1182  * Results:
1183  *      None.
1184  *
1185  * Side effects:
1186  *      None.
1187  *
1188  *----------------------------------------------------------------------
1189  */
1190
1191 static void
1192 SerialWatchProc(
1193     ClientData instanceData,    /* Serial state. */
1194     int mask)                   /* What events to watch for, OR-ed combination
1195                                  * of TCL_READABLE, TCL_WRITABLE and
1196                                  * TCL_EXCEPTION. */
1197 {
1198     SerialInfo **nextPtrPtr, *ptr;
1199     SerialInfo *infoPtr = (SerialInfo *) instanceData;
1200     int oldMask = infoPtr->watchMask;
1201     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1202
1203     /*
1204      * Since the file is always ready for events, we set the block time so we
1205      * will poll.
1206      */
1207
1208     infoPtr->watchMask = mask & infoPtr->validMask;
1209     if (infoPtr->watchMask) {
1210         if (!oldMask) {
1211             infoPtr->nextPtr = tsdPtr->firstSerialPtr;
1212             tsdPtr->firstSerialPtr = infoPtr;
1213         }
1214         SerialBlockTime(infoPtr->blockTime);
1215     } else if (oldMask) {
1216         /*
1217          * Remove the serial port from the list of watched serial ports.
1218          */
1219
1220         for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; ptr!=NULL;
1221                 nextPtrPtr=&ptr->nextPtr, ptr=*nextPtrPtr) {
1222             if (infoPtr == ptr) {
1223                 *nextPtrPtr = ptr->nextPtr;
1224                 break;
1225             }
1226         }
1227     }
1228 }
1229 \f
1230 /*
1231  *----------------------------------------------------------------------
1232  *
1233  * SerialGetHandleProc --
1234  *
1235  *      Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
1236  *      command serial port based channel.
1237  *
1238  * Results:
1239  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
1240  *      handle for the specified direction.
1241  *
1242  * Side effects:
1243  *      None.
1244  *
1245  *----------------------------------------------------------------------
1246  */
1247
1248 static int
1249 SerialGetHandleProc(
1250     ClientData instanceData,    /* The serial state. */
1251     int direction,              /* TCL_READABLE or TCL_WRITABLE */
1252     ClientData *handlePtr)      /* Where to store the handle. */
1253 {
1254     SerialInfo *infoPtr = (SerialInfo *) instanceData;
1255
1256     *handlePtr = (ClientData) infoPtr->handle;
1257     return TCL_OK;
1258 }
1259 \f
1260 /*
1261  *----------------------------------------------------------------------
1262  *
1263  * SerialWriterThread --
1264  *
1265  *      This function runs in a separate thread and writes data onto a serial.
1266  *
1267  * Results:
1268  *      Always returns 0.
1269  *
1270  * Side effects:
1271  *      Signals the main thread when an output operation is completed. May
1272  *      cause the main thread to wake up by posting a message.
1273  *
1274  *----------------------------------------------------------------------
1275  */
1276
1277 static DWORD WINAPI
1278 SerialWriterThread(
1279     LPVOID arg)
1280 {
1281     TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
1282     SerialInfo *infoPtr = NULL; /* access info only after success init/wait */
1283     DWORD bytesWritten, toWrite;
1284     char *buf;
1285     OVERLAPPED myWrite;         /* Have an own OVERLAPPED in this thread. */
1286
1287     for (;;) {
1288         /*
1289          * Wait for the main thread to signal before attempting to write.
1290          */
1291         if (!TclPipeThreadWaitForSignal(&pipeTI)) {
1292             /* exit */
1293             break;
1294         }
1295         infoPtr = (SerialInfo *)pipeTI->clientData;
1296
1297         buf = infoPtr->writeBuf;
1298         toWrite = infoPtr->toWrite;
1299
1300         myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
1301
1302         /*
1303          * Loop until all of the bytes are written or an error occurs.
1304          */
1305
1306         while (toWrite > 0) {
1307             /*
1308              * Check for pending writeError. Ignore all write operations until
1309              * the user has been notified.
1310              */
1311
1312             if (infoPtr->writeError) {
1313                 break;
1314             }
1315             if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
1316                     &bytesWritten, &myWrite) == FALSE) {
1317                 infoPtr->writeError = GetLastError();
1318                 break;
1319             }
1320             if (bytesWritten != toWrite) {
1321                 /*
1322                  * Write timeout.
1323                  */
1324
1325                 infoPtr->writeError = ERROR_WRITE_FAULT;
1326                 break;
1327             }
1328             toWrite -= bytesWritten;
1329             buf += bytesWritten;
1330         }
1331
1332         CloseHandle(myWrite.hEvent);
1333
1334         /*
1335          * Signal the main thread by signalling the evWritable event and then
1336          * waking up the notifier thread.
1337          */
1338
1339         SetEvent(infoPtr->evWritable);
1340
1341         /*
1342          * Alert the foreground thread. Note that we need to treat this like a
1343          * critical section so the foreground thread does not terminate this
1344          * thread while we are holding a mutex in the notifier code.
1345          */
1346
1347         Tcl_MutexLock(&serialMutex);
1348         if (infoPtr->threadId != NULL) {
1349             /*
1350              * TIP #218: When in flight ignore the event, no one will receive
1351              * it anyway.
1352              */
1353
1354             Tcl_ThreadAlert(infoPtr->threadId);
1355         }
1356         Tcl_MutexUnlock(&serialMutex);
1357     }
1358
1359     /* Worker exit, so inform the main thread or free TI-structure (if owned) */
1360     TclPipeThreadExit(&pipeTI);
1361
1362     return 0;
1363 }
1364 \f
1365 /*
1366  *----------------------------------------------------------------------
1367  *
1368  * TclWinSerialOpen --
1369  *
1370  *      Opens or Reopens the serial port with the OVERLAPPED FLAG set
1371  *
1372  * Results:
1373  *      Returns the new handle, or INVALID_HANDLE_VALUE.
1374  *      If an existing channel is specified it is closed and reopened.
1375  *
1376  * Side effects:
1377  *      May close/reopen the original handle
1378  *
1379  *----------------------------------------------------------------------
1380  */
1381
1382 HANDLE
1383 TclWinSerialOpen(
1384     HANDLE handle,
1385     const WCHAR *name,
1386     DWORD access)
1387 {
1388     SerialInit();
1389
1390     /*
1391      * If an open channel is specified, close it
1392      */
1393
1394     if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
1395         return INVALID_HANDLE_VALUE;
1396     }
1397
1398     /*
1399      * Multithreaded I/O needs the overlapped flag set otherwise
1400      * ClearCommError blocks under Windows NT/2000 until serial output is
1401      * finished
1402      */
1403
1404     handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING,
1405             FILE_FLAG_OVERLAPPED, 0);
1406
1407     return handle;
1408 }
1409 \f
1410 /*
1411  *----------------------------------------------------------------------
1412  *
1413  * TclWinOpenSerialChannel --
1414  *
1415  *      Constructs a Serial port channel for the specified standard OS handle.
1416  *      This is a helper function to break up the construction of channels
1417  *      into File, Console, or Serial.
1418  *
1419  * Results:
1420  *      Returns the new channel, or NULL.
1421  *
1422  * Side effects:
1423  *      May open the channel
1424  *
1425  *----------------------------------------------------------------------
1426  */
1427
1428 Tcl_Channel
1429 TclWinOpenSerialChannel(
1430     HANDLE handle,
1431     char *channelName,
1432     int permissions)
1433 {
1434     SerialInfo *infoPtr;
1435
1436     SerialInit();
1437
1438     infoPtr = ckalloc(sizeof(SerialInfo));
1439     memset(infoPtr, 0, sizeof(SerialInfo));
1440
1441     infoPtr->validMask = permissions;
1442     infoPtr->handle = handle;
1443     infoPtr->channel = (Tcl_Channel) NULL;
1444     infoPtr->readable = 0;
1445     infoPtr->writable = 1;
1446     infoPtr->toWrite = infoPtr->writeQueue = 0;
1447     infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
1448     infoPtr->lastEventTime = 0;
1449     infoPtr->lastError = infoPtr->error = 0;
1450     infoPtr->threadId = Tcl_GetCurrentThread();
1451     infoPtr->sysBufRead = 4096;
1452     infoPtr->sysBufWrite = 4096;
1453
1454     /*
1455      * Use the pointer to keep the channel names unique, in case the handles
1456      * are shared between multiple channels (stdin/stdout).
1457      */
1458
1459     sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
1460
1461     infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
1462             infoPtr, permissions);
1463
1464
1465     SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
1466     PurgeComm(handle,
1467             PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
1468
1469     /*
1470      * Default is blocking.
1471      */
1472
1473     SetCommTimeouts(handle, &no_timeout);
1474
1475     InitializeCriticalSection(&infoPtr->csWrite);
1476     if (permissions & TCL_READABLE) {
1477         infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
1478     }
1479     if (permissions & TCL_WRITABLE) {
1480         /*
1481          * Initially the channel is writable and the writeThread is idle.
1482          */
1483
1484         infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
1485         infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
1486         infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
1487                 TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
1488                         infoPtr->evWritable), 0, NULL);
1489     }
1490
1491     /*
1492      * Files have default translation of AUTO and ^Z eof char, which means
1493      * that a ^Z will be accepted as EOF when reading.
1494      */
1495
1496     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1497     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1498
1499     return infoPtr->channel;
1500 }
1501 \f
1502 /*
1503  *----------------------------------------------------------------------
1504  *
1505  * SerialErrorStr --
1506  *
1507  *      Converts a Win32 serial error code to a list of readable errors.
1508  *
1509  * Results:
1510  *      None.
1511  *
1512  * Side effects:
1513  *      Generates readable errors in the supplied DString.
1514  *
1515  *----------------------------------------------------------------------
1516  */
1517
1518 static void
1519 SerialErrorStr(
1520     DWORD error,                /* Win32 serial error code. */
1521     Tcl_DString *dsPtr)         /* Where to store string. */
1522 {
1523     if (error & CE_RXOVER) {
1524         Tcl_DStringAppendElement(dsPtr, "RXOVER");
1525     }
1526     if (error & CE_OVERRUN) {
1527         Tcl_DStringAppendElement(dsPtr, "OVERRUN");
1528     }
1529     if (error & CE_RXPARITY) {
1530         Tcl_DStringAppendElement(dsPtr, "RXPARITY");
1531     }
1532     if (error & CE_FRAME) {
1533         Tcl_DStringAppendElement(dsPtr, "FRAME");
1534     }
1535     if (error & CE_BREAK) {
1536         Tcl_DStringAppendElement(dsPtr, "BREAK");
1537     }
1538     if (error & CE_TXFULL) {
1539         Tcl_DStringAppendElement(dsPtr, "TXFULL");
1540     }
1541     if (error & CE_PTO) {       /* PTO used to signal WRITE-TIMEOUT */
1542         Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
1543     }
1544     if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) {
1545         char buf[TCL_INTEGER_SPACE + 1];
1546
1547         wsprintfA(buf, "%d", error);
1548         Tcl_DStringAppendElement(dsPtr, buf);
1549     }
1550 }
1551 \f
1552 /*
1553  *----------------------------------------------------------------------
1554  *
1555  * SerialModemStatusStr --
1556  *
1557  *      Converts a Win32 modem status list of readable flags
1558  *
1559  * Result:
1560  *      None.
1561  *
1562  * Side effects:
1563  *      Appends modem status flag strings to the given DString.
1564  *
1565  *----------------------------------------------------------------------
1566  */
1567
1568 static void
1569 SerialModemStatusStr(
1570     DWORD status,               /* Win32 modem status. */
1571     Tcl_DString *dsPtr)         /* Where to store string. */
1572 {
1573     Tcl_DStringAppendElement(dsPtr, "CTS");
1574     Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON)  ?  "1" : "0");
1575     Tcl_DStringAppendElement(dsPtr, "DSR");
1576     Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON)   ? "1" : "0");
1577     Tcl_DStringAppendElement(dsPtr, "RING");
1578     Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON)  ? "1" : "0");
1579     Tcl_DStringAppendElement(dsPtr, "DCD");
1580     Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON)  ? "1" : "0");
1581 }
1582 \f
1583 /*
1584  *----------------------------------------------------------------------
1585  *
1586  * SerialSetOptionProc --
1587  *
1588  *      Sets an option on a channel.
1589  *
1590  * Results:
1591  *      A standard Tcl result. Also sets the interp's result on error if
1592  *      interp is not NULL.
1593  *
1594  * Side effects:
1595  *      May modify an option on a device.
1596  *
1597  *----------------------------------------------------------------------
1598  */
1599
1600 static int
1601 SerialSetOptionProc(
1602     ClientData instanceData,    /* File state. */
1603     Tcl_Interp *interp,         /* For error reporting - can be NULL. */
1604     const char *optionName,     /* Which option to set? */
1605     const char *value)          /* New value for option. */
1606 {
1607     SerialInfo *infoPtr;
1608     DCB dcb;
1609     BOOL result, flag;
1610     size_t len, vlen;
1611     Tcl_DString ds;
1612     const WCHAR *native;
1613     int argc;
1614     const char **argv;
1615
1616     infoPtr = (SerialInfo *) instanceData;
1617
1618     /*
1619      * Parse options. This would be far easier if we had Tcl_Objs to work with
1620      * as that would let us use Tcl_GetIndexFromObj()...
1621      */
1622
1623     len = strlen(optionName);
1624     vlen = strlen(value);
1625
1626     /*
1627      * Option -mode baud,parity,databits,stopbits
1628      */
1629
1630     if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
1631         if (!GetCommState(infoPtr->handle, &dcb)) {
1632             goto getStateFailed;
1633         }
1634         native = (const WCHAR *)Tcl_WinUtfToTChar(value, -1, &ds);
1635         result = BuildCommDCBW(native, &dcb);
1636         Tcl_DStringFree(&ds);
1637
1638         if (result == FALSE) {
1639             if (interp != NULL) {
1640                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1641                         "bad value \"%s\" for -mode: should be baud,parity,data,stop",
1642                         value));
1643                 Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
1644             }
1645             return TCL_ERROR;
1646         }
1647
1648         /*
1649          * Default settings for serial communications.
1650          */
1651
1652         dcb.fBinary = TRUE;
1653         dcb.fErrorChar = FALSE;
1654         dcb.fNull = FALSE;
1655         dcb.fAbortOnError = FALSE;
1656
1657         if (!SetCommState(infoPtr->handle, &dcb)) {
1658             goto setStateFailed;
1659         }
1660         return TCL_OK;
1661     }
1662
1663     /*
1664      * Option -handshake none|xonxoff|rtscts|dtrdsr
1665      */
1666
1667     if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
1668         if (!GetCommState(infoPtr->handle, &dcb)) {
1669             goto getStateFailed;
1670         }
1671
1672         /*
1673          * Reset all handshake options. DTR and RTS are ON by default.
1674          */
1675
1676         dcb.fOutX = dcb.fInX = FALSE;
1677         dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE;
1678         dcb.fDtrControl = DTR_CONTROL_ENABLE;
1679         dcb.fRtsControl = RTS_CONTROL_ENABLE;
1680         dcb.fTXContinueOnXoff = FALSE;
1681
1682         /*
1683          * Adjust the handshake limits. Yes, the XonXoff limits seem to
1684          * influence even hardware handshake.
1685          */
1686
1687         dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
1688         dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
1689
1690         if (strncasecmp(value, "NONE", vlen) == 0) {
1691             /*
1692              * Leave all handshake options disabled.
1693              */
1694         } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
1695             dcb.fOutX = dcb.fInX = TRUE;
1696         } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
1697             dcb.fOutxCtsFlow = TRUE;
1698             dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
1699         } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
1700             dcb.fOutxDsrFlow = TRUE;
1701             dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
1702         } else {
1703             if (interp != NULL) {
1704                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1705                         "bad value \"%s\" for -handshake: must be one of"
1706                         " xonxoff, rtscts, dtrdsr or none", value));
1707                 Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
1708             }
1709             return TCL_ERROR;
1710         }
1711
1712         if (!SetCommState(infoPtr->handle, &dcb)) {
1713             goto setStateFailed;
1714         }
1715         return TCL_OK;
1716     }
1717
1718     /*
1719      * Option -xchar {\x11 \x13}
1720      */
1721
1722     if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
1723         if (!GetCommState(infoPtr->handle, &dcb)) {
1724             goto getStateFailed;
1725         }
1726
1727         if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1728             return TCL_ERROR;
1729         }
1730         if (argc != 2) {
1731         badXchar:
1732             if (interp != NULL) {
1733                 Tcl_SetObjResult(interp, Tcl_NewStringObj(
1734                         "bad value for -xchar: should be a list of"
1735                         " two elements with each a single character", -1));
1736                 Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
1737             }
1738             ckfree(argv);
1739             return TCL_ERROR;
1740         }
1741
1742         /*
1743          * These dereferences are safe, even in the zero-length string cases,
1744          * because that just makes the xon/xoff character into NUL. When the
1745          * character looks like it is UTF-8 encoded, decode it before casting
1746          * into the format required for the Win guts. Note that this does not
1747          * convert character sets; it is expected that when people set the
1748          * control characters to something large and custom, they'll know the
1749          * hex/octal value rather than the printable form.
1750          */
1751
1752         dcb.XonChar = argv[0][0];
1753         dcb.XoffChar = argv[1][0];
1754         if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
1755             int character;
1756             int charLen;
1757
1758             charLen = TclUtfToUCS4(argv[0], &character);
1759             if ((character & ~0xFF) || argv[0][charLen]) {
1760                 goto badXchar;
1761             }
1762             dcb.XonChar = (char) character;
1763             charLen = TclUtfToUCS4(argv[1], &character);
1764             if ((character & ~0xFF) || argv[1][charLen]) {
1765                 goto badXchar;
1766             }
1767             dcb.XoffChar = (char) character;
1768         }
1769         ckfree(argv);
1770
1771         if (!SetCommState(infoPtr->handle, &dcb)) {
1772             goto setStateFailed;
1773         }
1774         return TCL_OK;
1775     }
1776
1777     /*
1778      * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
1779      */
1780
1781     if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
1782         int i, res = TCL_OK;
1783
1784         if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1785             return TCL_ERROR;
1786         }
1787         if ((argc % 2) == 1) {
1788             if (interp != NULL) {
1789                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1790                         "bad value \"%s\" for -ttycontrol: should be "
1791                         "a list of signal,value pairs", value));
1792                 Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
1793             }
1794             ckfree(argv);
1795             return TCL_ERROR;
1796         }
1797
1798         for (i = 0; i < argc - 1; i += 2) {
1799             if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
1800                 res = TCL_ERROR;
1801                 break;
1802             }
1803             if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
1804                 if (!EscapeCommFunction(infoPtr->handle,
1805                         (DWORD) (flag ? SETDTR : CLRDTR))) {
1806                     if (interp != NULL) {
1807                         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1808                                 "can't set DTR signal", -1));
1809                         Tcl_SetErrorCode(interp, "TCL", "OPERATION",
1810                                 "FCONFIGURE", "TTY_SIGNAL", NULL);
1811                     }
1812                     res = TCL_ERROR;
1813                     break;
1814                 }
1815             } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
1816                 if (!EscapeCommFunction(infoPtr->handle,
1817                         (DWORD) (flag ? SETRTS : CLRRTS))) {
1818                     if (interp != NULL) {
1819                         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1820                                 "can't set RTS signal", -1));
1821                         Tcl_SetErrorCode(interp, "TCL", "OPERATION",
1822                                 "FCONFIGURE", "TTY_SIGNAL", NULL);
1823                     }
1824                     res = TCL_ERROR;
1825                     break;
1826                 }
1827             } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
1828                 if (!EscapeCommFunction(infoPtr->handle,
1829                         (DWORD) (flag ? SETBREAK : CLRBREAK))) {
1830                     if (interp != NULL) {
1831                         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1832                                 "can't set BREAK signal", -1));
1833                         Tcl_SetErrorCode(interp, "TCL", "OPERATION",
1834                                 "FCONFIGURE", "TTY_SIGNAL", NULL);
1835                     }
1836                     res = TCL_ERROR;
1837                     break;
1838                 }
1839             } else {
1840                 if (interp != NULL) {
1841                     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1842                             "bad signal name \"%s\" for -ttycontrol: must be"
1843                             " DTR, RTS or BREAK", argv[i]));
1844                     Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
1845                             NULL);
1846                 }
1847                 res = TCL_ERROR;
1848                 break;
1849             }
1850         }
1851
1852         ckfree(argv);
1853         return res;
1854     }
1855
1856     /*
1857      * Option -sysbuffer {read_size write_size}
1858      * Option -sysbuffer read_size
1859      */
1860
1861     if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
1862         /*
1863          * -sysbuffer 4096 or -sysbuffer {64536 4096}
1864          */
1865
1866         size_t inSize = (size_t) -1, outSize = (size_t) -1;
1867
1868         if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1869             return TCL_ERROR;
1870         }
1871         if (argc == 1) {
1872             inSize = atoi(argv[0]);
1873             outSize = infoPtr->sysBufWrite;
1874         } else if (argc == 2) {
1875             inSize  = atoi(argv[0]);
1876             outSize = atoi(argv[1]);
1877         }
1878         ckfree(argv);
1879
1880         if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
1881             if (interp != NULL) {
1882                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1883                         "bad value \"%s\" for -sysbuffer: should be "
1884                         "a list of one or two integers > 0", value));
1885                 Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
1886             }
1887             return TCL_ERROR;
1888         }
1889
1890         if (!SetupComm(infoPtr->handle, inSize, outSize)) {
1891             if (interp != NULL) {
1892                 TclWinConvertError(GetLastError());
1893                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1894                         "can't setup comm buffers: %s",
1895                         Tcl_PosixError(interp)));
1896             }
1897             return TCL_ERROR;
1898         }
1899         infoPtr->sysBufRead  = inSize;
1900         infoPtr->sysBufWrite = outSize;
1901
1902         /*
1903          * Adjust the handshake limits. Yes, the XonXoff limits seem to
1904          * influence even hardware handshake.
1905          */
1906
1907         if (!GetCommState(infoPtr->handle, &dcb)) {
1908             goto getStateFailed;
1909         }
1910         dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
1911         dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
1912         if (!SetCommState(infoPtr->handle, &dcb)) {
1913             goto setStateFailed;
1914         }
1915         return TCL_OK;
1916     }
1917
1918     /*
1919      * Option -pollinterval msec
1920      */
1921
1922     if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
1923         if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) {
1924             return TCL_ERROR;
1925         }
1926         return TCL_OK;
1927     }
1928
1929     /*
1930      * Option -timeout msec
1931      */
1932
1933     if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
1934         int msec;
1935         COMMTIMEOUTS tout = {0,0,0,0,0};
1936
1937         if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
1938             return TCL_ERROR;
1939         }
1940         tout.ReadTotalTimeoutConstant = msec;
1941         if (!SetCommTimeouts(infoPtr->handle, &tout)) {
1942             if (interp != NULL) {
1943                 TclWinConvertError(GetLastError());
1944                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1945                         "can't set comm timeouts: %s",
1946                         Tcl_PosixError(interp)));
1947             }
1948             return TCL_ERROR;
1949         }
1950
1951         return TCL_OK;
1952     }
1953
1954     return Tcl_BadChannelOption(interp, optionName,
1955             "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
1956
1957   getStateFailed:
1958     if (interp != NULL) {
1959         TclWinConvertError(GetLastError());
1960         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1961                 "can't get comm state: %s", Tcl_PosixError(interp)));
1962     }
1963     return TCL_ERROR;
1964
1965   setStateFailed:
1966     if (interp != NULL) {
1967         TclWinConvertError(GetLastError());
1968         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1969                 "can't set comm state: %s", Tcl_PosixError(interp)));
1970     }
1971     return TCL_ERROR;
1972 }
1973 \f
1974 /*
1975  *----------------------------------------------------------------------
1976  *
1977  * SerialGetOptionProc --
1978  *
1979  *      Gets a mode associated with an IO channel. If the optionName arg is
1980  *      non NULL, retrieves the value of that option. If the optionName arg is
1981  *      NULL, retrieves a list of alternating option names and values for the
1982  *      given channel.
1983  *
1984  * Results:
1985  *      A standard Tcl result. Also sets the supplied DString to the string
1986  *      value of the option(s) returned.
1987  *
1988  * Side effects:
1989  *      The string returned by this function is in static storage and may be
1990  *      reused at any time subsequent to the call.
1991  *
1992  *----------------------------------------------------------------------
1993  */
1994
1995 static int
1996 SerialGetOptionProc(
1997     ClientData instanceData,    /* File state. */
1998     Tcl_Interp *interp,         /* For error reporting - can be NULL. */
1999     const char *optionName,     /* Option to get. */
2000     Tcl_DString *dsPtr)         /* Where to store value(s). */
2001 {
2002     SerialInfo *infoPtr;
2003     DCB dcb;
2004     size_t len;
2005     int valid = 0;              /* Flag if valid option parsed. */
2006
2007     infoPtr = (SerialInfo *) instanceData;
2008
2009     if (optionName == NULL) {
2010         len = 0;
2011     } else {
2012         len = strlen(optionName);
2013     }
2014
2015     /*
2016      * Get option -mode
2017      */
2018
2019     if (len == 0) {
2020         Tcl_DStringAppendElement(dsPtr, "-mode");
2021     }
2022     if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
2023         char parity;
2024         const char *stop;
2025         char buf[2 * TCL_INTEGER_SPACE + 16];
2026
2027         if (!GetCommState(infoPtr->handle, &dcb)) {
2028             if (interp != NULL) {
2029                 TclWinConvertError(GetLastError());
2030                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2031                         "can't get comm state: %s", Tcl_PosixError(interp)));
2032             }
2033             return TCL_ERROR;
2034         }
2035
2036         valid = 1;
2037         parity = 'n';
2038         if (dcb.Parity <= 4) {
2039             parity = "noems"[dcb.Parity];
2040         }
2041         stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
2042                 (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
2043
2044         wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
2045                 dcb.ByteSize, stop);
2046         Tcl_DStringAppendElement(dsPtr, buf);
2047     }
2048
2049     /*
2050      * Get option -pollinterval
2051      */
2052
2053     if (len == 0) {
2054         Tcl_DStringAppendElement(dsPtr, "-pollinterval");
2055     }
2056     if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
2057         char buf[TCL_INTEGER_SPACE + 1];
2058
2059         valid = 1;
2060         wsprintfA(buf, "%d", infoPtr->blockTime);
2061         Tcl_DStringAppendElement(dsPtr, buf);
2062     }
2063
2064     /*
2065      * Get option -sysbuffer
2066      */
2067
2068     if (len == 0) {
2069         Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
2070         Tcl_DStringStartSublist(dsPtr);
2071     }
2072     if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
2073         char buf[TCL_INTEGER_SPACE + 1];
2074         valid = 1;
2075
2076         wsprintfA(buf, "%d", infoPtr->sysBufRead);
2077         Tcl_DStringAppendElement(dsPtr, buf);
2078         wsprintfA(buf, "%d", infoPtr->sysBufWrite);
2079         Tcl_DStringAppendElement(dsPtr, buf);
2080     }
2081     if (len == 0) {
2082         Tcl_DStringEndSublist(dsPtr);
2083     }
2084
2085     /*
2086      * Get option -xchar
2087      */
2088
2089     if (len == 0) {
2090         Tcl_DStringAppendElement(dsPtr, "-xchar");
2091         Tcl_DStringStartSublist(dsPtr);
2092     }
2093     if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
2094         char buf[4];
2095         valid = 1;
2096
2097         if (!GetCommState(infoPtr->handle, &dcb)) {
2098             if (interp != NULL) {
2099                 TclWinConvertError(GetLastError());
2100                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2101                         "can't get comm state: %s", Tcl_PosixError(interp)));
2102             }
2103             return TCL_ERROR;
2104         }
2105         sprintf(buf, "%c", dcb.XonChar);
2106         Tcl_DStringAppendElement(dsPtr, buf);
2107         sprintf(buf, "%c", dcb.XoffChar);
2108         Tcl_DStringAppendElement(dsPtr, buf);
2109     }
2110     if (len == 0) {
2111         Tcl_DStringEndSublist(dsPtr);
2112     }
2113
2114     /*
2115      * Get option -lasterror
2116      *
2117      * Option is readonly and returned by [fconfigure chan -lasterror] but not
2118      * returned by unnamed [fconfigure chan].
2119      */
2120
2121     if (len>1 && strncmp(optionName, "-lasterror", len)==0) {
2122         valid = 1;
2123         SerialErrorStr(infoPtr->lastError, dsPtr);
2124     }
2125
2126     /*
2127      * get option -queue
2128      *
2129      * Option is readonly and returned by [fconfigure chan -queue].
2130      */
2131
2132     if (len>1 && strncmp(optionName, "-queue", len)==0) {
2133         char buf[TCL_INTEGER_SPACE + 1];
2134         COMSTAT cStat;
2135         DWORD error;
2136         int inBuffered, outBuffered, count;
2137
2138         valid = 1;
2139
2140         /*
2141          * Query the pending data in Tcl's internal queues.
2142          */
2143
2144         inBuffered  = Tcl_InputBuffered(infoPtr->channel);
2145         outBuffered = Tcl_OutputBuffered(infoPtr->channel);
2146
2147         /*
2148          * Query the number of bytes in our output queue:
2149          *     1. The bytes pending in the output thread
2150          *     2. The bytes in the system drivers buffer
2151          * The writer thread should not interfere this action.
2152          */
2153
2154         EnterCriticalSection(&infoPtr->csWrite);
2155         ClearCommError(infoPtr->handle, &error, &cStat);
2156         count = (int) cStat.cbOutQue + infoPtr->writeQueue;
2157         LeaveCriticalSection(&infoPtr->csWrite);
2158
2159         wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
2160         Tcl_DStringAppendElement(dsPtr, buf);
2161         wsprintfA(buf, "%d", outBuffered + count);
2162         Tcl_DStringAppendElement(dsPtr, buf);
2163     }
2164
2165     /*
2166      * get option -ttystatus
2167      *
2168      * Option is readonly and returned by [fconfigure chan -ttystatus] but not
2169      * returned by unnamed [fconfigure chan].
2170      */
2171
2172     if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
2173         DWORD status;
2174
2175         if (!GetCommModemStatus(infoPtr->handle, &status)) {
2176             if (interp != NULL) {
2177                 TclWinConvertError(GetLastError());
2178                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2179                         "can't get tty status: %s", Tcl_PosixError(interp)));
2180             }
2181             return TCL_ERROR;
2182         }
2183         valid = 1;
2184         SerialModemStatusStr(status, dsPtr);
2185     }
2186
2187     if (valid) {
2188         return TCL_OK;
2189     }
2190     return Tcl_BadChannelOption(interp, optionName,
2191             "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
2192 }
2193 \f
2194 /*
2195  *----------------------------------------------------------------------
2196  *
2197  * SerialThreadActionProc --
2198  *
2199  *      Insert or remove any thread local refs to this channel.
2200  *
2201  * Results:
2202  *      None.
2203  *
2204  * Side effects:
2205  *      Changes thread local list of valid channels.
2206  *
2207  *----------------------------------------------------------------------
2208  */
2209
2210 static void
2211 SerialThreadActionProc(
2212     ClientData instanceData,
2213     int action)
2214 {
2215     SerialInfo *infoPtr = (SerialInfo *) instanceData;
2216
2217     /*
2218      * We do not access firstSerialPtr in the thread structures. This is not
2219      * for all serials managed by the thread, but only those we are watching.
2220      * Removal of the filevent handlers before transfer thus takes care of
2221      * this structure.
2222      */
2223
2224     Tcl_MutexLock(&serialMutex);
2225     if (action == TCL_CHANNEL_THREAD_INSERT) {
2226         /*
2227          * We can't copy the thread information from the channel when the
2228          * channel is created. At this time the channel back pointer has not
2229          * been set yet. However in that case the threadId has already been
2230          * set by TclpCreateCommandChannel itself, so the structure is still
2231          * good.
2232          */
2233
2234         SerialInit();
2235         if (infoPtr->channel != NULL) {
2236             infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
2237         }
2238     } else {
2239         infoPtr->threadId = NULL;
2240     }
2241     Tcl_MutexUnlock(&serialMutex);
2242 }
2243 \f
2244 /*
2245  * Local Variables:
2246  * mode: c
2247  * c-basic-offset: 4
2248  * fill-column: 78
2249  * End:
2250  */