* All the changes below serve to fix bug [219148] which reports a

	  80x performance hit for file I/O on Win* systems. On my system
	  it was closer to a 120x hit. Problem report by Uwe Traum <no
	  email address available>.

	  The fix goes like this: The obstacle is 'FlushFileBuffers',
	  executed whenever Tcl writes data to the OS, as Tcl has to wait
	  for the disk to complete I/O, and disks are slow. We remove that
	  obstacle. This opens another problem, [file size] reports back
	  wrong numbers. So for [file size] we add the call back in. As
	  optimization we keep track of the channels which were written to
	  and flush only these.

	* win/tclWinFile.c (TclpObjStat): Added a call to
	  'TclWinFlushDirtyChannels'. This ensures that [file size] and
	  related commands report the correct size of a file even if Tcl
	  has recently written to it. Unixoid OS's always report the
	  correct size even for files with pending data, but Win*
	  syssystem don't. They only report what is actually on disk.

	* win/tclWinInt.h: Added declaration of
	  'TclWinFlushDirtyChannels', making it available to other parts
	  of the tcl core.

	* win/tclWinChan.c (TclWinFlushDirtyChannels): New, internal,
	  procedure. Goes through the list of open file channels and
	  forces the OS to flush its file buffers for all which were
	  written to since the last call of this function. This is an
	  expensive operation as Tcl has to wait for the OS to complete
	  actual writes to the disk.

	  (FileInfo): Added dirty flag required by the procedure above.

	  (FileOutputProc): Removed flushing of file buffers, setting the
	  dirty flag instead. This means that the previously incurred
	  delays do not happen anymore.

	  (TclWinOpenFileChannel): Added initialization of 'dirty' flag.

3 files changed, 59 insertions, 5 deletions

diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 51d418a..78b7daf 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinChan.c,v 1.14 2001/08/30 08:53:15 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.15 2001/09/07 17:08:50 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -40,6 +40,8 @@ typedef struct FileInfo {
     int flags;			/* State flags, see above for a list. */
     HANDLE handle;		/* Input/output file. */
     struct FileInfo *nextPtr;	/* Pointer to next registered file. */
+    int dirty;                  /* Boolean flag. Set if the OS may have data
+				 * pending on the channel */
 } FileInfo;
 
 typedef struct ThreadSpecificData {
@@ -557,7 +559,7 @@ FileOutputProc(instanceData, buf, toWrite, errorCode)
         *errorCode = errno;
         return -1;
     }
-    FlushFileBuffers(infoPtr->handle);
+    infoPtr->dirty = 1;
     return bytesWritten;
 }
 
@@ -1122,7 +1124,7 @@ TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
     infoPtr->watchMask = 0;
     infoPtr->flags = appendMode;
     infoPtr->handle = handle;
-	
+    infoPtr->dirty = 0;
     wsprintfA(channelName, "file%lx", (int) infoPtr);
     
     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
@@ -1139,3 +1141,45 @@ TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
     return infoPtr->channel;
 }
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenFileChannel --
+ *
+ *	Constructs a File channel for the specified standard OS handle.
+ *      This is a helper function to break up the construction of 
+ *      channels into File, Console, or Serial.
+ *
+ * Results:
+ *	Returns the new channel, or NULL.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinFlushDirtyChannels ()
+{
+    FileInfo *infoPtr;
+    ThreadSpecificData *tsdPtr;
+
+    tsdPtr = FileInit();
+
+    /*
+     * Flush all channels which are dirty, i.e. may have data pending
+     * in the OS
+     */
+    
+    for (infoPtr = tsdPtr->firstFilePtr;
+	 infoPtr != NULL; 
+	 infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->dirty) {
+	    FlushFileBuffers(infoPtr->handle);
+	    infoPtr->dirty = 0;
+	}
+    }
+}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c62b9ac..1c8a300 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.13 2001/08/30 08:53:15 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.14 2001/09/07 17:08:50 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -694,6 +694,14 @@ TclpObjChdir(pathPtr)
     int result;
     TCHAR *nativePath;
 
+    /*
+     * Ensure correct file sizes by forcing the OS to write any
+     * pending data to disk. This is done only for channels which are
+     * dirty, i.e. have been written to since the last flush here.
+     */
+
+    TclWinFlushDirtyChannels ();
+
     nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
     result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
 
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 82dc69c..364f195 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinInt.h,v 1.9 2001/03/26 11:08:16 dkf Exp $
+ * RCS: @(#) $Id: tclWinInt.h,v 1.10 2001/09/07 17:08:50 andreas_kupries Exp $
  */
 
 #ifndef _TCLWININT
@@ -100,6 +100,8 @@ EXTERN TclWinProcs *tclWinProcs;
 
 EXTERN void		TclWinInit(HINSTANCE hInst);
 
+EXTERN void TclWinFlushDirtyChannels _ANSI_ARGS_((void));
+
 # undef TCL_STORAGE_CLASS
 # define TCL_STORAGE_CLASS DLLIMPORT