summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog32
-rw-r--r--doc/CrtChannel.3129
-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
-rw-r--r--mac/tclMacChan.c10
-rw-r--r--unix/mkLinks2
-rw-r--r--unix/tclUnixChan.c82
-rw-r--r--win/tclWinChan.c88
-rw-r--r--win/tclWinPort.h8
13 files changed, 580 insertions, 159 deletions
diff --git a/ChangeLog b/ChangeLog
index de0ff00..32f0315 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,35 @@
+2002-05-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ === 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-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* win/tclWinSock.c (TcpWatchProc): Fixed SF Tcl Bug #557878. We
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index 3273c6c..3214e9c 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -5,13 +5,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtChannel.3,v 1.14 2002/01/23 21:22:06 andreas_kupries Exp $
+'\" RCS: @(#) $Id: CrtChannel.3,v 1.15 2002/05/24 21:19:05 dkf Exp $
.so man.macros
.TH Tcl_CreateChannel 3 8.3 Tcl "Tcl Library Procedures"
.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 @@ int
.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 @@ void
.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_DriverOutputProc *
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 @@ Tcl_DriverFlushProc *
.sp
Tcl_DriverHandlerProc *
\fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR)
-.VE
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType *channelName in
@@ -234,7 +237,7 @@ for each driver to determine what type of handle is returned.
\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 @@ channel. See \fBWATCHPROC\fR below for more details.
.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 @@ Application to a channel registered in some interpreter is not allowed.
\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 @@ A channel driver provides a \fBTcl_ChannelType\fR structure that contains
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 @@ typedef struct Tcl_ChannelType {
Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
Tcl_DriverFlushProc *\fIflushProc\fR;
Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+ Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
} Tcl_ChannelType;
.CE
.PP
@@ -333,7 +334,6 @@ device should return \fBEINVAL\fR when invoked to indicate that they
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 @@ structure, the following functions should be used to obtain the values:
\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 @@ The change to the structures was made in such a way that standard channel
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 @@ The \fItypeName\fR field contains a null-terminated string that
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 @@ For some device types, the blocking and nonblocking behavior can be
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 @@ return a nonzero POSIX error code. In addition, if an error occurs and
\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 @@ for the shortest possible time until at least one byte of data can be read
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 @@ If the channel is nonblocking and the output device is unable to absorb any
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 @@ does not implement seeking.
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 @@ the function should leave an error message in the
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 @@ channel driver will get called to implement them. The \fIgetOptionProc\fR
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 @@ the Tcl event queue to allow the channel event to be scheduled in sequence
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 @@ stored in the location referred to by \fIhandlePtr\fR, and
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 @@ type of event occured on this channel.
.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 @@ is a space separated list of specific option words.
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 @@ internal channel code will determine the version. It is imperative to use
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)
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. */
diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c
index 7daa41b..d29c80e 100644
--- a/mac/tclMacChan.c
+++ b/mac/tclMacChan.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacChan.c,v 1.14 2002/05/20 10:22:33 das Exp $
+ * RCS: @(#) $Id: tclMacChan.c,v 1.15 2002/05/24 21:19:06 dkf Exp $
*/
#include "tclInt.h"
@@ -115,8 +115,8 @@ static int FileInput _ANSI_ARGS_((ClientData instanceData,
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,
@@ -1131,10 +1131,10 @@ FileOutput(
*----------------------------------------------------------------------
*/
-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. */
{
diff --git a/unix/mkLinks b/unix/mkLinks
index a925818..db75bd3 100644
--- a/unix/mkLinks
+++ b/unix/mkLinks
@@ -174,6 +174,7 @@ if test -r CrtChannel.3; then
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 @@ if test -r CrtChannel.3; then
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
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 2e1131c..53ada2b 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.34 2002/05/14 10:46:52 dkf Exp $
+ * RCS: @(#) $Id: tclUnixChan.c,v 1.35 2002/05/24 21:19:08 dkf Exp $
*/
#include "tclInt.h" /* Internal definitions for Tcl. */
@@ -247,7 +247,9 @@ static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
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 int WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
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 @@ static Tcl_ChannelType fileChannelType = {
FileBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ FileWideSeekProc, /* wide seek proc. */
};
#ifdef SUPPORTS_TTY
@@ -585,15 +588,72 @@ FileCloseProc(instanceData, interp)
*----------------------------------------------------------------------
*/
-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;
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index ad10251..530492d 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinChan.c,v 1.22 2002/05/13 13:20:00 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.23 2002/05/24 21:19:09 dkf Exp $
*/
#include "tclWinInt.h"
@@ -89,7 +89,9 @@ static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
CONST char *buf, int toWrite, int *errorCode));
-static Tcl_WideInt FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+ long offset, int mode, int *errorCode));
+static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
Tcl_WideInt offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
@@ -103,7 +105,7 @@ static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_3, /* v3 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -116,6 +118,7 @@ static Tcl_ChannelType fileChannelType = {
FileBlockProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ FileWideSeekProc, /* Wide seek proc. */
};
#ifdef HAVE_NO_SEH
@@ -436,9 +439,86 @@ FileCloseProc(instanceData, interp)
*----------------------------------------------------------------------
*/
-static Tcl_WideInt
+static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
ClientData instanceData; /* File state. */
+ long offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? */
+ int *errorCodePtr; /* To store error code. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ DWORD moveMethod;
+ DWORD newPos, newPosHigh;
+ DWORD oldPos, oldPosHigh;
+
+ *errorCodePtr = 0;
+ if (mode == SEEK_SET) {
+ moveMethod = FILE_BEGIN;
+ } else if (mode == SEEK_CUR) {
+ moveMethod = FILE_CURRENT;
+ } else {
+ moveMethod = FILE_END;
+ }
+
+ /*
+ * Save our current place in case we need to roll-back the seek.
+ */
+ oldPosHigh = (DWORD)0;
+ oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
+ FILE_CURRENT);
+ if (oldPos == INVALID_SET_FILE_POINTER) {
+ int winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ *errorCodePtr = errno;
+ return -1;
+ }
+ }
+
+ newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
+ newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
+ moveMethod);
+ if (newPos == INVALID_SET_FILE_POINTER) {
+ int winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ *errorCodePtr = errno;
+ return -1;
+ }
+ }
+
+ /*
+ * Check for expressability in our return type, and roll-back otherwise.
+ */
+ if (newPosHigh != 0) {
+ *errorCodePtr = EOVERFLOW;
+ SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
+ return -1;
+ }
+ return (int) newPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ * Seeks on a file-based channel. Returns the new position.
+ *
+ * Results:
+ * -1 if failed, the new position if successful. If failed, it
+ * also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ * Moves the location at which the channel will be accessed in
+ * future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* File state. */
Tcl_WideInt offset; /* Offset to seek to. */
int mode; /* Relative to where should we seek? */
int *errorCodePtr; /* To store error code. */
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index c1b3189..9f7a7c4 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinPort.h,v 1.27 2002/02/22 09:04:48 dkf Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.28 2002/05/24 21:19:09 dkf Exp $
*/
#ifndef _TCLWINPORT
@@ -199,6 +199,12 @@
#ifndef EREMOTE
#define EREMOTE 66 /* The object is remote */
#endif
+/*
+ * Note that EOVERFLOW is really just a specialist ERANGE...
+ */
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE /* The object couldn't fit in the datatype */
+#endif
/*
* Supply definitions for macros to query wait status, if not already
generated by cgit v0.12 at 2024-11-06 00:51:52 (GMT)