Attachment "tip91.patch" to
ticket [552250ffff]
added by
dkf
2002-05-18 08:00:28.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.988
diff -u -r1.988 ChangeLog
--- ChangeLog 14 May 2002 10:46:52 -0000 1.988
+++ ChangeLog 18 May 2002 00:56:42 -0000
@@ -1,3 +1,35 @@
+2002-05-18 Donal K. Fellows <[email protected]>
+
+ === Changes due to TIP#91 ===
+
+ * win/tclWinPort.h: Added declaration of EOVERFLOW.
+ * doc/CrtChannel.3: Added documentation of wideSeekProc.
+ * generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc):
+ Adapted to use the new channel mechanism.
+ * unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed
+ FileSeekProc to FileWideSeekProc and created new FileSeekProc
+ which has the old-style interface and which errors out with
+ EOVERFLOW when the returned file position can't fit into the
+ return type (int for historical reasons.)
+ * win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed
+ FileSeekProc to FileWideSeekProc and created new FileSeekProc
+ which has the old-style interface and which errors out with
+ EOVERFLOW when the returned file position can't fit into the
+ return type (int for historical reasons.)
+ * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs
+ lack large-file support because I can't see how to add it.
+ * generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions
+ knowledge of the new arrangement of channel types.
+ (Tcl_ChannelVersion): Added recognition of new version code.
+ (HaveVersion): New function to do version checking.
+ (Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc)
+ (Tcl_ChannelHandlerProc): Made these functions use HaveVersion for
+ ease of future maintainability.
+ (Tcl_ChannelBlockModeProc): Obvious lookup function.
+ * generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and
+ seekProc type restored to old interpretation.
+ (TCL_CHANNEL_VERSION_3): New channel version.
+
2002-05-14 Donal K. Fellows <[email protected]>
* unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function
Index: doc/CrtChannel.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtChannel.3,v
retrieving revision 1.14
diff -u -r1.14 CrtChannel.3
--- doc/CrtChannel.3 23 Jan 2002 21:22:06 -0000 1.14
+++ doc/CrtChannel.3 18 May 2002 00:56:43 -0000
@@ -11,7 +11,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
+Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -34,7 +34,7 @@
.VS 8.4
Tcl_ThreadId
\fBTcl_GetChannelThread\fR(\fIchannel\fR)
-.VE
+.VE 8.4
.sp
int
\fBTcl_GetChannelBufferSize\fR(\fIchannel\fR)
@@ -64,8 +64,7 @@
.sp
void
\fBTcl_ClearChannelHandlers\fR(\fIchannel\fR)
-.VE
-.VS 8.3.2
+.VE 8.4
.sp
int
\fBTcl_ChannelBuffered\fR(\fIchannel\fR)
@@ -94,6 +93,11 @@
Tcl_DriverSeekProc *
\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR)
.sp
+.VS 8.4
+Tcl_DriverWideSeekProc *
+\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
+.VE 8.4
+.sp
Tcl_DriverSetOptionProc *
\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
.sp
@@ -111,7 +115,6 @@
.sp
Tcl_DriverHandlerProc *
\fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR)
-.VE
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType *channelName in
@@ -234,7 +237,7 @@
\fBTcl_GetChannelThread\fR returns the id of the thread currently managing
the specified \fIchannel\fR. This allows channel drivers to send their file
events to the correct event queue even for a multi-threaded core.
-.VE
+.VE 8.4
.PP
\fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR
and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input
@@ -260,14 +263,11 @@
.PP
\fBTcl_BadChannelOption\fR is called from driver specific set or get option
procs to generate a complete error message.
-.VE
.PP
-.VS 8.3.2
\fBTcl_ChannelBuffered\fR returns the number of bytes of input
currently buffered in the internal buffer (push back area) of the
channel itself. It does not report about the data in the overall
buffers for the stack of channels the supplied channel is part of.
-.VE
.PP
.VS 8.4
\fBTcl_IsChannelShared\fR checks the refcount of the specified
@@ -294,7 +294,7 @@
\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
scripts associated with the specified \fIchannel\fR, thus shutting
down all event processing for this channel.
-.VE
+.VE 8.4
.SH TCL_CHANNELTYPE
.PP
@@ -302,8 +302,8 @@
pointers to functions that implement the various operations on a channel;
these operations are invoked as needed by the generic layer. The structure
was versioned starting in Tcl 8.3.2/8.4 to correct a problem with stacked
-channel drivers. See the \fBOLD_CHANNEL\fR section below for details about
-the old structure.
+channel drivers. See the \fBOLD CHANNEL TYPES\fR section below for
+details about the old structure.
.PP
The \fBTcl_ChannelType\fR structure contains the following fields:
.CS
@@ -322,6 +322,7 @@
Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
Tcl_DriverFlushProc *\fIflushProc\fR;
Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+ Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
} Tcl_ChannelType;
.CE
.PP
@@ -333,7 +334,6 @@
are not implemented, except in the case of \fIflushProc\fR and
\fIhandlerProc\fR, which should specified as NULL if not otherwise defined.
.PP
-.VS 8.3.2
The user should only use the above structure for \fBTcl_ChannelType\fR
instantiation. When referencing fields in a \fBTcl_ChannelType\fR
structure, the following functions should be used to obtain the values:
@@ -341,6 +341,9 @@
\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR,
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
+.VS 8.4
+\fBTcl_ChannelWideSeekProc\fR,
+.VE 8.4
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
@@ -349,7 +352,6 @@
types are binary compatible. However, channel types that use stacked
channels (ie: TLS, Trf) have new versions to correspond to the above change
since the previous code for stacked channels had problems.
-.VE
.SH TYPENAME
.PP
@@ -357,24 +359,23 @@
identifies the type of the device implemented by this driver, e.g.
\fBfile\fR or \fBsocket\fR.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelName\fR, which returns
a pointer to the string.
-.VE
-.VS 8.3.2
.SH VERSION
.PP
The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR.
-If it is not set to this value \fBTCL_CHANNEL_VERSION_2\fR, then this
+If it is not set to this value \fBTCL_CHANNEL_VERSION_3\fR, then this
\fBTcl_ChannelType\fR is assumed to have the older structure. See
-\fBOLD_CHANNEL\fR for more details. While Tcl will recognize and
-function with either structure, stacked channels must be of the newer
-style to function correctly.
+\fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize
+and function with either structure, stacked channels must be of at
+least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
.PP
This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
-either \fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
-.VE
+.VS 8.4
+one of \fBTCL_CHANNEL_VERSION_3\fR,
+.VE 8.4
+\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
.SH BLOCKMODEPROC
.PP
@@ -402,10 +403,8 @@
implemented by the underlying operating system; for other device types, the
behavior must be emulated in the channel driver.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelBlockModeProc\fR, which returns
a pointer to the function.
-.VE
.SH "CLOSEPROC AND CLOSE2PROC"
.PP
@@ -457,11 +456,9 @@
\fIinterp\fR is not NULL, the procedure should store an error message
in the interpreter's result.
.PP
-.VS 8.3.2
These value can be retrieved with \fBTcl_ChannelCloseProc\fR or
\fBTcl_ChannelClose2Proc\fR, which returns a pointer to the respective
function.
-.VE
.SH INPUTPROC
.PP
@@ -505,10 +502,8 @@
from the device; then, it should return as much data as it can read without
blocking.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelInputProc\fR, which returns
a pointer to the function.
-.VE
.SH OUTPUTPROC
.PP
@@ -546,12 +541,10 @@
data whatsoever, the function should return -1 with an \fBEAGAIN\fR error
without writing any data.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelOutputProc\fR, which returns
a pointer to the function.
-.VE
-.SH SEEKPROC
+.SH "SEEKPROC AND WIDESEEKPROC"
.PP
The \fIseekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
@@ -580,10 +573,32 @@
The return value is the new access point or -1 in case of error. If an
error occurred, the function should not move the access point.
.PP
-.VS 8.3.2
-This value can be retrieved with \fBTcl_ChannelSeekProc\fR, which returns
-a pointer to the function.
-.VE
+.VS 8.4
+If there is a non-NULL \fIseekProc\fR field, the \fIwideSeekProc\fR
+field may contain the address of an alternative function to use which
+handles wide (i.e. larger than 32-bit) offsets, so allowing seeks
+within files larger than 2GB. The \fIwideSeekProc\fR will be called
+in preference to the \fIseekProc\fR, but both must be defined if the
+\fIwideSeekProc\fR is defined. \fIWideSeekProc\fR must match the
+following prototype:
+.PP
+.CS
+typedef Tcl_WideInt Tcl_DriverWideSeekProc(
+ ClientData \fIinstanceData\fR,
+ Tcl_WideInt \fIoffset\fR,
+ int \fIseekMode\fR,
+ int *\fIerrorCodePtr\fR);
+.CE
+.PP
+The arguments and return values mean the same thing as with
+\fIseekProc\fR above, except that the type of offsets and the return
+type are different.
+.PP
+The \fIseekProc\fR value can be retrieved with
+\fBTcl_ChannelSeekProc\fR, which returns a pointer to the function,
+and similarly the \fIwideSeekProc\fR can be retrieved with
+\fBTcl_ChannelWideSeekProc\fR.
+.VE 8.4
.SH SETOPTIONPROC
.PP
@@ -624,10 +639,8 @@
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
-.VE
.SH GETOPTIONPROC
.PP
@@ -664,10 +677,8 @@
field can be NULL, which indicates that this channel type supports no type
specific options.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelGetOptionProc\fR, which returns
a pointer to the function.
-.VE
.SH WATCHPROC
.PP
@@ -699,10 +710,8 @@
with other events. See the description of \fBTcl_QueueEvent\fR for
details on how to queue an event.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelWatchProc\fR, which returns
a pointer to the function.
-.VE
.SH GETHANDLEPROC
.PP
@@ -731,12 +740,9 @@
specified direction, or if the channel implementation does not use
device handles, the function should return \fBTCL_ERROR\fR.
.PP
-.VS 8.3.2
This value can be retrieved with \fBTcl_ChannelGetHandleProc\fR, which returns
a pointer to the function.
-.VE
-.VS 8.3.2
.SH FLUSHPROC
.PP
The \fIflushProc\fR field is currently reserved for future use.
@@ -772,7 +778,6 @@
.PP
This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns
a pointer to the function.
-.VE
.SH TCL_BADCHANNELOPTION
.PP
@@ -801,7 +806,7 @@
The function takes good care of inserting minus signs before
each option, commas after, and an ``or'' before the last option.
-.SH OLD_CHANNEL
+.SH "OLD CHANNEL TYPES"
The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains
the following fields:
@@ -827,6 +832,34 @@
the new \fBTcl_ChannelType\fR structure if you are creating a stacked
channel driver, due to problems with the earlier stacked channel
implementation (in 8.2.0 to 8.3.1).
+.PP
+.VS 8.4
+Prior to 8.4.0 (i.e. during the later releases of 8.3 and early part
+of the 8.4 development cycle) the \fBTcl_ChannelType\fR structure
+contained the following fields:
+.PP
+.CS
+typedef struct Tcl_ChannelType {
+ char *\fItypeName\fR;
+ Tcl_ChannelTypeVersion \fIversion\fR;
+ Tcl_DriverCloseProc *\fIcloseProc\fR;
+ Tcl_DriverInputProc *\fIinputProc\fR;
+ Tcl_DriverOutputProc *\fIoutputProc\fR;
+ Tcl_DriverSeekProc *\fIseekProc\fR;
+ Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
+ Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+ Tcl_DriverWatchProc *\fIwatchProc\fR;
+ Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+ Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_DriverFlushProc *\fIflushProc\fR;
+ Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+} Tcl_ChannelType;
+.CE
+.PP
+When the above structure is registered as a channel type, the
+\fIversion\fR field should always be \fBTCL_CHANNEL_VERSION_2\fR.
+.VE 8.4
.SH "SEE ALSO"
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3), Tcl_GetStdChannel(3)
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.86
diff -u -r1.86 tcl.decls
--- generic/tcl.decls 20 Mar 2002 22:47:36 -0000 1.86
+++ generic/tcl.decls 18 May 2002 00:56:43 -0000
@@ -28,12 +28,12 @@
# 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 @@
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 @@
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 @@
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 @@
# 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 ###
@@ -1743,6 +1739,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)
}
##############################################################################
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.123
diff -u -r1.123 tcl.h
--- generic/tcl.h 8 Apr 2002 09:02:38 -0000 1.123
+++ generic/tcl.h 18 May 2002 00:56:43 -0000
@@ -1419,7 +1419,7 @@
*/
#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 @@
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 @@
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 @@
/* 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;
/*
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.86
diff -u -r1.86 tclDecls.h
--- generic/tclDecls.h 20 Mar 2002 22:47:36 -0000 1.86
+++ generic/tclDecls.h 18 May 2002 00:56:43 -0000
@@ -1553,6 +1553,9 @@
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 @@
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
@@ -4116,6 +4120,10 @@
#ifndef Tcl_Tell
#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) */
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.55
diff -u -r1.55 tclIO.c
--- generic/tclIO.c 18 Apr 2002 01:51:20 -0000 1.55
+++ generic/tclIO.c 18 May 2002 00:56:44 -0000
@@ -123,6 +123,8 @@
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 @@
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 @@
* nonblocking mode after the seek. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5349,7 +5352,9 @@
* 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 @@
if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
Tcl_SetErrno(EINVAL);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5377,7 +5382,7 @@
if ((inputBuffered != 0) && (outputBuffered != 0)) {
Tcl_SetErrno(EFAULT);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5416,7 +5421,7 @@
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 @@
/*
* 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 @@
statePtr->flags |= CHANNEL_NONBLOCKING;
result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
if (result != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
}
@@ -5491,12 +5508,12 @@
{
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 @@
*/
if (CheckForDeadChannel(NULL, statePtr)) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5523,7 +5540,7 @@
if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
Tcl_SetErrno(EINVAL);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5536,24 +5553,31 @@
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_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 @@
*/
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 @@
Tcl_ChannelName(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->typeName);
+ return chanTypePtr->typeName;
}
/*
@@ -8699,7 +8721,7 @@
* 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 @@
{
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 @@
/*
*----------------------------------------------------------------------
*
+ * 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 @@
* 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_ChannelCloseProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->closeProc);
+ return chanTypePtr->closeProc;
}
/*
@@ -8792,7 +8845,7 @@
Tcl_ChannelClose2Proc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->close2Proc);
+ return chanTypePtr->close2Proc;
}
/*
@@ -8815,7 +8868,7 @@
Tcl_ChannelInputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->inputProc);
+ return chanTypePtr->inputProc;
}
/*
@@ -8838,7 +8891,7 @@
Tcl_ChannelOutputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->outputProc);
+ return chanTypePtr->outputProc;
}
/*
@@ -8861,7 +8914,7 @@
Tcl_ChannelSeekProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->seekProc);
+ return chanTypePtr->seekProc;
}
/*
@@ -8884,7 +8937,7 @@
Tcl_ChannelSetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->setOptionProc);
+ return chanTypePtr->setOptionProc;
}
/*
@@ -8907,7 +8960,7 @@
Tcl_ChannelGetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->getOptionProc);
+ return chanTypePtr->getOptionProc;
}
/*
@@ -8930,7 +8983,7 @@
Tcl_ChannelWatchProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->watchProc);
+ return chanTypePtr->watchProc;
}
/*
@@ -8953,7 +9006,7 @@
Tcl_ChannelGetHandleProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->getHandleProc);
+ return chanTypePtr->getHandleProc;
}
/*
@@ -8976,7 +9029,11 @@
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_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;
+ }
}
Index: generic/tclIOGT.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOGT.c,v
retrieving revision 1.6
diff -u -r1.6 tclIOGT.c
--- generic/tclIOGT.c 15 Feb 2002 19:58:28 -0000 1.6
+++ generic/tclIOGT.c 18 May 2002 00:56:44 -0000
@@ -33,8 +33,8 @@
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 @@
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 @@
TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
NULL, /* Flush proc. */
TransformNotifyProc, /* Handling of events bubbling up */
+ TransformWideSeekProc, /* Wide seek proc */
};
/*
@@ -843,14 +847,13 @@
*------------------------------------------------------*
*/
-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 @@
* 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 @@
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));
}
/*
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.69
diff -u -r1.69 tclStubInit.c
--- generic/tclStubInit.c 19 Apr 2002 14:19:02 -0000 1.69
+++ generic/tclStubInit.c 18 May 2002 00:56:45 -0000
@@ -896,6 +896,7 @@
Tcl_AllocStatBuf, /* 490 */
Tcl_Seek, /* 491 */
Tcl_Tell, /* 492 */
+ Tcl_ChannelWideSeekProc, /* 493 */
};
/* !END!: Do not edit above this line. */
Index: mac/tclMacChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacChan.c,v
retrieving revision 1.13
diff -u -r1.13 tclMacChan.c
--- mac/tclMacChan.c 15 Feb 2002 14:28:49 -0000 1.13
+++ mac/tclMacChan.c 18 May 2002 00:56:45 -0000
@@ -109,8 +109,8 @@
char *buf, int toRead, int *errorCode));
static int FileOutput _ANSI_ARGS_((ClientData instanceData,
CONST char *buf, int toWrite, int *errorCode));
-static Tcl_WideInt FileSeek _ANSI_ARGS_((ClientData instanceData,
- Tcl_WideInt offset, int mode, int *errorCode));
+static int FileSeek _ANSI_ARGS_((ClientData instanceData,
+ long offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1125,10 +1125,10 @@
*----------------------------------------------------------------------
*/
-static Tcl_WideInt
+static int
FileSeek(
ClientData instanceData, /* Unused. */
- Tcl_WideInt offset, /* Offset to seek to. */
+ long offset, /* Offset to seek to. */
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
{
Index: unix/mkLinks
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/mkLinks,v
retrieving revision 1.44
diff -u -r1.44 mkLinks
--- unix/mkLinks 24 Apr 2002 09:45:37 -0000 1.44
+++ unix/mkLinks 18 May 2002 00:56:45 -0000
@@ -174,6 +174,7 @@
rm -f Tcl_ChannelInputProc.3
rm -f Tcl_ChannelOutputProc.3
rm -f Tcl_ChannelSeekProc.3
+ rm -f Tcl_ChannelWideSeekProc.3
rm -f Tcl_ChannelSetOptionProc.3
rm -f Tcl_ChannelGetOptionProc.3
rm -f Tcl_ChannelWatchProc.3
@@ -206,6 +207,7 @@
ln CrtChannel.3 Tcl_ChannelInputProc.3
ln CrtChannel.3 Tcl_ChannelOutputProc.3
ln CrtChannel.3 Tcl_ChannelSeekProc.3
+ ln CrtChannel.3 Tcl_ChannelWideSeekProc.3
ln CrtChannel.3 Tcl_ChannelSetOptionProc.3
ln CrtChannel.3 Tcl_ChannelGetOptionProc.3
ln CrtChannel.3 Tcl_ChannelWatchProc.3
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.34
diff -u -r1.34 tclUnixChan.c
--- unix/tclUnixChan.c 14 May 2002 10:46:52 -0000 1.34
+++ unix/tclUnixChan.c 18 May 2002 00:56:46 -0000
@@ -247,7 +247,9 @@
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 FileWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
@@ -298,7 +300,7 @@
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. */
@@ -311,6 +313,7 @@
FileBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ FileWideSeekProc, /* wide seek proc. */
};
#ifdef SUPPORTS_TTY
@@ -585,15 +588,72 @@
*----------------------------------------------------------------------
*/
-static Tcl_WideInt
+static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* File state. */
- Tcl_WideInt offset; /* Offset to seek to. */
- int mode; /* Relative to where
- * should we seek? Can be
- * one of SEEK_START,
- * SEEK_SET or SEEK_END. */
- int *errorCodePtr; /* To store error code. */
+ ClientData instanceData; /* File state. */
+ long offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? Can be
+ * one of SEEK_START, SEEK_SET or SEEK_END. */
+ int *errorCodePtr; /* To store error code. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ Tcl_WideInt oldLoc, newLoc;
+
+ /*
+ * Save our current place in case we need to roll-back the seek.
+ */
+ oldLoc = Tcl_PlatformSeek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
+ if (oldLoc == Tcl_LongAsWide(-1)) {
+ /*
+ * Bad things are happening. Error out...
+ */
+ *errorCodePtr = errno;
+ return -1;
+ }
+
+ newLoc = Tcl_PlatformSeek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
+
+ /*
+ * Check for expressability in our return type, and roll-back otherwise.
+ */
+ if (newLoc > Tcl_LongAsWide(INT_MAX)) {
+ *errorCodePtr = EOVERFLOW;
+ Tcl_PlatformSeek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
+ return -1;
+ } else {
+ *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
+ }
+ return (int) Tcl_WideAsLong(newLoc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ * This procedure is called by the generic IO level to move the
+ * access point in a file based channel, with offsets expressed
+ * as wide integers.
+ *
+ * Results:
+ * -1 if failed, the new position if successful. An output
+ * argument contains the POSIX error code if an error occurred,
+ * or zero.
+ *
+ * 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? Can be
+ * one of SEEK_START, SEEK_CUR or SEEK_END. */
+ int *errorCodePtr; /* To store error code. */
{
FileState *fsPtr = (FileState *) instanceData;
Tcl_WideInt newLoc;
Index: win/tclWinChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinChan.c,v
retrieving revision 1.22
diff -u -r1.22 tclWinChan.c
--- win/tclWinChan.c 13 May 2002 13:20:00 -0000 1.22
+++ win/tclWinChan.c 18 May 2002 00:56:46 -0000
@@ -89,7 +89,9 @@
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 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 @@
FileBlockProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ FileWideSeekProc, /* Wide seek proc. */
};
#ifdef HAVE_NO_SEH
@@ -436,8 +439,85 @@
*----------------------------------------------------------------------
*/
-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? */
Index: win/tclWinPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPort.h,v
retrieving revision 1.27
diff -u -r1.27 tclWinPort.h
--- win/tclWinPort.h 22 Feb 2002 09:04:48 -0000 1.27
+++ win/tclWinPort.h 18 May 2002 00:56:46 -0000
@@ -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
