summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls42
-rw-r--r--generic/tcl.h22
-rw-r--r--generic/tclDecls.h10
-rw-r--r--generic/tclIO.c194
-rw-r--r--generic/tclIOGT.c117
-rw-r--r--generic/tclStubInit.c3
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. */