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

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

1 files changed, 107 insertions, 10 deletions

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 022ba35..0bc3083 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -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.
  *
- * CVS: $Id: tclIOGT.c,v 1.6 2002/02/15 19:58:28 andreas_kupries Exp $
+ * CVS: $Id: tclIOGT.c,v 1.7 2002/05/24 21:19:06 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -33,8 +33,8 @@ static int		TransformInputProc _ANSI_ARGS_ ((
 static int		TransformOutputProc _ANSI_ARGS_ ((
 				ClientData instanceData, CONST char *buf,
 				int toWrite, int* errorCodePtr));
-static Tcl_WideInt	TransformSeekProc _ANSI_ARGS_ ((
-				ClientData instanceData, Tcl_WideInt offset,
+static int		TransformSeekProc _ANSI_ARGS_ ((
+				ClientData instanceData, long offset,
 				int mode, int* errorCodePtr));
 static int		TransformSetOptionProc _ANSI_ARGS_((
 				ClientData instanceData, Tcl_Interp *interp,
@@ -49,6 +49,9 @@ static int		TransformGetFileHandleProc _ANSI_ARGS_ ((
 				ClientData* handlePtr));
 static int		TransformNotifyProc _ANSI_ARGS_ ((
 				ClientData instanceData, int mask));
+static Tcl_WideInt	TransformWideSeekProc _ANSI_ARGS_ ((
+				ClientData instanceData, Tcl_WideInt offset,
+				int mode, int* errorCodePtr));
 
 /*
  * Forward declarations of internal procedures.
@@ -141,6 +144,7 @@ static Tcl_ChannelType transformChannelType = {
     TransformBlockModeProc,		/* Set blocking/nonblocking mode.*/
     NULL,				/* Flush proc. */
     TransformNotifyProc,                /* Handling of events bubbling up */
+    TransformWideSeekProc,		/* Wide seek proc */
 };
 
 /*
@@ -843,14 +847,13 @@ TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
  *------------------------------------------------------*
  */
 
-static Tcl_WideInt
+static int
 TransformSeekProc (instanceData, offset, mode, errorCodePtr)
     ClientData  instanceData;	/* The channel to manipulate */
-    Tcl_WideInt offset;		/* Size of movement. */
+    long	offset;		/* Size of movement. */
     int         mode;		/* How to move */
     int*        errorCodePtr;	/* Location of error flag. */
 {
-    Tcl_WideInt result;
     TransformChannelData* dataPtr	= (TransformChannelData*) instanceData;
     Tcl_Channel           parent        = Tcl_GetStackedChannel(dataPtr->self);
     Tcl_ChannelType*      parentType	= Tcl_GetChannelType(parent);
@@ -861,9 +864,8 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr)
 	 * location. Simply pass the request down.
 	 */
 
-	result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+	return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
 		offset, mode, errorCodePtr);
-	return result;
     }
 
     /*
@@ -884,9 +886,104 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr)
 	dataPtr->readIsFlushed = 0;
     }
 
-    result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+    return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
 	    offset, mode, errorCodePtr);
-    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformWideSeekProc --
+ *
+ *	This procedure is called by the generic IO level to move the
+ *	access point in a channel, with a (potentially) 64-bit offset.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.  Flushes all transformation buffers, then
+ *	forwards it to the underlying channel.
+ *
+ * Result:
+ *	-1 if failed, the new position if successful. An output
+ *	argument contains the POSIX error code if an error occurred,
+ *	or zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+TransformWideSeekProc (instanceData, offset, mode, errorCodePtr)
+    ClientData  instanceData;	/* The channel to manipulate */
+    Tcl_WideInt offset;		/* Size of movement. */
+    int         mode;		/* How to move */
+    int*        errorCodePtr;	/* Location of error flag. */
+{
+    TransformChannelData* dataPtr =
+	(TransformChannelData*) instanceData;
+    Tcl_Channel parent =
+	Tcl_GetStackedChannel(dataPtr->self);
+    Tcl_ChannelType* parentType	=
+	Tcl_GetChannelType(parent);
+    Tcl_DriverSeekProc* parentSeekProc =
+	Tcl_ChannelSeekProc(parentType);
+    Tcl_DriverWideSeekProc* parentWideSeekProc =
+	Tcl_ChannelWideSeekProc(parentType);
+    ClientData parentData =
+	Tcl_GetChannelInstanceData(parent);
+
+    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
+        /*
+	 * This is no seek but a request to tell the caller the current
+	 * location. Simply pass the request down.
+	 */
+
+	if (parentWideSeekProc != NULL) {
+	    return (*parentWideSeekProc) (parentData, offset, mode,
+		    errorCodePtr);
+	}
+
+	return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,
+		errorCodePtr));
+    }
+
+    /*
+     * It is a real request to change the position. Flush all data waiting
+     * for output and discard everything in the input buffers. Then pass
+     * the request down, unchanged.
+     */
+
+    if (dataPtr->mode & TCL_WRITABLE) {
+        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
+		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
+    }
+
+    if (dataPtr->mode & TCL_READABLE) {
+        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
+		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+	ResultClear(&dataPtr->result);
+	dataPtr->readIsFlushed = 0;
+    }
+
+    /*
+     * If we have a wide seek capability, we should stick with that.
+     */
+    if (parentWideSeekProc != NULL) {
+	return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr);
+    }
+
+    /*
+     * We're transferring to narrow seeks at this point; this is a bit
+     * complex because we have to check whether the seek is possible
+     * first (i.e. whether we are losing information in truncating the
+     * bits of the offset.)  Luckily, there's a defined error for what
+     * happens when trying to go out of the representable range.
+     */
+    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+	*errorCodePtr = EOVERFLOW;
+	return Tcl_LongAsWide(-1);
+    }
+    return Tcl_LongAsWide((*parentSeekProc) (parentData,
+	    Tcl_WideAsLong(offset), mode, errorCodePtr));
 }
 
 /*