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

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

6 files changed, 298 insertions, 90 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 75e787e..b384108 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.86 2002/03/20 22:47:36 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.87 2002/05/24 21:19:05 dkf Exp $
 
 library tcl
 
@@ -28,12 +28,12 @@ hooks {tclPlat tclInt tclIntPlat}
 # to preserve backwards compatibility.
 
 declare 0 generic {
-    int Tcl_PkgProvideEx( Tcl_Interp* interp, CONST char* name,
-	    CONST char* version, ClientData clientData )
+    int Tcl_PkgProvideEx(Tcl_Interp* interp, CONST char* name,
+	    CONST char* version, ClientData clientData)
 }
 declare 1 generic {
-    CONST char * Tcl_PkgRequireEx( Tcl_Interp *interp, CONST char *name,
-	    CONST char *version, int exact, ClientData *clientDataPtr )
+    CONST char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name,
+	    CONST char *version, int exact, ClientData *clientDataPtr)
 }
 declare 2 generic {
     void Tcl_Panic(CONST char *format, ...)
@@ -86,7 +86,7 @@ declare 15 generic {
     void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
 }
 declare 16 generic {
-    void Tcl_AppendToObj( Tcl_Obj* objPtr, CONST char* bytes, int length )
+    void Tcl_AppendToObj(Tcl_Obj* objPtr, CONST char* bytes, int length)
 }
 declare 17 generic {
     Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[])
@@ -248,7 +248,7 @@ declare 64 generic {
     void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
 }
 declare 65 generic {
-    void Tcl_SetStringObj( Tcl_Obj* objPtr, CONST char* bytes, int length )
+    void Tcl_SetStringObj(Tcl_Obj* objPtr, CONST char* bytes, int length)
 }
 declare 66 generic {
     void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message)
@@ -936,10 +936,10 @@ declare 264 generic {
 	    Tcl_Obj *CONST objv[], CONST char *message)
 }
 declare 265 generic {
-    int Tcl_DumpActiveMemory( CONST char *fileName )
+    int Tcl_DumpActiveMemory(CONST char *fileName)
 }
 declare 266 generic {
-    void Tcl_ValidateAllMemory( CONST char *file, int line )
+    void Tcl_ValidateAllMemory(CONST char *file, int line)
 }
 
 declare 267 generic {
@@ -1698,26 +1698,22 @@ declare 481 generic {
 
 # New export due to TIP#73 
 declare 482 generic {
-    void Tcl_GetTime( Tcl_Time* timeBuf )
+    void Tcl_GetTime(Tcl_Time* timeBuf)
 }
 
 # New exports due to TIP#32
 
 declare 483 generic {
-    Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp* interp,
-             	                  int level,
-	                          int flags,
-                                  Tcl_CmdObjTraceProc* objProc,
-                                  ClientData clientData,
-			          Tcl_CmdObjTraceDeleteProc* delProc )
+    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp* interp, int level, int flags,
+	    Tcl_CmdObjTraceProc* objProc, ClientData clientData,
+	    Tcl_CmdObjTraceDeleteProc* delProc)
 }
 declare 484 generic {
-    int Tcl_GetCommandInfoFromToken( Tcl_Command token,
-	                             Tcl_CmdInfo* infoPtr )
+    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo* infoPtr)
 }
 declare 485 generic {
-    int Tcl_SetCommandInfoFromToken( Tcl_Command token,
-	                             CONST Tcl_CmdInfo* infoPtr )
+    int Tcl_SetCommandInfoFromToken(Tcl_Command token,
+	    CONST Tcl_CmdInfo* infoPtr)
 }
 
 ### New functions on 64-bit dev branch ###
@@ -1745,6 +1741,12 @@ declare 492 generic {
     Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
 }
 
+# New export due to TIP#91
+declare 493 generic {
+    Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
+	    Tcl_ChannelType *chanTypePtr)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tcl.h b/generic/tcl.h
index 80bdd32..0df69dd 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.123 2002/04/08 09:02:38 das Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.124 2002/05/24 21:19:05 dkf Exp $
  */
 
 #ifndef _TCL
@@ -1419,7 +1419,7 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
  */
 #define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
 #define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
