summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-05-24 21:19:05 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-05-24 21:19:05 (GMT)
commit72a4179af19fda9a49f2da72163af2736a7419a1 (patch)
treed34442300ca635a1ed50e2595f393b9dfaca97f4 /win
parentd77d232574a42bc3399bd68a7f826c5cc25d86f4 (diff)
downloadtcl-72a4179af19fda9a49f2da72163af2736a7419a1.zip
tcl-72a4179af19fda9a49f2da72163af2736a7419a1.tar.gz
tcl-72a4179af19fda9a49f2da72163af2736a7419a1.tar.bz2
TIP#91 implementation; makes old style channels binary compatible with
new TIP#72-enabled Tcl. See http://purl.org/tcl/tip/91 for details.
Diffstat (limited to 'win')
-rw-r--r--win/tclWinChan.c88
-rw-r--r--win/tclWinPort.h8
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