diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.decls | 42 | ||||
| -rw-r--r-- | generic/tcl.h | 22 | ||||
| -rw-r--r-- | generic/tclDecls.h | 10 | ||||
| -rw-r--r-- | generic/tclIO.c | 194 | ||||
| -rw-r--r-- | generic/tclIOGT.c | 117 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 |
6 files changed, 298 insertions, 90 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 75e787e..b384108 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.86 2002/03/20 22:47:36 dgp Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.87 2002/05/24 21:19:05 dkf Exp $ library tcl @@ -28,12 +28,12 @@ hooks {tclPlat tclInt tclIntPlat} # to preserve backwards compatibility. declare 0 generic { - int Tcl_PkgProvideEx( Tcl_Interp* interp, CONST char* name, - CONST char* version, ClientData clientData ) + int Tcl_PkgProvideEx(Tcl_Interp* interp, CONST char* name, + CONST char* version, ClientData clientData) } declare 1 generic { - CONST char * Tcl_PkgRequireEx( Tcl_Interp *interp, CONST char *name, - CONST char *version, int exact, ClientData *clientDataPtr ) + CONST char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name, + CONST char *version, int exact, ClientData *clientDataPtr) } declare 2 generic { void Tcl_Panic(CONST char *format, ...) @@ -86,7 +86,7 @@ declare 15 generic { void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) } declare 16 generic { - void Tcl_AppendToObj( Tcl_Obj* objPtr, CONST char* bytes, int length ) + void Tcl_AppendToObj(Tcl_Obj* objPtr, CONST char* bytes, int length) } declare 17 generic { Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[]) @@ -248,7 +248,7 @@ declare 64 generic { void Tcl_SetObjLength(Tcl_Obj *objPtr, int length) } declare 65 generic { - void Tcl_SetStringObj( Tcl_Obj* objPtr, CONST char* bytes, int length ) + void Tcl_SetStringObj(Tcl_Obj* objPtr, CONST char* bytes, int length) } declare 66 generic { void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message) @@ -936,10 +936,10 @@ declare 264 generic { Tcl_Obj *CONST objv[], CONST char *message) } declare 265 generic { - int Tcl_DumpActiveMemory( CONST char *fileName ) + int Tcl_DumpActiveMemory(CONST char *fileName) } declare 266 generic { - void Tcl_ValidateAllMemory( CONST char *file, int line ) + void Tcl_ValidateAllMemory(CONST char *file, int line) } declare 267 generic { @@ -1698,26 +1698,22 @@ declare 481 generic { # New export due to TIP#73 declare 482 generic { - void Tcl_GetTime( Tcl_Time* timeBuf ) + void Tcl_GetTime(Tcl_Time* timeBuf) } # New exports due to TIP#32 declare 483 generic { - Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp* interp, - int level, - int flags, - Tcl_CmdObjTraceProc* objProc, - ClientData clientData, - Tcl_CmdObjTraceDeleteProc* delProc ) + Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp* interp, int level, int flags, + Tcl_CmdObjTraceProc* objProc, ClientData clientData, + Tcl_CmdObjTraceDeleteProc* delProc) } declare 484 generic { - int Tcl_GetCommandInfoFromToken( Tcl_Command token, - Tcl_CmdInfo* infoPtr ) + int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo* infoPtr) } declare 485 generic { - int Tcl_SetCommandInfoFromToken( Tcl_Command token, - CONST Tcl_CmdInfo* infoPtr ) + int Tcl_SetCommandInfoFromToken(Tcl_Command token, + CONST Tcl_CmdInfo* infoPtr) } ### New functions on 64-bit dev branch ### @@ -1745,6 +1741,12 @@ declare 492 generic { Tcl_WideInt Tcl_Tell(Tcl_Channel chan) } +# New export due to TIP#91 +declare 493 generic { + Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( + Tcl_ChannelType *chanTypePtr) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are diff --git a/generic/tcl.h b/generic/tcl.h index 80bdd32..0df69dd 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.123 2002/04/08 09:02:38 das Exp $ + * RCS: @(#) $Id: tcl.h,v 1.124 2002/05/24 21:19:05 dkf Exp $ */ #ifndef _TCL @@ -1419,7 +1419,7 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); */ #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) - +#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3) /* * Typedefs for the various operations in a channel type: @@ -1434,8 +1434,8 @@ typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCodePtr)); typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData, CONST84 char *buf, int toWrite, int *errorCodePtr)); -typedef Tcl_WideInt (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData, - Tcl_WideInt offset, int mode, int *errorCodePtr)); +typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData, + long offset, int mode, int *errorCodePtr)); typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)); @@ -1451,6 +1451,9 @@ typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_(( ClientData instanceData)); typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( ClientData instanceData, int interestMask)); +typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_(( + ClientData instanceData, Tcl_WideInt offset, + int mode, int *errorCodePtr)); /* @@ -1526,13 +1529,22 @@ typedef struct Tcl_ChannelType { /* Set blocking mode for the * raw channel. May be NULL. */ /* - * Only valid in TCL_CHANNEL_VERSION_2 channels + * Only valid in TCL_CHANNEL_VERSION_2 channels or later */ Tcl_DriverFlushProc *flushProc; /* Procedure to call to flush a * channel. May be NULL. */ Tcl_DriverHandlerProc *handlerProc; /* Procedure to call to handle a * channel event. This will be passed * up the stacked channel chain. */ + /* + * Only valid in TCL_CHANNEL_VERSION_3 channels or later + */ + Tcl_DriverWideSeekProc *wideSeekProc; + /* Procedure to call to seek + * on the channel which can + * handle 64-bit offsets. May be + * NULL, and must be NULL if + * seekProc is NULL. */ } Tcl_ChannelType; /* diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 392a2e7..95e47ec 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.86 2002/03/20 22:47:36 dgp Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.87 2002/05/24 21:19:05 dkf Exp $ */ #ifndef _TCLDECLS @@ -1553,6 +1553,9 @@ EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 492 */ EXTERN Tcl_WideInt Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan)); +/* 493 */ +EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_(( + Tcl_ChannelType * chanTypePtr)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -2105,6 +2108,7 @@ typedef struct TclStubs { Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */ Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */ Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */ + Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */ } TclStubs; #ifdef __cplusplus @@ -4117,6 +4121,10 @@ extern TclStubs *tclStubsPtr; #define Tcl_Tell \ (tclStubsPtr->tcl_Tell) /* 492 */ #endif +#ifndef Tcl_ChannelWideSeekProc +#define Tcl_ChannelWideSeekProc \ + (tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclIO.c b/generic/tclIO.c index f884f6e..4895824 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.55 2002/04/18 01:51:20 hobbs Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.56 2002/05/24 21:19:05 dkf Exp $ */ #include "tclInt.h" @@ -123,6 +123,8 @@ static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush)); static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp)); static int GetInput _ANSI_ARGS_((Channel *chanPtr)); +static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr, + Tcl_ChannelTypeVersion minimumVersion)); static void PeekAhead _ANSI_ARGS_((Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr)); static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr, @@ -5332,6 +5334,7 @@ Tcl_Seek(chan, offset, mode) Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* state info for channel */ int inputBuffered, outputBuffered; + /* # bytes held in buffers. */ int result; /* Of device driver operations. */ Tcl_WideInt curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the @@ -5339,7 +5342,7 @@ Tcl_Seek(chan, offset, mode) * nonblocking mode after the seek. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5349,7 +5352,9 @@ Tcl_Seek(chan, offset, mode) * registered in an interpreter. */ - if (CheckForDeadChannel(NULL, statePtr)) return -1; + if (CheckForDeadChannel(NULL, statePtr)) { + return Tcl_LongAsWide(-1); + } /* * This operation should occur at the top of a channel stack. @@ -5364,7 +5369,7 @@ Tcl_Seek(chan, offset, mode) if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) { Tcl_SetErrno(EINVAL); - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5377,7 +5382,7 @@ Tcl_Seek(chan, offset, mode) if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5416,7 +5421,7 @@ Tcl_Seek(chan, offset, mode) wasAsync = 1; result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); if (result != 0) { - return -1; + return Tcl_LongAsWide(-1); } statePtr->flags &= (~(CHANNEL_NONBLOCKING)); if (statePtr->flags & BG_FLUSH_SCHEDULED) { @@ -5438,14 +5443,26 @@ Tcl_Seek(chan, offset, mode) /* * Now seek to the new position in the channel as requested by the - * caller. + * caller. Note that we prefer the wideSeekProc if that is + * available and non-NULL... */ - curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData, - offset, mode, &result); - if (curPos == -1) { - Tcl_SetErrno(result); - } + if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && + chanPtr->typePtr->wideSeekProc != NULL) { + curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, + offset, mode, &result); + } else if (offset < Tcl_LongAsWide(LONG_MIN) || + offset > Tcl_LongAsWide(LONG_MAX)) { + Tcl_SetErrno(EOVERFLOW); + curPos = Tcl_LongAsWide(-1); + } else { + curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( + chanPtr->instanceData, Tcl_WideAsLong(offset), mode, + &result)); + if (curPos == Tcl_LongAsWide(-1)) { + Tcl_SetErrno(result); + } + } } /* @@ -5459,7 +5476,7 @@ Tcl_Seek(chan, offset, mode) statePtr->flags |= CHANNEL_NONBLOCKING; result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); if (result != 0) { - return -1; + return Tcl_LongAsWide(-1); } } @@ -5491,12 +5508,12 @@ Tcl_Tell(chan) { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* state info for channel */ - int inputBuffered, outputBuffered; + int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of calling device driver. */ Tcl_WideInt curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5507,7 +5524,7 @@ Tcl_Tell(chan) */ if (CheckForDeadChannel(NULL, statePtr)) { - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5523,7 +5540,7 @@ Tcl_Tell(chan) if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) { Tcl_SetErrno(EINVAL); - return -1; + return Tcl_LongAsWide(-1); } /* @@ -5536,24 +5553,31 @@ Tcl_Tell(chan) if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); - return -1; + return Tcl_LongAsWide(-1); } /* * Get the current position in the device and compute the position - * where the next character will be read or written. + * where the next character will be read or written. Note that we + * prefer the wideSeekProc if that is available and non-NULL... */ - curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData, - Tcl_LongAsWide(0), SEEK_CUR, &result); - if (curPos == -1) { + if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && + chanPtr->typePtr->wideSeekProc != NULL) { + curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, + Tcl_LongAsWide(0), SEEK_CUR, &result); + } else { + curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( + chanPtr->instanceData, 0, SEEK_CUR, &result)); + } + if (curPos == Tcl_LongAsWide(-1)) { Tcl_SetErrno(result); - return -1; + return Tcl_LongAsWide(-1); } if (inputBuffered != 0) { - return (curPos - inputBuffered); + return curPos - inputBuffered; } - return (curPos + outputBuffered); + return curPos + outputBuffered; } /* @@ -5562,10 +5586,12 @@ Tcl_Tell(chan) * Tcl_SeekOld, Tcl_TellOld -- * * Backward-compatability versions of the seek/tell interface that - * do not support 64-bit offsets. + * do not support 64-bit offsets. This interface is not documented + * or expected to be supported indefinitely. * * Results: - * As for Tcl_Seek and Tcl_Tell respectively. + * As for Tcl_Seek and Tcl_Tell respectively, except truncated to + * whatever value will fit in an 'int'. * * Side effects: * As for Tcl_Seek and Tcl_Tell respectively. @@ -6663,17 +6689,13 @@ Tcl_NotifyChannel(channel, mask) */ while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) { + Tcl_DriverHandlerProc* upHandlerProc; + upChanPtr = chanPtr->upChanPtr; upTypePtr = upChanPtr->typePtr; - - if ((Tcl_ChannelVersion(upTypePtr) == TCL_CHANNEL_VERSION_2) && - (Tcl_ChannelHandlerProc(upTypePtr) != - ((Tcl_DriverHandlerProc *) NULL))) { - - Tcl_DriverHandlerProc* handlerProc = - Tcl_ChannelHandlerProc(upTypePtr); - - mask = (*handlerProc) (upChanPtr->instanceData, mask); + upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr); + if (upHandlerProc != NULL) { + mask = (*upHandlerProc) (upChanPtr->instanceData, mask); } /* ELSE: @@ -8688,7 +8710,7 @@ CONST char * Tcl_ChannelName(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->typeName); + return chanTypePtr->typeName; } /* @@ -8699,7 +8721,7 @@ Tcl_ChannelName(chanTypePtr) * Return the of version of the channel type. * * Results: - * TCL_CHANNEL_VERSION_2 or TCL_CHANNEL_VERSION_1. + * One of the TCL_CHANNEL_VERSION_* constants from tcl.h * * Side effects: * None. @@ -8713,6 +8735,8 @@ Tcl_ChannelVersion(chanTypePtr) { if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) { return TCL_CHANNEL_VERSION_2; + } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) { + return TCL_CHANNEL_VERSION_3; } else { /* * In <v2 channel versions, the version field is occupied @@ -8725,6 +8749,33 @@ Tcl_ChannelVersion(chanTypePtr) /* *---------------------------------------------------------------------- * + * HaveVersion -- + * + * Return whether a channel type is (at least) of a given version. + * + * Results: + * True if the minimum version is exceeded by the version actually + * present. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +HaveVersion(chanTypePtr, minimumVersion) + Tcl_ChannelType *chanTypePtr; + Tcl_ChannelTypeVersion minimumVersion; +{ + Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr); + + return ((int)actualVersion) >= ((int)minimumVersion); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ChannelBlockModeProc -- * * Return the Tcl_DriverBlockModeProc of the channel type. @@ -8735,16 +8786,18 @@ Tcl_ChannelVersion(chanTypePtr) * Side effects: * None. * - *---------------------------------------------------------------------- - */ + *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) { - return (chanTypePtr->blockModeProc); + if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { + return chanTypePtr->blockModeProc; } else { + /* + * The v1 structure had the blockModeProc in a different place. + */ return (Tcl_DriverBlockModeProc *) (chanTypePtr->version); } } @@ -8769,7 +8822,7 @@ Tcl_DriverCloseProc * Tcl_ChannelCloseProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->closeProc); + return chanTypePtr->closeProc; } /* @@ -8792,7 +8845,7 @@ Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->close2Proc); + return chanTypePtr->close2Proc; } /* @@ -8815,7 +8868,7 @@ Tcl_DriverInputProc * Tcl_ChannelInputProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->inputProc); + return chanTypePtr->inputProc; } /* @@ -8838,7 +8891,7 @@ Tcl_DriverOutputProc * Tcl_ChannelOutputProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->outputProc); + return chanTypePtr->outputProc; } /* @@ -8861,7 +8914,7 @@ Tcl_DriverSeekProc * Tcl_ChannelSeekProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->seekProc); + return chanTypePtr->seekProc; } /* @@ -8884,7 +8937,7 @@ Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->setOptionProc); + return chanTypePtr->setOptionProc; } /* @@ -8907,7 +8960,7 @@ Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->getOptionProc); + return chanTypePtr->getOptionProc; } /* @@ -8930,7 +8983,7 @@ Tcl_DriverWatchProc * Tcl_ChannelWatchProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->watchProc); + return chanTypePtr->watchProc; } /* @@ -8953,7 +9006,7 @@ Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->getHandleProc); + return chanTypePtr->getHandleProc; } /* @@ -8976,7 +9029,11 @@ Tcl_DriverFlushProc * Tcl_ChannelFlushProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->flushProc); + if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { + return chanTypePtr->flushProc; + } else { + return NULL; + } } /* @@ -8999,5 +9056,36 @@ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { - return (chanTypePtr->handlerProc); + if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { + return chanTypePtr->handlerProc; + } else { + return NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ChannelWideSeekProc -- + * + * Return the Tcl_DriverWideSeekProc of the channel type. + * + * Results: + * A pointer to the proc. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_DriverWideSeekProc * +Tcl_ChannelWideSeekProc(chanTypePtr) + Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ +{ + if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) { + return chanTypePtr->wideSeekProc; + } else { + return NULL; + } } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 022ba35..0bc3083 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * CVS: $Id: tclIOGT.c,v 1.6 2002/02/15 19:58:28 andreas_kupries Exp $ + * CVS: $Id: tclIOGT.c,v 1.7 2002/05/24 21:19:06 dkf Exp $ */ #include "tclInt.h" @@ -33,8 +33,8 @@ static int TransformInputProc _ANSI_ARGS_ (( static int TransformOutputProc _ANSI_ARGS_ (( ClientData instanceData, CONST char *buf, int toWrite, int* errorCodePtr)); -static Tcl_WideInt TransformSeekProc _ANSI_ARGS_ (( - ClientData instanceData, Tcl_WideInt offset, +static int TransformSeekProc _ANSI_ARGS_ (( + ClientData instanceData, long offset, int mode, int* errorCodePtr)); static int TransformSetOptionProc _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, @@ -49,6 +49,9 @@ static int TransformGetFileHandleProc _ANSI_ARGS_ (( ClientData* handlePtr)); static int TransformNotifyProc _ANSI_ARGS_ (( ClientData instanceData, int mask)); +static Tcl_WideInt TransformWideSeekProc _ANSI_ARGS_ (( + ClientData instanceData, Tcl_WideInt offset, + int mode, int* errorCodePtr)); /* * Forward declarations of internal procedures. @@ -141,6 +144,7 @@ static Tcl_ChannelType transformChannelType = { TransformBlockModeProc, /* Set blocking/nonblocking mode.*/ NULL, /* Flush proc. */ TransformNotifyProc, /* Handling of events bubbling up */ + TransformWideSeekProc, /* Wide seek proc */ }; /* @@ -843,14 +847,13 @@ TransformOutputProc (instanceData, buf, toWrite, errorCodePtr) *------------------------------------------------------* */ -static Tcl_WideInt +static int TransformSeekProc (instanceData, offset, mode, errorCodePtr) ClientData instanceData; /* The channel to manipulate */ - Tcl_WideInt offset; /* Size of movement. */ + long offset; /* Size of movement. */ int mode; /* How to move */ int* errorCodePtr; /* Location of error flag. */ { - Tcl_WideInt result; TransformChannelData* dataPtr = (TransformChannelData*) instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); Tcl_ChannelType* parentType = Tcl_GetChannelType(parent); @@ -861,9 +864,8 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr) * location. Simply pass the request down. */ - result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent), + return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); - return result; } /* @@ -884,9 +886,104 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr) dataPtr->readIsFlushed = 0; } - result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent), + return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); - return result; +} + +/* + *---------------------------------------------------------------------- + * + * TransformWideSeekProc -- + * + * This procedure is called by the generic IO level to move the + * access point in a channel, with a (potentially) 64-bit offset. + * + * Side effects: + * Moves the location at which the channel will be accessed in + * future operations. Flushes all transformation buffers, then + * forwards it to the underlying channel. + * + * Result: + * -1 if failed, the new position if successful. An output + * argument contains the POSIX error code if an error occurred, + * or zero. + * + *---------------------------------------------------------------------- + */ + +static Tcl_WideInt +TransformWideSeekProc (instanceData, offset, mode, errorCodePtr) + ClientData instanceData; /* The channel to manipulate */ + Tcl_WideInt offset; /* Size of movement. */ + int mode; /* How to move */ + int* errorCodePtr; /* Location of error flag. */ +{ + TransformChannelData* dataPtr = + (TransformChannelData*) instanceData; + Tcl_Channel parent = + Tcl_GetStackedChannel(dataPtr->self); + Tcl_ChannelType* parentType = + Tcl_GetChannelType(parent); + Tcl_DriverSeekProc* parentSeekProc = + Tcl_ChannelSeekProc(parentType); + Tcl_DriverWideSeekProc* parentWideSeekProc = + Tcl_ChannelWideSeekProc(parentType); + ClientData parentData = + Tcl_GetChannelInstanceData(parent); + + if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) { + /* + * This is no seek but a request to tell the caller the current + * location. Simply pass the request down. + */ + + if (parentWideSeekProc != NULL) { + return (*parentWideSeekProc) (parentData, offset, mode, + errorCodePtr); + } + + return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode, + errorCodePtr)); + } + + /* + * It is a real request to change the position. Flush all data waiting + * for output and discard everything in the input buffers. Then pass + * the request down, unchanged. + */ + + if (dataPtr->mode & TCL_WRITABLE) { + ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE, + NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); + } + + if (dataPtr->mode & TCL_READABLE) { + ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ, + NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); + ResultClear(&dataPtr->result); + dataPtr->readIsFlushed = 0; + } + + /* + * If we have a wide seek capability, we should stick with that. + */ + if (parentWideSeekProc != NULL) { + return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr); + } + + /* + * We're transferring to narrow seeks at this point; this is a bit + * complex because we have to check whether the seek is possible + * first (i.e. whether we are losing information in truncating the + * bits of the offset.) Luckily, there's a defined error for what + * happens when trying to go out of the representable range. + */ + if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) { + *errorCodePtr = EOVERFLOW; + return Tcl_LongAsWide(-1); + } + return Tcl_LongAsWide((*parentSeekProc) (parentData, + Tcl_WideAsLong(offset), mode, errorCodePtr)); } /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 52ee177..be2902e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.69 2002/04/19 14:19:02 das Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.70 2002/05/24 21:19:06 dkf Exp $ */ #include "tclInt.h" @@ -896,6 +896,7 @@ TclStubs tclStubs = { Tcl_AllocStatBuf, /* 490 */ Tcl_Seek, /* 491 */ Tcl_Tell, /* 492 */ + Tcl_ChannelWideSeekProc, /* 493 */ }; /* !END!: Do not edit above this line. */ |