os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinChan.c
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
     1 /* 
     2  * tclWinChan.c
     3  *
     4  *	Channel drivers for Windows channels based on files, command
     5  *	pipes and TCP sockets.
     6  *
     7  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
     8  *
     9  * See the file "license.terms" for information on usage and redistribution
    10  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    11  *
    12  * RCS: @(#) $Id: tclWinChan.c,v 1.30.2.5 2006/08/30 17:53:28 hobbs Exp $
    13  */
    14 
    15 #include "tclWinInt.h"
    16 #include "tclIO.h"
    17 
    18 /*
    19  * State flags used in the info structures below.
    20  */
    21 
    22 #define FILE_PENDING	(1<<0)	/* Message is pending in the queue. */
    23 #define FILE_ASYNC	(1<<1)	/* Channel is non-blocking. */
    24 #define FILE_APPEND	(1<<2)	/* File is in append mode. */
    25 
    26 #define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
    27 #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
    28 
    29 /*
    30  * The following structure contains per-instance data for a file based channel.
    31  */
    32 
    33 typedef struct FileInfo {
    34     Tcl_Channel channel;	/* Pointer to channel structure. */
    35     int validMask;		/* OR'ed combination of TCL_READABLE,
    36 				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
    37 				 * which operations are valid on the file. */
    38     int watchMask;		/* OR'ed combination of TCL_READABLE,
    39 				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
    40 				 * which events should be reported. */
    41     int flags;			/* State flags, see above for a list. */
    42     HANDLE handle;		/* Input/output file. */
    43     struct FileInfo *nextPtr;	/* Pointer to next registered file. */
    44     int dirty;                  /* Boolean flag. Set if the OS may have data
    45 				 * pending on the channel */
    46 } FileInfo;
    47 
    48 typedef struct ThreadSpecificData {
    49     /*
    50      * List of all file channels currently open.
    51      */
    52 
    53     FileInfo *firstFilePtr;
    54 } ThreadSpecificData;
    55 
    56 static Tcl_ThreadDataKey dataKey;
    57 
    58 /*
    59  * The following structure is what is added to the Tcl event queue when
    60  * file events are generated.
    61  */
    62 
    63 typedef struct FileEvent {
    64     Tcl_Event header;		/* Information that is standard for
    65 				 * all events. */
    66     FileInfo *infoPtr;		/* Pointer to file info structure.  Note
    67 				 * that we still have to verify that the
    68 				 * file exists before dereferencing this
    69 				 * pointer. */
    70 } FileEvent;
    71 
    72 /*
    73  * Static routines for this file:
    74  */
    75 
    76 static int		FileBlockProc _ANSI_ARGS_((ClientData instanceData,
    77 			    int mode));
    78 static void		FileChannelExitHandler _ANSI_ARGS_((
    79 		            ClientData clientData));
    80 static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
    81 			    int flags));
    82 static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
    83 		            Tcl_Interp *interp));
    84 static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, 
    85 			    int flags));
    86 static int		FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
    87 		            int direction, ClientData *handlePtr));
    88 static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
    89 static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
    90 	            	    char *buf, int toRead, int *errorCode));
    91 static int		FileOutputProc _ANSI_ARGS_((ClientData instanceData,
    92 			    CONST char *buf, int toWrite, int *errorCode));
    93 static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
    94 			    long offset, int mode, int *errorCode));
    95 static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
    96 			    Tcl_WideInt offset, int mode, int *errorCode));
    97 static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
    98 			    int flags));
    99 static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
   100 		            int mask));
   101 static void             FileThreadActionProc _ANSI_ARGS_ ((
   102 			   ClientData instanceData, int action));
   103 static DWORD		FileGetType _ANSI_ARGS_((HANDLE handle));
   104 
   105 /*
   106  * This structure describes the channel type structure for file based IO.
   107  */
   108 
   109 static Tcl_ChannelType fileChannelType = {
   110     "file",			/* Type name. */
   111     TCL_CHANNEL_VERSION_4,	/* v4 channel */
   112     FileCloseProc,		/* Close proc. */
   113     FileInputProc,		/* Input proc. */
   114     FileOutputProc,		/* Output proc. */
   115     FileSeekProc,		/* Seek proc. */
   116     NULL,			/* Set option proc. */
   117     NULL,			/* Get option proc. */
   118     FileWatchProc,		/* Set up the notifier to watch the channel. */
   119     FileGetHandleProc,		/* Get an OS handle from channel. */
   120     NULL,			/* close2proc. */
   121     FileBlockProc,		/* Set blocking or non-blocking mode.*/
   122     NULL,			/* flush proc. */
   123     NULL,			/* handler proc. */
   124     FileWideSeekProc,		/* Wide seek proc. */
   125     FileThreadActionProc,	/* Thread action proc. */
   126 };
   127 
   128 #ifdef HAVE_NO_SEH
   129 
   130 /*
   131  * Unlike Borland and Microsoft, we don't register exception handlers
   132  * by pushing registration records onto the runtime stack.  Instead, we
   133  * register them by creating an EXCEPTION_REGISTRATION within the activation
   134  * record.
   135  */
   136 
   137 typedef struct EXCEPTION_REGISTRATION {
   138     struct EXCEPTION_REGISTRATION* link;
   139     EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
   140 				      struct _CONTEXT*, void* );
   141     void* ebp;
   142     void* esp;
   143     int status;
   144 } EXCEPTION_REGISTRATION;
   145 
   146 #endif
   147 
   148 /*
   149  *----------------------------------------------------------------------
   150  *
   151  * FileInit --
   152  *
   153  *	This function creates the window used to simulate file events.
   154  *
   155  * Results:
   156  *	None.
   157  *
   158  * Side effects:
   159  *	Creates a new window and creates an exit handler. 
   160  *
   161  *----------------------------------------------------------------------
   162  */
   163 
   164 static ThreadSpecificData *
   165 FileInit()
   166 {
   167     ThreadSpecificData *tsdPtr =
   168 	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
   169     if (tsdPtr == NULL) {
   170 	tsdPtr = TCL_TSD_INIT(&dataKey);
   171 	tsdPtr->firstFilePtr = NULL;
   172 	Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
   173 	Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
   174     }
   175     return tsdPtr;
   176 }
   177 
   178 /*
   179  *----------------------------------------------------------------------
   180  *
   181  * FileChannelExitHandler --
   182  *
   183  *	This function is called to cleanup the channel driver before
   184  *	Tcl is unloaded.
   185  *
   186  * Results:
   187  *	None.
   188  *
   189  * Side effects:
   190  *	Destroys the communication window.
   191  *
   192  *----------------------------------------------------------------------
   193  */
   194 
   195 static void
   196 FileChannelExitHandler(clientData)
   197     ClientData clientData;	/* Old window proc */
   198 {
   199     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
   200 }
   201 
   202 /*
   203  *----------------------------------------------------------------------
   204  *
   205  * FileSetupProc --
   206  *
   207  *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
   208  *	for an event.
   209  *
   210  * Results:
   211  *	None.
   212  *
   213  * Side effects:
   214  *	Adjusts the block time if needed.
   215  *
   216  *----------------------------------------------------------------------
   217  */
   218 
   219 void
   220 FileSetupProc(data, flags)
   221     ClientData data;		/* Not used. */
   222     int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
   223 {
   224     FileInfo *infoPtr;
   225     Tcl_Time blockTime = { 0, 0 };
   226     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
   227 
   228     if (!(flags & TCL_FILE_EVENTS)) {
   229 	return;
   230     }
   231     
   232     /*
   233      * Check to see if there is a ready file.  If so, poll.
   234      */
   235 
   236     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
   237 	    infoPtr = infoPtr->nextPtr) {
   238 	if (infoPtr->watchMask) {
   239 	    Tcl_SetMaxBlockTime(&blockTime);
   240 	    break;
   241 	}
   242     }
   243 }
   244 
   245 /*
   246  *----------------------------------------------------------------------
   247  *
   248  * FileCheckProc --
   249  *
   250  *	This procedure is called by Tcl_DoOneEvent to check the file
   251  *	event source for events. 
   252  *
   253  * Results:
   254  *	None.
   255  *
   256  * Side effects:
   257  *	May queue an event.
   258  *
   259  *----------------------------------------------------------------------
   260  */
   261 
   262 static void
   263 FileCheckProc(data, flags)
   264     ClientData data;		/* Not used. */
   265     int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
   266 {
   267     FileEvent *evPtr;
   268     FileInfo *infoPtr;
   269     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
   270 
   271     if (!(flags & TCL_FILE_EVENTS)) {
   272 	return;
   273     }
   274     
   275     /*
   276      * Queue events for any ready files that don't already have events
   277      * queued (caused by persistent states that won't generate WinSock
   278      * events).
   279      */
   280 
   281     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
   282 	    infoPtr = infoPtr->nextPtr) {
   283 	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
   284 	    infoPtr->flags |= FILE_PENDING;
   285 	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
   286 	    evPtr->header.proc = FileEventProc;
   287 	    evPtr->infoPtr = infoPtr;
   288 	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
   289 	}
   290     }
   291 }
   292 
   293 /*----------------------------------------------------------------------
   294  *
   295  * FileEventProc --
   296  *
   297  *	This function is invoked by Tcl_ServiceEvent when a file event
   298  *	reaches the front of the event queue.  This procedure invokes
   299  *	Tcl_NotifyChannel on the file.
   300  *
   301  * Results:
   302  *	Returns 1 if the event was handled, meaning it should be removed
   303  *	from the queue.  Returns 0 if the event was not handled, meaning
   304  *	it should stay on the queue.  The only time the event isn't
   305  *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
   306  *
   307  * Side effects:
   308  *	Whatever the notifier callback does.
   309  *
   310  *----------------------------------------------------------------------
   311  */
   312 
   313 static int
   314 FileEventProc(evPtr, flags)
   315     Tcl_Event *evPtr;		/* Event to service. */
   316     int flags;			/* Flags that indicate what events to
   317 				 * handle, such as TCL_FILE_EVENTS. */
   318 {
   319     FileEvent *fileEvPtr = (FileEvent *)evPtr;
   320     FileInfo *infoPtr;
   321     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
   322 
   323     if (!(flags & TCL_FILE_EVENTS)) {
   324 	return 0;
   325     }
   326 
   327     /*
   328      * Search through the list of watched files for the one whose handle
   329      * matches the event.  We do this rather than simply dereferencing
   330      * the handle in the event so that files can be deleted while the
   331      * event is in the queue.
   332      */
   333 
   334     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
   335 	    infoPtr = infoPtr->nextPtr) {
   336 	if (fileEvPtr->infoPtr == infoPtr) {
   337 	    infoPtr->flags &= ~(FILE_PENDING);
   338 	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
   339 	    break;
   340 	}
   341     }
   342     return 1;
   343 }
   344 
   345 /*
   346  *----------------------------------------------------------------------
   347  *
   348  * FileBlockProc --
   349  *
   350  *	Set blocking or non-blocking mode on channel.
   351  *
   352  * Results:
   353  *	0 if successful, errno when failed.
   354  *
   355  * Side effects:
   356  *	Sets the device into blocking or non-blocking mode.
   357  *
   358  *----------------------------------------------------------------------
   359  */
   360 
   361 static int
   362 FileBlockProc(instanceData, mode)
   363     ClientData instanceData;	/* Instance data for channel. */
   364     int mode;			/* TCL_MODE_BLOCKING or
   365                                  * TCL_MODE_NONBLOCKING. */
   366 {
   367     FileInfo *infoPtr = (FileInfo *) instanceData;
   368     
   369     /*
   370      * Files on Windows can not be switched between blocking and nonblocking,
   371      * hence we have to emulate the behavior. This is done in the input
   372      * function by checking against a bit in the state. We set or unset the
   373      * bit here to cause the input function to emulate the correct behavior.
   374      */
   375 
   376     if (mode == TCL_MODE_NONBLOCKING) {
   377 	infoPtr->flags |= FILE_ASYNC;
   378     } else {
   379 	infoPtr->flags &= ~(FILE_ASYNC);
   380     }
   381     return 0;
   382 }
   383 
   384 /*
   385  *----------------------------------------------------------------------
   386  *
   387  * FileCloseProc --
   388  *
   389  *	Closes the IO channel.
   390  *
   391  * Results:
   392  *	0 if successful, the value of errno if failed.
   393  *
   394  * Side effects:
   395  *	Closes the physical channel
   396  *
   397  *----------------------------------------------------------------------
   398  */
   399 
   400 static int
   401 FileCloseProc(instanceData, interp)
   402     ClientData instanceData;	/* Pointer to FileInfo structure. */
   403     Tcl_Interp *interp;		/* Not used. */
   404 {
   405     FileInfo *fileInfoPtr = (FileInfo *) instanceData;
   406     FileInfo *infoPtr;
   407     ThreadSpecificData *tsdPtr;
   408     int errorCode = 0;
   409 
   410     /*
   411      * Remove the file from the watch list.
   412      */
   413 
   414     FileWatchProc(instanceData, 0);
   415 
   416     /*
   417      * Don't close the Win32 handle if the handle is a standard channel
   418      * during the thread exit process.  Otherwise, one thread may kill
   419      * the stdio of another.
   420      */
   421 
   422     if (!TclInThreadExit() 
   423 	    || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
   424 		&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
   425 		&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
   426 	if (CloseHandle(fileInfoPtr->handle) == FALSE) {
   427 	    TclWinConvertError(GetLastError());
   428 	    errorCode = errno;
   429 	}
   430     }
   431 
   432     /*
   433      * See if this FileInfo* is still on the thread local list.
   434      */
   435     tsdPtr = TCL_TSD_INIT(&dataKey);
   436     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
   437 	    infoPtr = infoPtr->nextPtr) {
   438 	if (infoPtr == fileInfoPtr) {
   439             /*
   440              * This channel exists on the thread local list. It should
   441              * have been removed by an earlier Thread Action call,
   442              * but do that now since just deallocating fileInfoPtr would
   443              * leave an deallocated pointer on the thread local list.
   444              */
   445 	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
   446             break;
   447         }
   448     }
   449     ckfree((char *)fileInfoPtr);
   450     return errorCode;
   451 }
   452 
   453 /*
   454  *----------------------------------------------------------------------
   455  *
   456  * FileSeekProc --
   457  *
   458  *	Seeks on a file-based channel. Returns the new position.
   459  *
   460  * Results:
   461  *	-1 if failed, the new position if successful. If failed, it
   462  *	also sets *errorCodePtr to the error code.
   463  *
   464  * Side effects:
   465  *	Moves the location at which the channel will be accessed in
   466  *	future operations.
   467  *
   468  *----------------------------------------------------------------------
   469  */
   470 
   471 static int
   472 FileSeekProc(instanceData, offset, mode, errorCodePtr)
   473     ClientData instanceData;	/* File state. */
   474     long offset;		/* Offset to seek to. */
   475     int mode;			/* Relative to where should we seek? */
   476     int *errorCodePtr;		/* To store error code. */
   477 {
   478     FileInfo *infoPtr = (FileInfo *) instanceData;
   479     DWORD moveMethod;
   480     DWORD newPos, newPosHigh;
   481     DWORD oldPos, oldPosHigh;
   482 
   483     *errorCodePtr = 0;
   484     if (mode == SEEK_SET) {
   485         moveMethod = FILE_BEGIN;
   486     } else if (mode == SEEK_CUR) {
   487         moveMethod = FILE_CURRENT;
   488     } else {
   489         moveMethod = FILE_END;
   490     }
   491 
   492     /*
   493      * Save our current place in case we need to roll-back the seek.
   494      */
   495     oldPosHigh = (DWORD)0;
   496     oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
   497 	    FILE_CURRENT);
   498     if (oldPos == INVALID_SET_FILE_POINTER) {
   499 	DWORD winError = GetLastError();
   500 	if (winError != NO_ERROR) {
   501 	    TclWinConvertError(winError);
   502 	    *errorCodePtr = errno;
   503 	    return -1;
   504 	}
   505     }
   506 
   507     newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
   508     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
   509 			    moveMethod);
   510     if (newPos == INVALID_SET_FILE_POINTER) {
   511 	DWORD winError = GetLastError();
   512 	if (winError != NO_ERROR) {
   513 	    TclWinConvertError(winError);
   514 	    *errorCodePtr = errno;
   515 	    return -1;
   516 	}
   517     }
   518 
   519     /*
   520      * Check for expressability in our return type, and roll-back otherwise.
   521      */
   522     if (newPosHigh != 0) {
   523 	*errorCodePtr = EOVERFLOW;
   524 	SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
   525 	return -1;
   526     }
   527     return (int) newPos;
   528 }
   529 
   530 /*
   531  *----------------------------------------------------------------------
   532  *
   533  * FileWideSeekProc --
   534  *
   535  *	Seeks on a file-based channel. Returns the new position.
   536  *
   537  * Results:
   538  *	-1 if failed, the new position if successful. If failed, it
   539  *	also sets *errorCodePtr to the error code.
   540  *
   541  * Side effects:
   542  *	Moves the location at which the channel will be accessed in
   543  *	future operations.
   544  *
   545  *----------------------------------------------------------------------
   546  */
   547 
   548 static Tcl_WideInt
   549 FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
   550     ClientData instanceData;	/* File state. */
   551     Tcl_WideInt offset;		/* Offset to seek to. */
   552     int mode;			/* Relative to where should we seek? */
   553     int *errorCodePtr;		/* To store error code. */
   554 {
   555     FileInfo *infoPtr = (FileInfo *) instanceData;
   556     DWORD moveMethod;
   557     DWORD newPos, newPosHigh;
   558 
   559     *errorCodePtr = 0;
   560     if (mode == SEEK_SET) {
   561         moveMethod = FILE_BEGIN;
   562     } else if (mode == SEEK_CUR) {
   563         moveMethod = FILE_CURRENT;
   564     } else {
   565         moveMethod = FILE_END;
   566     }
   567 
   568     newPosHigh = (DWORD)(offset >> 32);
   569     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
   570 			    moveMethod);
   571     if (newPos == INVALID_SET_FILE_POINTER) {
   572 	DWORD winError = GetLastError();
   573 	if (winError != NO_ERROR) {
   574 	    TclWinConvertError(winError);
   575 	    *errorCodePtr = errno;
   576 	    return -1;
   577 	}
   578     }
   579     return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
   580 }
   581 
   582 /*
   583  *----------------------------------------------------------------------
   584  *
   585  * FileInputProc --
   586  *
   587  *	Reads input from the IO channel into the buffer given. Returns
   588  *	count of how many bytes were actually read, and an error indication.
   589  *
   590  * Results:
   591  *	A count of how many bytes were read is returned and an error
   592  *	indication is returned in an output argument.
   593  *
   594  * Side effects:
   595  *	Reads input from the actual channel.
   596  *
   597  *----------------------------------------------------------------------
   598  */
   599 
   600 static int
   601 FileInputProc(instanceData, buf, bufSize, errorCode)
   602     ClientData instanceData;		/* File state. */
   603     char *buf;				/* Where to store data read. */
   604     int bufSize;			/* How much space is available
   605                                          * in the buffer? */
   606     int *errorCode;			/* Where to store error code. */
   607 {
   608     FileInfo *infoPtr;
   609     DWORD bytesRead;
   610 
   611     *errorCode = 0;
   612     infoPtr = (FileInfo *) instanceData;
   613 
   614     /*
   615      * Note that we will block on reads from a console buffer until a
   616      * full line has been entered.  The only way I know of to get
   617      * around this is to write a console driver.  We should probably
   618      * do this at some point, but for now, we just block.  The same
   619      * problem exists for files being read over the network.
   620      */
   621 
   622     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
   623             (LPOVERLAPPED) NULL) != FALSE) {
   624 	return bytesRead;
   625     }
   626     
   627     TclWinConvertError(GetLastError());
   628     *errorCode = errno;
   629     if (errno == EPIPE) {
   630 	return 0;
   631     }
   632     return -1;
   633 }
   634 
   635 /*
   636  *----------------------------------------------------------------------
   637  *
   638  * FileOutputProc --
   639  *
   640  *	Writes the given output on the IO channel. Returns count of how
   641  *	many characters were actually written, and an error indication.
   642  *
   643  * Results:
   644  *	A count of how many characters were written is returned and an
   645  *	error indication is returned in an output argument.
   646  *
   647  * Side effects:
   648  *	Writes output on the actual channel.
   649  *
   650  *----------------------------------------------------------------------
   651  */
   652 
   653 static int
   654 FileOutputProc(instanceData, buf, toWrite, errorCode)
   655     ClientData instanceData;		/* File state. */
   656     CONST char *buf;			/* The data buffer. */
   657     int toWrite;			/* How many bytes to write? */
   658     int *errorCode;			/* Where to store error code. */
   659 {
   660     FileInfo *infoPtr = (FileInfo *) instanceData;
   661     DWORD bytesWritten;
   662     
   663     *errorCode = 0;
   664 
   665     /*
   666      * If we are writing to a file that was opened with O_APPEND, we need to
   667      * seek to the end of the file before writing the current buffer.
   668      */
   669 
   670     if (infoPtr->flags & FILE_APPEND) {
   671         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
   672     }
   673 
   674     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
   675             (LPOVERLAPPED) NULL) == FALSE) {
   676         TclWinConvertError(GetLastError());
   677         *errorCode = errno;
   678         return -1;
   679     }
   680     infoPtr->dirty = 1;
   681     return bytesWritten;
   682 }
   683 
   684 /*
   685  *----------------------------------------------------------------------
   686  *
   687  * FileWatchProc --
   688  *
   689  *	Called by the notifier to set up to watch for events on this
   690  *	channel.
   691  *
   692  * Results:
   693  *	None.
   694  *
   695  * Side effects:
   696  *	None.
   697  *
   698  *----------------------------------------------------------------------
   699  */
   700 
   701 static void
   702 FileWatchProc(instanceData, mask)
   703     ClientData instanceData;		/* File state. */
   704     int mask;				/* What events to watch for; OR-ed
   705                                          * combination of TCL_READABLE,
   706                                          * TCL_WRITABLE and TCL_EXCEPTION. */
   707 {
   708     FileInfo *infoPtr = (FileInfo *) instanceData;
   709     Tcl_Time blockTime = { 0, 0 };
   710 
   711     /*
   712      * Since the file is always ready for events, we set the block time
   713      * to zero so we will poll.
   714      */
   715 
   716     infoPtr->watchMask = mask & infoPtr->validMask;
   717     if (infoPtr->watchMask) {
   718 	Tcl_SetMaxBlockTime(&blockTime);
   719     }
   720 }
   721 
   722 /*
   723  *----------------------------------------------------------------------
   724  *
   725  * FileGetHandleProc --
   726  *
   727  *	Called from Tcl_GetChannelHandle to retrieve OS handles from
   728  *	a file based channel.
   729  *
   730  * Results:
   731  *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
   732  *	there is no handle for the specified direction. 
   733  *
   734  * Side effects:
   735  *	None.
   736  *
   737  *----------------------------------------------------------------------
   738  */
   739 
   740 static int
   741 FileGetHandleProc(instanceData, direction, handlePtr)
   742     ClientData instanceData;	/* The file state. */
   743     int direction;		/* TCL_READABLE or TCL_WRITABLE */
   744     ClientData *handlePtr;	/* Where to store the handle.  */
   745 {
   746     FileInfo *infoPtr = (FileInfo *) instanceData;
   747 
   748     if (direction & infoPtr->validMask) {
   749 	*handlePtr = (ClientData) infoPtr->handle;
   750 	return TCL_OK;
   751     } else {
   752 	return TCL_ERROR;
   753     }
   754 }
   755 
   756 
   757 /*
   758  *----------------------------------------------------------------------
   759  *
   760  * TclpOpenFileChannel --
   761  *
   762  *	Open an File based channel on Unix systems.
   763  *
   764  * Results:
   765  *	The new channel or NULL. If NULL, the output argument
   766  *	errorCodePtr is set to a POSIX error.
   767  *
   768  * Side effects:
   769  *	May open the channel and may cause creation of a file on the
   770  *	file system.
   771  *
   772  *----------------------------------------------------------------------
   773  */
   774 
   775 Tcl_Channel
   776 TclpOpenFileChannel(interp, pathPtr, mode, permissions)
   777     Tcl_Interp *interp;			/* Interpreter for error reporting;
   778                                          * can be NULL. */
   779     Tcl_Obj *pathPtr;			/* Name of file to open. */
   780     int mode;				/* POSIX mode. */
   781     int permissions;			/* If the open involves creating a
   782                                          * file, with what modes to create
   783                                          * it? */
   784 {
   785     Tcl_Channel channel = 0;
   786     int channelPermissions;
   787     DWORD accessMode, createMode, shareMode, flags;
   788     CONST TCHAR *nativeName;
   789     HANDLE handle;
   790     char channelName[16 + TCL_INTEGER_SPACE];
   791     TclFile readFile = NULL;
   792     TclFile writeFile = NULL;
   793 
   794     nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
   795     if (nativeName == NULL) {
   796 	return NULL;
   797     }
   798     
   799     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
   800 	case O_RDONLY:
   801 	    accessMode = GENERIC_READ;
   802 	    channelPermissions = TCL_READABLE;
   803 	    break;
   804 	case O_WRONLY:
   805 	    accessMode = GENERIC_WRITE;
   806 	    channelPermissions = TCL_WRITABLE;
   807 	    break;
   808 	case O_RDWR:
   809 	    accessMode = (GENERIC_READ | GENERIC_WRITE);
   810 	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
   811 	    break;
   812 	default:
   813 	    panic("TclpOpenFileChannel: invalid mode value");
   814 	    break;
   815     }
   816 
   817     /*
   818      * Map the creation flags to the NT create mode.
   819      */
   820 
   821     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
   822 	case (O_CREAT | O_EXCL):
   823 	case (O_CREAT | O_EXCL | O_TRUNC):
   824 	    createMode = CREATE_NEW;
   825 	    break;
   826 	case (O_CREAT | O_TRUNC):
   827 	    createMode = CREATE_ALWAYS;
   828 	    break;
   829 	case O_CREAT:
   830 	    createMode = OPEN_ALWAYS;
   831 	    break;
   832 	case O_TRUNC:
   833 	case (O_TRUNC | O_EXCL):
   834 	    createMode = TRUNCATE_EXISTING;
   835 	    break;
   836 	default:
   837 	    createMode = OPEN_EXISTING;
   838 	    break;
   839     }
   840 
   841     /*
   842      * If the file is being created, get the file attributes from the
   843      * permissions argument, else use the existing file attributes.
   844      */
   845 
   846     if (mode & O_CREAT) {
   847         if (permissions & S_IWRITE) {
   848             flags = FILE_ATTRIBUTE_NORMAL;
   849         } else {
   850             flags = FILE_ATTRIBUTE_READONLY;
   851         }
   852     } else {
   853 	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
   854         if (flags == 0xFFFFFFFF) {
   855 	    flags = 0;
   856 	}
   857     }
   858 
   859     /*
   860      * Set up the file sharing mode.  We want to allow simultaneous access.
   861      */
   862 
   863     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
   864 
   865     /*
   866      * Now we get to create the file.
   867      */
   868 
   869     handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, 
   870 	    shareMode, NULL, createMode, flags, (HANDLE) NULL);
   871 
   872     if (handle == INVALID_HANDLE_VALUE) {
   873 	DWORD err;
   874 	err = GetLastError();
   875 	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
   876 	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
   877 	}
   878         TclWinConvertError(err);
   879 	if (interp != (Tcl_Interp *) NULL) {
   880             Tcl_AppendResult(interp, "couldn't open \"", 
   881 			     Tcl_GetString(pathPtr), "\": ",
   882 			     Tcl_PosixError(interp), (char *) NULL);
   883         }
   884         return NULL;
   885     }
   886     
   887     channel = NULL;
   888 
   889     switch ( FileGetType(handle) ) {
   890     case FILE_TYPE_SERIAL:
   891 	/*
   892 	 * Reopen channel for OVERLAPPED operation
   893 	 * Normally this shouldn't fail, because the channel exists
   894 	 */
   895 	handle = TclWinSerialReopen(handle, nativeName, accessMode);
   896 	if (handle == INVALID_HANDLE_VALUE) {
   897 	    TclWinConvertError(GetLastError());
   898 	    if (interp != (Tcl_Interp *) NULL) {
   899 		Tcl_AppendResult(interp, "couldn't reopen serial \"",
   900 			Tcl_GetString(pathPtr), "\": ",
   901 			Tcl_PosixError(interp), (char *) NULL);
   902 	    }
   903 	    return NULL;
   904 	}
   905 	channel = TclWinOpenSerialChannel(handle, channelName,
   906 	        channelPermissions);
   907 	break;
   908     case FILE_TYPE_CONSOLE:
   909 	channel = TclWinOpenConsoleChannel(handle, channelName,
   910 	        channelPermissions);
   911 	break;
   912     case FILE_TYPE_PIPE:
   913 	if (channelPermissions & TCL_READABLE) {
   914 	    readFile = TclWinMakeFile(handle);
   915 	}
   916 	if (channelPermissions & TCL_WRITABLE) {
   917 	    writeFile = TclWinMakeFile(handle);
   918 	}
   919 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
   920 	break;
   921     case FILE_TYPE_CHAR:
   922     case FILE_TYPE_DISK:
   923     case FILE_TYPE_UNKNOWN:
   924 	channel = TclWinOpenFileChannel(handle, channelName,
   925 					channelPermissions,
   926 					(mode & O_APPEND) ? FILE_APPEND : 0);
   927 	break;
   928 
   929     default:
   930 	/*
   931 	 * The handle is of an unknown type, probably /dev/nul equivalent
   932 	 * or possibly a closed handle.  
   933 	 */
   934 	
   935 	channel = NULL;
   936 	Tcl_AppendResult(interp, "couldn't open \"", 
   937 			 Tcl_GetString(pathPtr), "\": ",
   938 			 "bad file type", (char *) NULL);
   939 	break;
   940     }
   941 
   942     return channel;
   943 }
   944 
   945 /*
   946  *----------------------------------------------------------------------
   947  *
   948  * Tcl_MakeFileChannel --
   949  *
   950  *	Creates a Tcl_Channel from an existing platform specific file
   951  *	handle.
   952  *
   953  * Results:
   954  *	The Tcl_Channel created around the preexisting file.
   955  *
   956  * Side effects:
   957  *	None.
   958  *
   959  *----------------------------------------------------------------------
   960  */
   961 
   962 Tcl_Channel
   963 Tcl_MakeFileChannel(rawHandle, mode)
   964     ClientData rawHandle;	/* OS level handle */
   965     int mode;			/* ORed combination of TCL_READABLE and
   966                                  * TCL_WRITABLE to indicate file mode. */
   967 {
   968 #ifdef HAVE_NO_SEH
   969     EXCEPTION_REGISTRATION registration;
   970 #endif
   971     char channelName[16 + TCL_INTEGER_SPACE];
   972     Tcl_Channel channel = NULL;
   973     HANDLE handle = (HANDLE) rawHandle;
   974     HANDLE dupedHandle;
   975     TclFile readFile = NULL;
   976     TclFile writeFile = NULL;
   977     BOOL result;
   978 
   979     if (mode == 0) {
   980 	return NULL;
   981     }
   982 
   983     switch (FileGetType(handle))
   984     {
   985     case FILE_TYPE_SERIAL:
   986 	channel = TclWinOpenSerialChannel(handle, channelName, mode);
   987 	break;
   988     case FILE_TYPE_CONSOLE:
   989 	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
   990 	break;
   991     case FILE_TYPE_PIPE:
   992 	if (mode & TCL_READABLE)
   993 	{
   994 	    readFile = TclWinMakeFile(handle);
   995 	}
   996 	if (mode & TCL_WRITABLE)
   997 	{
   998 	    writeFile = TclWinMakeFile(handle);
   999 	}
  1000 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
  1001 	break;
  1002 
  1003     case FILE_TYPE_DISK:
  1004     case FILE_TYPE_CHAR:
  1005 	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
  1006 	break;
  1007 	
  1008     case FILE_TYPE_UNKNOWN:
  1009     default:
  1010 	/*
  1011 	 * The handle is of an unknown type.  Test the validity of this OS
  1012 	 * handle by duplicating it, then closing the dupe.  The Win32 API
  1013 	 * doesn't provide an IsValidHandle() function, so we have to emulate
  1014 	 * it here.  This test will not work on a console handle reliably,
  1015 	 * which is why we can't test every handle that comes into this
  1016 	 * function in this way.
  1017 	 */
  1018 
  1019 	result = DuplicateHandle(GetCurrentProcess(), handle,
  1020 		GetCurrentProcess(), &dupedHandle, 0, FALSE,
  1021 		DUPLICATE_SAME_ACCESS);
  1022 
  1023 	if (result == 0) {
  1024 	    /* 
  1025 	     * Unable to make a duplicate. It's definately invalid at this
  1026 	     * point.
  1027 	     */
  1028 
  1029 	    return NULL;
  1030 	}
  1031 
  1032 	/*
  1033 	 * Use structured exception handling (Win32 SEH) to protect the close
  1034 	 * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
  1035 	 */
  1036 
  1037 	result = 0;
  1038 #ifndef HAVE_NO_SEH
  1039 	__try {
  1040 	    CloseHandle(dupedHandle);
  1041 	    result = 1;
  1042 	} __except (EXCEPTION_EXECUTE_HANDLER) {}
  1043 #else
  1044 	/*
  1045 	 * Don't have SEH available, do things the hard way.
  1046 	 * Note that this needs to be one block of asm, to avoid stack
  1047 	 * imbalance; also, it is illegal for one asm block to contain 
  1048 	 * a jump to another.
  1049 	 */
  1050 	
  1051 	__asm__ __volatile__ (
  1052 
  1053 	    /*
  1054 	     * Pick up parameters before messing with the stack
  1055 	     */
  1056 
  1057 	    "movl       %[dupedHandle], %%ebx"          "\n\t"
  1058 
  1059 	    /*
  1060 	     * Construct an EXCEPTION_REGISTRATION to protect the
  1061 	     * call to CloseHandle
  1062 	     */
  1063 	    "leal       %[registration], %%edx"         "\n\t"
  1064 	    "movl       %%fs:0,         %%eax"          "\n\t"
  1065 	    "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
  1066 	    "leal       1f,             %%eax"          "\n\t"
  1067 	    "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
  1068 	    "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
  1069 	    "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
  1070 	    "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
  1071 	
  1072 	    /* Link the EXCEPTION_REGISTRATION on the chain */
  1073 	    
  1074 	    "movl       %%edx,          %%fs:0"         "\n\t"
  1075 	    
  1076 	    /* Call CloseHandle( dupedHandle ) */
  1077 	    
  1078 	    "pushl      %%ebx"                          "\n\t"
  1079 	    "call       _CloseHandle@4"                 "\n\t"
  1080 	    
  1081 	    /* 
  1082 	     * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
  1083 	     * and put a TRUE status return into it.
  1084 	     */
  1085 	    
  1086 	    "movl       %%fs:0,         %%edx"          "\n\t"
  1087 	    "movl	$1,		%%eax"		"\n\t"
  1088 	    "movl       %%eax,          0x10(%%edx)"    "\n\t"
  1089 	    "jmp        2f"                             "\n"
  1090 	    
  1091 	    /*
  1092 	     * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
  1093 	     */
  1094 	    
  1095 	    "1:"                                        "\t"
  1096 	    "movl       %%fs:0,         %%edx"          "\n\t"
  1097 	    "movl       0x8(%%edx),     %%edx"          "\n\t"
  1098 	    
  1099 	    /* 
  1100 	     * Come here however we exited.  Restore context from the
  1101 	     * EXCEPTION_REGISTRATION in case the stack is unbalanced.
  1102 	     */
  1103 	    
  1104 	    "2:"                                        "\t"
  1105 	    "movl       0xc(%%edx),     %%esp"          "\n\t"
  1106 	    "movl       0x8(%%edx),     %%ebp"          "\n\t"
  1107 	    "movl       0x0(%%edx),     %%eax"          "\n\t"
  1108 	    "movl       %%eax,          %%fs:0"         "\n\t"
  1109 	    
  1110 	    :
  1111 	    /* No outputs */
  1112 	    :
  1113 	    [registration]  "m"     (registration),
  1114 	    [dupedHandle]   "m"	    (dupedHandle)
  1115 	    :
  1116 	    "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
  1117 	    );
  1118 	result = registration.status;
  1119 
  1120 #endif
  1121 	if (result == FALSE) {
  1122 	    return NULL;
  1123 	}
  1124 
  1125 	/* Fall through, the handle is valid. */
  1126 
  1127 	/*
  1128 	 * Create the undefined channel, anyways, because we know the handle
  1129 	 * is valid to something.
  1130 	 */
  1131 
  1132 	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
  1133     }
  1134 
  1135     return channel;
  1136 }
  1137 
  1138 /*
  1139  *----------------------------------------------------------------------
  1140  *
  1141  * TclpGetDefaultStdChannel --
  1142  *
  1143  *	Constructs a channel for the specified standard OS handle.
  1144  *
  1145  * Results:
  1146  *	Returns the specified default standard channel, or NULL.
  1147  *
  1148  * Side effects:
  1149  *	May cause the creation of a standard channel and the underlying
  1150  *	file.
  1151  *
  1152  *----------------------------------------------------------------------
  1153  */
  1154 
  1155 Tcl_Channel
  1156 TclpGetDefaultStdChannel(type)
  1157     int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  1158 {
  1159     Tcl_Channel channel;
  1160     HANDLE handle;
  1161     int mode;
  1162     char *bufMode;
  1163     DWORD handleId;		/* Standard handle to retrieve. */
  1164 
  1165 
  1166     switch (type) {
  1167 	case TCL_STDIN:
  1168 	    handleId = STD_INPUT_HANDLE;
  1169 	    mode = TCL_READABLE;
  1170 	    bufMode = "line";
  1171 	    break;
  1172 	case TCL_STDOUT:
  1173 	    handleId = STD_OUTPUT_HANDLE;
  1174 	    mode = TCL_WRITABLE;
  1175 	    bufMode = "line";
  1176 	    break;
  1177 	case TCL_STDERR:
  1178 	    handleId = STD_ERROR_HANDLE;
  1179 	    mode = TCL_WRITABLE;
  1180 	    bufMode = "none";
  1181 	    break;
  1182 	default:
  1183 	    panic("TclGetDefaultStdChannel: Unexpected channel type");
  1184 	    break;
  1185     }
  1186 
  1187     handle = GetStdHandle(handleId);
  1188 
  1189     /*
  1190      * Note that we need to check for 0 because Windows may return 0 if this
  1191      * is not a console mode application, even though this is not a valid
  1192      * handle.
  1193      */
  1194 
  1195     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
  1196 	return (Tcl_Channel) NULL;
  1197     }
  1198 
  1199     channel = Tcl_MakeFileChannel(handle, mode);
  1200 
  1201     if (channel == NULL) {
  1202 	return (Tcl_Channel) NULL;
  1203     }
  1204 
  1205     /*
  1206      * Set up the normal channel options for stdio handles.
  1207      */
  1208 
  1209     if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
  1210             "auto") == TCL_ERROR)
  1211 	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
  1212 		    "\032 {}") == TCL_ERROR)
  1213 	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
  1214 		    "-buffering", bufMode) == TCL_ERROR)) {
  1215         Tcl_Close((Tcl_Interp *) NULL, channel);
  1216         return (Tcl_Channel) NULL;
  1217     }
  1218     return channel;
  1219 }
  1220 
  1221 
  1222 
  1223 /*
  1224  *----------------------------------------------------------------------
  1225  *
  1226  * TclWinOpenFileChannel --
  1227  *
  1228  *	Constructs a File channel for the specified standard OS handle.
  1229  *      This is a helper function to break up the construction of 
  1230  *      channels into File, Console, or Serial.
  1231  *
  1232  * Results:
  1233  *	Returns the new channel, or NULL.
  1234  *
  1235  * Side effects:
  1236  *	May open the channel and may cause creation of a file on the
  1237  *	file system.
  1238  *
  1239  *----------------------------------------------------------------------
  1240  */
  1241 
  1242 Tcl_Channel
  1243 TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
  1244     HANDLE handle;
  1245     char *channelName;
  1246     int permissions;
  1247     int appendMode;
  1248 {
  1249     FileInfo *infoPtr;
  1250     ThreadSpecificData *tsdPtr;
  1251 
  1252     tsdPtr = FileInit();
  1253 
  1254     /*
  1255      * See if a channel with this handle already exists.
  1256      */
  1257     
  1258     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
  1259 	 infoPtr = infoPtr->nextPtr) {
  1260 	if (infoPtr->handle == (HANDLE) handle) {
  1261 	    return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
  1262 	}
  1263     }
  1264 
  1265     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
  1266     /* TIP #218. Removed the code inserting the new structure
  1267      * into the global list. This is now handled in the thread
  1268      * action callbacks, and only there.
  1269      */
  1270     infoPtr->nextPtr = NULL;
  1271     infoPtr->validMask = permissions;
  1272     infoPtr->watchMask = 0;
  1273     infoPtr->flags = appendMode;
  1274     infoPtr->handle = handle;
  1275     infoPtr->dirty = 0;
  1276     wsprintfA(channelName, "file%lx", (int) infoPtr);
  1277     
  1278     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
  1279 	    (ClientData) infoPtr, permissions);
  1280     
  1281     /*
  1282      * Files have default translation of AUTO and ^Z eof char, which
  1283      * means that a ^Z will be accepted as EOF when reading.
  1284      */
  1285     
  1286     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
  1287     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
  1288 
  1289     return infoPtr->channel;
  1290 }
  1291 
  1292 
  1293 /*
  1294  *----------------------------------------------------------------------
  1295  *
  1296  * TclWinFlushDirtyChannels --
  1297  *
  1298  *	Flush all dirty channels to disk, so that requesting the
  1299  *	size of any file returns the correct value.
  1300  *
  1301  * Results:
  1302  *	None.
  1303  *
  1304  * Side effects:
  1305  *	Information is actually written to disk now, rather than
  1306  *	later.  Don't call this too often, or there will be a 
  1307  *	performance hit (i.e. only call when we need to ask for
  1308  *	the size of a file).
  1309  *
  1310  *----------------------------------------------------------------------
  1311  */
  1312 
  1313 void
  1314 TclWinFlushDirtyChannels ()
  1315 {
  1316     FileInfo *infoPtr;
  1317     ThreadSpecificData *tsdPtr;
  1318 
  1319     tsdPtr = FileInit();
  1320 
  1321     /*
  1322      * Flush all channels which are dirty, i.e. may have data pending
  1323      * in the OS
  1324      */
  1325     
  1326     for (infoPtr = tsdPtr->firstFilePtr;
  1327 	 infoPtr != NULL; 
  1328 	 infoPtr = infoPtr->nextPtr) {
  1329 	if (infoPtr->dirty) {
  1330 	    FlushFileBuffers(infoPtr->handle);
  1331 	    infoPtr->dirty = 0;
  1332 	}
  1333     }
  1334 }
  1335 
  1336 /*
  1337  *----------------------------------------------------------------------
  1338  *
  1339  * FileThreadActionProc --
  1340  *
  1341  *	Insert or remove any thread local refs to this channel.
  1342  *
  1343  * Results:
  1344  *	None.
  1345  *
  1346  * Side effects:
  1347  *	Changes thread local list of valid channels.
  1348  *
  1349  *----------------------------------------------------------------------
  1350  */
  1351 
  1352 static void
  1353 FileThreadActionProc (instanceData, action)
  1354      ClientData instanceData;
  1355      int action;
  1356 {
  1357     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  1358     FileInfo *infoPtr = (FileInfo *) instanceData;
  1359 
  1360     if (action == TCL_CHANNEL_THREAD_INSERT) {
  1361         infoPtr->nextPtr = tsdPtr->firstFilePtr;
  1362 	tsdPtr->firstFilePtr = infoPtr;
  1363     } else {
  1364         FileInfo **nextPtrPtr;
  1365 	int removed = 0;
  1366 
  1367 	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
  1368 	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
  1369 	    if ((*nextPtrPtr) == infoPtr) {
  1370 	        (*nextPtrPtr) = infoPtr->nextPtr;
  1371 		removed = 1;
  1372 		break;
  1373 	    }
  1374 	}
  1375 
  1376 	/*
  1377 	 * This could happen if the channel was created in one thread
  1378 	 * and then moved to another without updating the thread
  1379 	 * local data in each thread.
  1380 	 */
  1381 
  1382 	if (!removed) {
  1383 	    panic("file info ptr not on thread channel list");
  1384 	}
  1385     }
  1386 }
  1387 
  1388 
  1389 /*
  1390  *----------------------------------------------------------------------
  1391  *
  1392  * FileGetType --
  1393  *
  1394  *	Given a file handle, return its type
  1395  *
  1396  * Results:
  1397  *	None.
  1398  *
  1399  * Side effects:
  1400  *	None.
  1401  *
  1402  *----------------------------------------------------------------------
  1403  */
  1404 
  1405 DWORD
  1406 FileGetType(handle)
  1407     HANDLE handle; /* Opened file handle */
  1408 { 
  1409     DWORD type;
  1410     DWORD consoleParams;
  1411     DCB dcb;
  1412 
  1413     type = GetFileType(handle);
  1414 
  1415     /*
  1416      * If the file is a character device, we need to try to figure out
  1417      * whether it is a serial port, a console, or something else.  We
  1418      * test for the console case first because this is more common.
  1419      */
  1420     
  1421     if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) {
  1422 	    if (GetConsoleMode(handle, &consoleParams)) {
  1423 	      type = FILE_TYPE_CONSOLE;
  1424       } else {
  1425 	      dcb.DCBlength = sizeof( DCB ) ;
  1426 	      if (GetCommState(handle, &dcb)) {
  1427 		      type = FILE_TYPE_SERIAL;
  1428         }
  1429       }
  1430     }
  1431 
  1432     return type;
  1433 }