-
+#define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
 
 /*
  * Typedefs for the various operations in a channel type:
@@ -1434,8 +1434,8 @@ typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
 		    char *buf, int toRead, int *errorCodePtr));
 typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
 		    CONST84 char *buf, int toWrite, int *errorCodePtr));
-typedef Tcl_WideInt (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_WideInt offset, int mode, int *errorCodePtr));
+typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
+		    long offset, int mode, int *errorCodePtr));
 typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_Interp *interp,
 	            CONST char *optionName, CONST char *value));
@@ -1451,6 +1451,9 @@ typedef int	(Tcl_DriverFlushProc) _ANSI_ARGS_((
 		    ClientData instanceData));
 typedef int	(Tcl_DriverHandlerProc) _ANSI_ARGS_((
 		    ClientData instanceData, int interestMask));
+typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_WideInt offset,
+		    int mode, int *errorCodePtr));
 
 
 /*
@@ -1526,13 +1529,22 @@ typedef struct Tcl_ChannelType {
 					/* Set blocking mode for the
 					 * raw channel. May be NULL. */
     /*
-     * Only valid in TCL_CHANNEL_VERSION_2 channels
+     * Only valid in TCL_CHANNEL_VERSION_2 channels or later
      */
     Tcl_DriverFlushProc *flushProc;	/* Procedure to call to flush a
 					 * channel. May be NULL. */
     Tcl_DriverHandlerProc *handlerProc;	/* Procedure to call to handle a
 					 * channel event.  This will be passed
 					 * up the stacked channel chain. */
+    /*
+     * Only valid in TCL_CHANNEL_VERSION_3 channels or later
+     */
+    Tcl_DriverWideSeekProc *wideSeekProc;
+					/* Procedure to call to seek
+					 * on the channel which can
+					 * handle 64-bit offsets. May be
+					 * NULL, and must be NULL if
+					 * seekProc is NULL. */
 } Tcl_ChannelType;
 
 /*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 392a2e7..95e47ec 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.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: tclDecls.h,v 1.86 2002/03/20 22:47:36 dgp Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.87 2002/05/24 21:19:05 dkf Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1553,6 +1553,9 @@ EXTERN Tcl_WideInt	Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
 				Tcl_WideInt offset, int mode));
 /* 492 */
 EXTERN Tcl_WideInt	Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+/* 493 */
+EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
+				Tcl_ChannelType * chanTypePtr));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -2105,6 +2108,7 @@ typedef struct TclStubs {
     Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */
     Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
     Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
+    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -4117,6 +4121,10 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_Tell \
 	(tclStubsPtr->tcl_Tell) /* 492 */
 #endif
+#ifndef Tcl_ChannelWideSeekProc
+#define Tcl_ChannelWideSeekProc \
+	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f884f6e..4895824 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.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.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.55 2002/04/18 01:51:20 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.56 2002/05/24 21:19:05 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -123,6 +123,8 @@ static int		FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
 				Channel *chanPtr, int calledFromAsyncFlush));
 static Tcl_HashTable *	GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
 static int		GetInput _ANSI_ARGS_((Channel *chanPtr));
+static int		HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
+				Tcl_ChannelTypeVersion minimumVersion));
 static void		PeekAhead _ANSI_ARGS_((Channel *chanPtr,
 				char **dstEndPtr, GetsState *gsPtr));
 static int		ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
@@ -5332,6 +5334,7 @@ Tcl_Seek(chan, offset, mode)
     Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */
     ChannelState *statePtr = chanPtr->state;	/* state info for channel */
     int inputBuffered, outputBuffered;
+				/* # bytes held in buffers. */
     int result;			/* Of device driver operations. */
     Tcl_WideInt curPos;		/* Position on the device. */
     int wasAsync;		/* Was the channel nonblocking before the
@@ -5339,7 +5342,7 @@ Tcl_Seek(chan, offset, mode)
                                  * nonblocking mode after the seek. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
-	return -1;
+	return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5349,7 +5352,9 @@ Tcl_Seek(chan, offset, mode)
      * registered in an interpreter.
      */
 
-    if (CheckForDeadChannel(NULL, statePtr)) return -1;
+    if (CheckForDeadChannel(NULL, statePtr)) {
+	return Tcl_LongAsWide(-1);
+    }
 
     /*
      * This operation should occur at the top of a channel stack.
@@ -5364,7 +5369,7 @@ Tcl_Seek(chan, offset, mode)
 
     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
         Tcl_SetErrno(EINVAL);
-        return -1;
+        return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5377,7 +5382,7 @@ Tcl_Seek(chan, offset, mode)
 
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
         Tcl_SetErrno(EFAULT);
-        return -1;
+        return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5416,7 +5421,7 @@ Tcl_Seek(chan, offset, mode)
         wasAsync = 1;
         result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
-	    return -1;
+	    return Tcl_LongAsWide(-1);
 	}
         statePtr->flags &= (~(CHANNEL_NONBLOCKING));
         if (statePtr->flags & BG_FLUSH_SCHEDULED) {
@@ -5438,14 +5443,26 @@ Tcl_Seek(chan, offset, mode)
 
         /*
          * Now seek to the new position in the channel as requested by the
-         * caller.
+         * caller.  Note that we prefer the wideSeekProc if that is
+	 * available and non-NULL...
          */
 
