TIP#91 implementation; makes old style channels binary compatible with

new TIP#72-enabled Tcl.  See http://purl.org/tcl/tip/91 for details.

2 files changed, 91 insertions, 5 deletions

diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index ad10251..530492d 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.22 2002/05/13 13:20:00 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.23 2002/05/24 21:19:09 dkf Exp $
  */
 
 #include "tclWinInt.h"
@@ -89,7 +89,9 @@ static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
 	            	    char *buf, int toRead, int *errorCode));
 static int		FileOutputProc _ANSI_ARGS_((ClientData instanceData,
 			    CONST char *buf, int toWrite, int *errorCode));
-static Tcl_WideInt	FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+			    long offset, int mode, int *errorCode));
+static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
 			    Tcl_WideInt offset, int mode, int *errorCode));
 static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
 			    int flags));
@@ -103,7 +105,7 @@ static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
 
 static Tcl_ChannelType fileChannelType = {
     "file",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_3,	/* v3 channel */
     FileCloseProc,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
@@ -116,6 +118,7 @@ static Tcl_ChannelType fileChannelType = {
     FileBlockProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    FileWideSeekProc,		/* Wide seek proc. */
 };
 
 #ifdef HAVE_NO_SEH
@@ -436,9 +439,86 @@ FileCloseProc(instanceData, interp)
  *----------------------------------------------------------------------
  */
 
-static Tcl_WideInt
+static int
 FileSeekProc(instanceData, offset, mode, errorCodePtr)
     ClientData instanceData;	/* File state. */
+    long offset;		/* Offset to seek to. */
+    int mode;			/* Relative to where should we seek? */
+    int *errorCodePtr;		/* To store error code. */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+    DWORD moveMethod;
+    DWORD newPos, newPosHigh;
+    DWORD oldPos, oldPosHigh;
+
+    *errorCodePtr = 0;
+    if (mode == SEEK_SET) {
+        moveMethod = FILE_BEGIN;
+    } else if (mode == SEEK_CUR) {
+        moveMethod = FILE_CURRENT;
+    } else {
+        moveMethod = FILE_END;
+    }
+
+    /*
+     * Save our current place in case we need to roll-back the seek.
+     */
+    oldPosHigh = (DWORD)0;
+    oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
+	    FILE_CURRENT);
+    if (oldPos == INVALID_SET_FILE_POINTER) {
+	int winError = GetLastError();
+	if (winError != NO_ERROR) {
+	    TclWinConvertError(winError);
+	    *errorCodePtr = errno;
+	    return -1;
+	}
+    }
+
+    newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
+    newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
+			    moveMethod);
+    if (newPos == INVALID_SET_FILE_POINTER) {
+	int winError = GetLastError();
+	if (winError != NO_ERROR) {
+	    TclWinConvertError(winError);
+	    *errorCodePtr = errno;
+	    return -1;
+	}
+    }
+
+    /*
+     * Check for expressability in our return type, and roll-back otherwise.
+     */
+    if (newPosHigh != 0) {
+	*errorCodePtr = EOVERFLOW;
+	SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
+	return -1;
+    }
+    return (int) newPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ *	Seeks on a file-based channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
+    ClientData instanceData;	/* File state. */
     Tcl_WideInt offset;		/* Offset to seek to. */
     int mode;			/* Relative to where should we seek? */
     int *errorCodePtr;		/* To store error code. */
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index c1b3189..9f7a7c4 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinPort.h,v 1.27 2002/02/22 09:04:48 dkf Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.28 2002/05/24 21:19:09 dkf Exp $
  */
 
 #ifndef _TCLWINPORT
@@ -199,6 +199,12 @@
 #ifndef EREMOTE
 #define EREMOTE		66	/* The object is remote */
 #endif
+/*
+ * Note that EOVERFLOW is really just a specialist ERANGE...
+ */
+#ifndef EOVERFLOW
+#define EOVERFLOW	ERANGE	/* The object couldn't fit in the datatype */
+#endif
 
 /*
  * Supply definitions for macros to query wait status, if not already