/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinpipe.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinpipe.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tcl_base/tclwinpipe.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinpipe.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinpipe.c,v 1.1.1.1 2001/06/13 04:49:50 dtashley Exp $ */  
   
 /*  
  * tclWinPipe.c --  
  *  
  *      This file implements the Windows-specific exec pipeline functions,  
  *      the "pipe" channel driver, and the "pid" Tcl command.  
  *  
  * Copyright (c) 1996-1997 by Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclwinpipe.c,v 1.1.1.1 2001/06/13 04:49:50 dtashley Exp $  
  */  
   
 #include "tclWinInt.h"  
   
 #include <dos.h>  
 #include <fcntl.h>  
 #include <io.h>  
 #include <sys/stat.h>  
   
 /*  
  * The following variable is used to tell whether this module has been  
  * initialized.  
  */  
   
 static int initialized = 0;  
   
 /*  
  * The pipeMutex locks around access to the initialized and procList variables,  
  * and it is used to protect background threads from being terminated while  
  * they are using APIs that hold locks.  
  */  
   
 TCL_DECLARE_MUTEX(pipeMutex)  
   
 /*  
  * The following defines identify the various types of applications that  
  * run under windows.  There is special case code for the various types.  
  */  
   
 #define APPL_NONE       0  
 #define APPL_DOS        1  
 #define APPL_WIN3X      2  
 #define APPL_WIN32      3  
   
 /*  
  * The following constants and structures are used to encapsulate the state  
  * of various types of files used in a pipeline.  
  * This used to have a 1 && 2 that supported Win32s.  
  */  
   
 #define WIN_FILE 3              /* Basic Win32 file. */  
   
 /*  
  * This structure encapsulates the common state associated with all file  
  * types used in a pipeline.  
  */  
   
 typedef struct WinFile {  
     int type;                   /* One of the file types defined above. */  
     HANDLE handle;              /* Open file handle. */  
 } WinFile;  
   
 /*  
  * This list is used to map from pids to process handles.  
  */  
   
 typedef struct ProcInfo {  
     HANDLE hProcess;  
     DWORD dwProcessId;  
     struct ProcInfo *nextPtr;  
 } ProcInfo;  
   
 static ProcInfo *procList;  
   
 /*  
  * Bit masks used in the flags field of the PipeInfo structure below.  
  */  
   
 #define PIPE_PENDING    (1<<0)  /* Message is pending in the queue. */  
 #define PIPE_ASYNC      (1<<1)  /* Channel is non-blocking. */  
   
 /*  
  * Bit masks used in the sharedFlags field of the PipeInfo structure below.  
  */  
   
 #define PIPE_EOF        (1<<2)  /* Pipe has reached EOF. */  
 #define PIPE_EXTRABYTE  (1<<3)  /* The reader thread has consumed one byte. */  
   
 /*  
  * This structure describes per-instance data for a pipe based channel.  
  */  
   
 typedef struct PipeInfo {  
     struct PipeInfo *nextPtr;   /* Pointer to next registered pipe. */  
     Tcl_Channel channel;        /* Pointer to channel structure. */  
     int validMask;              /* OR'ed combination of TCL_READABLE,  
                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates  
                                  * which operations are valid on the file. */  
     int watchMask;              /* OR'ed combination of TCL_READABLE,  
                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates  
                                  * which events should be reported. */  
     int flags;                  /* State flags, see above for a list. */  
     TclFile readFile;           /* Output from pipe. */  
     TclFile writeFile;          /* Input from pipe. */  
     TclFile errorFile;          /* Error output from pipe. */  
     int numPids;                /* Number of processes attached to pipe. */  
     Tcl_Pid *pidPtr;            /* Pids of attached processes. */  
     Tcl_ThreadId threadId;      /* Thread to which events should be reported.  
                                  * This value is used by the reader/writer  
                                  * threads. */  
     HANDLE writeThread;         /* Handle to writer thread. */  
     HANDLE readThread;          /* Handle to reader thread. */  
     HANDLE writable;            /* Manual-reset event to signal when the  
                                  * writer thread has finished waiting for  
                                  * the current buffer to be written. */  
     HANDLE readable;            /* Manual-reset event to signal when the  
                                  * reader thread has finished waiting for  
                                  * input. */  
     HANDLE startWriter;         /* Auto-reset event used by the main thread to  
                                  * signal when the writer thread should attempt  
                                  * to write to the pipe. */  
     HANDLE startReader;         /* Auto-reset event used by the main thread to  
                                  * signal when the reader thread should attempt  
                                  * to read from the pipe. */  
     DWORD writeError;           /* An error caused by the last background  
                                  * write.  Set to 0 if no error has been  
                                  * detected.  This word is shared with the  
                                  * writer thread so access must be  
                                  * synchronized with the writable object.  
                                  */  
     char *writeBuf;             /* Current background output buffer.  
                                  * Access is synchronized with the writable  
                                  * object. */  
     int writeBufLen;            /* Size of write buffer.  Access is  
                                  * synchronized with the writable  
                                  * object. */  
     int toWrite;                /* Current amount to be written.  Access is  
                                  * synchronized with the writable object. */  
     int readFlags;              /* Flags that are shared with the reader  
                                  * thread.  Access is synchronized with the  
                                  * readable object.  */  
     char extraByte;             /* Buffer for extra character consumed by  
                                  * reader thread.  This byte is shared with  
                                  * the reader thread so access must be  
                                  * synchronized with the readable object. */  
 } PipeInfo;  
   
 typedef struct ThreadSpecificData {  
     /*  
      * The following pointer refers to the head of the list of pipes  
      * that are being watched for file events.  
      */  
       
     PipeInfo *firstPipePtr;  
 } ThreadSpecificData;  
   
 static Tcl_ThreadDataKey dataKey;  
   
 /*  
  * The following structure is what is added to the Tcl event queue when  
  * pipe events are generated.  
  */  
   
 typedef struct PipeEvent {  
     Tcl_Event header;           /* Information that is standard for  
                                  * all events. */  
     PipeInfo *infoPtr;          /* Pointer to pipe info structure.  Note  
                                  * that we still have to verify that the  
                                  * pipe exists before dereferencing this  
                                  * pointer. */  
 } PipeEvent;  
   
 /*  
  * Declarations for functions used only in this file.  
  */  
   
 static int              ApplicationType(Tcl_Interp *interp,  
                             const char *fileName, char *fullName);  
 static void             BuildCommandLine(const char *executable, int argc,  
                             char **argv, Tcl_DString *linePtr);  
 static BOOL             HasConsole(void);  
 static int              PipeBlockModeProc(ClientData instanceData, int mode);  
 static void             PipeCheckProc(ClientData clientData, int flags);  
 static int              PipeClose2Proc(ClientData instanceData,  
                             Tcl_Interp *interp, int flags);  
 static int              PipeEventProc(Tcl_Event *evPtr, int flags);  
 static void             PipeExitHandler(ClientData clientData);  
 static int              PipeGetHandleProc(ClientData instanceData,  
                             int direction, ClientData *handlePtr);  
 static void             PipeInit(void);  
 static int              PipeInputProc(ClientData instanceData, char *buf,  
                             int toRead, int *errorCode);  
 static int              PipeOutputProc(ClientData instanceData, char *buf,  
                             int toWrite, int *errorCode);  
 static DWORD WINAPI     PipeReaderThread(LPVOID arg);  
 static void             PipeSetupProc(ClientData clientData, int flags);  
 static void             PipeWatchProc(ClientData instanceData, int mask);  
 static DWORD WINAPI     PipeWriterThread(LPVOID arg);  
 static void             ProcExitHandler(ClientData clientData);  
 static int              TempFileName(WCHAR name[MAX_PATH]);  
 static int              WaitForRead(PipeInfo *infoPtr, int blocking);  
   
 /*  
  * This structure describes the channel type structure for command pipe  
  * based IO.  
  */  
   
 static Tcl_ChannelType pipeChannelType = {  
     "pipe",                     /* Type name. */  
     PipeBlockModeProc,          /* Set blocking or non-blocking mode.*/  
     TCL_CLOSE2PROC,             /* Close proc. */  
     PipeInputProc,              /* Input proc. */  
     PipeOutputProc,             /* Output proc. */  
     NULL,                       /* Seek proc. */  
     NULL,                       /* Set option proc. */  
     NULL,                       /* Get option proc. */  
     PipeWatchProc,              /* Set up notifier to watch the channel. */  
     PipeGetHandleProc,          /* Get an OS handle from channel. */  
     PipeClose2Proc  
 };  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeInit --  
  *  
  *      This function initializes the static variables for this file.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Creates a new event source.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 PipeInit()  
 {  
     ThreadSpecificData *tsdPtr;  
   
     /*  
      * Check the initialized flag first, then check again in the mutex.  
      * This is a speed enhancement.  
      */  
   
     if (!initialized) {  
         Tcl_MutexLock(&pipeMutex);  
         if (!initialized) {  
             initialized = 1;  
             procList = NULL;  
             Tcl_CreateExitHandler(ProcExitHandler, NULL);  
         }  
         Tcl_MutexUnlock(&pipeMutex);  
     }  
   
     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);  
     if (tsdPtr == NULL) {  
         tsdPtr = TCL_TSD_INIT(&dataKey);  
         tsdPtr->firstPipePtr = NULL;  
         Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);  
         Tcl_CreateThreadExitHandler(PipeExitHandler, NULL);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeExitHandler --  
  *  
  *      This function is called to cleanup the pipe module before  
  *      Tcl is unloaded.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Removes the pipe event source.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 PipeExitHandler(  
     ClientData clientData)      /* Old window proc */  
 {  
     Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ProcExitHandler --  
  *  
  *      This function is called to cleanup the process list before  
  *      Tcl is unloaded.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Resets the process list.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ProcExitHandler(  
     ClientData clientData)      /* Old window proc */  
 {  
     Tcl_MutexLock(&pipeMutex);  
     initialized = 0;  
     Tcl_MutexUnlock(&pipeMutex);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeSetupProc --  
  *  
  *      This procedure is invoked before Tcl_DoOneEvent blocks waiting  
  *      for an event.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Adjusts the block time if needed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 PipeSetupProc(  
     ClientData data,            /* Not used. */  
     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */  
 {  
     PipeInfo *infoPtr;  
     Tcl_Time blockTime = { 0, 0 };  
     int block = 1;  
     WinFile *filePtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     if (!(flags & TCL_FILE_EVENTS)) {  
         return;  
     }  
       
     /*  
      * Look to see if any events are already pending.  If they are, poll.  
      */  
   
     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;  
             infoPtr = infoPtr->nextPtr) {  
         if (infoPtr->watchMask & TCL_WRITABLE) {  
             filePtr = (WinFile*) infoPtr->writeFile;  
             if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {  
                 block = 0;  
             }  
         }  
         if (infoPtr->watchMask & TCL_READABLE) {  
             filePtr = (WinFile*) infoPtr->readFile;  
             if (WaitForRead(infoPtr, 0) >= 0) {  
                 block = 0;  
             }  
         }  
     }  
     if (!block) {  
         Tcl_SetMaxBlockTime(&blockTime);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeCheckProc --  
  *  
  *      This procedure is called by Tcl_DoOneEvent to check the pipe  
  *      event source for events.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May queue an event.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 PipeCheckProc(  
     ClientData data,            /* Not used. */  
     int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */  
 {  
     PipeInfo *infoPtr;  
     PipeEvent *evPtr;  
     WinFile *filePtr;  
     int needEvent;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     if (!(flags & TCL_FILE_EVENTS)) {  
         return;  
     }  
       
     /*  
      * Queue events for any ready pipes that don't already have events  
      * queued.  
      */  
   
     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;  
             infoPtr = infoPtr->nextPtr) {  
         if (infoPtr->flags & PIPE_PENDING) {  
             continue;  
         }  
           
         /*  
          * Queue an event if the pipe is signaled for reading or writing.  
          */  
   
         needEvent = 0;  
         filePtr = (WinFile*) infoPtr->writeFile;  
         if ((infoPtr->watchMask & TCL_WRITABLE) &&  
                 (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {  
             needEvent = 1;  
         }  
           
         filePtr = (WinFile*) infoPtr->readFile;  
         if ((infoPtr->watchMask & TCL_READABLE) &&  
                 (WaitForRead(infoPtr, 0) >= 0)) {  
             needEvent = 1;  
         }  
   
         if (needEvent) {  
             infoPtr->flags |= PIPE_PENDING;  
             evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));  
             evPtr->header.proc = PipeEventProc;  
             evPtr->infoPtr = infoPtr;  
             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinMakeFile --  
  *  
  *      This function constructs a new TclFile from a given data and  
  *      type value.  
  *  
  * Results:  
  *      Returns a newly allocated WinFile as a TclFile.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 TclFile  
 TclWinMakeFile(  
     HANDLE handle)              /* Type-specific data. */  
 {  
     WinFile *filePtr;  
   
     filePtr = (WinFile *) ckalloc(sizeof(WinFile));  
     filePtr->type = WIN_FILE;  
     filePtr->handle = handle;  
   
     return (TclFile)filePtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TempFileName --  
  *  
  *      Gets a temporary file name and deals with the fact that the  
  *      temporary file path provided by Windows may not actually exist  
  *      if the TMP or TEMP environment variables refer to a  
  *      non-existent directory.  
  *  
  * Results:      
  *      0 if error, non-zero otherwise.  If non-zero is returned, the  
  *      name buffer will be filled with a name that can be used to  
  *      construct a temporary file.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 TempFileName(name)  
     WCHAR name[MAX_PATH];       /* Buffer in which name for temporary  
                                  * file gets stored. */  
 {  
     TCHAR *prefix;  
   
     prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";  
     if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {  
         if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,  
                 name) != 0) {  
             return 1;  
         }  
     }  
     if (tclWinProcs->useWide) {  
         ((WCHAR *) name)[0] = '.';  
         ((WCHAR *) name)[1] = '\0';  
     } else {  
         ((char *) name)[0] = '.';  
         ((char *) name)[1] = '\0';  
     }  
     return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,  
             name);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpMakeFile --  
  *  
  *      Make a TclFile from a channel.  
  *  
  * Results:  
  *      Returns a new TclFile or NULL on failure.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 TclFile  
 TclpMakeFile(channel, direction)  
     Tcl_Channel channel;        /* Channel to get file from. */  
     int direction;              /* Either TCL_READABLE or TCL_WRITABLE. */  
 {  
     HANDLE handle;  
   
     if (Tcl_GetChannelHandle(channel, direction,  
             (ClientData *) &handle) == TCL_OK) {  
         return TclWinMakeFile(handle);  
     } else {  
         return (TclFile) NULL;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpOpenFile --  
  *  
  *      This function opens files for use in a pipeline.  
  *  
  * Results:  
  *      Returns a newly allocated TclFile structure containing the  
  *      file handle.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 TclFile  
 TclpOpenFile(path, mode)  
     CONST char *path;           /* The name of the file to open. */  
     int mode;                   /* In what mode to open the file? */  
 {  
     HANDLE handle;  
     DWORD accessMode, createMode, shareMode, flags;  
     Tcl_DString ds;  
     TCHAR *nativePath;  
       
     /*  
      * Map the access bits to the NT access mode.  
      */  
   
     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {  
         case O_RDONLY:  
             accessMode = GENERIC_READ;  
             break;  
         case O_WRONLY:  
             accessMode = GENERIC_WRITE;  
             break;  
         case O_RDWR:  
             accessMode = (GENERIC_READ | GENERIC_WRITE);  
             break;  
         default:  
             TclWinConvertError(ERROR_INVALID_FUNCTION);  
             return NULL;  
     }  
   
     /*  
      * Map the creation flags to the NT create mode.  
      */  
   
     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {  
         case (O_CREAT | O_EXCL):  
         case (O_CREAT | O_EXCL | O_TRUNC):  
             createMode = CREATE_NEW;  
             break;  
         case (O_CREAT | O_TRUNC):  
             createMode = CREATE_ALWAYS;  
             break;  
         case O_CREAT:  
             createMode = OPEN_ALWAYS;  
             break;  
         case O_TRUNC:  
         case (O_TRUNC | O_EXCL):  
             createMode = TRUNCATE_EXISTING;  
             break;  
         default:  
             createMode = OPEN_EXISTING;  
             break;  
     }  
   
     nativePath = Tcl_WinUtfToTChar(path, -1, &ds);  
   
     /*  
      * If the file is not being created, use the existing file attributes.  
      */  
   
     flags = 0;  
     if (!(mode & O_CREAT)) {  
         flags = (*tclWinProcs->getFileAttributesProc)(nativePath);  
         if (flags == 0xFFFFFFFF) {  
             flags = 0;  
         }  
     }  
   
     /*  
      * Set up the file sharing mode.  We want to allow simultaneous access.  
      */  
   
     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;  
   
     /*  
      * Now we get to create the file.  
      */  
   
     handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,  
             shareMode, NULL, createMode, flags, NULL);  
     Tcl_DStringFree(&ds);  
   
     if (handle == INVALID_HANDLE_VALUE) {  
         DWORD err;  
           
         err = GetLastError();  
         if ((err & 0xffffL) == ERROR_OPEN_FAILED) {  
             err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;  
         }  
         TclWinConvertError(err);  
         return NULL;  
     }  
   
     /*  
      * Seek to the end of file if we are writing.  
      */  
   
     if (mode & O_WRONLY) {  
         SetFilePointer(handle, 0, NULL, FILE_END);  
     }  
   
     return TclWinMakeFile(handle);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCreateTempFile --  
  *  
  *      This function opens a unique file with the property that it  
  *      will be deleted when its file handle is closed.  The temporary  
  *      file is created in the system temporary directory.  
  *  
  * Results:  
  *      Returns a valid TclFile, or NULL on failure.  
  *  
  * Side effects:  
  *      Creates a new temporary file.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 TclFile  
 TclpCreateTempFile(contents)  
     CONST char *contents;       /* String to write into temp file, or NULL. */  
 {  
     WCHAR name[MAX_PATH];  
     CONST char *native;  
     Tcl_DString dstring;  
     HANDLE handle;  
   
     if (TempFileName(name) == 0) {  
         return NULL;  
     }  
   
     handle = (*tclWinProcs->createFileProc)((TCHAR *) name,  
             GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,  
             FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);  
     if (handle == INVALID_HANDLE_VALUE) {  
         goto error;  
     }  
   
     /*  
      * Write the file out, doing line translations on the way.  
      */  
   
     if (contents != NULL) {  
         DWORD result, length;  
         CONST char *p;  
   
         /*  
          * Convert the contents from UTF to native encoding  
          */  
         native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);  
           
         for (p = native; *p != '\0'; p++) {  
             if (*p == '\n') {  
                 length = p - native;  
                 if (length > 0) {  
                     if (!WriteFile(handle, native, length, &result, NULL)) {  
                         goto error;  
                     }  
                 }  
                 if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {  
                     goto error;  
                 }  
                 native = p+1;  
             }  
         }  
         length = p - native;  
         if (length > 0) {  
             if (!WriteFile(handle, native, length, &result, NULL)) {  
                 goto error;  
             }  
         }  
         Tcl_DStringFree(&dstring);  
         if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {  
             goto error;  
         }  
     }  
   
     return TclWinMakeFile(handle);  
   
   error:  
     /* Free the native representation of the contents if necessary */  
     if (contents != NULL) {  
         Tcl_DStringFree(&dstring);  
     }  
   
     TclWinConvertError(GetLastError());  
     CloseHandle(handle);  
     (*tclWinProcs->deleteFileProc)((TCHAR *) name);  
     return NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCreatePipe --  
  *  
  *      Creates an anonymous pipe.  
  *  
  * Results:  
  *      Returns 1 on success, 0 on failure.  
  *  
  * Side effects:  
  *      Creates a pipe.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclpCreatePipe(  
     TclFile *readPipe,  /* Location to store file handle for  
                                  * read side of pipe. */  
     TclFile *writePipe) /* Location to store file handle for  
                                  * write side of pipe. */  
 {  
     HANDLE readHandle, writeHandle;  
   
     if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {  
         *readPipe = TclWinMakeFile(readHandle);  
         *writePipe = TclWinMakeFile(writeHandle);  
         return 1;  
     }  
   
     TclWinConvertError(GetLastError());  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCloseFile --  
  *  
  *      Closes a pipeline file handle.  These handles are created by  
  *      TclpOpenFile, TclpCreatePipe, or TclpMakeFile.  
  *  
  * Results:  
  *      0 on success, -1 on failure.  
  *  
  * Side effects:  
  *      The file is closed and deallocated.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclpCloseFile(  
     TclFile file)       /* The file to close. */  
 {  
     WinFile *filePtr = (WinFile *) file;  
   
     switch (filePtr->type) {  
         case WIN_FILE:  
             /*  
              * Don't close the Win32 handle if the handle is a standard channel  
              * during the exit process.  Otherwise, one thread may kill the  
              * stdio of another.  
              */  
   
             if (!TclInExit()  
                     || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)  
                             && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)  
                             && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {  
                 if (CloseHandle(filePtr->handle) == FALSE) {  
                     TclWinConvertError(GetLastError());  
                     ckfree((char *) filePtr);  
                     return -1;  
                 }  
             }  
             break;  
   
         default:  
             panic("TclpCloseFile: unexpected file type");  
     }  
   
     ckfree((char *) filePtr);  
     return 0;  
 }  
   
 /*  
  *--------------------------------------------------------------------------  
  *  
  * TclpGetPid --  
  *  
  *      Given a HANDLE to a child process, return the process id for that  
  *      child process.  
  *  
  * Results:  
  *      Returns the process id for the child process.  If the pid was not  
  *      known by Tcl, either because the pid was not created by Tcl or the  
  *      child process has already been reaped, -1 is returned.  
  *  
  * Side effects:  
  *      None.  
  *  
  *--------------------------------------------------------------------------  
  */  
   
 unsigned long  
 TclpGetPid(  
     Tcl_Pid pid)                /* The HANDLE of the child process. */  
 {  
     ProcInfo *infoPtr;  
   
     Tcl_MutexLock(&pipeMutex);  
     for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {  
         if (infoPtr->hProcess == (HANDLE) pid) {  
             Tcl_MutexUnlock(&pipeMutex);  
             return infoPtr->dwProcessId;  
         }  
     }  
     Tcl_MutexUnlock(&pipeMutex);  
     return (unsigned long) -1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCreateProcess --  
  *  
  *      Create a child process that has the specified files as its  
  *      standard input, output, and error.  The child process runs  
  *      asynchronously under Windows NT and Windows 9x, and runs  
  *      with the same environment variables as the creating process.  
  *  
  *      The complete Windows search path is searched to find the specified  
  *      executable.  If an executable by the given name is not found,  
  *      automatically tries appending ".com", ".exe", and ".bat" to the  
  *      executable name.  
  *  
  * Results:  
  *      The return value is TCL_ERROR and an error message is left in  
  *      the interp's result if there was a problem creating the child  
  *      process.  Otherwise, the return value is TCL_OK and *pidPtr is  
  *      filled with the process id of the child process.  
  *  
  * Side effects:  
  *      A process is created.  
  *        
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclpCreateProcess(  
     Tcl_Interp *interp,         /* Interpreter in which to leave errors that  
                                  * occurred when creating the child process.  
                                  * Error messages from the child process  
                                  * itself are sent to errorFile. */  
     int argc,                   /* Number of arguments in following array. */  
     char **argv,                /* Array of argument strings.  argv[0]  
                                  * contains the name of the executable  
                                  * converted to native format (using the  
                                  * Tcl_TranslateFileName call).  Additional  
                                  * arguments have not been converted. */  
     TclFile inputFile,          /* If non-NULL, gives the file to use as  
                                  * input for the child process.  If inputFile  
                                  * file is not readable or is NULL, the child  
                                  * will receive no standard input. */  
     TclFile outputFile,         /* If non-NULL, gives the file that  
                                  * receives output from the child process.  If  
                                  * outputFile file is not writeable or is  
                                  * NULL, output from the child will be  
                                  * discarded. */  
     TclFile errorFile,          /* If non-NULL, gives the file that  
                                  * receives errors from the child process.  If  
                                  * errorFile file is not writeable or is NULL,  
                                  * errors from the child will be discarded.  
                                  * errorFile may be the same as outputFile. */  
     Tcl_Pid *pidPtr)            /* If this procedure is successful, pidPtr  
                                  * is filled with the process id of the child  
                                  * process. */  
 {  
     int result, applType, createFlags;  
     Tcl_DString cmdLine;        /* Complete command line (TCHAR). */  
     STARTUPINFOA startInfo;  
     PROCESS_INFORMATION procInfo;  
     SECURITY_ATTRIBUTES secAtts;  
     HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;  
     char execPath[MAX_PATH * TCL_UTF_MAX];  
     WinFile *filePtr;  
   
     PipeInit();  
   
     applType = ApplicationType(interp, argv[0], execPath);  
     if (applType == APPL_NONE) {  
         return TCL_ERROR;  
     }  
   
     result = TCL_ERROR;  
     Tcl_DStringInit(&cmdLine);  
     hProcess = GetCurrentProcess();  
   
     /*  
      * STARTF_USESTDHANDLES must be used to pass handles to child process.  
      * Using SetStdHandle() and/or dup2() only works when a console mode  
      * parent process is spawning an attached console mode child process.  
      */  
   
     ZeroMemory(&startInfo, sizeof(startInfo));  
     startInfo.cb = sizeof(startInfo);  
     startInfo.dwFlags   = STARTF_USESTDHANDLES;  
     startInfo.hStdInput = INVALID_HANDLE_VALUE;  
     startInfo.hStdOutput= INVALID_HANDLE_VALUE;  
     startInfo.hStdError = INVALID_HANDLE_VALUE;  
   
     secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);  
     secAtts.lpSecurityDescriptor = NULL;  
     secAtts.bInheritHandle = TRUE;  
   
     /*  
      * We have to check the type of each file, since we cannot duplicate  
      * some file types.    
      */  
   
     inputHandle = INVALID_HANDLE_VALUE;  
     if (inputFile != NULL) {  
         filePtr = (WinFile *)inputFile;  
         if (filePtr->type == WIN_FILE) {  
             inputHandle = filePtr->handle;  
         }  
     }  
     outputHandle = INVALID_HANDLE_VALUE;  
     if (outputFile != NULL) {  
         filePtr = (WinFile *)outputFile;  
         if (filePtr->type == WIN_FILE) {  
             outputHandle = filePtr->handle;  
         }  
     }  
     errorHandle = INVALID_HANDLE_VALUE;  
     if (errorFile != NULL) {  
         filePtr = (WinFile *)errorFile;  
         if (filePtr->type == WIN_FILE) {  
             errorHandle = filePtr->handle;  
         }  
     }  
   
     /*  
      * Duplicate all the handles which will be passed off as stdin, stdout  
      * and stderr of the child process. The duplicate handles are set to  
      * be inheritable, so the child process can use them.  
      */  
   
     if (inputHandle == INVALID_HANDLE_VALUE) {  
         /*  
          * If handle was not set, stdin should return immediate EOF.  
          * Under Windows95, some applications (both 16 and 32 bit!)  
          * cannot read from the NUL device; they read from console  
          * instead.  When running tk, this is fatal because the child  
          * process would hang forever waiting for EOF from the unmapped  
          * console window used by the helper application.  
          *  
          * Fortunately, the helper application detects a closed pipe  
          * as an immediate EOF and can pass that information to the  
          * child process.  
          */  
   
         if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {  
             CloseHandle(h);  
         }  
     } else {  
         DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,  
                 0, TRUE, DUPLICATE_SAME_ACCESS);  
     }  
     if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {  
         TclWinConvertError(GetLastError());  
         Tcl_AppendResult(interp, "couldn't duplicate input handle: ",  
                 Tcl_PosixError(interp), (char *) NULL);  
         goto end;  
     }  
   
     if (outputHandle == INVALID_HANDLE_VALUE) {  
         /*  
          * If handle was not set, output should be sent to an infinitely  
          * deep sink.  Under Windows 95, some 16 bit applications cannot  
          * have stdout redirected to NUL; they send their output to  
          * the console instead.  Some applications, like "more" or "dir /p",  
          * when outputting multiple pages to the console, also then try and  
          * read from the console to go the next page.  When running tk, this  
          * is fatal because the child process would hang forever waiting  
          * for input from the unmapped console window used by the helper  
          * application.  
          *  
          * Fortunately, the helper application will detect a closed pipe  
          * as a sink.  
          */  
   
         if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)  
                 && (applType == APPL_DOS)) {  
             if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {  
                 CloseHandle(h);  
             }  
         } else {  
             startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,  
                     &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);  
         }  
     } else {  
         DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput,  
                 0, TRUE, DUPLICATE_SAME_ACCESS);  
     }  
     if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {  
         TclWinConvertError(GetLastError());  
         Tcl_AppendResult(interp, "couldn't duplicate output handle: ",  
                 Tcl_PosixError(interp), (char *) NULL);  
         goto end;  
     }  
   
     if (errorHandle == INVALID_HANDLE_VALUE) {  
         /*  
          * If handle was not set, errors should be sent to an infinitely  
          * deep sink.  
          */  
   
         startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,  
                 &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);  
     } else {  
         DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,  
                 0, TRUE, DUPLICATE_SAME_ACCESS);  
     }  
     if (startInfo.hStdError == INVALID_HANDLE_VALUE) {  
         TclWinConvertError(GetLastError());  
         Tcl_AppendResult(interp, "couldn't duplicate error handle: ",  
                 Tcl_PosixError(interp), (char *) NULL);  
         goto end;  
     }  
     /*  
      * If we do not have a console window, then we must run DOS and  
      * WIN32 console mode applications as detached processes. This tells  
      * the loader that the child application should not inherit the  
      * console, and that it should not create a new console window for  
      * the child application.  The child application should get its stdio  
      * from the redirection handles provided by this application, and run  
      * in the background.  
      *  
      * If we are starting a GUI process, they don't automatically get a  
      * console, so it doesn't matter if they are started as foreground or  
      * detached processes.  The GUI window will still pop up to the  
      * foreground.  
      */  
   
     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {  
         if (HasConsole()) {  
             createFlags = 0;  
         } else if (applType == APPL_DOS) {  
             /*  
              * Under NT, 16-bit DOS applications will not run unless they  
              * can be attached to a console.  If we are running without a  
              * console, run the 16-bit program as an normal process inside  
              * of a hidden console application, and then run that hidden  
              * console as a detached process.  
              */  
   
             startInfo.wShowWindow = SW_HIDE;  
             startInfo.dwFlags |= STARTF_USESHOWWINDOW;  
             createFlags = CREATE_NEW_CONSOLE;  
             Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1);  
         } else {  
             createFlags = DETACHED_PROCESS;  
         }  
     } else {  
         if (HasConsole()) {  
             createFlags = 0;  
         } else {  
             createFlags = DETACHED_PROCESS;  
         }  
           
         if (applType == APPL_DOS) {  
             /*  
              * Under Windows 95, 16-bit DOS applications do not work well  
              * with pipes:  
              *  
              * 1. EOF on a pipe between a detached 16-bit DOS application  
              * and another application is not seen at the other  
              * end of the pipe, so the listening process blocks forever on  
              * reads.  This inablity to detect EOF happens when either a  
              * 16-bit app or the 32-bit app is the listener.    
              *  
              * 2. If a 16-bit DOS application (detached or not) blocks when  
              * writing to a pipe, it will never wake up again, and it  
              * eventually brings the whole system down around it.  
              *  
              * The 16-bit application is run as a normal process inside  
              * of a hidden helper console app, and this helper may be run  
              * as a detached process.  If any of the stdio handles is  
              * a pipe, the helper application accumulates information  
              * into temp files and forwards it to or from the DOS  
              * application as appropriate.  This means that DOS apps  
              * must receive EOF from a stdin pipe before they will actually  
              * begin, and must finish generating stdout or stderr before  
              * the data will be sent to the next stage of the pipe.  
              *  
              * The helper app should be located in the same directory as  
              * the tcl dll.  
              */  
   
             if (createFlags != 0) {  
                 startInfo.wShowWindow = SW_HIDE;  
                 startInfo.dwFlags |= STARTF_USESHOWWINDOW;  
                 createFlags = CREATE_NEW_CONSOLE;  
             }  
             Tcl_DStringAppend(&cmdLine, "tclpip" STRINGIFY(TCL_MAJOR_VERSION)  
                     STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);  
         }  
     }  
       
     /*  
      * cmdLine gets the full command line used to invoke the executable,  
      * including the name of the executable itself.  The command line  
      * arguments in argv[] are stored in cmdLine separated by spaces.  
      * Special characters in individual arguments from argv[] must be  
      * quoted when being stored in cmdLine.  
      *  
      * When calling any application, bear in mind that arguments that  
      * specify a path name are not converted.  If an argument contains  
      * forward slashes as path separators, it may or may not be  
      * recognized as a path name, depending on the program.  In general,  
      * most applications accept forward slashes only as option  
      * delimiters and backslashes only as paths.  
      *  
      * Additionally, when calling a 16-bit dos or windows application,  
      * all path names must use the short, cryptic, path format (e.g.,  
      * using ab~1.def instead of "a b.default").    
      */  
   
     BuildCommandLine(execPath, argc, argv, &cmdLine);  
   
     if ((*tclWinProcs->createProcessProc)(NULL,  
             (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,  
             createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {  
         TclWinConvertError(GetLastError());  
         Tcl_AppendResult(interp, "couldn't execute \"", argv[0],  
                 "\": ", Tcl_PosixError(interp), (char *) NULL);  
         goto end;  
     }  
   
     /*  
      * This wait is used to force the OS to give some time to the DOS  
      * process.  
      */  
   
     if (applType == APPL_DOS) {  
         WaitForSingleObject(procInfo.hProcess, 50);  
     }  
   
     /*  
      * "When an application spawns a process repeatedly, a new thread  
      * instance will be created for each process but the previous  
      * instances may not be cleaned up.  This results in a significant  
      * virtual memory loss each time the process is spawned.  If there  
      * is a WaitForInputIdle() call between CreateProcess() and  
      * CloseHandle(), the problem does not occur." PSS ID Number: Q124121  
      */  
   
     WaitForInputIdle(procInfo.hProcess, 5000);  
     CloseHandle(procInfo.hThread);  
   
     *pidPtr = (Tcl_Pid) procInfo.hProcess;  
     if (*pidPtr != 0) {  
         TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);  
     }  
     result = TCL_OK;  
   
     end:  
     Tcl_DStringFree(&cmdLine);  
     if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {  
         CloseHandle(startInfo.hStdInput);  
     }  
     if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {  
         CloseHandle(startInfo.hStdOutput);  
     }  
     if (startInfo.hStdError != INVALID_HANDLE_VALUE) {  
         CloseHandle(startInfo.hStdError);  
     }  
     return result;  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * HasConsole --  
  *  
  *      Determines whether the current application is attached to a  
  *      console.  
  *  
  * Results:  
  *      Returns TRUE if this application has a console, else FALSE.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static BOOL  
 HasConsole()  
 {  
     HANDLE handle;  
       
     handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,  
             NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);  
   
     if (handle != INVALID_HANDLE_VALUE) {  
         CloseHandle(handle);  
         return TRUE;  
     } else {  
         return FALSE;  
     }  
 }  
   
 /*  
  *--------------------------------------------------------------------  
  *  
  * ApplicationType --  
  *  
  *      Search for the specified program and identify if it refers to a DOS,  
  *      Windows 3.X, or Win32 program.  Used to determine how to invoke  
  *      a program, or if it can even be invoked.  
  *  
  *      It is possible to almost positively identify DOS and Windows  
  *      applications that contain the appropriate magic numbers.  However,  
  *      DOS .com files do not seem to contain a magic number; if the program  
  *      name ends with .com and could not be identified as a Windows .com  
  *      file, it will be assumed to be a DOS application, even if it was  
  *      just random data.  If the program name does not end with .com, no  
  *      such assumption is made.  
  *  
  *      The Win32 procedure GetBinaryType incorrectly identifies any  
  *      junk file that ends with .exe as a dos executable and some  
  *      executables that don't end with .exe as not executable.  Plus it  
  *      doesn't exist under win95, so I won't feel bad about reimplementing  
  *      functionality.  
  *  
  * Results:  
  *      The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32  
  *      if the filename referred to the corresponding application type.  
  *      If the file name could not be found or did not refer to any known  
  *      application type, APPL_NONE is returned and an error message is  
  *      left in interp.  .bat files are identified as APPL_DOS.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ApplicationType(interp, originalName, fullName)  
     Tcl_Interp *interp;         /* Interp, for error message. */  
     const char *originalName;   /* Name of the application to find. */  
     char fullName[];            /* Filled with complete path to  
                                  * application. */  
 {  
     int applType, i, nameLen, found;  
     HANDLE hFile;  
     TCHAR *rest;  
     char *ext;  
     char buf[2];  
     DWORD attr, read;  
     IMAGE_DOS_HEADER header;  
     Tcl_DString nameBuf, ds;  
     TCHAR *nativeName;  
     WCHAR nativeFullPath[MAX_PATH];  
     static char extensions[][5] = {"", ".com", ".exe", ".bat"};  
   
     /* Look for the program as an external program.  First try the name  
      * as it is, then try adding .com, .exe, and .bat, in that order, to  
      * the name, looking for an executable.  
      *  
      * Using the raw SearchPath() procedure doesn't do quite what is  
      * necessary.  If the name of the executable already contains a '.'  
      * character, it will not try appending the specified extension when  
      * searching (in other words, SearchPath will not find the program  
      * "a.b.exe" if the arguments specified "a.b" and ".exe").    
      * So, first look for the file as it is named.  Then manually append  
      * the extensions, looking for a match.    
      */  
   
     applType = APPL_NONE;  
     Tcl_DStringInit(&nameBuf);  
     Tcl_DStringAppend(&nameBuf, originalName, -1);  
     nameLen = Tcl_DStringLength(&nameBuf);  
   
     for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {  
         Tcl_DStringSetLength(&nameBuf, nameLen);  
         Tcl_DStringAppend(&nameBuf, extensions[i], -1);  
         nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),  
                 Tcl_DStringLength(&nameBuf), &ds);  
         found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,  
                 MAX_PATH, nativeFullPath, &rest);  
         Tcl_DStringFree(&ds);  
         if (found == 0) {  
             continue;  
         }  
   
         /*  
          * Ignore matches on directories or data files, return if identified  
          * a known type.  
          */  
   
         attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);  
         if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {  
             continue;  
         }  
         strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));  
         Tcl_DStringFree(&ds);  
   
         ext = strrchr(fullName, '.');  
         if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {  
             applType = APPL_DOS;  
             break;  
         }  
           
         hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,  
                 GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,  
                 FILE_ATTRIBUTE_NORMAL, NULL);  
         if (hFile == INVALID_HANDLE_VALUE) {  
             continue;  
         }  
   
         header.e_magic = 0;  
         ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);  
         if (header.e_magic != IMAGE_DOS_SIGNATURE) {  
             /*  
              * Doesn't have the magic number for relocatable executables.  If  
              * filename ends with .com, assume it's a DOS application anyhow.  
              * Note that we didn't make this assumption at first, because some  
              * supposed .com files are really 32-bit executables with all the  
              * magic numbers and everything.    
              */  
   
             CloseHandle(hFile);  
             if ((ext != NULL) && (strcmp(ext, ".com") == 0)) {  
                 applType = APPL_DOS;  
                 break;  
             }  
             continue;  
         }  
         if (header.e_lfarlc != sizeof(header)) {  
             /*  
              * All Windows 3.X and Win32 and some DOS programs have this value  
              * set here.  If it doesn't, assume that since it already had the  
              * other magic number it was a DOS application.  
              */  
   
             CloseHandle(hFile);  
             applType = APPL_DOS;  
             break;  
         }  
   
         /*  
          * The DWORD at header.e_lfanew points to yet another magic number.  
          */  
   
         buf[0] = '\0';  
         SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);  
         ReadFile(hFile, (void *) buf, 2, &read, NULL);  
         CloseHandle(hFile);  
   
         if ((buf[0] == 'N') && (buf[1] == 'E')) {  
             applType = APPL_WIN3X;  
         } else if ((buf[0] == 'P') && (buf[1] == 'E')) {  
             applType = APPL_WIN32;  
         } else {  
             /*  
              * Strictly speaking, there should be a test that there  
              * is an 'L' and 'E' at buf[0..1], to identify the type as  
              * DOS, but of course we ran into a DOS executable that  
              * _doesn't_ have the magic number -- specifically, one  
              * compiled using the Lahey Fortran90 compiler.  
              */  
   
             applType = APPL_DOS;  
         }  
         break;  
     }  
     Tcl_DStringFree(&nameBuf);  
   
     if (applType == APPL_NONE) {  
         TclWinConvertError(GetLastError());  
         Tcl_AppendResult(interp, "couldn't execute \"", originalName,  
                 "\": ", Tcl_PosixError(interp), (char *) NULL);  
         return APPL_NONE;  
     }  
   
     if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {  
         /*  
          * Replace long path name of executable with short path name for  
          * 16-bit applications.  Otherwise the application may not be able  
          * to correctly parse its own command line to separate off the  
          * application name from the arguments.  
          */  
   
         (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,  
                 nativeFullPath, MAX_PATH);  
         strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));  
         Tcl_DStringFree(&ds);  
     }  
     return applType;  
 }  
   
 /*      
  *----------------------------------------------------------------------  
  *  
  * BuildCommandLine --  
  *  
  *      The command line arguments are stored in linePtr separated  
  *      by spaces, in a form that CreateProcess() understands.  Special  
  *      characters in individual arguments from argv[] must be quoted  
  *      when being stored in cmdLine.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 BuildCommandLine(  
     CONST char *executable,     /* Full path of executable (including  
                                  * extension).  Replacement for argv[0]. */  
     int argc,                   /* Number of arguments. */  
     char **argv,                /* Argument strings in UTF. */  
     Tcl_DString *linePtr)       /* Initialized Tcl_DString that receives the  
                                  * command line (TCHAR). */  
 {  
     CONST char *arg, *start, *special;  
     int quote, i;  
     Tcl_DString ds;  
   
     Tcl_DStringInit(&ds);  
   
     /*  
      * Prime the path.  
      */  
       
     Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);  
       
     for (i = 0; i < argc; i++) {  
         if (i == 0) {  
             arg = executable;  
         } else {  
             arg = argv[i];  
             Tcl_DStringAppend(&ds, " ", 1);  
         }  
   
         quote = 0;  
         if (argv[i][0] == '\0') {  
             quote = 1;  
         } else {  
             for (start = argv[i]; *start != '\0'; start++) {  
                 if (isspace(*start)) { /* INTL: ISO space. */  
                     quote = 1;  
                     break;  
                 }  
             }  
         }  
         if (quote) {  
             Tcl_DStringAppend(&ds, "\"", 1);  
         }  
   
         start = arg;          
         for (special = arg; ; ) {  
             if ((*special == '\\') &&  
                     (special[1] == '\\' || special[1] == '"')) {  
                 Tcl_DStringAppend(&ds, start, special - start);  
                 start = special;  
                 while (1) {  
                     special++;  
                     if (*special == '"') {  
                         /*  
                          * N backslashes followed a quote -> insert  
                          * N * 2 + 1 backslashes then a quote.  
                          */  
   
                         Tcl_DStringAppend(&ds, start, special - start);  
                         break;  
                     }  
                     if (*special != '\\') {  
                         break;  
                     }  
                 }  
                 Tcl_DStringAppend(&ds, start, special - start);  
                 start = special;  
             }  
             if (*special == '"') {  
                 Tcl_DStringAppend(&ds, start, special - start);  
                 Tcl_DStringAppend(&ds, "\\\"", 2);  
                 start = special + 1;  
             }  
             if (*special == '\0') {  
                 break;  
             }  
             special++;  
         }  
         Tcl_DStringAppend(&ds, start, special - start);  
         if (quote) {  
             Tcl_DStringAppend(&ds, "\"", 1);  
         }  
     }  
     Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);  
     Tcl_DStringFree(&ds);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCreateCommandChannel --  
  *  
  *      This function is called by Tcl_OpenCommandChannel to perform  
  *      the platform specific channel initialization for a command  
  *      channel.  
  *  
  * Results:  
  *      Returns a new channel or NULL on failure.  
  *  
  * Side effects:  
  *      Allocates a new channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Channel  
 TclpCreateCommandChannel(  
     TclFile readFile,           /* If non-null, gives the file for reading. */  
     TclFile writeFile,          /* If non-null, gives the file for writing. */  
     TclFile errorFile,          /* If non-null, gives the file where errors  
                                  * can be read. */  
     int numPids,                /* The number of pids in the pid array. */  
     Tcl_Pid *pidPtr)            /* An array of process identifiers. */  
 {  
     char channelName[16 + TCL_INTEGER_SPACE];  
     int channelId;  
     DWORD id;  
     PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));  
   
     PipeInit();  
   
     infoPtr->watchMask = 0;  
     infoPtr->flags = 0;  
     infoPtr->readFlags = 0;  
     infoPtr->readFile = readFile;  
     infoPtr->writeFile = writeFile;  
     infoPtr->errorFile = errorFile;  
     infoPtr->numPids = numPids;  
     infoPtr->pidPtr = pidPtr;  
     infoPtr->writeBuf = 0;  
     infoPtr->writeBufLen = 0;  
     infoPtr->writeError = 0;  
   
     /*  
      * Use one of the fds associated with the channel as the  
      * channel id.  
      */  
   
     if (readFile) {  
         channelId = (int) ((WinFile*)readFile)->handle;  
     } else if (writeFile) {  
         channelId = (int) ((WinFile*)writeFile)->handle;  
     } else if (errorFile) {  
         channelId = (int) ((WinFile*)errorFile)->handle;  
     } else {  
         channelId = 0;  
     }  
   
     infoPtr->validMask = 0;  
   
     infoPtr->threadId = Tcl_GetCurrentThread();  
   
     if (readFile != NULL) {  
         /*  
          * Start the background reader thread.  
          */  
   
         infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);  
         infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);  
         infoPtr->readThread = CreateThread(NULL, 8000, PipeReaderThread,  
                 infoPtr, 0, &id);  
         SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);  
         infoPtr->validMask |= TCL_READABLE;  
     } else {  
         infoPtr->readThread = 0;  
     }  
     if (writeFile != NULL) {  
         /*  
          * Start the background writeer thwrite.  
          */  
   
         infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);  
         infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);  
         infoPtr->writeThread = CreateThread(NULL, 8000, PipeWriterThread,  
                 infoPtr, 0, &id);  
         SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);  
         infoPtr->validMask |= TCL_WRITABLE;  
     }  
   
     /*  
      * For backward compatibility with previous versions of Tcl, we  
      * use "file%d" as the base name for pipes even though it would  
      * be more natural to use "pipe%d".  
      * Use the pointer to keep the channel names unique, in case  
      * channels share handles (stdin/stdout).  
      */  
   
     wsprintfA(channelName, "file%lx", infoPtr);  
     infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,  
             (ClientData) infoPtr, infoPtr->validMask);  
   
     /*  
      * Pipes have AUTO translation mode on Windows and ^Z eof char, which  
      * means that a ^Z will be appended to them at close. This is needed  
      * for Windows programs that expect a ^Z at EOF.  
      */  
   
     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,  
             "-translation", "auto");  
     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,  
             "-eofchar", "\032 {}");  
     return infoPtr->channel;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclGetAndDetachPids --  
  *  
  *      Stores a list of the command PIDs for a command channel in  
  *      the interp's result.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Modifies the interp's result.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TclGetAndDetachPids(  
     Tcl_Interp *interp,  
     Tcl_Channel chan)  
 {  
     PipeInfo *pipePtr;  
     Tcl_ChannelType *chanTypePtr;  
     int i;  
     char buf[TCL_INTEGER_SPACE];  
   
     /*  
      * Punt if the channel is not a command channel.  
      */  
   
     chanTypePtr = Tcl_GetChannelType(chan);  
     if (chanTypePtr != &pipeChannelType) {  
         return;  
     }  
   
     pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);  
     for (i = 0; i < pipePtr->numPids; i++) {  
         wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));  
         Tcl_AppendElement(interp, buf);  
         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));  
     }  
     if (pipePtr->numPids > 0) {  
         ckfree((char *) pipePtr->pidPtr);  
         pipePtr->numPids = 0;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeBlockModeProc --  
  *  
  *      Set blocking or non-blocking mode on channel.  
  *  
  * Results:  
  *      0 if successful, errno when failed.  
  *  
  * Side effects:  
  *      Sets the device into blocking or non-blocking mode.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeBlockModeProc(  
     ClientData instanceData,    /* Instance data for channel. */  
     int mode)                   /* TCL_MODE_BLOCKING or  
                                  * TCL_MODE_NONBLOCKING. */  
 {  
     PipeInfo *infoPtr = (PipeInfo *) instanceData;  
       
     /*  
      * Pipes on Windows can not be switched between blocking and nonblocking,  
      * hence we have to emulate the behavior. This is done in the input  
      * function by checking against a bit in the state. We set or unset the  
      * bit here to cause the input function to emulate the correct behavior.  
      */  
   
     if (mode == TCL_MODE_NONBLOCKING) {  
         infoPtr->flags |= PIPE_ASYNC;  
     } else {  
         infoPtr->flags &= ~(PIPE_ASYNC);  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeClose2Proc --  
  *  
  *      Closes a pipe based IO channel.  
  *  
  * Results:  
  *      0 on success, errno otherwise.  
  *  
  * Side effects:  
  *      Closes the physical channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeClose2Proc(  
     ClientData instanceData,    /* Pointer to PipeInfo structure. */  
     Tcl_Interp *interp,         /* For error reporting. */  
     int flags)                  /* Flags that indicate which side to close. */  
 {  
     PipeInfo *pipePtr = (PipeInfo *) instanceData;  
     Tcl_Channel errChan;  
     int errorCode, result;  
     PipeInfo *infoPtr, **nextPtrPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     errorCode = 0;  
     if ((!flags || (flags == TCL_CLOSE_READ))  
             && (pipePtr->readFile != NULL)) {  
         /*  
          * Clean up the background thread if necessary.  Note that this  
          * must be done before we can close the file, since the  
          * thread may be blocking trying to read from the pipe.  
          */  
   
         if (pipePtr->readThread) {  
             /*  
              * Forcibly terminate the background thread.  We cannot rely on the  
              * thread to cleanly terminate itself because we have no way of  
              * closing the pipe handle without blocking in the case where the  
              * thread is in the middle of an I/O operation.  Note that we need  
              * to guard against terminating the thread while it is in the  
              * middle of Tcl_ThreadAlert because it won't be able to release  
              * the notifier lock.  
              */  
   
             Tcl_MutexLock(&pipeMutex);  
             TerminateThread(pipePtr->readThread, 0);  
   
             /*  
              * Wait for the thread to terminate.  This ensures that we are  
              * completely cleaned up before we leave this function.  
              */  
   
             WaitForSingleObject(pipePtr->readThread, INFINITE);  
             Tcl_MutexUnlock(&pipeMutex);  
   
             CloseHandle(pipePtr->readThread);  
             CloseHandle(pipePtr->readable);  
             CloseHandle(pipePtr->startReader);  
             pipePtr->readThread = NULL;  
         }  
         if (TclpCloseFile(pipePtr->readFile) != 0) {  
             errorCode = errno;  
         }  
         pipePtr->validMask &= ~TCL_READABLE;  
         pipePtr->readFile = NULL;  
     }  
     if ((!flags || (flags & TCL_CLOSE_WRITE))  
             && (pipePtr->writeFile != NULL)) {  
         /*  
          * Wait for the writer thread to finish the current buffer, then  
          * terminate the thread and close the handles.  If the channel is  
          * nonblocking, there should be no pending write operations.  
          */  
   
         if (pipePtr->writeThread) {  
             WaitForSingleObject(pipePtr->writable, INFINITE);  
   
             /*  
              * Forcibly terminate the background thread.  We cannot rely on the  
              * thread to cleanly terminate itself because we have no way of  
              * closing the pipe handle without blocking in the case where the  
              * thread is in the middle of an I/O operation.  Note that we need  
              * to guard against terminating the thread while it is in the  
              * middle of Tcl_ThreadAlert because it won't be able to release  
              * the notifier lock.  
              */  
   
             Tcl_MutexLock(&pipeMutex);  
             TerminateThread(pipePtr->writeThread, 0);  
   
             /*  
              * Wait for the thread to terminate.  This ensures that we are  
              * completely cleaned up before we leave this function.  
              */  
   
             WaitForSingleObject(pipePtr->writeThread, INFINITE);  
             Tcl_MutexUnlock(&pipeMutex);  
   
   
             CloseHandle(pipePtr->writeThread);  
             CloseHandle(pipePtr->writable);  
             CloseHandle(pipePtr->startWriter);  
             pipePtr->writeThread = NULL;  
         }  
         if (TclpCloseFile(pipePtr->writeFile) != 0) {  
             if (errorCode == 0) {  
                 errorCode = errno;  
             }  
         }  
         pipePtr->validMask &= ~TCL_WRITABLE;  
         pipePtr->writeFile = NULL;  
     }  
   
     pipePtr->watchMask &= pipePtr->validMask;  
   
     /*  
      * Don't free the channel if any of the flags were set.  
      */  
   
     if (flags) {  
         return errorCode;  
     }  
   
     /*  
      * Remove the file from the list of watched files.  
      */  
   
     for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;  
             infoPtr != NULL;  
             nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {  
         if (infoPtr == (PipeInfo *)pipePtr) {  
             *nextPtrPtr = infoPtr->nextPtr;  
             break;  
         }  
     }  
   
     /*  
      * Wrap the error file into a channel and give it to the cleanup  
      * routine.  
      */  
   
     if (pipePtr->errorFile) {  
         WinFile *filePtr;  
   
         filePtr = (WinFile*)pipePtr->errorFile;  
         errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,  
                 TCL_READABLE);  
         ckfree((char *) filePtr);  
     } else {  
         errChan = NULL;  
     }  
   
     result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,  
             errChan);  
   
     if (pipePtr->numPids > 0) {  
         ckfree((char *) pipePtr->pidPtr);  
     }  
   
     if (pipePtr->writeBuf != NULL) {  
         ckfree(pipePtr->writeBuf);  
     }  
   
     ckfree((char*) pipePtr);  
   
     if (errorCode == 0) {  
         return result;  
     }  
     return errorCode;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeInputProc --  
  *  
  *      Reads input from the IO channel into the buffer given. Returns  
  *      count of how many bytes were actually read, and an error indication.  
  *  
  * Results:  
  *      A count of how many bytes were read is returned and an error  
  *      indication is returned in an output argument.  
  *  
  * Side effects:  
  *      Reads input from the actual channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeInputProc(  
     ClientData instanceData,            /* Pipe state. */  
     char *buf,                          /* Where to store data read. */  
     int bufSize,                        /* How much space is available  
                                          * in the buffer? */  
     int *errorCode)                     /* Where to store error code. */  
 {  
     PipeInfo *infoPtr = (PipeInfo *) instanceData;  
     WinFile *filePtr = (WinFile*) infoPtr->readFile;  
     DWORD count, bytesRead = 0;  
     int result;  
   
     *errorCode = 0;  
     /*  
      * Synchronize with the reader thread.  
      */  
   
     result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1);  
   
     /*  
      * If an error occurred, return immediately.  
      */  
   
     if (result == -1) {  
         *errorCode = errno;  
         return -1;  
     }  
   
     if (infoPtr->readFlags & PIPE_EXTRABYTE) {  
         /*  
          * The reader thread consumed 1 byte as a side effect of  
          * waiting so we need to move it into the buffer.  
          */  
   
         *buf = infoPtr->extraByte;  
         infoPtr->readFlags &= ~PIPE_EXTRABYTE;  
         buf++;  
         bufSize--;  
         bytesRead = 1;  
   
         /*  
          * If further read attempts would block, return what we have.  
          */  
   
         if (result == 0) {  
             return bytesRead;  
         }  
     }  
   
     /*  
      * Attempt to read bufSize bytes.  The read will return immediately  
      * if there is any data available.  Otherwise it will block until  
      * at least one byte is available or an EOF occurs.  
      */  
   
     if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,  
             (LPOVERLAPPED) NULL) == TRUE) {  
         return bytesRead + count;  
     } else if (bytesRead) {  
         /*  
          * Ignore errors if we have data to return.  
          */  
   
         return bytesRead;  
     }  
   
     TclWinConvertError(GetLastError());  
     if (errno == EPIPE) {  
         infoPtr->readFlags |= PIPE_EOF;  
         return 0;  
     }  
     *errorCode = errno;  
     return -1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeOutputProc --  
  *  
  *      Writes the given output on the IO channel. Returns count of how  
  *      many characters were actually written, and an error indication.  
  *  
  * Results:  
  *      A count of how many characters were written is returned and an  
  *      error indication is returned in an output argument.  
  *  
  * Side effects:  
  *      Writes output on the actual channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeOutputProc(  
     ClientData instanceData,            /* Pipe state. */  
     char *buf,                          /* The data buffer. */  
     int toWrite,                        /* How many bytes to write? */  
     int *errorCode)                     /* Where to store error code. */  
 {  
     PipeInfo *infoPtr = (PipeInfo *) instanceData;  
     WinFile *filePtr = (WinFile*) infoPtr->writeFile;  
     DWORD bytesWritten, timeout;  
       
     *errorCode = 0;  
     timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;  
     if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {  
         /*  
          * The writer thread is blocked waiting for a write to complete  
          * and the channel is in non-blocking mode.  
          */  
   
         errno = EAGAIN;  
         goto error;  
     }  
       
     /*  
      * Check for a background error on the last write.  
      */  
   
     if (infoPtr->writeError) {  
         TclWinConvertError(infoPtr->writeError);  
         infoPtr->writeError = 0;  
         goto error;  
     }  
   
     if (infoPtr->flags & PIPE_ASYNC) {  
         /*  
          * The pipe is non-blocking, so copy the data into the output  
          * buffer and restart the writer thread.  
          */  
   
         if (toWrite > infoPtr->writeBufLen) {  
             /*  
              * Reallocate the buffer to be large enough to hold the data.  
              */  
   
             if (infoPtr->writeBuf) {  
                 ckfree(infoPtr->writeBuf);  
             }  
             infoPtr->writeBufLen = toWrite;  
             infoPtr->writeBuf = ckalloc(toWrite);  
         }  
         memcpy(infoPtr->writeBuf, buf, toWrite);  
         infoPtr->toWrite = toWrite;  
         ResetEvent(infoPtr->writable);  
         SetEvent(infoPtr->startWriter);  
         bytesWritten = toWrite;  
     } else {  
         /*  
          * In the blocking case, just try to write the buffer directly.  
          * This avoids an unnecessary copy.  
          */  
   
         if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,  
                 &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {  
             TclWinConvertError(GetLastError());  
             goto error;  
         }  
     }  
     return bytesWritten;  
   
     error:  
     *errorCode = errno;  
     return -1;  
   
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeEventProc --  
  *  
  *      This function is invoked by Tcl_ServiceEvent when a file event  
  *      reaches the front of the event queue.  This procedure invokes  
  *      Tcl_NotifyChannel on the pipe.  
  *  
  * Results:  
  *      Returns 1 if the event was handled, meaning it should be removed  
  *      from the queue.  Returns 0 if the event was not handled, meaning  
  *      it should stay on the queue.  The only time the event isn't  
  *      handled is if the TCL_FILE_EVENTS flag bit isn't set.  
  *  
  * Side effects:  
  *      Whatever the notifier callback does.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeEventProc(  
     Tcl_Event *evPtr,           /* Event to service. */  
     int flags)                  /* Flags that indicate what events to  
                                  * handle, such as TCL_FILE_EVENTS. */  
 {  
     PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;  
     PipeInfo *infoPtr;  
     WinFile *filePtr;  
     int mask;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     if (!(flags & TCL_FILE_EVENTS)) {  
         return 0;  
     }  
   
     /*  
      * Search through the list of watched pipes for the one whose handle  
      * matches the event.  We do this rather than simply dereferencing  
      * the handle in the event so that pipes can be deleted while the  
      * event is in the queue.  
      */  
   
     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;  
             infoPtr = infoPtr->nextPtr) {  
         if (pipeEvPtr->infoPtr == infoPtr) {  
             infoPtr->flags &= ~(PIPE_PENDING);  
             break;  
         }  
     }  
   
     /*  
      * Remove stale events.  
      */  
   
     if (!infoPtr) {  
         return 1;  
     }  
   
     /*  
      * Check to see if the pipe is readable.  Note  
      * that we can't tell if a pipe is writable, so we always report it  
      * as being writable unless we have detected EOF.  
      */  
   
     filePtr = (WinFile*) ((PipeInfo*)infoPtr)->writeFile;  
     mask = 0;  
     if ((infoPtr->watchMask & TCL_WRITABLE) &&  
             (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {  
         mask = TCL_WRITABLE;  
     }  
   
     filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;  
     if ((infoPtr->watchMask & TCL_READABLE) &&  
             (WaitForRead(infoPtr, 0) >= 0)) {  
         if (infoPtr->readFlags & PIPE_EOF) {  
             mask = TCL_READABLE;  
         } else {  
             mask |= TCL_READABLE;  
         }  
     }  
   
     /*  
      * Inform the channel of the events.  
      */  
   
     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);  
     return 1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeWatchProc --  
  *  
  *      Called by the notifier to set up to watch for events on this  
  *      channel.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 PipeWatchProc(  
     ClientData instanceData,            /* Pipe state. */  
     int mask)                           /* What events to watch for, OR-ed  
                                          * combination of TCL_READABLE,  
                                          * TCL_WRITABLE and TCL_EXCEPTION. */  
 {  
     PipeInfo **nextPtrPtr, *ptr;  
     PipeInfo *infoPtr = (PipeInfo *) instanceData;  
     int oldMask = infoPtr->watchMask;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     /*  
      * Since most of the work is handled by the background threads,  
      * we just need to update the watchMask and then force the notifier  
      * to poll once.  
      */  
   
     infoPtr->watchMask = mask & infoPtr->validMask;  
     if (infoPtr->watchMask) {  
         Tcl_Time blockTime = { 0, 0 };  
         if (!oldMask) {  
             infoPtr->nextPtr = tsdPtr->firstPipePtr;  
             tsdPtr->firstPipePtr = infoPtr;  
         }  
         Tcl_SetMaxBlockTime(&blockTime);  
     } else {  
         if (oldMask) {  
             /*  
              * Remove the pipe from the list of watched pipes.  
              */  
   
             for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;  
                  ptr != NULL;  
                  nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {  
                 if (infoPtr == ptr) {  
                     *nextPtrPtr = ptr->nextPtr;  
                     break;  
                 }  
             }  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeGetHandleProc --  
  *  
  *      Called from Tcl_GetChannelHandle to retrieve OS handles from  
  *      inside a command pipeline based channel.  
  *  
  * Results:  
  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if  
  *      there is no handle for the specified direction.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 PipeGetHandleProc(  
     ClientData instanceData,    /* The pipe state. */  
     int direction,              /* TCL_READABLE or TCL_WRITABLE */  
     ClientData *handlePtr)      /* Where to store the handle.  */  
 {  
     PipeInfo *infoPtr = (PipeInfo *) instanceData;  
     WinFile *filePtr;  
   
     if (direction == TCL_READABLE && infoPtr->readFile) {  
         filePtr = (WinFile*) infoPtr->readFile;  
         *handlePtr = (ClientData) filePtr->handle;  
         return TCL_OK;  
     }  
     if (direction == TCL_WRITABLE && infoPtr->writeFile) {  
         filePtr = (WinFile*) infoPtr->writeFile;  
         *handlePtr = (ClientData) filePtr->handle;  
         return TCL_OK;  
     }  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_WaitPid --  
  *  
  *      Emulates the waitpid system call.  
  *  
  * Results:  
  *      Returns 0 if the process is still alive, -1 on an error, or  
  *      the pid on a clean close.    
  *  
  * Side effects:  
  *      Unless WNOHANG is set and the wait times out, the process  
  *      information record will be deleted and the process handle  
  *      will be closed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Pid  
 Tcl_WaitPid(  
     Tcl_Pid pid,  
     int *statPtr,  
     int options)  
 {  
     ProcInfo *infoPtr, **prevPtrPtr;  
     int flags;  
     Tcl_Pid result;  
     DWORD ret;  
   
     PipeInit();  
   
     /*  
      * If no pid is specified, do nothing.  
      */  
       
     if (pid == 0) {  
         *statPtr = 0;  
         return 0;  
     }  
   
     /*  
      * Find the process on the process list.  
      */  
   
     Tcl_MutexLock(&pipeMutex);  
     prevPtrPtr = &procList;  
     for (infoPtr = procList; infoPtr != NULL;  
             prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {  
          if (infoPtr->hProcess == (HANDLE) pid) {  
             break;  
         }  
     }  
     Tcl_MutexUnlock(&pipeMutex);  
   
     /*  
      * If the pid is not one of the processes we know about (we started it)  
      * then do nothing.  
      */  
                       
     if (infoPtr == NULL) {  
         *statPtr = 0;  
         return 0;  
     }  
   
     /*  
      * Officially "wait" for it to finish. We either poll (WNOHANG) or  
      * wait for an infinite amount of time.  
      */  
       
     if (options & WNOHANG) {  
         flags = 0;  
     } else {  
         flags = INFINITE;  
     }  
     ret = WaitForSingleObject(infoPtr->hProcess, flags);  
     if (ret == WAIT_TIMEOUT) {  
         *statPtr = 0;  
         if (options & WNOHANG) {  
             return 0;  
         } else {  
             result = 0;  
         }  
     } else if (ret != WAIT_FAILED) {  
         GetExitCodeProcess(infoPtr->hProcess, (DWORD*)statPtr);  
         *statPtr = ((*statPtr << 8) & 0xff00);  
         result = pid;  
     } else {  
         errno = ECHILD;  
         *statPtr = ECHILD;  
         result = (Tcl_Pid) -1;  
     }  
   
     /*  
      * Remove the process from the process list and close the process handle.  
      */  
   
     CloseHandle(infoPtr->hProcess);  
     *prevPtrPtr = infoPtr->nextPtr;  
     ckfree((char*)infoPtr);  
   
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinAddProcess --  
  *  
  *     Add a process to the process list so that we can use  
  *     Tcl_WaitPid on the process.  
  *  
  * Results:  
  *     None  
  *  
  * Side effects:  
  *      Adds the specified process handle to the process list so  
  *      Tcl_WaitPid knows about it.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TclWinAddProcess(hProcess, id)  
     HANDLE hProcess;           /* Handle to process */  
     DWORD id;                  /* Global process identifier */  
 {  
     ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));  
     procPtr->hProcess = hProcess;  
     procPtr->dwProcessId = id;  
     Tcl_MutexLock(&pipeMutex);  
     procPtr->nextPtr = procList;  
     procList = procPtr;  
     Tcl_MutexUnlock(&pipeMutex);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_PidObjCmd --  
  *  
  *      This procedure is invoked to process the "pid" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tcl_PidObjCmd(  
     ClientData dummy,           /* Not used. */  
     Tcl_Interp *interp,         /* Current interpreter. */  
     int objc,                   /* Number of arguments. */  
     Tcl_Obj *CONST *objv)       /* Argument strings. */  
 {  
     Tcl_Channel chan;  
     Tcl_ChannelType *chanTypePtr;  
     PipeInfo *pipePtr;  
     int i;  
     Tcl_Obj *resultPtr;  
     char buf[TCL_INTEGER_SPACE];  
   
     if (objc > 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");  
         return TCL_ERROR;  
     }  
     if (objc == 1) {  
         resultPtr = Tcl_GetObjResult(interp);  
         wsprintfA(buf, "%lu", (unsigned long) getpid());  
         Tcl_SetStringObj(resultPtr, buf, -1);  
     } else {  
         chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),  
                 NULL);  
         if (chan == (Tcl_Channel) NULL) {  
             return TCL_ERROR;  
         }  
         chanTypePtr = Tcl_GetChannelType(chan);  
         if (chanTypePtr != &pipeChannelType) {  
             return TCL_OK;  
         }  
   
         pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);  
         resultPtr = Tcl_GetObjResult(interp);  
         for (i = 0; i < pipePtr->numPids; i++) {  
             wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));  
             Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,  
                     Tcl_NewStringObj(buf, -1));  
         }  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * WaitForRead --  
  *  
  *      Wait until some data is available, the pipe is at  
  *      EOF or the reader thread is blocked waiting for data (if the  
  *      channel is in non-blocking mode).  
  *  
  * Results:  
  *      Returns 1 if pipe is readable.  Returns 0 if there is no data  
  *      on the pipe, but there is buffered data.  Returns -1 if an  
  *      error occurred.  If an error occurred, the threads may not  
  *      be synchronized.  
  *  
  * Side effects:  
  *      Updates the shared state flags and may consume 1 byte of data  
  *      from the pipe.  If no error occurred, the reader thread is  
  *      blocked waiting for a signal from the main thread.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 WaitForRead(  
     PipeInfo *infoPtr,          /* Pipe state. */  
     int blocking)               /* Indicates whether call should be  
                                  * blocking or not. */  
 {  
     DWORD timeout, count;  
     HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;  
   
     while (1) {  
         /*  
          * Synchronize with the reader thread.  
          */  
         
         timeout = blocking ? INFINITE : 0;  
         if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {  
             /*  
              * The reader thread is blocked waiting for data and the channel  
              * is in non-blocking mode.  
              */  
   
             errno = EAGAIN;  
             return -1;  
         }  
   
         /*  
          * At this point, the two threads are synchronized, so it is safe  
          * to access shared state.  
          */  
   
   
         /*  
          * If the pipe has hit EOF, it is always readable.  
          */  
   
         if (infoPtr->readFlags & PIPE_EOF) {  
             return 1;  
         }  
       
         /*  
          * Check to see if there is any data sitting in the pipe.  
          */  
   
         if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,  
                 (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {  
             TclWinConvertError(GetLastError());  
             /*  
              * Check to see if the peek failed because of EOF.  
              */  
   
             if (errno == EPIPE) {  
                 infoPtr->readFlags |= PIPE_EOF;  
                 return 1;  
             }  
   
             /*  
              * Ignore errors if there is data in the buffer.  
              */  
   
             if (infoPtr->readFlags & PIPE_EXTRABYTE) {  
                 return 0;  
             } else {  
                 return -1;  
             }  
         }  
   
         /*  
          * We found some data in the pipe, so it must be readable.  
          */  
   
         if (count > 0) {  
             return 1;  
         }  
   
         /*  
          * The pipe isn't readable, but there is some data sitting  
          * in the buffer, so return immediately.  
          */  
   
         if (infoPtr->readFlags & PIPE_EXTRABYTE) {  
             return 0;  
         }  
   
         /*  
          * There wasn't any data available, so reset the thread and  
          * try again.  
          */  
       
         ResetEvent(infoPtr->readable);  
         SetEvent(infoPtr->startReader);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeReaderThread --  
  *  
  *      This function runs in a separate thread and waits for input  
  *      to become available on a pipe.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Signals the main thread when input become available.  May  
  *      cause the main thread to wake up by posting a message.  May  
  *      consume one byte from the pipe for each wait operation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static DWORD WINAPI  
 PipeReaderThread(LPVOID arg)  
 {  
     PipeInfo *infoPtr = (PipeInfo *)arg;  
     HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;  
     DWORD count, err;  
     int done = 0;  
   
     while (!done) {  
         /*  
          * Wait for the main thread to signal before attempting to wait.  
          */  
   
         WaitForSingleObject(infoPtr->startReader, INFINITE);  
   
         /*  
          * Try waiting for 0 bytes.  This will block until some data is  
          * available on NT, but will return immediately on Win 95.  So,  
          * if no data is available after the first read, we block until  
          * we can read a single byte off of the pipe.  
          */  
   
         if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE)  
                 || (PeekNamedPipe(handle, NULL, 0, NULL, &count,  
                         NULL) == FALSE)) {  
             /*  
              * The error is a result of an EOF condition, so set the  
              * EOF bit before signalling the main thread.  
              */  
   
             err = GetLastError();  
             if (err == ERROR_BROKEN_PIPE) {  
                 infoPtr->readFlags |= PIPE_EOF;  
                 done = 1;  
             } else if (err == ERROR_INVALID_HANDLE) {  
                 break;  
             }  
         } else if (count == 0) {  
             if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)  
                     != FALSE) {  
                 /*  
                  * One byte was consumed as a side effect of waiting  
                  * for the pipe to become readable.  
                  */  
   
                 infoPtr->readFlags |= PIPE_EXTRABYTE;  
             } else {  
                 err = GetLastError();  
                 if (err == ERROR_BROKEN_PIPE) {  
                     /*  
                      * The error is a result of an EOF condition, so set the  
                      * EOF bit before signalling the main thread.  
                      */  
   
                     infoPtr->readFlags |= PIPE_EOF;  
                     done = 1;  
                 } else if (err == ERROR_INVALID_HANDLE) {  
                     break;  
                 }  
             }  
         }  
   
                   
         /*  
          * Signal the main thread by signalling the readable event and  
          * then waking up the notifier thread.  
          */  
   
         SetEvent(infoPtr->readable);  
           
         /*  
          * Alert the foreground thread.  Note that we need to treat this like  
          * a critical section so the foreground thread does not terminate  
          * this thread while we are holding a mutex in the notifier code.  
          */  
   
         Tcl_MutexLock(&pipeMutex);  
         Tcl_ThreadAlert(infoPtr->threadId);  
         Tcl_MutexUnlock(&pipeMutex);  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PipeWriterThread --  
  *  
  *      This function runs in a separate thread and writes data  
  *      onto a pipe.  
  *  
  * Results:  
  *      Always returns 0.  
  *  
  * Side effects:  
  *      Signals the main thread when an output operation is completed.  
  *      May cause the main thread to wake up by posting a message.    
  *  
  *----------------------------------------------------------------------  
  */  
   
 static DWORD WINAPI  
 PipeWriterThread(LPVOID arg)  
 {  
   
     PipeInfo *infoPtr = (PipeInfo *)arg;  
     HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;  
     DWORD count, toWrite;  
     char *buf;  
     int done = 0;  
   
     while (!done) {  
         /*  
          * Wait for the main thread to signal before attempting to write.  
          */  
   
         WaitForSingleObject(infoPtr->startWriter, INFINITE);  
   
         buf = infoPtr->writeBuf;  
         toWrite = infoPtr->toWrite;  
   
         /*  
          * Loop until all of the bytes are written or an error occurs.  
          */  
   
         while (toWrite > 0) {  
             if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {  
                 infoPtr->writeError = GetLastError();  
                 done = 1;  
                 break;  
             } else {  
                 toWrite -= count;  
                 buf += count;  
             }  
         }  
           
         /*  
          * Signal the main thread by signalling the writable event and  
          * then waking up the notifier thread.  
          */  
   
         SetEvent(infoPtr->writable);  
   
         /*  
          * Alert the foreground thread.  Note that we need to treat this like  
          * a critical section so the foreground thread does not terminate  
          * this thread while we are holding a mutex in the notifier code.  
          */  
   
         Tcl_MutexLock(&pipeMutex);  
         Tcl_ThreadAlert(infoPtr->threadId);  
         Tcl_MutexUnlock(&pipeMutex);  
     }  
     return 0;  
 }  
   
   
 /* $History: tclwinpipe.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:27a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLWINPIPE.C */  
1    /* $Header$ */
2    /*
3     * tclWinPipe.c --
4     *
5     *      This file implements the Windows-specific exec pipeline functions,
6     *      the "pipe" channel driver, and the "pid" Tcl command.
7     *
8     * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
9     *
10     * See the file "license.terms" for information on usage and redistribution
11     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12     *
13     * RCS: @(#) $Id: tclwinpipe.c,v 1.1.1.1 2001/06/13 04:49:50 dtashley Exp $
14     */
15    
16    #include "tclWinInt.h"
17    
18    #include <dos.h>
19    #include <fcntl.h>
20    #include <io.h>
21    #include <sys/stat.h>
22    
23    /*
24     * The following variable is used to tell whether this module has been
25     * initialized.
26     */
27    
28    static int initialized = 0;
29    
30    /*
31     * The pipeMutex locks around access to the initialized and procList variables,
32     * and it is used to protect background threads from being terminated while
33     * they are using APIs that hold locks.
34     */
35    
36    TCL_DECLARE_MUTEX(pipeMutex)
37    
38    /*
39     * The following defines identify the various types of applications that
40     * run under windows.  There is special case code for the various types.
41     */
42    
43    #define APPL_NONE       0
44    #define APPL_DOS        1
45    #define APPL_WIN3X      2
46    #define APPL_WIN32      3
47    
48    /*
49     * The following constants and structures are used to encapsulate the state
50     * of various types of files used in a pipeline.
51     * This used to have a 1 && 2 that supported Win32s.
52     */
53    
54    #define WIN_FILE 3              /* Basic Win32 file. */
55    
56    /*
57     * This structure encapsulates the common state associated with all file
58     * types used in a pipeline.
59     */
60    
61    typedef struct WinFile {
62        int type;                   /* One of the file types defined above. */
63        HANDLE handle;              /* Open file handle. */
64    } WinFile;
65    
66    /*
67     * This list is used to map from pids to process handles.
68     */
69    
70    typedef struct ProcInfo {
71        HANDLE hProcess;
72        DWORD dwProcessId;
73        struct ProcInfo *nextPtr;
74    } ProcInfo;
75    
76    static ProcInfo *procList;
77    
78    /*
79     * Bit masks used in the flags field of the PipeInfo structure below.
80     */
81    
82    #define PIPE_PENDING    (1<<0)  /* Message is pending in the queue. */
83    #define PIPE_ASYNC      (1<<1)  /* Channel is non-blocking. */
84    
85    /*
86     * Bit masks used in the sharedFlags field of the PipeInfo structure below.
87     */
88    
89    #define PIPE_EOF        (1<<2)  /* Pipe has reached EOF. */
90    #define PIPE_EXTRABYTE  (1<<3)  /* The reader thread has consumed one byte. */
91    
92    /*
93     * This structure describes per-instance data for a pipe based channel.
94     */
95    
96    typedef struct PipeInfo {
97        struct PipeInfo *nextPtr;   /* Pointer to next registered pipe. */
98        Tcl_Channel channel;        /* Pointer to channel structure. */
99        int validMask;              /* OR'ed combination of TCL_READABLE,
100                                     * TCL_WRITABLE, or TCL_EXCEPTION: indicates
101                                     * which operations are valid on the file. */
102        int watchMask;              /* OR'ed combination of TCL_READABLE,
103                                     * TCL_WRITABLE, or TCL_EXCEPTION: indicates
104                                     * which events should be reported. */
105        int flags;                  /* State flags, see above for a list. */
106        TclFile readFile;           /* Output from pipe. */
107        TclFile writeFile;          /* Input from pipe. */
108        TclFile errorFile;          /* Error output from pipe. */
109        int numPids;                /* Number of processes attached to pipe. */
110        Tcl_Pid *pidPtr;            /* Pids of attached processes. */
111        Tcl_ThreadId threadId;      /* Thread to which events should be reported.
112                                     * This value is used by the reader/writer
113                                     * threads. */
114        HANDLE writeThread;         /* Handle to writer thread. */
115        HANDLE readThread;          /* Handle to reader thread. */
116        HANDLE writable;            /* Manual-reset event to signal when the
117                                     * writer thread has finished waiting for
118                                     * the current buffer to be written. */
119        HANDLE readable;            /* Manual-reset event to signal when the
120                                     * reader thread has finished waiting for
121                                     * input. */
122        HANDLE startWriter;         /* Auto-reset event used by the main thread to
123                                     * signal when the writer thread should attempt
124                                     * to write to the pipe. */
125        HANDLE startReader;         /* Auto-reset event used by the main thread to
126                                     * signal when the reader thread should attempt
127                                     * to read from the pipe. */
128        DWORD writeError;           /* An error caused by the last background
129                                     * write.  Set to 0 if no error has been
130                                     * detected.  This word is shared with the
131                                     * writer thread so access must be
132                                     * synchronized with the writable object.
133                                     */
134        char *writeBuf;             /* Current background output buffer.
135                                     * Access is synchronized with the writable
136                                     * object. */
137        int writeBufLen;            /* Size of write buffer.  Access is
138                                     * synchronized with the writable
139                                     * object. */
140        int toWrite;                /* Current amount to be written.  Access is
141                                     * synchronized with the writable object. */
142        int readFlags;              /* Flags that are shared with the reader
143                                     * thread.  Access is synchronized with the
144                                     * readable object.  */
145        char extraByte;             /* Buffer for extra character consumed by
146                                     * reader thread.  This byte is shared with
147                                     * the reader thread so access must be
148                                     * synchronized with the readable object. */
149    } PipeInfo;
150    
151    typedef struct ThreadSpecificData {
152        /*
153         * The following pointer refers to the head of the list of pipes
154         * that are being watched for file events.
155         */
156        
157        PipeInfo *firstPipePtr;
158    } ThreadSpecificData;
159    
160    static Tcl_ThreadDataKey dataKey;
161    
162    /*
163     * The following structure is what is added to the Tcl event queue when
164     * pipe events are generated.
165     */
166    
167    typedef struct PipeEvent {
168        Tcl_Event header;           /* Information that is standard for
169                                     * all events. */
170        PipeInfo *infoPtr;          /* Pointer to pipe info structure.  Note
171                                     * that we still have to verify that the
172                                     * pipe exists before dereferencing this
173                                     * pointer. */
174    } PipeEvent;
175    
176    /*
177     * Declarations for functions used only in this file.
178     */
179    
180    static int              ApplicationType(Tcl_Interp *interp,
181                                const char *fileName, char *fullName);
182    static void             BuildCommandLine(const char *executable, int argc,
183                                char **argv, Tcl_DString *linePtr);
184    static BOOL             HasConsole(void);
185    static int              PipeBlockModeProc(ClientData instanceData, int mode);
186    static void             PipeCheckProc(ClientData clientData, int flags);
187    static int              PipeClose2Proc(ClientData instanceData,
188                                Tcl_Interp *interp, int flags);
189    static int              PipeEventProc(Tcl_Event *evPtr, int flags);
190    static void             PipeExitHandler(ClientData clientData);
191    static int              PipeGetHandleProc(ClientData instanceData,
192                                int direction, ClientData *handlePtr);
193    static void             PipeInit(void);
194    static int              PipeInputProc(ClientData instanceData, char *buf,
195                                int toRead, int *errorCode);
196    static int              PipeOutputProc(ClientData instanceData, char *buf,
197                                int toWrite, int *errorCode);
198    static DWORD WINAPI     PipeReaderThread(LPVOID arg);
199    static void             PipeSetupProc(ClientData clientData, int flags);
200    static void             PipeWatchProc(ClientData instanceData, int mask);
201    static DWORD WINAPI     PipeWriterThread(LPVOID arg);
202    static void             ProcExitHandler(ClientData clientData);
203    static int              TempFileName(WCHAR name[MAX_PATH]);
204    static int              WaitForRead(PipeInfo *infoPtr, int blocking);
205    
206    /*
207     * This structure describes the channel type structure for command pipe
208     * based IO.
209     */
210    
211    static Tcl_ChannelType pipeChannelType = {
212        "pipe",                     /* Type name. */
213        PipeBlockModeProc,          /* Set blocking or non-blocking mode.*/
214        TCL_CLOSE2PROC,             /* Close proc. */
215        PipeInputProc,              /* Input proc. */
216        PipeOutputProc,             /* Output proc. */
217        NULL,                       /* Seek proc. */
218        NULL,                       /* Set option proc. */
219        NULL,                       /* Get option proc. */
220        PipeWatchProc,              /* Set up notifier to watch the channel. */
221        PipeGetHandleProc,          /* Get an OS handle from channel. */
222        PipeClose2Proc
223    };
224    
225    /*
226     *----------------------------------------------------------------------
227     *
228     * PipeInit --
229     *
230     *      This function initializes the static variables for this file.
231     *
232     * Results:
233     *      None.
234     *
235     * Side effects:
236     *      Creates a new event source.
237     *
238     *----------------------------------------------------------------------
239     */
240    
241    static void
242    PipeInit()
243    {
244        ThreadSpecificData *tsdPtr;
245    
246        /*
247         * Check the initialized flag first, then check again in the mutex.
248         * This is a speed enhancement.
249         */
250    
251        if (!initialized) {
252            Tcl_MutexLock(&pipeMutex);
253            if (!initialized) {
254                initialized = 1;
255                procList = NULL;
256                Tcl_CreateExitHandler(ProcExitHandler, NULL);
257            }
258            Tcl_MutexUnlock(&pipeMutex);
259        }
260    
261        tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
262        if (tsdPtr == NULL) {
263            tsdPtr = TCL_TSD_INIT(&dataKey);
264            tsdPtr->firstPipePtr = NULL;
265            Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
266            Tcl_CreateThreadExitHandler(PipeExitHandler, NULL);
267        }
268    }
269    
270    /*
271     *----------------------------------------------------------------------
272     *
273     * PipeExitHandler --
274     *
275     *      This function is called to cleanup the pipe module before
276     *      Tcl is unloaded.
277     *
278     * Results:
279     *      None.
280     *
281     * Side effects:
282     *      Removes the pipe event source.
283     *
284     *----------------------------------------------------------------------
285     */
286    
287    static void
288    PipeExitHandler(
289        ClientData clientData)      /* Old window proc */
290    {
291        Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
292    }
293    
294    /*
295     *----------------------------------------------------------------------
296     *
297     * ProcExitHandler --
298     *
299     *      This function is called to cleanup the process list before
300     *      Tcl is unloaded.
301     *
302     * Results:
303     *      None.
304     *
305     * Side effects:
306     *      Resets the process list.
307     *
308     *----------------------------------------------------------------------
309     */
310    
311    static void
312    ProcExitHandler(
313        ClientData clientData)      /* Old window proc */
314    {
315        Tcl_MutexLock(&pipeMutex);
316        initialized = 0;
317        Tcl_MutexUnlock(&pipeMutex);
318    }
319    
320    /*
321     *----------------------------------------------------------------------
322     *
323     * PipeSetupProc --
324     *
325     *      This procedure is invoked before Tcl_DoOneEvent blocks waiting
326     *      for an event.
327     *
328     * Results:
329     *      None.
330     *
331     * Side effects:
332     *      Adjusts the block time if needed.
333     *
334     *----------------------------------------------------------------------
335     */
336    
337    void
338    PipeSetupProc(
339        ClientData data,            /* Not used. */
340        int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
341    {
342        PipeInfo *infoPtr;
343        Tcl_Time blockTime = { 0, 0 };
344        int block = 1;
345        WinFile *filePtr;
346        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
347    
348        if (!(flags & TCL_FILE_EVENTS)) {
349            return;
350        }
351        
352        /*
353         * Look to see if any events are already pending.  If they are, poll.
354         */
355    
356        for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
357                infoPtr = infoPtr->nextPtr) {
358            if (infoPtr->watchMask & TCL_WRITABLE) {
359                filePtr = (WinFile*) infoPtr->writeFile;
360                if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
361                    block = 0;
362                }
363            }
364            if (infoPtr->watchMask & TCL_READABLE) {
365                filePtr = (WinFile*) infoPtr->readFile;
366                if (WaitForRead(infoPtr, 0) >= 0) {
367                    block = 0;
368                }
369            }
370        }
371        if (!block) {
372            Tcl_SetMaxBlockTime(&blockTime);
373        }
374    }
375    
376    /*
377     *----------------------------------------------------------------------
378     *
379     * PipeCheckProc --
380     *
381     *      This procedure is called by Tcl_DoOneEvent to check the pipe
382     *      event source for events.
383     *
384     * Results:
385     *      None.
386     *
387     * Side effects:
388     *      May queue an event.
389     *
390     *----------------------------------------------------------------------
391     */
392    
393    static void
394    PipeCheckProc(
395        ClientData data,            /* Not used. */
396        int flags)                  /* Event flags as passed to Tcl_DoOneEvent. */
397    {
398        PipeInfo *infoPtr;
399        PipeEvent *evPtr;
400        WinFile *filePtr;
401        int needEvent;
402        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
403    
404        if (!(flags & TCL_FILE_EVENTS)) {
405            return;
406        }
407        
408        /*
409         * Queue events for any ready pipes that don't already have events
410         * queued.
411         */
412    
413        for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
414                infoPtr = infoPtr->nextPtr) {
415            if (infoPtr->flags & PIPE_PENDING) {
416                continue;
417            }
418            
419            /*
420             * Queue an event if the pipe is signaled for reading or writing.
421             */
422    
423            needEvent = 0;
424            filePtr = (WinFile*) infoPtr->writeFile;
425            if ((infoPtr->watchMask & TCL_WRITABLE) &&
426                    (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
427                needEvent = 1;
428            }
429            
430            filePtr = (WinFile*) infoPtr->readFile;
431            if ((infoPtr->watchMask & TCL_READABLE) &&
432                    (WaitForRead(infoPtr, 0) >= 0)) {
433                needEvent = 1;
434            }
435    
436            if (needEvent) {
437                infoPtr->flags |= PIPE_PENDING;
438                evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
439                evPtr->header.proc = PipeEventProc;
440                evPtr->infoPtr = infoPtr;
441                Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
442            }
443        }
444    }
445    
446    /*
447     *----------------------------------------------------------------------
448     *
449     * TclWinMakeFile --
450     *
451     *      This function constructs a new TclFile from a given data and
452     *      type value.
453     *
454     * Results:
455     *      Returns a newly allocated WinFile as a TclFile.
456     *
457     * Side effects:
458     *      None.
459     *
460     *----------------------------------------------------------------------
461     */
462    
463    TclFile
464    TclWinMakeFile(
465        HANDLE handle)              /* Type-specific data. */
466    {
467        WinFile *filePtr;
468    
469        filePtr = (WinFile *) ckalloc(sizeof(WinFile));
470        filePtr->type = WIN_FILE;
471        filePtr->handle = handle;
472    
473        return (TclFile)filePtr;
474    }
475    
476    /*
477     *----------------------------------------------------------------------
478     *
479     * TempFileName --
480     *
481     *      Gets a temporary file name and deals with the fact that the
482     *      temporary file path provided by Windows may not actually exist
483     *      if the TMP or TEMP environment variables refer to a
484     *      non-existent directory.
485     *
486     * Results:    
487     *      0 if error, non-zero otherwise.  If non-zero is returned, the
488     *      name buffer will be filled with a name that can be used to
489     *      construct a temporary file.
490     *
491     * Side effects:
492     *      None.
493     *
494     *----------------------------------------------------------------------
495     */
496    
497    static int
498    TempFileName(name)
499        WCHAR name[MAX_PATH];       /* Buffer in which name for temporary
500                                     * file gets stored. */
501    {
502        TCHAR *prefix;
503    
504        prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
505        if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
506            if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
507                    name) != 0) {
508                return 1;
509            }
510        }
511        if (tclWinProcs->useWide) {
512            ((WCHAR *) name)[0] = '.';
513            ((WCHAR *) name)[1] = '\0';
514        } else {
515            ((char *) name)[0] = '.';
516            ((char *) name)[1] = '\0';
517        }
518        return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
519                name);
520    }
521    
522    /*
523     *----------------------------------------------------------------------
524     *
525     * TclpMakeFile --
526     *
527     *      Make a TclFile from a channel.
528     *
529     * Results:
530     *      Returns a new TclFile or NULL on failure.
531     *
532     * Side effects:
533     *      None.
534     *
535     *----------------------------------------------------------------------
536     */
537    
538    TclFile
539    TclpMakeFile(channel, direction)
540        Tcl_Channel channel;        /* Channel to get file from. */
541        int direction;              /* Either TCL_READABLE or TCL_WRITABLE. */
542    {
543        HANDLE handle;
544    
545        if (Tcl_GetChannelHandle(channel, direction,
546                (ClientData *) &handle) == TCL_OK) {
547            return TclWinMakeFile(handle);
548        } else {
549            return (TclFile) NULL;
550        }
551    }
552    
553    /*
554     *----------------------------------------------------------------------
555     *
556     * TclpOpenFile --
557     *
558     *      This function opens files for use in a pipeline.
559     *
560     * Results:
561     *      Returns a newly allocated TclFile structure containing the
562     *      file handle.
563     *
564     * Side effects:
565     *      None.
566     *
567     *----------------------------------------------------------------------
568     */
569    
570    TclFile
571    TclpOpenFile(path, mode)
572        CONST char *path;           /* The name of the file to open. */
573        int mode;                   /* In what mode to open the file? */
574    {
575        HANDLE handle;
576        DWORD accessMode, createMode, shareMode, flags;
577        Tcl_DString ds;
578        TCHAR *nativePath;
579        
580        /*
581         * Map the access bits to the NT access mode.
582         */
583    
584        switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
585            case O_RDONLY:
586                accessMode = GENERIC_READ;
587                break;
588            case O_WRONLY:
589                accessMode = GENERIC_WRITE;
590                break;
591            case O_RDWR:
592                accessMode = (GENERIC_READ | GENERIC_WRITE);
593                break;
594            default:
595                TclWinConvertError(ERROR_INVALID_FUNCTION);
596                return NULL;
597        }
598    
599        /*
600         * Map the creation flags to the NT create mode.
601         */
602    
603        switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
604            case (O_CREAT | O_EXCL):
605            case (O_CREAT | O_EXCL | O_TRUNC):
606                createMode = CREATE_NEW;
607                break;
608            case (O_CREAT | O_TRUNC):
609                createMode = CREATE_ALWAYS;
610                break;
611            case O_CREAT:
612                createMode = OPEN_ALWAYS;
613                break;
614            case O_TRUNC:
615            case (O_TRUNC | O_EXCL):
616                createMode = TRUNCATE_EXISTING;
617                break;
618            default:
619                createMode = OPEN_EXISTING;
620                break;
621        }
622    
623        nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
624    
625        /*
626         * If the file is not being created, use the existing file attributes.
627         */
628    
629        flags = 0;
630        if (!(mode & O_CREAT)) {
631            flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
632            if (flags == 0xFFFFFFFF) {
633                flags = 0;
634            }
635        }
636    
637        /*
638         * Set up the file sharing mode.  We want to allow simultaneous access.
639         */
640    
641        shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
642    
643        /*
644         * Now we get to create the file.
645         */
646    
647        handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
648                shareMode, NULL, createMode, flags, NULL);
649        Tcl_DStringFree(&ds);
650    
651        if (handle == INVALID_HANDLE_VALUE) {
652            DWORD err;
653            
654            err = GetLastError();
655            if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
656                err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
657            }
658            TclWinConvertError(err);
659            return NULL;
660        }
661    
662        /*
663         * Seek to the end of file if we are writing.
664         */
665    
666        if (mode & O_WRONLY) {
667            SetFilePointer(handle, 0, NULL, FILE_END);
668        }
669    
670        return TclWinMakeFile(handle);
671    }
672    
673    /*
674     *----------------------------------------------------------------------
675     *
676     * TclpCreateTempFile --
677     *
678     *      This function opens a unique file with the property that it
679     *      will be deleted when its file handle is closed.  The temporary
680     *      file is created in the system temporary directory.
681     *
682     * Results:
683     *      Returns a valid TclFile, or NULL on failure.
684     *
685     * Side effects:
686     *      Creates a new temporary file.
687     *
688     *----------------------------------------------------------------------
689     */
690    
691    TclFile
692    TclpCreateTempFile(contents)
693        CONST char *contents;       /* String to write into temp file, or NULL. */
694    {
695        WCHAR name[MAX_PATH];
696        CONST char *native;
697        Tcl_DString dstring;
698        HANDLE handle;
699    
700        if (TempFileName(name) == 0) {
701            return NULL;
702        }
703    
704        handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
705                GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
706                FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
707        if (handle == INVALID_HANDLE_VALUE) {
708            goto error;
709        }
710    
711        /*
712         * Write the file out, doing line translations on the way.
713         */
714    
715        if (contents != NULL) {
716            DWORD result, length;
717            CONST char *p;
718    
719            /*
720             * Convert the contents from UTF to native encoding
721             */
722            native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
723            
724            for (p = native; *p != '\0'; p++) {
725                if (*p == '\n') {
726                    length = p - native;
727                    if (length > 0) {
728                        if (!WriteFile(handle, native, length, &result, NULL)) {
729                            goto error;
730                        }
731                    }
732                    if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
733                        goto error;
734                    }
735                    native = p+1;
736                }
737            }
738            length = p - native;
739            if (length > 0) {
740                if (!WriteFile(handle, native, length, &result, NULL)) {
741                    goto error;
742                }
743            }
744            Tcl_DStringFree(&dstring);
745            if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
746                goto error;
747            }
748        }
749    
750        return TclWinMakeFile(handle);
751    
752      error:
753        /* Free the native representation of the contents if necessary */
754        if (contents != NULL) {
755            Tcl_DStringFree(&dstring);
756        }
757    
758        TclWinConvertError(GetLastError());
759        CloseHandle(handle);
760        (*tclWinProcs->deleteFileProc)((TCHAR *) name);
761        return NULL;
762    }
763    
764    /*
765     *----------------------------------------------------------------------
766     *
767     * TclpCreatePipe --
768     *
769     *      Creates an anonymous pipe.
770     *
771     * Results:
772     *      Returns 1 on success, 0 on failure.
773     *
774     * Side effects:
775     *      Creates a pipe.
776     *
777     *----------------------------------------------------------------------
778     */
779    
780    int
781    TclpCreatePipe(
782        TclFile *readPipe,  /* Location to store file handle for
783                                     * read side of pipe. */
784        TclFile *writePipe) /* Location to store file handle for
785                                     * write side of pipe. */
786    {
787        HANDLE readHandle, writeHandle;
788    
789        if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
790            *readPipe = TclWinMakeFile(readHandle);
791            *writePipe = TclWinMakeFile(writeHandle);
792            return 1;
793        }
794    
795        TclWinConvertError(GetLastError());
796        return 0;
797    }
798    
799    /*
800     *----------------------------------------------------------------------
801     *
802     * TclpCloseFile --
803     *
804     *      Closes a pipeline file handle.  These handles are created by
805     *      TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
806     *
807     * Results:
808     *      0 on success, -1 on failure.
809     *
810     * Side effects:
811     *      The file is closed and deallocated.
812     *
813     *----------------------------------------------------------------------
814     */
815    
816    int
817    TclpCloseFile(
818        TclFile file)       /* The file to close. */
819    {
820        WinFile *filePtr = (WinFile *) file;
821    
822        switch (filePtr->type) {
823            case WIN_FILE:
824                /*
825                 * Don't close the Win32 handle if the handle is a standard channel
826                 * during the exit process.  Otherwise, one thread may kill the
827                 * stdio of another.
828                 */
829    
830                if (!TclInExit()
831                        || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
832                                && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
833                                && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
834                    if (CloseHandle(filePtr->handle) == FALSE) {
835                        TclWinConvertError(GetLastError());
836                        ckfree((char *) filePtr);
837                        return -1;
838                    }
839                }
840                break;
841    
842            default:
843                panic("TclpCloseFile: unexpected file type");
844        }
845    
846        ckfree((char *) filePtr);
847        return 0;
848    }
849    
850    /*
851     *--------------------------------------------------------------------------
852     *
853     * TclpGetPid --
854     *
855     *      Given a HANDLE to a child process, return the process id for that
856     *      child process.
857     *
858     * Results:
859     *      Returns the process id for the child process.  If the pid was not
860     *      known by Tcl, either because the pid was not created by Tcl or the
861     *      child process has already been reaped, -1 is returned.
862     *
863     * Side effects:
864     *      None.
865     *
866     *--------------------------------------------------------------------------
867     */
868    
869    unsigned long
870    TclpGetPid(
871        Tcl_Pid pid)                /* The HANDLE of the child process. */
872    {
873        ProcInfo *infoPtr;
874    
875        Tcl_MutexLock(&pipeMutex);
876        for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
877            if (infoPtr->hProcess == (HANDLE) pid) {
878                Tcl_MutexUnlock(&pipeMutex);
879                return infoPtr->dwProcessId;
880            }
881        }
882        Tcl_MutexUnlock(&pipeMutex);
883        return (unsigned long) -1;
884    }
885    
886    /*
887     *----------------------------------------------------------------------
888     *
889     * TclpCreateProcess --
890     *
891     *      Create a child process that has the specified files as its
892     *      standard input, output, and error.  The child process runs
893     *      asynchronously under Windows NT and Windows 9x, and runs
894     *      with the same environment variables as the creating process.
895     *
896     *      The complete Windows search path is searched to find the specified
897     *      executable.  If an executable by the given name is not found,
898     *      automatically tries appending ".com", ".exe", and ".bat" to the
899     *      executable name.
900     *
901     * Results:
902     *      The return value is TCL_ERROR and an error message is left in
903     *      the interp's result if there was a problem creating the child
904     *      process.  Otherwise, the return value is TCL_OK and *pidPtr is
905     *      filled with the process id of the child process.
906     *
907     * Side effects:
908     *      A process is created.
909     *      
910     *----------------------------------------------------------------------
911     */
912    
913    int
914    TclpCreateProcess(
915        Tcl_Interp *interp,         /* Interpreter in which to leave errors that
916                                     * occurred when creating the child process.
917                                     * Error messages from the child process
918                                     * itself are sent to errorFile. */
919        int argc,                   /* Number of arguments in following array. */
920        char **argv,                /* Array of argument strings.  argv[0]
921                                     * contains the name of the executable
922                                     * converted to native format (using the
923                                     * Tcl_TranslateFileName call).  Additional
924                                     * arguments have not been converted. */
925        TclFile inputFile,          /* If non-NULL, gives the file to use as
926                                     * input for the child process.  If inputFile
927                                     * file is not readable or is NULL, the child
928                                     * will receive no standard input. */
929        TclFile outputFile,         /* If non-NULL, gives the file that
930                                     * receives output from the child process.  If
931                                     * outputFile file is not writeable or is
932                                     * NULL, output from the child will be
933                                     * discarded. */
934        TclFile errorFile,          /* If non-NULL, gives the file that
935                                     * receives errors from the child process.  If
936                                     * errorFile file is not writeable or is NULL,
937                                     * errors from the child will be discarded.
938                                     * errorFile may be the same as outputFile. */
939        Tcl_Pid *pidPtr)            /* If this procedure is successful, pidPtr
940                                     * is filled with the process id of the child
941                                     * process. */
942    {
943        int result, applType, createFlags;
944        Tcl_DString cmdLine;        /* Complete command line (TCHAR). */
945        STARTUPINFOA startInfo;
946        PROCESS_INFORMATION procInfo;
947        SECURITY_ATTRIBUTES secAtts;
948        HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
949        char execPath[MAX_PATH * TCL_UTF_MAX];
950        WinFile *filePtr;
951    
952        PipeInit();
953    
954        applType = ApplicationType(interp, argv[0], execPath);
955        if (applType == APPL_NONE) {
956            return TCL_ERROR;
957        }
958    
959        result = TCL_ERROR;
960        Tcl_DStringInit(&cmdLine);
961        hProcess = GetCurrentProcess();
962    
963        /*
964         * STARTF_USESTDHANDLES must be used to pass handles to child process.
965         * Using SetStdHandle() and/or dup2() only works when a console mode
966         * parent process is spawning an attached console mode child process.
967         */
968    
969        ZeroMemory(&startInfo, sizeof(startInfo));
970        startInfo.cb = sizeof(startInfo);
971        startInfo.dwFlags   = STARTF_USESTDHANDLES;
972        startInfo.hStdInput = INVALID_HANDLE_VALUE;
973        startInfo.hStdOutput= INVALID_HANDLE_VALUE;
974        startInfo.hStdError = INVALID_HANDLE_VALUE;
975    
976        secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
977        secAtts.lpSecurityDescriptor = NULL;
978        secAtts.bInheritHandle = TRUE;
979    
980        /*
981         * We have to check the type of each file, since we cannot duplicate
982         * some file types.  
983         */
984    
985        inputHandle = INVALID_HANDLE_VALUE;
986        if (inputFile != NULL) {
987            filePtr = (WinFile *)inputFile;
988            if (filePtr->type == WIN_FILE) {
989                inputHandle = filePtr->handle;
990            }
991        }
992        outputHandle = INVALID_HANDLE_VALUE;
993        if (outputFile != NULL) {
994            filePtr = (WinFile *)outputFile;
995            if (filePtr->type == WIN_FILE) {
996                outputHandle = filePtr->handle;
997            }
998        }
999        errorHandle = INVALID_HANDLE_VALUE;
1000        if (errorFile != NULL) {
1001            filePtr = (WinFile *)errorFile;
1002            if (filePtr->type == WIN_FILE) {
1003                errorHandle = filePtr->handle;
1004            }
1005        }
1006    
1007        /*
1008         * Duplicate all the handles which will be passed off as stdin, stdout
1009         * and stderr of the child process. The duplicate handles are set to
1010         * be inheritable, so the child process can use them.
1011         */
1012    
1013        if (inputHandle == INVALID_HANDLE_VALUE) {
1014            /*
1015             * If handle was not set, stdin should return immediate EOF.
1016             * Under Windows95, some applications (both 16 and 32 bit!)
1017             * cannot read from the NUL device; they read from console
1018             * instead.  When running tk, this is fatal because the child
1019             * process would hang forever waiting for EOF from the unmapped
1020             * console window used by the helper application.
1021             *
1022             * Fortunately, the helper application detects a closed pipe
1023             * as an immediate EOF and can pass that information to the
1024             * child process.
1025             */
1026    
1027            if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
1028                CloseHandle(h);
1029            }
1030        } else {
1031            DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
1032                    0, TRUE, DUPLICATE_SAME_ACCESS);
1033        }
1034        if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
1035            TclWinConvertError(GetLastError());
1036            Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
1037                    Tcl_PosixError(interp), (char *) NULL);
1038            goto end;
1039        }
1040    
1041        if (outputHandle == INVALID_HANDLE_VALUE) {
1042            /*
1043             * If handle was not set, output should be sent to an infinitely
1044             * deep sink.  Under Windows 95, some 16 bit applications cannot
1045             * have stdout redirected to NUL; they send their output to
1046             * the console instead.  Some applications, like "more" or "dir /p",
1047             * when outputting multiple pages to the console, also then try and
1048             * read from the console to go the next page.  When running tk, this
1049             * is fatal because the child process would hang forever waiting
1050             * for input from the unmapped console window used by the helper
1051             * application.
1052             *
1053             * Fortunately, the helper application will detect a closed pipe
1054             * as a sink.
1055             */
1056    
1057            if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
1058                    && (applType == APPL_DOS)) {
1059                if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
1060                    CloseHandle(h);
1061                }
1062            } else {
1063                startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
1064                        &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
1065            }
1066        } else {
1067            DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput,
1068                    0, TRUE, DUPLICATE_SAME_ACCESS);
1069        }
1070        if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
1071            TclWinConvertError(GetLastError());
1072            Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
1073                    Tcl_PosixError(interp), (char *) NULL);
1074            goto end;
1075        }
1076    
1077        if (errorHandle == INVALID_HANDLE_VALUE) {
1078            /*
1079             * If handle was not set, errors should be sent to an infinitely
1080             * deep sink.
1081             */
1082    
1083            startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
1084                    &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
1085        } else {
1086            DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
1087                    0, TRUE, DUPLICATE_SAME_ACCESS);
1088        }
1089        if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
1090            TclWinConvertError(GetLastError());
1091            Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
1092                    Tcl_PosixError(interp), (char *) NULL);
1093            goto end;
1094        }
1095        /*
1096         * If we do not have a console window, then we must run DOS and
1097         * WIN32 console mode applications as detached processes. This tells
1098         * the loader that the child application should not inherit the
1099         * console, and that it should not create a new console window for
1100         * the child application.  The child application should get its stdio
1101         * from the redirection handles provided by this application, and run
1102         * in the background.
1103         *
1104         * If we are starting a GUI process, they don't automatically get a
1105         * console, so it doesn't matter if they are started as foreground or
1106         * detached processes.  The GUI window will still pop up to the
1107         * foreground.
1108         */
1109    
1110        if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
1111            if (HasConsole()) {
1112                createFlags = 0;
1113            } else if (applType == APPL_DOS) {
1114                /*
1115                 * Under NT, 16-bit DOS applications will not run unless they
1116                 * can be attached to a console.  If we are running without a
1117                 * console, run the 16-bit program as an normal process inside
1118                 * of a hidden console application, and then run that hidden
1119                 * console as a detached process.
1120                 */
1121    
1122                startInfo.wShowWindow = SW_HIDE;
1123                startInfo.dwFlags |= STARTF_USESHOWWINDOW;
1124                createFlags = CREATE_NEW_CONSOLE;
1125                Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1);
1126            } else {
1127                createFlags = DETACHED_PROCESS;
1128            }
1129        } else {
1130            if (HasConsole()) {
1131                createFlags = 0;
1132            } else {
1133                createFlags = DETACHED_PROCESS;
1134            }
1135            
1136            if (applType == APPL_DOS) {
1137                /*
1138                 * Under Windows 95, 16-bit DOS applications do not work well
1139                 * with pipes:
1140                 *
1141                 * 1. EOF on a pipe between a detached 16-bit DOS application
1142                 * and another application is not seen at the other
1143                 * end of the pipe, so the listening process blocks forever on
1144                 * reads.  This inablity to detect EOF happens when either a
1145                 * 16-bit app or the 32-bit app is the listener.  
1146                 *
1147                 * 2. If a 16-bit DOS application (detached or not) blocks when
1148                 * writing to a pipe, it will never wake up again, and it
1149                 * eventually brings the whole system down around it.
1150                 *
1151                 * The 16-bit application is run as a normal process inside
1152                 * of a hidden helper console app, and this helper may be run
1153                 * as a detached process.  If any of the stdio handles is
1154                 * a pipe, the helper application accumulates information
1155                 * into temp files and forwards it to or from the DOS
1156                 * application as appropriate.  This means that DOS apps
1157                 * must receive EOF from a stdin pipe before they will actually
1158                 * begin, and must finish generating stdout or stderr before
1159                 * the data will be sent to the next stage of the pipe.
1160                 *
1161                 * The helper app should be located in the same directory as
1162                 * the tcl dll.
1163                 */
1164    
1165                if (createFlags != 0) {
1166                    startInfo.wShowWindow = SW_HIDE;
1167                    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
1168                    createFlags = CREATE_NEW_CONSOLE;
1169                }
1170                Tcl_DStringAppend(&cmdLine, "tclpip" STRINGIFY(TCL_MAJOR_VERSION)
1171                        STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);
1172            }
1173        }
1174        
1175        /*
1176         * cmdLine gets the full command line used to invoke the executable,
1177         * including the name of the executable itself.  The command line
1178         * arguments in argv[] are stored in cmdLine separated by spaces.
1179         * Special characters in individual arguments from argv[] must be
1180         * quoted when being stored in cmdLine.
1181         *
1182         * When calling any application, bear in mind that arguments that
1183         * specify a path name are not converted.  If an argument contains
1184         * forward slashes as path separators, it may or may not be
1185         * recognized as a path name, depending on the program.  In general,
1186         * most applications accept forward slashes only as option
1187         * delimiters and backslashes only as paths.
1188         *
1189         * Additionally, when calling a 16-bit dos or windows application,
1190         * all path names must use the short, cryptic, path format (e.g.,
1191         * using ab~1.def instead of "a b.default").  
1192         */
1193    
1194        BuildCommandLine(execPath, argc, argv, &cmdLine);
1195    
1196        if ((*tclWinProcs->createProcessProc)(NULL,
1197                (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
1198                createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
1199            TclWinConvertError(GetLastError());
1200            Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
1201                    "\": ", Tcl_PosixError(interp), (char *) NULL);
1202            goto end;
1203        }
1204    
1205        /*
1206         * This wait is used to force the OS to give some time to the DOS
1207         * process.
1208         */
1209    
1210        if (applType == APPL_DOS) {
1211            WaitForSingleObject(procInfo.hProcess, 50);
1212        }
1213    
1214        /*
1215         * "When an application spawns a process repeatedly, a new thread
1216         * instance will be created for each process but the previous
1217         * instances may not be cleaned up.  This results in a significant
1218         * virtual memory loss each time the process is spawned.  If there
1219         * is a WaitForInputIdle() call between CreateProcess() and
1220         * CloseHandle(), the problem does not occur." PSS ID Number: Q124121
1221         */
1222    
1223        WaitForInputIdle(procInfo.hProcess, 5000);
1224        CloseHandle(procInfo.hThread);
1225    
1226        *pidPtr = (Tcl_Pid) procInfo.hProcess;
1227        if (*pidPtr != 0) {
1228            TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
1229        }
1230        result = TCL_OK;
1231    
1232        end:
1233        Tcl_DStringFree(&cmdLine);
1234        if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
1235            CloseHandle(startInfo.hStdInput);
1236        }
1237        if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
1238            CloseHandle(startInfo.hStdOutput);
1239        }
1240        if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
1241            CloseHandle(startInfo.hStdError);
1242        }
1243        return result;
1244    }
1245    
1246    
1247    /*
1248     *----------------------------------------------------------------------
1249     *
1250     * HasConsole --
1251     *
1252     *      Determines whether the current application is attached to a
1253     *      console.
1254     *
1255     * Results:
1256     *      Returns TRUE if this application has a console, else FALSE.
1257     *
1258     * Side effects:
1259     *      None.
1260     *
1261     *----------------------------------------------------------------------
1262     */
1263    
1264    static BOOL
1265    HasConsole()
1266    {
1267        HANDLE handle;
1268        
1269        handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
1270                NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
1271    
1272        if (handle != INVALID_HANDLE_VALUE) {
1273            CloseHandle(handle);
1274            return TRUE;
1275        } else {
1276            return FALSE;
1277        }
1278    }
1279    
1280    /*
1281     *--------------------------------------------------------------------
1282     *
1283     * ApplicationType --
1284     *
1285     *      Search for the specified program and identify if it refers to a DOS,
1286     *      Windows 3.X, or Win32 program.  Used to determine how to invoke
1287     *      a program, or if it can even be invoked.
1288     *
1289     *      It is possible to almost positively identify DOS and Windows
1290     *      applications that contain the appropriate magic numbers.  However,
1291     *      DOS .com files do not seem to contain a magic number; if the program
1292     *      name ends with .com and could not be identified as a Windows .com
1293     *      file, it will be assumed to be a DOS application, even if it was
1294     *      just random data.  If the program name does not end with .com, no
1295     *      such assumption is made.
1296     *
1297     *      The Win32 procedure GetBinaryType incorrectly identifies any
1298     *      junk file that ends with .exe as a dos executable and some
1299     *      executables that don't end with .exe as not executable.  Plus it
1300     *      doesn't exist under win95, so I won't feel bad about reimplementing
1301     *      functionality.
1302     *
1303     * Results:
1304     *      The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32
1305     *      if the filename referred to the corresponding application type.
1306     *      If the file name could not be found or did not refer to any known
1307     *      application type, APPL_NONE is returned and an error message is
1308     *      left in interp.  .bat files are identified as APPL_DOS.
1309     *
1310     * Side effects:
1311     *      None.
1312     *
1313     *----------------------------------------------------------------------
1314     */
1315    
1316    static int
1317    ApplicationType(interp, originalName, fullName)
1318        Tcl_Interp *interp;         /* Interp, for error message. */
1319        const char *originalName;   /* Name of the application to find. */
1320        char fullName[];            /* Filled with complete path to
1321                                     * application. */
1322    {
1323        int applType, i, nameLen, found;
1324        HANDLE hFile;
1325        TCHAR *rest;
1326        char *ext;
1327        char buf[2];
1328        DWORD attr, read;
1329        IMAGE_DOS_HEADER header;
1330        Tcl_DString nameBuf, ds;
1331        TCHAR *nativeName;
1332        WCHAR nativeFullPath[MAX_PATH];
1333        static char extensions[][5] = {"", ".com", ".exe", ".bat"};
1334    
1335        /* Look for the program as an external program.  First try the name
1336         * as it is, then try adding .com, .exe, and .bat, in that order, to
1337         * the name, looking for an executable.
1338         *
1339         * Using the raw SearchPath() procedure doesn't do quite what is
1340         * necessary.  If the name of the executable already contains a '.'
1341         * character, it will not try appending the specified extension when
1342         * searching (in other words, SearchPath will not find the program
1343         * "a.b.exe" if the arguments specified "a.b" and ".exe").  
1344         * So, first look for the file as it is named.  Then manually append
1345         * the extensions, looking for a match.  
1346         */
1347    
1348        applType = APPL_NONE;
1349        Tcl_DStringInit(&nameBuf);
1350        Tcl_DStringAppend(&nameBuf, originalName, -1);
1351        nameLen = Tcl_DStringLength(&nameBuf);
1352    
1353        for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
1354            Tcl_DStringSetLength(&nameBuf, nameLen);
1355            Tcl_DStringAppend(&nameBuf, extensions[i], -1);
1356            nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
1357                    Tcl_DStringLength(&nameBuf), &ds);
1358            found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
1359                    MAX_PATH, nativeFullPath, &rest);
1360            Tcl_DStringFree(&ds);
1361            if (found == 0) {
1362                continue;
1363            }
1364    
1365            /*
1366             * Ignore matches on directories or data files, return if identified
1367             * a known type.
1368             */
1369    
1370            attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
1371            if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
1372                continue;
1373            }
1374            strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
1375            Tcl_DStringFree(&ds);
1376    
1377            ext = strrchr(fullName, '.');
1378            if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {
1379                applType = APPL_DOS;
1380                break;
1381            }
1382            
1383            hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
1384                    GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
1385                    FILE_ATTRIBUTE_NORMAL, NULL);
1386            if (hFile == INVALID_HANDLE_VALUE) {
1387                continue;
1388            }
1389    
1390            header.e_magic = 0;
1391            ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
1392            if (header.e_magic != IMAGE_DOS_SIGNATURE) {
1393                /*
1394                 * Doesn't have the magic number for relocatable executables.  If
1395                 * filename ends with .com, assume it's a DOS application anyhow.
1396                 * Note that we didn't make this assumption at first, because some
1397                 * supposed .com files are really 32-bit executables with all the
1398                 * magic numbers and everything.  
1399                 */
1400    
1401                CloseHandle(hFile);
1402                if ((ext != NULL) && (strcmp(ext, ".com") == 0)) {
1403                    applType = APPL_DOS;
1404                    break;
1405                }
1406                continue;
1407            }
1408            if (header.e_lfarlc != sizeof(header)) {
1409                /*
1410                 * All Windows 3.X and Win32 and some DOS programs have this value
1411                 * set here.  If it doesn't, assume that since it already had the
1412                 * other magic number it was a DOS application.
1413                 */
1414    
1415                CloseHandle(hFile);
1416                applType = APPL_DOS;
1417                break;
1418            }
1419    
1420            /*
1421             * The DWORD at header.e_lfanew points to yet another magic number.
1422             */
1423    
1424            buf[0] = '\0';
1425            SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
1426            ReadFile(hFile, (void *) buf, 2, &read, NULL);
1427            CloseHandle(hFile);
1428    
1429            if ((buf[0] == 'N') && (buf[1] == 'E')) {
1430                applType = APPL_WIN3X;
1431            } else if ((buf[0] == 'P') && (buf[1] == 'E')) {
1432                applType = APPL_WIN32;
1433            } else {
1434                /*
1435                 * Strictly speaking, there should be a test that there
1436                 * is an 'L' and 'E' at buf[0..1], to identify the type as
1437                 * DOS, but of course we ran into a DOS executable that
1438                 * _doesn't_ have the magic number -- specifically, one
1439                 * compiled using the Lahey Fortran90 compiler.
1440                 */
1441    
1442                applType = APPL_DOS;
1443            }
1444            break;
1445        }
1446        Tcl_DStringFree(&nameBuf);
1447    
1448        if (applType == APPL_NONE) {
1449            TclWinConvertError(GetLastError());
1450            Tcl_AppendResult(interp, "couldn't execute \"", originalName,
1451                    "\": ", Tcl_PosixError(interp), (char *) NULL);
1452            return APPL_NONE;
1453        }
1454    
1455        if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
1456            /*
1457             * Replace long path name of executable with short path name for
1458             * 16-bit applications.  Otherwise the application may not be able
1459             * to correctly parse its own command line to separate off the
1460             * application name from the arguments.
1461             */
1462    
1463            (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
1464                    nativeFullPath, MAX_PATH);
1465            strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
1466            Tcl_DStringFree(&ds);
1467        }
1468        return applType;
1469    }
1470    
1471    /*    
1472     *----------------------------------------------------------------------
1473     *
1474     * BuildCommandLine --
1475     *
1476     *      The command line arguments are stored in linePtr separated
1477     *      by spaces, in a form that CreateProcess() understands.  Special
1478     *      characters in individual arguments from argv[] must be quoted
1479     *      when being stored in cmdLine.
1480     *
1481     * Results:
1482     *      None.
1483     *
1484     * Side effects:
1485     *      None.
1486     *
1487     *----------------------------------------------------------------------
1488     */
1489    
1490    static void
1491    BuildCommandLine(
1492        CONST char *executable,     /* Full path of executable (including
1493                                     * extension).  Replacement for argv[0]. */
1494        int argc,                   /* Number of arguments. */
1495        char **argv,                /* Argument strings in UTF. */
1496        Tcl_DString *linePtr)       /* Initialized Tcl_DString that receives the
1497                                     * command line (TCHAR). */
1498    {
1499        CONST char *arg, *start, *special;
1500        int quote, i;
1501        Tcl_DString ds;
1502    
1503        Tcl_DStringInit(&ds);
1504    
1505        /*
1506         * Prime the path.
1507         */
1508        
1509        Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
1510        
1511        for (i = 0; i < argc; i++) {
1512            if (i == 0) {
1513                arg = executable;
1514            } else {
1515                arg = argv[i];
1516                Tcl_DStringAppend(&ds, " ", 1);
1517            }
1518    
1519            quote = 0;
1520            if (argv[i][0] == '\0') {
1521                quote = 1;
1522            } else {
1523                for (start = argv[i]; *start != '\0'; start++) {
1524                    if (isspace(*start)) { /* INTL: ISO space. */
1525                        quote = 1;
1526                        break;
1527                    }
1528                }
1529            }
1530            if (quote) {
1531                Tcl_DStringAppend(&ds, "\"", 1);
1532            }
1533    
1534            start = arg;        
1535            for (special = arg; ; ) {
1536                if ((*special == '\\') &&
1537                        (special[1] == '\\' || special[1] == '"')) {
1538                    Tcl_DStringAppend(&ds, start, special - start);
1539                    start = special;
1540                    while (1) {
1541                        special++;
1542                        if (*special == '"') {
1543                            /*
1544                             * N backslashes followed a quote -> insert
1545                             * N * 2 + 1 backslashes then a quote.
1546                             */
1547    
1548                            Tcl_DStringAppend(&ds, start, special - start);
1549                            break;
1550                        }
1551                        if (*special != '\\') {
1552                            break;
1553                        }
1554                    }
1555                    Tcl_DStringAppend(&ds, start, special - start);
1556                    start = special;
1557                }
1558                if (*special == '"') {
1559                    Tcl_DStringAppend(&ds, start, special - start);
1560                    Tcl_DStringAppend(&ds, "\\\"", 2);
1561                    start = special + 1;
1562                }
1563                if (*special == '\0') {
1564                    break;
1565                }
1566                special++;
1567            }
1568            Tcl_DStringAppend(&ds, start, special - start);
1569            if (quote) {
1570                Tcl_DStringAppend(&ds, "\"", 1);
1571            }
1572        }
1573        Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
1574        Tcl_DStringFree(&ds);
1575    }
1576    
1577    /*
1578     *----------------------------------------------------------------------
1579     *
1580     * TclpCreateCommandChannel --
1581     *
1582     *      This function is called by Tcl_OpenCommandChannel to perform
1583     *      the platform specific channel initialization for a command
1584     *      channel.
1585     *
1586     * Results:
1587     *      Returns a new channel or NULL on failure.
1588     *
1589     * Side effects:
1590     *      Allocates a new channel.
1591     *
1592     *----------------------------------------------------------------------
1593     */
1594    
1595    Tcl_Channel
1596    TclpCreateCommandChannel(
1597        TclFile readFile,           /* If non-null, gives the file for reading. */
1598        TclFile writeFile,          /* If non-null, gives the file for writing. */
1599        TclFile errorFile,          /* If non-null, gives the file where errors
1600                                     * can be read. */
1601        int numPids,                /* The number of pids in the pid array. */
1602        Tcl_Pid *pidPtr)            /* An array of process identifiers. */
1603    {
1604        char channelName[16 + TCL_INTEGER_SPACE];
1605        int channelId;
1606        DWORD id;
1607        PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
1608    
1609        PipeInit();
1610    
1611        infoPtr->watchMask = 0;
1612        infoPtr->flags = 0;
1613        infoPtr->readFlags = 0;
1614        infoPtr->readFile = readFile;
1615        infoPtr->writeFile = writeFile;
1616        infoPtr->errorFile = errorFile;
1617        infoPtr->numPids = numPids;
1618        infoPtr->pidPtr = pidPtr;
1619        infoPtr->writeBuf = 0;
1620        infoPtr->writeBufLen = 0;
1621        infoPtr->writeError = 0;
1622    
1623        /*
1624         * Use one of the fds associated with the channel as the
1625         * channel id.
1626         */
1627    
1628        if (readFile) {
1629            channelId = (int) ((WinFile*)readFile)->handle;
1630        } else if (writeFile) {
1631            channelId = (int) ((WinFile*)writeFile)->handle;
1632        } else if (errorFile) {
1633            channelId = (int) ((WinFile*)errorFile)->handle;
1634        } else {
1635            channelId = 0;
1636        }
1637    
1638        infoPtr->validMask = 0;
1639    
1640        infoPtr->threadId = Tcl_GetCurrentThread();
1641    
1642        if (readFile != NULL) {
1643            /*
1644             * Start the background reader thread.
1645             */
1646    
1647            infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
1648            infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
1649            infoPtr->readThread = CreateThread(NULL, 8000, PipeReaderThread,
1650                    infoPtr, 0, &id);
1651            SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
1652            infoPtr->validMask |= TCL_READABLE;
1653        } else {
1654            infoPtr->readThread = 0;
1655        }
1656        if (writeFile != NULL) {
1657            /*
1658             * Start the background writeer thwrite.
1659             */
1660    
1661            infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
1662            infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1663            infoPtr->writeThread = CreateThread(NULL, 8000, PipeWriterThread,
1664                    infoPtr, 0, &id);
1665            SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
1666            infoPtr->validMask |= TCL_WRITABLE;
1667        }
1668    
1669        /*
1670         * For backward compatibility with previous versions of Tcl, we
1671         * use "file%d" as the base name for pipes even though it would
1672         * be more natural to use "pipe%d".
1673         * Use the pointer to keep the channel names unique, in case
1674         * channels share handles (stdin/stdout).
1675         */
1676    
1677        wsprintfA(channelName, "file%lx", infoPtr);
1678        infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
1679                (ClientData) infoPtr, infoPtr->validMask);
1680    
1681        /*
1682         * Pipes have AUTO translation mode on Windows and ^Z eof char, which
1683         * means that a ^Z will be appended to them at close. This is needed
1684         * for Windows programs that expect a ^Z at EOF.
1685         */
1686    
1687        Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
1688                "-translation", "auto");
1689        Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
1690                "-eofchar", "\032 {}");
1691        return infoPtr->channel;
1692    }
1693    
1694    /*
1695     *----------------------------------------------------------------------
1696     *
1697     * TclGetAndDetachPids --
1698     *
1699     *      Stores a list of the command PIDs for a command channel in
1700     *      the interp's result.
1701     *
1702     * Results:
1703     *      None.
1704     *
1705     * Side effects:
1706     *      Modifies the interp's result.
1707     *
1708     *----------------------------------------------------------------------
1709     */
1710    
1711    void
1712    TclGetAndDetachPids(
1713        Tcl_Interp *interp,
1714        Tcl_Channel chan)
1715    {
1716        PipeInfo *pipePtr;
1717        Tcl_ChannelType *chanTypePtr;
1718        int i;
1719        char buf[TCL_INTEGER_SPACE];
1720    
1721        /*
1722         * Punt if the channel is not a command channel.
1723         */
1724    
1725        chanTypePtr = Tcl_GetChannelType(chan);
1726        if (chanTypePtr != &pipeChannelType) {
1727            return;
1728        }
1729    
1730        pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
1731        for (i = 0; i < pipePtr->numPids; i++) {
1732            wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
1733            Tcl_AppendElement(interp, buf);
1734            Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
1735        }
1736        if (pipePtr->numPids > 0) {
1737            ckfree((char *) pipePtr->pidPtr);
1738            pipePtr->numPids = 0;
1739        }
1740    }
1741    
1742    /*
1743     *----------------------------------------------------------------------
1744     *
1745     * PipeBlockModeProc --
1746     *
1747     *      Set blocking or non-blocking mode on channel.
1748     *
1749     * Results:
1750     *      0 if successful, errno when failed.
1751     *
1752     * Side effects:
1753     *      Sets the device into blocking or non-blocking mode.
1754     *
1755     *----------------------------------------------------------------------
1756     */
1757    
1758    static int
1759    PipeBlockModeProc(
1760        ClientData instanceData,    /* Instance data for channel. */
1761        int mode)                   /* TCL_MODE_BLOCKING or
1762                                     * TCL_MODE_NONBLOCKING. */
1763    {
1764        PipeInfo *infoPtr = (PipeInfo *) instanceData;
1765        
1766        /*
1767         * Pipes on Windows can not be switched between blocking and nonblocking,
1768         * hence we have to emulate the behavior. This is done in the input
1769         * function by checking against a bit in the state. We set or unset the
1770         * bit here to cause the input function to emulate the correct behavior.
1771         */
1772    
1773        if (mode == TCL_MODE_NONBLOCKING) {
1774            infoPtr->flags |= PIPE_ASYNC;
1775        } else {
1776            infoPtr->flags &= ~(PIPE_ASYNC);
1777        }
1778        return 0;
1779    }
1780    
1781    /*
1782     *----------------------------------------------------------------------
1783     *
1784     * PipeClose2Proc --
1785     *
1786     *      Closes a pipe based IO channel.
1787     *
1788     * Results:
1789     *      0 on success, errno otherwise.
1790     *
1791     * Side effects:
1792     *      Closes the physical channel.
1793     *
1794     *----------------------------------------------------------------------
1795     */
1796    
1797    static int
1798    PipeClose2Proc(
1799        ClientData instanceData,    /* Pointer to PipeInfo structure. */
1800        Tcl_Interp *interp,         /* For error reporting. */
1801        int flags)                  /* Flags that indicate which side to close. */
1802    {
1803        PipeInfo *pipePtr = (PipeInfo *) instanceData;
1804        Tcl_Channel errChan;
1805        int errorCode, result;
1806        PipeInfo *infoPtr, **nextPtrPtr;
1807        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1808    
1809        errorCode = 0;
1810        if ((!flags || (flags == TCL_CLOSE_READ))
1811                && (pipePtr->readFile != NULL)) {
1812            /*
1813