-        curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
-		offset, mode, &result);
-        if (curPos == -1) {
-            Tcl_SetErrno(result);
-        }
+	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
+		chanPtr->typePtr->wideSeekProc != NULL) {
+	    curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
+		    offset, mode, &result);
+	} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
+		offset > Tcl_LongAsWide(LONG_MAX)) {
+	    Tcl_SetErrno(EOVERFLOW);
+	    curPos = Tcl_LongAsWide(-1);
+	} else {
+	    curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
+		    chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
+		    &result));
+	    if (curPos == Tcl_LongAsWide(-1)) {
+		Tcl_SetErrno(result);
+	    }
+	}
     }
     
     /*
@@ -5459,7 +5476,7 @@ Tcl_Seek(chan, offset, mode)
         statePtr->flags |= CHANNEL_NONBLOCKING;
         result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
 	if (result != 0) {
-	    return -1;
+	    return Tcl_LongAsWide(-1);
 	}
     }
 
@@ -5491,12 +5508,12 @@ Tcl_Tell(chan)
 {
     Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */
     ChannelState *statePtr = chanPtr->state;	/* state info for channel */
-    int inputBuffered, outputBuffered;
+    int inputBuffered, outputBuffered;	/* # bytes held in buffers. */
     int result;				/* Of calling device driver. */
     Tcl_WideInt curPos;			/* Position on device. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
-	return -1;
+	return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5507,7 +5524,7 @@ Tcl_Tell(chan)
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
-	return -1;
+	return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5523,7 +5540,7 @@ Tcl_Tell(chan)
 
     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
         Tcl_SetErrno(EINVAL);
-        return -1;
+        return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5536,24 +5553,31 @@ Tcl_Tell(chan)
 
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
         Tcl_SetErrno(EFAULT);
-        return -1;
+        return Tcl_LongAsWide(-1);
     }
 
     /*
      * Get the current position in the device and compute the position
-     * where the next character will be read or written.
+     * where the next character will be read or written.  Note that we
+     * prefer the wideSeekProc if that is available and non-NULL...
      */
 
-    curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
-	    Tcl_LongAsWide(0), SEEK_CUR, &result);
-    if (curPos == -1) {
+    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
+	    chanPtr->typePtr->wideSeekProc != NULL) {
+	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
+		Tcl_LongAsWide(0), SEEK_CUR, &result);
+    } else {
+	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
+		chanPtr->instanceData, 0, SEEK_CUR, &result));
+    }
+    if (curPos == Tcl_LongAsWide(-1)) {
         Tcl_SetErrno(result);
-        return -1;
+        return Tcl_LongAsWide(-1);
     }
     if (inputBuffered != 0) {
-        return (curPos - inputBuffered);
+        return curPos - inputBuffered;
     }
-    return (curPos + outputBuffered);
+    return curPos + outputBuffered;
 }
 
 /*
@@ -5562,10 +5586,12 @@ Tcl_Tell(chan)
  * Tcl_SeekOld, Tcl_TellOld --
  *
  *	Backward-compatability versions of the seek/tell interface that
- *	do not support 64-bit offsets.
+ *	do not support 64-bit offsets.  This interface is not documented
+ *	or expected to be supported indefinitely.
  *
  * Results:
- *	As for Tcl_Seek and Tcl_Tell respectively.
+ *	As for Tcl_Seek and Tcl_Tell respectively, except truncated to
+ *	whatever value will fit in an 'int'.
  *
  * Side effects:
  *	As for Tcl_Seek and Tcl_Tell respectively.
@@ -6663,17 +6689,13 @@ Tcl_NotifyChannel(channel, mask)
      */
 
     while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
+	Tcl_DriverHandlerProc* upHandlerProc;
+
         upChanPtr = chanPtr->upChanPtr;
 	upTypePtr = upChanPtr->typePtr;
-
-	if ((Tcl_ChannelVersion(upTypePtr) == TCL_CHANNEL_VERSION_2) &&
-		(Tcl_ChannelHandlerProc(upTypePtr) !=
-			((Tcl_DriverHandlerProc *) NULL))) {
-
-	    Tcl_DriverHandlerProc* handlerProc =
-		Tcl_ChannelHandlerProc(upTypePtr);
-
-	  mask = (*handlerProc) (upChanPtr->instanceData, mask);
+	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
+	if (upHandlerProc != NULL) {
+	    mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
 	}
 
 	/* ELSE:
@@ -8688,7 +8710,7 @@ CONST char *
 Tcl_ChannelName(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->typeName);
+    return chanTypePtr->typeName;
 }
 
 /*
@@ -8699,7 +8721,7 @@ Tcl_ChannelName(chanTypePtr)
  *	Return the of version of the channel type.
  *
  * Results:
- *	TCL_CHANNEL_VERSION_2 or TCL_CHANNEL_VERSION_1.
+ *	One of the TCL_CHANNEL_VERSION_* constants from tcl.h
  *
  * Side effects:
  *	None.
@@ -8713,6 +8735,8 @@ Tcl_ChannelVersion(chanTypePtr)
 {
     if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
 	return TCL_CHANNEL_VERSION_2;
+    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
+	return TCL_CHANNEL_VERSION_3;
     } else {
 	/*
 	 * In <v2 channel versions, the version field is occupied
@@ -8725,6 +8749,33 @@ Tcl_ChannelVersion(chanTypePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * HaveVersion --
+ *
+ *	Return whether a channel type is (at least) of a given version.
+ *
+ * Results:
+ *	True if the minimum version is exceeded by the version actually
+ *	present.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+HaveVersion(chanTypePtr, minimumVersion)
+    Tcl_ChannelType *chanTypePtr;
+    Tcl_ChannelTypeVersion minimumVersion;
+{
+    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
+
+    return ((int)actualVersion) >= ((int)minimumVersion);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ChannelBlockModeProc --
  *
  *	Return the Tcl_DriverBlockModeProc of the channel type.
@@ -8735,16 +8786,18 @@ Tcl_ChannelVersion(chanTypePtr)
  * Side effects:
  *	None.
  *
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
 
 Tcl_DriverBlockModeProc *
 Tcl_ChannelBlockModeProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
-	return (chanTypePtr->blockModeProc);
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+	return chanTypePtr->blockModeProc;
     } else {
+	/*
+	 * The v1 structure had the blockModeProc in a different place.
+	 */
 	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
     }
 }
@@ -8769,7 +8822,7 @@ Tcl_DriverCloseProc *
 Tcl_ChannelCloseProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->closeProc);
+    return chanTypePtr->closeProc;
 }
 
 /*
@@ -8792,7 +8845,7 @@ Tcl_DriverClose2Proc *
 Tcl_ChannelClose2Proc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->close2Proc);
+    return chanTypePtr->close2Proc;
 }
 
 /*
@@ -8815,7 +8868,7 @@ Tcl_DriverInputProc *
 Tcl_ChannelInputProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->inputProc);
+    return chanTypePtr->inputProc;
 }
 
 /*
@@ -8838,7 +8891,7 @@ Tcl_DriverOutputProc *
 Tcl_ChannelOutputProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->outputProc);
+    return chanTypePtr->outputProc;
 }
 
 /*
@@ -8861,7 +8914,7 @@ Tcl_DriverSeekProc *
 Tcl_ChannelSeekProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->seekProc);
+    return chanTypePtr->seekProc;
 }
 
 /*
@@ -8884,7 +8937,7 @@ Tcl_DriverSetOptionProc *
 Tcl_ChannelSetOptionProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->setOptionProc);
+    return chanTypePtr->setOptionProc;
 }
 
 /*
@@ -8907,7 +8960,7 @@ Tcl_DriverGetOptionProc *
 Tcl_ChannelGetOptionProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->getOptionProc);
+    return chanTypePtr->getOptionProc;
 }
 
 /*
@@ -8930,7 +8983,7 @@ Tcl_DriverWatchProc *
 Tcl_ChannelWatchProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->watchProc);
+    return chanTypePtr->watchProc;
 }
 
 /*
@@ -8953,7 +9006,7 @@ Tcl_DriverGetHandleProc *
 Tcl_ChannelGetHandleProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->getHandleProc);
+    return chanTypePtr->getHandleProc;
 }
 
 /*
@@ -8976,7 +9029,11 @@ Tcl_DriverFlushProc *
 Tcl_ChannelFlushProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->flushProc);
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+	return chanTypePtr->flushProc;
+    } else {
+	return NULL;
+    }
 }
 
 /*
@@ -8999,5 +9056,36 @@ Tcl_DriverHandlerProc *
 Tcl_ChannelHandlerProc(chanTypePtr)
     Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
-    return (chanTypePtr->handlerProc);
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+	return chanTypePtr->handlerProc;
+    } else {
+	return NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelWideSeekProc --
+ *
+ *	Return the Tcl_DriverWideSeekProc of the channel type.
+ *
+ * Results:
+ *	A pointer to the proc.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverWideSeekProc *
+Tcl_ChannelWideSeekProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+{
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
+	return chanTypePtr->wideSeekProc;
+    } else {
+	return NULL;
+    }
 }
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));
 }
 
 /*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 52ee177..be2902e 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -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: tclStubInit.c,v 1.69 2002/04/19 14:19:02 das Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.70 2002/05/24 21:19:06 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -896,6 +896,7 @@ TclStubs tclStubs = {
     Tcl_AllocStatBuf, /* 490 */
     Tcl_Seek, /* 491 */
     Tcl_Tell, /* 492 */
+    Tcl_ChannelWideSeekProc, /* 493 */
 };
 
 /* !END!: Do not edit above this line. */