summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs@noemail.net>2000-07-27 01:39:11 (GMT)
committerhobbs <hobbs@noemail.net>2000-07-27 01:39:11 (GMT)
commit3608949d93d06c2ee54f8c5cbcb94d2f54314b4f (patch)
tree8f7857f0f254d922c82fd8567c90fa182445fcbc
parent2e7af7cb8f1d982bbd9f3e5981f6cbf38caed180 (diff)
downloadtcl-3608949d93d06c2ee54f8c5cbcb94d2f54314b4f.zip
tcl-3608949d93d06c2ee54f8c5cbcb94d2f54314b4f.tar.gz
tcl-3608949d93d06c2ee54f8c5cbcb94d2f54314b4f.tar.bz2
* merged core-8-3-1-io-rewrite back into core-8-3-1-branch.
The core-8-3-1-io-rewrite branch should now be considered defunct. FossilOrigin-Name: 4a5dd63d1f5efaf30ac7fb5f31fafb9893f69100
-rw-r--r--ChangeLog182
-rw-r--r--README6
-rw-r--r--generic/tcl.decls64
-rw-r--r--generic/tcl.h68
-rw-r--r--generic/tclDecls.h148
-rw-r--r--generic/tclIO.c4284
-rw-r--r--generic/tclIO.h379
-rw-r--r--generic/tclIOGT.c1361
-rw-r--r--generic/tclInt.decls29
-rw-r--r--generic/tclIntDecls.h41
-rw-r--r--generic/tclStubInit.c26
-rw-r--r--generic/tclTest.c585
-rw-r--r--tests/all.tcl4
-rw-r--r--tests/iogt.test940
-rw-r--r--tests/socket.test61
-rw-r--r--tools/tcl.wse.in2
-rw-r--r--unix/Makefile.in12
-rw-r--r--unix/configure.in4
-rw-r--r--unix/tcl.spec4
-rw-r--r--win/Makefile.in3
-rw-r--r--win/README.binary6
-rw-r--r--win/configure.in4
-rw-r--r--win/makefile.vc3
-rw-r--r--win/tclWinChan.c8
-rw-r--r--win/tclWinConsole.c8
-rw-r--r--win/tclWinPipe.c9
-rw-r--r--win/tclWinSerial.c26
-rw-r--r--win/tclWinSock.c26
28 files changed, 5950 insertions, 2343 deletions
diff --git a/ChangeLog b/ChangeLog
index 934bacd..dcd00c3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,185 @@
+2000-07-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ * merged core-8-3-1-io-rewrite back into core-8-3-1-branch.
+ The core-8-3-1-io-rewrite branch should now be considered defunct.
+
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to
+ tclIO.c and made them proper stubbed functions. These are:
+ 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,
+ and Tcl_ChannelHandlerProc. These should be used to access the
+ Tcl_ChannelType structure instead of direct pointer dereferencing.
+
+ * unix/Makefile.in: undid 07-25 Makefile.in changes because we
+ don't really want to force all private makefiles on everyone.
+ This needs to be addressed again in the future. Best possible
+ solution is to create a tcl/ subdir in the installing include dir
+ (as is done already with the lib dir).
+
+ * tests/iogt.test: added RCS string, marked tests 2.* to be
+ unixOnly due to underlying system differences.
+
+ * tests/all.tcl: corrected additional sets by Kupries for testing.
+
+2000-07-25 Brent Welch <welch@ajubasolutions.com>
+
+ * unix/Makefile.in: Need to install all the Tcl headers because
+ Itcl depends on internal headers.
+
+2000-07-25 Andreas Kupries <a.kupries@westend.com>
+
+ * tests/iogt.test: (line 866f) New tests iogt-6.[01], highlighting
+ buffering trouble when stacking and unstacking transformations.
+ iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for
+ now, due to the perceived complexity of solutions.
+
+ * generic/tclIO.h: (line 139f) struct Channel, added a buffer
+ queue, to hold data pushed back when stacking a transformation.
+
+ * generic/tclIO.c:
+ (line 91f, line 7434f) New internal function 'CopyBuffer'.
+ Derived from 'CopyAndTranslateBuffer', with translation
+ removed.
+ (line 1025f, line 1212f): Initialization of new queue.
+ (line 1164f, Tcl_StackChannel): Pushback of input queue.
+ (line 1293f, Tcl_UnstackChannel): Discard input and pushback.
+ (line 3748f, Tcl_ReadRaw): Modified to use data in the push back
+ area before going to the driver. Uses 'CopyBuffer', s.a.
+ (line 4702f, GetInput): Modified to use data in the push back
+ area before going to the driver.
+ (line 4867f, Tcl_Seek): Modified to take pushback of the topmost
+ channel in a stack into account.
+ (line 5620f, Tcl_InputBuffered): See above. Added
+ 'Tcl_ChannelBuffered'. Analogue to 'Tcl_InputBuffered' but for
+ the buffer area in the channel.
+
+ * generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.
+
+2000-07-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/socket.test: removed doTestsWithRemoteServer constraint
+ from socket-12.*. It requires 'exec', not a remote server.
+ Cleaned up some coding errors.
+
+2000-07-18 Brent Welch <welch@ajubasolutions.com>
+
+ * win/Makefile.in: Added rules for static tcldde and tclreg libraries.
+
+2000-07-17 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * win/README:
+ * win/README.binary:
+ * win/configure.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * tools/tcl.wse.in:
+ * generic/tcl.h (TCL_RELEASE_SERIAL): updated to patchlevel 8.3.2
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: added tclIOGT.c to objects list to compile.
+
+ * generic/tclStubInit.c:
+ * generic/tclIntDecls.h:
+ * generic/tclInt.decls: commented out internal decls for
+ TclTestChannelCmd and TclTestChannelEventCmd as they were moved to
+ tclTest.c. Added new decls for TclChannelEventScriptInvoker and
+ TclChannelTransform.
+
+ * generic/tclIO.h: new file that contains the main internal
+ structures of Tcl_Channel code to allow for multiple files to
+ access them.
+ * generic/tclTest.c:
+ * generic/tclIO.c: broke into 3 files - tclIO.c core code, tclIO.h
+ header code, and tclIOGT.c - the giot test code from Kupries. The
+ channel test code also moved to tclTest.c.
+ * generic/tclIO.c (CloseChannel): stopped masking out of the
+ TCL_READABLE|TCL_WRITABLE bits from the state flags in
+ CloseChannel, instead adding extra intelligence to
+ CheckChannelErrors with a new CHANNEL_RAW_MODE bit for special
+ behavior when called from Raw channel APIs.
+
+2000-07-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIO.c (StackSetBlockMode): moved set of chanPtr
+ outside of blockModeProc check to avoid infinite loop when
+ blockModeProc was NULL (Kupries). updated TransformSeekProc to
+ not call Tcl_Seek directly (Kupries).
+
+ * win/tclWinChan.c: updated fileChannelType to v2 channel struct
+ * win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
+ * win/tclWinPipe.c: updated pipeChannelType to v2 channel struct
+ * win/tclWinSerial.c: updated serialChannelType to v2 channel struct
+ * win/tclWinSock.c: updated tcpChannelType to v2 channel struct
+
2000-07-11 Brent Welch <welch@ajubasolutions.com>
+
* win/tclConfig.sh.in: Cleaned up unix-specific autoconf variables.
-2000-07-10 Brent Welch <welch@ajubasolutions.com>
- * win/Makefile.in: Added rules for dde and registry
- static library make targets.
+2000-07-11 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/iogt.test: made tests [345].0 not run by default as they
+ were failing in the new design, but I'm not convinced that the
+ returned result isn't correct.
+
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tcl.decls: added Tcl_GetTopChannel C API that returns
+ the current top channel of a channel stack. Tcl_GetChannel was
+ changed earlier to return the bottommost channel of a stack
+ because that is the one that is guaranteed to stay around the
+ longest, and this was needed to compensate for certain
+ operations that want to look at the state of the main channel.
+ Most channel APIs already compensate for grabbing the top, so it
+ shouldn't be needed often.
+
+ * generic/tclIO.c (Tcl_StackChannel, Tcl_UnstackChannel): Added
+ flushing of buffers (Kupries), removed use of DownChannel macro,
+ added Tcl_GetTopChannel public API to get to the top channel of
+ the channel stack (necessary for TLS). Rewrote Tcl_NotifyChannel
+ for new channel design (Kupries). Did some code cleanup in the
+ transform code. tclIO.c must still be broken into bits (separate
+ out test code and giot code, create tclIO.h).
+
+2000-07-10 Andreas Kupries <a.kupries@westend.com>
+
+ * tests/iogt.test: Reverted some earlier changes as a fix by Jeff
+ revived the original and correct behaviour. IOW, the tests showed
+ a genuine error and I didn't see it :(.
+
+ * generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use
+ the drivers and not DoRead|DoWrite. The latter use the buffering
+ system, encoding and eol-translation and this wreaks havoc with
+ the data going through the transformations. Both procedures use
+ CheckForchannelErrors and let it believe that there is no
+ background copy in progress or else stacked channels could not
+ be used for that.
+
+ * generic/tclIO.c (TclCopyChannel, CopyData): Moved access to the
+ topmost channel from the first to the second procedure to make
+ the decision about that at the last possible time (Callbacks can
+ change the stacking).
+
+ test suite: failures of iogt-[345].0
+
+2000-07-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/iogt.test: new tests for stacked channel stuff based off
+ new 'testchannel transform|unstack' code (Kupries IOGT extension).
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+ * generic/tclStubsInit.c:
+ * generic/tclIO.c (TclCopyChannel): complete rewrite of Tcl
+ Channel code for stacked channels. HOBBS: ADD MORE WHEN DONE.
2000-06-02 Jeff Hobbs <hobbs@scriptics.com>
diff --git a/README b/README
index 2b6d3cf..b4010ea 100644
--- a/README
+++ b/README
@@ -1,11 +1,11 @@
README: Tcl
- This is the Tcl 8.3.1 source distribution.
+ This is the Tcl 8.3.2 source distribution.
You can get any release of Tcl from:
http://dev.scriptics.com/registration/<version>.tml
Tcl/Tk is also available through NetCVS:
http://dev.scriptics.com/software/tcltk/netcvs.html
-RCS: @(#) $Id: README,v 1.31 2000/04/26 17:31:19 hobbs Exp $
+RCS: @(#) $Id: README,v 1.31.2.1 2000/07/27 01:39:13 hobbs Exp $
Contents
--------
@@ -49,7 +49,7 @@ The home page for this release, including new features, is
http://dev.scriptics.com/software/tcltk/8.3.html
Detailed release notes can be found at
- http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.1.txt
+ http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.2.txt
Information about Tcl itself can be found at
http://dev.scriptics.com/scripting/
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 9d75c87..ad0d51d 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.33 2000/04/09 16:04:17 kupries Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.33.2.1 2000/07/27 01:39:14 hobbs Exp $
library tcl
@@ -987,7 +987,7 @@ declare 281 generic {
int mask, Tcl_Channel prevChan)
}
declare 282 generic {
- void Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
+ int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 283 generic {
Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
@@ -1358,6 +1358,66 @@ declare 393 generic {
ClientData clientData, int stackSize, int flags)
}
+declare 394 generic {
+ int Tcl_ReadRaw (Tcl_Channel chan, char *dst, int bytesToRead)
+}
+declare 395 generic {
+ int Tcl_WriteRaw (Tcl_Channel chan, char *src, int srcLen)
+}
+declare 396 generic {
+ Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan)
+}
+declare 397 generic {
+ int Tcl_ChannelBuffered (Tcl_Channel chan)
+}
+declare 398 generic {
+ char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+}
+declare 399 generic {
+ Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr)
+}
+declare 400 generic {
+ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 401 generic {
+ Tcl_DriverCloseProc * Tcl_ChannelCloseProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 402 generic {
+ Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(Tcl_ChannelType *chanTypePtr)
+}
+declare 403 generic {
+ Tcl_DriverInputProc * Tcl_ChannelInputProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 404 generic {
+ Tcl_DriverOutputProc * Tcl_ChannelOutputProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 405 generic {
+ Tcl_DriverSeekProc * Tcl_ChannelSeekProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 406 generic {
+ Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 407 generic {
+ Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 408 generic {
+ Tcl_DriverWatchProc * Tcl_ChannelWatchProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 409 generic {
+ Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 410 generic {
+ Tcl_DriverFlushProc * Tcl_ChannelFlushProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 411 generic {
+ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
diff --git a/generic/tcl.h b/generic/tcl.h
index cccf9f6..1333f25 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,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.70 2000/04/19 08:32:44 hobbs Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.70.2.1 2000/07/27 01:39:14 hobbs Exp $
*/
#ifndef _TCL
@@ -59,10 +59,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 3
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 1
+#define TCL_RELEASE_SERIAL 2
#define TCL_VERSION "8.3"
-#define TCL_PATCH_LEVEL "8.3.1"
+#define TCL_PATCH_LEVEL "8.3.2"
/*
* The following definitions set up the proper options for Windows
@@ -386,6 +386,7 @@ typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
+typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
/*
* Definition of the interface to procedures implementing threads.
@@ -1140,7 +1141,7 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
*/
#define TCL_CLOSE_READ (1<<1)
-#define TCL_CLOSE_WRITE (1<<2)
+#define TCL_CLOSE_WRITE (1<<2)
/*
* Value to use as the closeProc for a channel that supports the
@@ -1150,6 +1151,13 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1)
/*
+ * Channel version tag. This was introduced in 8.3.2/8.4.
+ */
+
+#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1)
+#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
+
+/*
* Typedefs for the various operations in a channel type:
*/
@@ -1176,6 +1184,10 @@ typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((
typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
ClientData instanceData, int direction,
ClientData *handlePtr));
+typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_((
+ ClientData instanceData));
+typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
+ ClientData instanceData, int interestMask));
/*
* The following declarations either map ckalloc and ckfree to
@@ -1224,38 +1236,50 @@ typedef enum Tcl_EolTranslation {
* One such structure exists for each type (kind) of channel.
* It collects together in one place all the functions that are
* part of the specific channel type.
+ *
+ * It is recommend that the Tcl_Channel* functions are used to access
+ * elements of this structure, instead of direct accessing.
*/
typedef struct Tcl_ChannelType {
char *typeName; /* The name of the channel type in Tcl
- * commands. This storage is owned by
- * channel type. */
- Tcl_DriverBlockModeProc *blockModeProc;
- /* Set blocking mode for the
- * raw channel. May be NULL. */
+ * commands. This storage is owned by
+ * channel type. */
+ Tcl_ChannelTypeVersion version; /* Version of the channel type. */
Tcl_DriverCloseProc *closeProc; /* Procedure to call to close the
- * channel, or TCL_CLOSE2PROC if the
- * close2Proc should be used
- * instead. */
+ * channel, or TCL_CLOSE2PROC if the
+ * close2Proc should be used
+ * instead. */
Tcl_DriverInputProc *inputProc; /* Procedure to call for input
- * on channel. */
+ * on channel. */
Tcl_DriverOutputProc *outputProc; /* Procedure to call for output
- * on channel. */
+ * on channel. */
Tcl_DriverSeekProc *seekProc; /* Procedure to call to seek
- * on the channel. May be NULL. */
+ * on the channel. May be NULL. */
Tcl_DriverSetOptionProc *setOptionProc;
- /* Set an option on a channel. */
+ /* Set an option on a channel. */
Tcl_DriverGetOptionProc *getOptionProc;
- /* Get an option from a channel. */
+ /* Get an option from a channel. */
Tcl_DriverWatchProc *watchProc; /* Set up the notifier to watch
- * for events on this channel. */
+ * for events on this channel. */
Tcl_DriverGetHandleProc *getHandleProc;
/* Get an OS handle from the channel
- * or NULL if not supported. */
- Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the
+ * or NULL if not supported. */
+ Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the
* channel if the device supports
* closing the read & write sides
* independently. */
+ Tcl_DriverBlockModeProc *blockModeProc;
+ /* Set blocking mode for the
+ * raw channel. May be NULL. */
+ /*
+ * Only valid in TCL_CHANNEL_VERSION_2 channels
+ */
+ 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. */
} Tcl_ChannelType;
/*
@@ -1264,8 +1288,8 @@ typedef struct Tcl_ChannelType {
* as arguments to the blockModeProc procedure in the above structure.
*/
-#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
-#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
+#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
+#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
* mode. */
/*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8cef5c4..04d1c56 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.34 2000/04/09 16:04:17 kupries Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.34.2.1 2000/07/27 01:39:15 hobbs Exp $
*/
#ifndef _TCLDECLS
@@ -909,7 +909,7 @@ EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp,
ClientData instanceData, int mask,
Tcl_Channel prevChan));
/* 282 */
-EXTERN void Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN int Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel chan));
/* 283 */
EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
@@ -1228,6 +1228,58 @@ EXTERN int Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr,
Tcl_ThreadCreateProc proc,
ClientData clientData, int stackSize,
int flags));
+/* 394 */
+EXTERN int Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan,
+ char * dst, int bytesToRead));
+/* 395 */
+EXTERN int Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
+ char * src, int srcLen));
+/* 396 */
+EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
+/* 397 */
+EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
+/* 398 */
+EXTERN char * Tcl_ChannelName _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 399 */
+EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 400 */
+EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 401 */
+EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 402 */
+EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 403 */
+EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 404 */
+EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 405 */
+EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 406 */
+EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 407 */
+EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 408 */
+EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 409 */
+EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 410 */
+EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 411 */
+EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -1577,7 +1629,7 @@ typedef struct TclStubs {
void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
- void (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */
+ int (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */
Tcl_Channel (*tcl_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 283 */
void *reserved284;
void *reserved285;
@@ -1689,6 +1741,24 @@ typedef struct TclStubs {
void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */
void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */
int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */
+ int (*tcl_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char * dst, int bytesToRead)); /* 394 */
+ int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char * src, int srcLen)); /* 395 */
+ Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */
+ int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */
+ char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
+ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */
+ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */
+ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */
+ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 402 */
+ Tcl_DriverInputProc * (*tcl_ChannelInputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 403 */
+ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 404 */
+ Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 405 */
+ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 406 */
+ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 407 */
+ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 408 */
+ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */
+ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */
+ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */
} TclStubs;
#ifdef __cplusplus
@@ -3310,6 +3380,78 @@ extern TclStubs *tclStubsPtr;
#define Tcl_CreateThread \
(tclStubsPtr->tcl_CreateThread) /* 393 */
#endif
+#ifndef Tcl_ReadRaw
+#define Tcl_ReadRaw \
+ (tclStubsPtr->tcl_ReadRaw) /* 394 */
+#endif
+#ifndef Tcl_WriteRaw
+#define Tcl_WriteRaw \
+ (tclStubsPtr->tcl_WriteRaw) /* 395 */
+#endif
+#ifndef Tcl_GetTopChannel
+#define Tcl_GetTopChannel \
+ (tclStubsPtr->tcl_GetTopChannel) /* 396 */
+#endif
+#ifndef Tcl_ChannelBuffered
+#define Tcl_ChannelBuffered \
+ (tclStubsPtr->tcl_ChannelBuffered) /* 397 */
+#endif
+#ifndef Tcl_ChannelName
+#define Tcl_ChannelName \
+ (tclStubsPtr->tcl_ChannelName) /* 398 */
+#endif
+#ifndef Tcl_ChannelVersion
+#define Tcl_ChannelVersion \
+ (tclStubsPtr->tcl_ChannelVersion) /* 399 */
+#endif
+#ifndef Tcl_ChannelBlockModeProc
+#define Tcl_ChannelBlockModeProc \
+ (tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
+#endif
+#ifndef Tcl_ChannelCloseProc
+#define Tcl_ChannelCloseProc \
+ (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
+#endif
+#ifndef Tcl_ChannelClose2Proc
+#define Tcl_ChannelClose2Proc \
+ (tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
+#endif
+#ifndef Tcl_ChannelInputProc
+#define Tcl_ChannelInputProc \
+ (tclStubsPtr->tcl_ChannelInputProc) /* 403 */
+#endif
+#ifndef Tcl_ChannelOutputProc
+#define Tcl_ChannelOutputProc \
+ (tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
+#endif
+#ifndef Tcl_ChannelSeekProc
+#define Tcl_ChannelSeekProc \
+ (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
+#endif
+#ifndef Tcl_ChannelSetOptionProc
+#define Tcl_ChannelSetOptionProc \
+ (tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
+#endif
+#ifndef Tcl_ChannelGetOptionProc
+#define Tcl_ChannelGetOptionProc \
+ (tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
+#endif
+#ifndef Tcl_ChannelWatchProc
+#define Tcl_ChannelWatchProc \
+ (tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
+#endif
+#ifndef Tcl_ChannelGetHandleProc
+#define Tcl_ChannelGetHandleProc \
+ (tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */
+#endif
+#ifndef Tcl_ChannelFlushProc
+#define Tcl_ChannelFlushProc \
+ (tclStubsPtr->tcl_ChannelFlushProc) /* 410 */
+#endif
+#ifndef Tcl_ChannelHandlerProc
+#define Tcl_ChannelHandlerProc \
+ (tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 54120df..e78d242 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4,351 +4,20 @@
* This file provides the generic portions (those that are the same on
* all platforms and for all channel types) of Tcl's IO facilities.
*
- * Copyright (c) 1998 Scriptics Corporation
+ * Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* 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.20.2.3 2000/06/02 20:04:06 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.20.2.4 2000/07/27 01:39:15 hobbs Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
+#include "tclIO.h"
-/*
- * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
- * compile on systems where neither is defined. We want both defined so
- * that we can test safely for both. In the code we still have to test for
- * both because there may be systems on which both are defined and have
- * different values.
- */
-
-#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
-# define EWOULDBLOCK EAGAIN
-#endif
-#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
-# define EAGAIN EWOULDBLOCK
-#endif
-#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
-error one of EWOULDBLOCK or EAGAIN must be defined
-#endif
-
-/*
- * The following structure encapsulates the state for a background channel
- * copy. Note that the data buffer for the copy will be appended to this
- * structure.
- */
-
-typedef struct CopyState {
- struct Channel *readPtr; /* Pointer to input channel. */
- struct Channel *writePtr; /* Pointer to output channel. */
- int readFlags; /* Original read channel flags. */
- int writeFlags; /* Original write channel flags. */
- int toRead; /* Number of bytes to copy, or -1. */
- int total; /* Total bytes transferred (written). */
- Tcl_Interp *interp; /* Interp that started the copy. */
- Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
- int bufSize; /* Size of appended buffer. */
- char buffer[1]; /* Copy buffer, this must be the last
- * field. */
-} CopyState;
-
-/*
- * struct ChannelBuffer:
- *
- * Buffers data being sent to or from a channel.
- */
-
-typedef struct ChannelBuffer {
- int nextAdded; /* The next position into which a character
- * will be put in the buffer. */
- int nextRemoved; /* Position of next byte to be removed
- * from the buffer. */
- int bufLength; /* How big is the buffer? */
- struct ChannelBuffer *nextPtr;
- /* Next buffer in chain. */
- char buf[4]; /* Placeholder for real buffer. The real
- * buffer occuppies this space + bufSize-4
- * bytes. This must be the last field in
- * the structure. */
-} ChannelBuffer;
-
-#define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
-
-/*
- * How much extra space to allocate in buffer to hold bytes from previous
- * buffer (when converting to UTF-8) or to hold bytes that will go to
- * next buffer (when converting from UTF-8).
- */
-
-#define BUFFER_PADDING 16
-
-/*
- * The following defines the *default* buffer size for channels.
- */
-
-#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
-
-/*
- * Structure to record a close callback. One such record exists for
- * each close callback registered for a channel.
- */
-
-typedef struct CloseCallback {
- Tcl_CloseProc *proc; /* The procedure to call. */
- ClientData clientData; /* Arbitrary one-word data to pass
- * to the callback. */
- struct CloseCallback *nextPtr; /* For chaining close callbacks. */
-} CloseCallback;
-
-/*
- * The following structure describes the information saved from a call to
- * "fileevent". This is used later when the event being waited for to
- * invoke the saved script in the interpreter designed in this record.
- */
-
-typedef struct EventScriptRecord {
- struct Channel *chanPtr; /* The channel for which this script is
- * registered. This is used only when an
- * error occurs during evaluation of the
- * script, to delete the handler. */
- Tcl_Obj *scriptPtr; /* Script to invoke. */
- Tcl_Interp *interp; /* In what interpreter to invoke script? */
- int mask; /* Events must overlap current mask for the
- * stored script to be invoked. */
- struct EventScriptRecord *nextPtr;
- /* Next in chain of records. */
-} EventScriptRecord;
-
-/*
- * struct Channel:
- *
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
- */
-
-typedef struct Channel {
- char *channelName; /* The name of the channel instance in Tcl
- * commands. Storage is owned by the generic IO
- * code, is dynamically allocated. */
- int flags; /* ORed combination of the flags defined
- * below. */
- Tcl_Encoding encoding; /* Encoding to apply when reading or writing
- * data on this channel. NULL means no
- * encoding is applied to data. */
- Tcl_EncodingState inputEncodingState;
- /* Current encoding state, used when converting
- * input data bytes to UTF-8. */
- int inputEncodingFlags; /* Encoding flags to pass to conversion
- * routine when converting input data bytes to
- * UTF-8. May be TCL_ENCODING_START before
- * converting first byte and TCL_ENCODING_END
- * when EOF is seen. */
- Tcl_EncodingState outputEncodingState;
- /* Current encoding state, used when converting
- * UTF-8 to output data bytes. */
- int outputEncodingFlags; /* Encoding flags to pass to conversion
- * routine when converting UTF-8 to output
- * data bytes. May be TCL_ENCODING_START
- * before converting first byte and
- * TCL_ENCODING_END when EOF is seen. */
- Tcl_EolTranslation inputTranslation;
- /* What translation to apply for end of line
- * sequences on input? */
- Tcl_EolTranslation outputTranslation;
- /* What translation to use for generating
- * end of line sequences in output? */
- int inEofChar; /* If nonzero, use this as a signal of EOF
- * on input. */
- int outEofChar; /* If nonzero, append this to the channel
- * when it is closed if it is open for
- * writing. */
- int unreportedError; /* Non-zero if an error report was deferred
- * because it happened in the background. The
- * value is the POSIX error code. */
- ClientData instanceData; /* Instance-specific data provided by
- * creator of channel. */
-
- Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
- int refCount; /* How many interpreters hold references to
- * this IO channel? */
- CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
- * channel is closed. */
- char *outputStage; /* Temporary staging buffer used when
- * translating EOL before converting from
- * UTF-8 to external form. */
- ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
- ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
- ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
-
- ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
- * need to allocate a new buffer for "gets"
- * that crosses buffer boundaries. */
- ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
- ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
-
- struct ChannelHandler *chPtr;/* List of channel handlers registered
- * for this channel. */
- int interestMask; /* Mask of all events this channel has
- * handlers for. */
- struct Channel *nextChanPtr;/* Next in list of channels currently open. */
- EventScriptRecord *scriptRecordPtr;
- /* Chain of all scripts registered for
- * event handlers ("fileevent") on this
- * channel. */
- int bufSize; /* What size buffers to allocate? */
- Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
- CopyState *csPtr; /* State of background copy, or NULL. */
- struct Channel* supercedes; /* Refers to channel this one was stacked upon.
- This reference is NULL for normal channels.
- See Tcl_StackChannel. */
-
-} Channel;
-
-/*
- * Values for the flags field in Channel. Any ORed combination of the
- * following flags can be stored in the field. These flags record various
- * options and state bits about the channel. In addition to the flags below,
- * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
- */
-
-#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
- * nonblocking mode. */
-#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
- * flushed after every newline. */
-#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
- * be flushed immediately. */
-#define BUFFER_READY (1<<6) /* Current output buffer (the
- * curOutPtr field in the
- * channel structure) should be
- * output as soon as possible even
- * though it may not be full. */
-#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
- * queued output buffers has been
- * scheduled. */
-#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
- * further Tcl-level IO on the
- * channel is allowed. */
-#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
- * This bit is cleared before every
- * input operation. */
-#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
- * we saw the input eofChar. This bit
- * prevents clearing of the EOF bit
- * before every input operation. */
-#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
- * on this channel. This bit is
- * cleared before every input or
- * output operation. */
-#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
- * translation mode and the last
- * byte seen was a "\r". */
-#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
- * and there should be a '\n' at
- * beginning of next buffer. */
-#define CHANNEL_DEAD (1<<13) /* The channel has been closed by
- * the exit handler (on exit) but
- * not deallocated. When any IO
- * operation sees this flag on a
- * channel, it does not call driver
- * level functions to avoid referring
- * to deallocated data. */
-#define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
- * because there was not enough data
- * to complete the operation. This
- * flag is set when gets fails to
- * get a complete line or when read
- * fails to get a complete character.
- * When set, file events will not be
- * delivered for buffered data until
- * the state of the channel changes. */
-
-/*
- * For each channel handler registered in a call to Tcl_CreateChannelHandler,
- * there is one record of the following type. All of records for a specific
- * channel are chained together in a singly linked list which is stored in
- * the channel structure.
- */
-
-typedef struct ChannelHandler {
- Channel *chanPtr; /* The channel structure for this channel. */
- int mask; /* Mask of desired events. */
- Tcl_ChannelProc *proc; /* Procedure to call in the type of
- * Tcl_CreateChannelHandler. */
- ClientData clientData; /* Argument to pass to procedure. */
- struct ChannelHandler *nextPtr;
- /* Next one in list of registered handlers. */
-} ChannelHandler;
-
-/*
- * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
- * problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
- * problem, structures of the type below indicate the next handler to be
- * processed for any (recursively nested) dispatches in progress. The
- * nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
- * deleted against the NEXT handler to be invoked in that invocation; when it
- * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
- * field of the structure to the next handler.
- */
-
-typedef struct NextChannelHandler {
- ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
- * this invocation. */
- struct NextChannelHandler *nestedHandlerPtr;
- /* Next nested invocation of
- * ChannelHandlerEventProc. */
-} NextChannelHandler;
-
-
-/*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
- */
-
-typedef struct ChannelHandlerEvent {
- Tcl_Event header; /* Standard header for all events. */
- Channel *chanPtr; /* The channel that is ready. */
- int readyMask; /* Events that have occurred. */
-} ChannelHandlerEvent;
-
-/*
- * The following structure is used by Tcl_GetsObj() to encapsulates the
- * state for a "gets" operation.
- */
-
-typedef struct GetsState {
- Tcl_Obj *objPtr; /* The object to which UTF-8 characters
- * will be appended. */
- char **dstPtr; /* Pointer into objPtr's string rep where
- * next character should be stored. */
- Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
- * to UTF-8. */
- ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
- * emptied. */
- Tcl_EncodingState state; /* The encoding state just before the last
- * external to UTF-8 conversion in
- * FilterInputBytes(). */
- int rawRead; /* The number of bytes removed from bufPtr
- * in the last call to FilterInputBytes(). */
- int bytesWrote; /* The number of bytes of UTF-8 data
- * appended to objPtr during the last call to
- * FilterInputBytes(). */
- int charsWrote; /* The corresponding number of UTF-8
- * characters appended to objPtr during the
- * last call to FilterInputBytes(). */
- int totalChars; /* The total number of UTF-8 characters
- * appended to objPtr so far, just before the
- * last call to FilterInputBytes(). */
-} GetsState;
-
+
/*
* All static variables used in this file are collected into a single
* instance of the following structure. For multi-threaded implementations,
@@ -367,9 +36,10 @@ typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/*
- * List of all channels currently open.
+ * List of all channels currently open, indexed by ChannelState,
+ * as only one ChannelState exists per set of stacked channels.
*/
- Channel *firstChanPtr;
+ ChannelState *firstCSPtr;
#ifdef oldcode
/*
* Has a channel exit handler been created yet?
@@ -402,73 +72,78 @@ static Tcl_ThreadDataKey dataKey;
*/
static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
-static void ChannelEventScriptInvoker _ANSI_ARGS_((
- ClientData clientData, int flags));
static void ChannelTimerProc _ANSI_ARGS_((
- ClientData clientData));
-static int CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
- int direction));
+ ClientData clientData));
+static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
+ int direction));
static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr, int newlineFlag));
+ ChannelBuffer *bufPtr, int newlineFlag));
static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chan));
+ ChannelState *statePtr));
static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
- Tcl_Channel chan));
+ Tcl_Channel chan));
static void CleanupChannelHandlers _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr));
+ Tcl_Interp *interp, Channel *chanPtr));
static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int errorCode));
+ Channel *chanPtr, int errorCode));
static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
- Tcl_Encoding encoding));
+ Tcl_Encoding encoding));
static int CopyAndTranslateBuffer _ANSI_ARGS_((
- Channel *chanPtr, char *result, int space));
+ ChannelState *statePtr, char *result,
+ int space));
+static int CopyBuffer _ANSI_ARGS_((
+ Channel *chanPtr, char *result,
+ int space));
static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
- int mask));
+ int mask));
static void CreateScriptRecord _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr,
- int mask, Tcl_Obj *scriptPtr));
+ Tcl_Interp *interp, Channel *chanPtr,
+ int mask, Tcl_Obj *scriptPtr));
static void DeleteChannelTable _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
+ ClientData clientData, Tcl_Interp *interp));
static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mask));
-static void DiscardInputQueued _ANSI_ARGS_((
- Channel *chanPtr, int discardSavedBuffers));
+ Channel *chanPtr, int mask));
+static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
+ int discardSavedBuffers));
static void DiscardOutputQueued _ANSI_ARGS_((
- Channel *chanPtr));
+ ChannelState *chanPtr));
static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- int slen));
+ int slen));
static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
- int srcLen));
+ int srcLen));
static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
- GetsState *statePtr));
+ GetsState *statePtr));
static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int calledFromAsyncFlush));
+ Channel *chanPtr, int calledFromAsyncFlush));
static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
static int GetInput _ANSI_ARGS_((Channel *chanPtr));
static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
- char **dstEndPtr, GetsState *gsPtr));
-static int ReadBytes _ANSI_ARGS_((Channel *chanPtr,
- Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
-static int ReadChars _ANSI_ARGS_((Channel *chanPtr,
- Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
- int *factorPtr));
-static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr, int mustDiscard));
+ char **dstEndPtr, GetsState *gsPtr));
+static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
+ Tcl_Obj *objPtr, int charsLeft,
+ int *offsetPtr));
+static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
+ Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
+ int *factorPtr));
+static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
+ ChannelBuffer *bufPtr, int mustDiscard));
+static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
+ int mode));
static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mode));
+ Channel *chanPtr, int mode));
static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
-static int TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
- char *dst, CONST char *src, int *dstLenPtr,
- int *srcLenPtr));
-static int TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
- char *dst, CONST char *src, int *dstLenPtr,
- int *srcLenPtr));
+static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
+ char *dst, CONST char *src, int *dstLenPtr,
+ int *srcLenPtr));
+static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
+ char *dst, CONST char *src, int *dstLenPtr,
+ int *srcLenPtr));
static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
+ CONST char *src, int srcLen));
static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
+ CONST char *src, int srcLen));
/*
@@ -522,12 +197,13 @@ TclFinalizeIOSubsystem()
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Channel *chanPtr; /* Iterates over open channels. */
- Channel *nextChanPtr; /* Iterates over open channels. */
-
+ ChannelState *nextCSPtr; /* Iterates over open channels. */
+ ChannelState *statePtr; /* state of channel stack */
- for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
- chanPtr = nextChanPtr) {
- nextChanPtr = chanPtr->nextChanPtr;
+ for (statePtr = tsdPtr->firstCSPtr; statePtr != (ChannelState *) NULL;
+ statePtr = nextCSPtr) {
+ chanPtr = statePtr->topChanPtr;
+ nextCSPtr = statePtr->nextCSPtr;
/*
* Set the channel back into blocking mode to ensure that we wait
@@ -546,10 +222,10 @@ TclFinalizeIOSubsystem()
* up to keep the channel from being closed.
*/
- chanPtr->refCount--;
+ statePtr->refCount--;
}
- if (chanPtr->refCount <= 0) {
+ if (statePtr->refCount <= 0) {
/*
* Close it only if the refcount indicates that the channel is not
@@ -588,7 +264,7 @@ TclFinalizeIOSubsystem()
*/
chanPtr->instanceData = (ClientData) NULL;
- chanPtr->flags |= CHANNEL_DEAD;
+ statePtr->flags |= CHANNEL_DEAD;
}
}
}
@@ -737,17 +413,17 @@ Tcl_CreateCloseHandler(chan, proc, clientData)
ClientData clientData; /* Arbitrary data to pass to the
* close callback. */
{
- Channel *chanPtr;
+ ChannelState *statePtr;
CloseCallback *cbPtr;
- chanPtr = (Channel *) chan;
+ statePtr = ((Channel *) chan)->state;
cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
- cbPtr->nextPtr = chanPtr->closeCbPtr;
- chanPtr->closeCbPtr = cbPtr;
+ cbPtr->nextPtr = statePtr->closeCbPtr;
+ statePtr->closeCbPtr = cbPtr;
}
/*
@@ -778,16 +454,16 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
ClientData clientData; /* The callback data for the callback
* to remove. */
{
- Channel *chanPtr;
+ ChannelState *statePtr;
CloseCallback *cbPtr, *cbPrevPtr;
- chanPtr = (Channel *) chan;
- for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
+ statePtr = ((Channel *) chan)->state;
+ for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
cbPtr != (CloseCallback *) NULL;
cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
if (cbPrevPtr == (CloseCallback *) NULL) {
- chanPtr->closeCbPtr = cbPtr->nextPtr;
+ statePtr->closeCbPtr = cbPtr->nextPtr;
}
ckfree((char *) cbPtr);
break;
@@ -887,12 +563,13 @@ DeleteChannelTable(clientData, interp)
Tcl_HashTable *hTblPtr; /* The hash table. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* Channel being deleted. */
+ Channel *chanPtr; /* Channel being deleted. */
+ ChannelState *statePtr; /* State of Channel being deleted. */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/* Variables to loop over all channel events
* registered, to delete the ones that refer
* to the interpreter being deleted. */
-
+
/*
* Delete all the registered channels - this will close channels whose
* refcount reaches zero.
@@ -904,25 +581,26 @@ DeleteChannelTable(clientData, interp)
hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
/*
* Remove any fileevents registered in this interpreter.
*/
- for (sPtr = chanPtr->scriptRecordPtr,
+ for (sPtr = statePtr->scriptRecordPtr,
prevPtr = (EventScriptRecord *) NULL;
sPtr != (EventScriptRecord *) NULL;
sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == (EventScriptRecord *) NULL) {
- chanPtr->scriptRecordPtr = nextPtr;
+ statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, (ClientData) sPtr);
Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
@@ -939,9 +617,9 @@ DeleteChannelTable(clientData, interp)
*/
Tcl_DeleteHashEntry(hPtr);
- chanPtr->refCount--;
- if (chanPtr->refCount <= 0) {
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->refCount--;
+ if (statePtr->refCount <= 0) {
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
@@ -976,24 +654,26 @@ static void
CheckForStdChannelsBeingClosed(chan)
Tcl_Channel chan;
{
- Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = ((Channel *) chan)->state;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
tsdPtr->stdinChannel = NULL;
return;
}
- } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
+ } else if ((chan == tsdPtr->stdoutChannel)
+ && (tsdPtr->stdoutInitialized)) {
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
tsdPtr->stdoutChannel = NULL;
return;
}
- } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
+ } else if ((chan == tsdPtr->stderrChannel)
+ && (tsdPtr->stderrInitialized)) {
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
tsdPtr->stderrChannel = NULL;
return;
}
@@ -1028,38 +708,32 @@ Tcl_RegisterChannel(interp, chan)
Tcl_HashEntry *hPtr; /* Search variable. */
int new; /* Is the hash entry new or does it exist? */
Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* State of the actual channel. */
- chanPtr = (Channel *) chan;
+ /*
+ * Always (un)register bottom-most channel in the stack. This makes
+ * management of the channel list easier because no manipulation is
+ * necessary during (un)stack operation.
+ */
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ statePtr = chanPtr->state;
- if (chanPtr->channelName == (char *) NULL) {
+ if (statePtr->channelName == (char *) NULL) {
panic("Tcl_RegisterChannel: channel without name");
}
if (interp != (Tcl_Interp *) NULL) {
hTblPtr = GetChannelTable(interp);
- hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
+ hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
if (new == 0) {
if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
return;
}
- /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
- * "Trf-Patch for filtering channels"
- *
- * This is the change to 'Tcl_RegisterChannel'.
- *
- * Explanation:
- * The moment a channel is stacked upon another he
- * takes the identity of the channel he supercedes,
- * i.e. he gets the *same* name. Because of this we
- * cannot check for duplicate names anymore, they
- * have to be allowed now.
- */
-
- /* panic("Tcl_RegisterChannel: duplicate channel names"); */
+ panic("Tcl_RegisterChannel: duplicate channel names");
}
Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
}
- chanPtr->refCount++;
+ statePtr->refCount++;
}
/*
@@ -1088,15 +762,22 @@ Tcl_UnregisterChannel(interp, chan)
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of the real channel. */
+
+ /*
+ * Always (un)register bottom-most channel in the stack. This makes
+ * management of the channel list easier because no manipulation is
+ * necessary during (un)stack operation.
+ */
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ statePtr = chanPtr->state;
- chanPtr = (Channel *) chan;
-
if (interp != (Tcl_Interp *) NULL) {
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == (Tcl_HashTable *) NULL) {
return TCL_OK;
}
- hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
+ hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
if (hPtr == (Tcl_HashEntry *) NULL) {
return TCL_OK;
}
@@ -1116,7 +797,7 @@ Tcl_UnregisterChannel(interp, chan)
CleanupChannelHandlers(interp, chanPtr);
}
- chanPtr->refCount--;
+ statePtr->refCount--;
/*
* Perform special handling for standard channels being closed. If the
@@ -1132,20 +813,20 @@ Tcl_UnregisterChannel(interp, chan)
* If the refCount reached zero, close the actual channel.
*/
- if (chanPtr->refCount <= 0) {
+ if (statePtr->refCount <= 0) {
/*
* Ensure that if there is another buffer, it gets flushed
* whether or not we are doing a background flush.
*/
- if ((chanPtr->curOutPtr != NULL) &&
- (chanPtr->curOutPtr->nextAdded >
- chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != NULL) &&
+ (statePtr->curOutPtr->nextAdded >
+ statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
}
- chanPtr->flags |= CHANNEL_CLOSED;
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->flags |= CHANNEL_CLOSED;
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
return TCL_ERROR;
}
@@ -1201,17 +882,17 @@ Tcl_GetChannel(interp, chanName, modePtr)
if ((chanName[0] == 's') && (chanName[1] == 't')) {
chanPtr = NULL;
if (strcmp(chanName, "stdin") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
} else if (strcmp(chanName, "stdout") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
} else if (strcmp(chanName, "stderr") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
}
if (chanPtr != NULL) {
- name = chanPtr->channelName;
+ name = chanPtr->state->channelName;
}
}
-
+
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == (Tcl_HashEntry *) NULL) {
@@ -1220,9 +901,16 @@ Tcl_GetChannel(interp, chanName, modePtr)
return NULL;
}
+ /*
+ * Always return bottom-most channel in the stack. This one lives
+ * the longest - other channels may go away unnoticed.
+ * The other APIs compensate where necessary to retrieve the
+ * topmost channel again.
+ */
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
}
return (Tcl_Channel) chanPtr;
@@ -1255,33 +943,45 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* if the channel is readable, writable. */
{
Channel *chanPtr; /* The channel structure newly created. */
+ ChannelState *statePtr; /* The stack-level independent state info
+ * for the channel. */
CONST char *name;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
-
+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+ statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
+ chanPtr->state = statePtr;
+
+ chanPtr->instanceData = instanceData;
+ chanPtr->typePtr = typePtr;
+
+ /*
+ * Set all the bits that are part of the stack-independent state
+ * information for the channel.
+ */
+
if (chanName != (char *) NULL) {
- chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
- strcpy(chanPtr->channelName, chanName);
+ statePtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
+ strcpy(statePtr->channelName, chanName);
} else {
panic("Tcl_CreateChannel: NULL channel name");
}
- chanPtr->flags = mask;
+ statePtr->flags = mask;
/*
* Set the channel to system default encoding.
*/
- chanPtr->encoding = NULL;
+ statePtr->encoding = NULL;
name = Tcl_GetEncodingName(NULL);
if (strcmp(name, "binary") != 0) {
- chanPtr->encoding = Tcl_GetEncoding(NULL, name);
+ statePtr->encoding = Tcl_GetEncoding(NULL, name);
}
- chanPtr->inputEncodingState = NULL;
- chanPtr->inputEncodingFlags = TCL_ENCODING_START;
- chanPtr->outputEncodingState = NULL;
- chanPtr->outputEncodingFlags = TCL_ENCODING_START;
+ statePtr->inputEncodingState = NULL;
+ statePtr->inputEncodingFlags = TCL_ENCODING_START;
+ statePtr->outputEncodingState = NULL;
+ statePtr->outputEncodingFlags = TCL_ENCODING_START;
/*
* Set the channel up initially in AUTO input translation mode to
@@ -1291,58 +991,68 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* indicator (e.g. ^Z) and does not append an EOF indicator to files.
*/
- chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
- chanPtr->inEofChar = 0;
- chanPtr->outEofChar = 0;
-
- chanPtr->unreportedError = 0;
- chanPtr->instanceData = instanceData;
- chanPtr->typePtr = typePtr;
- chanPtr->refCount = 0;
- chanPtr->closeCbPtr = (CloseCallback *) NULL;
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
- chanPtr->outQueueHead = (ChannelBuffer *) NULL;
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
- chanPtr->chPtr = (ChannelHandler *) NULL;
- chanPtr->interestMask = 0;
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
- chanPtr->timer = NULL;
- chanPtr->csPtr = NULL;
- chanPtr->supercedes = (Channel*) NULL;
-
- chanPtr->outputStage = NULL;
- if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
- chanPtr->outputStage = (char *)
- ckalloc((unsigned) (chanPtr->bufSize + 2));
+ statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->inEofChar = 0;
+ statePtr->outEofChar = 0;
+
+ statePtr->unreportedError = 0;
+ statePtr->refCount = 0;
+ statePtr->closeCbPtr = (CloseCallback *) NULL;
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
+ statePtr->inQueueHead = (ChannelBuffer *) NULL;
+ statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ statePtr->chPtr = (ChannelHandler *) NULL;
+ statePtr->interestMask = 0;
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+ statePtr->timer = NULL;
+ statePtr->csPtr = NULL;
+
+ statePtr->outputStage = NULL;
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
}
/*
+ * As we are creating the channel, it is obviously the top for now
+ */
+ statePtr->topChanPtr = chanPtr;
+ statePtr->bottomChanPtr = chanPtr;
+ chanPtr->downChanPtr = (Channel *) NULL;
+ chanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+
+ /*
* Link the channel into the list of all channels; create an on-exit
* handler if there is not one already, to close off all the channels
* in the list on exit.
*/
- chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
- tsdPtr->firstChanPtr = chanPtr;
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
/*
* Install this channel in the first empty standard channel slot, if
* the channel was previously closed explicitly.
*/
- if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
+ if ((tsdPtr->stdinChannel == NULL) &&
+ (tsdPtr->stdinInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
+ } else if ((tsdPtr->stdoutChannel == NULL) &&
+ (tsdPtr->stdoutInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
+ } else if ((tsdPtr->stderrChannel == NULL) &&
+ (tsdPtr->stderrInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
}
return (Tcl_Channel) chanPtr;
@@ -1379,53 +1089,36 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
Tcl_Channel
Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
- Tcl_Interp* interp; /* The interpreter we are working in */
+ Tcl_Interp *interp; /* The interpreter we are working in */
Tcl_ChannelType *typePtr; /* The channel type record for the new
* channel. */
- ClientData instanceData; /* Instance specific data for the new
+ ClientData instanceData; /* Instance specific data for the new
* channel. */
- int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
+ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
* if the channel is readable, writable. */
- Tcl_Channel prevChan; /* The channel structure to replace */
+ Tcl_Channel prevChan; /* The channel structure to replace */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr, *pt;
- int interest = 0;
-
- /*
- * AK, 06/30/1999
- *
- * Tcl_StackChannel differs from Tcl_ReplaceChannel of the
- * original "Trf" patch. Instead of seeing the
- * newly created structure as the *new* channel to cover the specified
- * one use it to *save* the current state of the specified channel and
- * then reinitialize the current structure for the given transformation.
- *
- * Advantages:
- * - No splicing into the (thread-)global list of channels (or the per-
- * interp hash-tables).
- * - Users of the C-API still have valid channel references even after
- * the call to this procedure.
- *
- * Disadvantages:
- * - Untested code.
- */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Channel *chanPtr, *prevChanPtr;
+ ChannelState *statePtr;
/*
* Find the given channel in the list of all channels.
+ * If we don't find it, then it was never registered correctly.
+ *
+ * This operation should occur at the top of a channel stack.
*/
- pt = (Channel*) tsdPtr->firstChanPtr;
+ statePtr = (ChannelState *) tsdPtr->firstCSPtr;
+ prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
- while (pt != (Channel *) prevChan) {
- pt = pt->nextChanPtr;
+ while (statePtr->topChanPtr != prevChanPtr) {
+ statePtr = statePtr->nextCSPtr;
}
- /*
- * 'pt == prevChan' now (or NULL, if not found).
- */
-
- if (!pt) {
+ if (statePtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't find state for channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
return (Tcl_Channel) NULL;
}
@@ -1442,189 +1135,93 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
* --+---+---+---+----+
*/
- if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
+ if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
+ Tcl_AppendResult(interp,
+ "reading and writing both disallowed for channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
return (Tcl_Channel) NULL;
}
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
-
/*
- * If there is some interest in the channel, remove it, break
- * down the whole chain. It will be reconstructed later.
+ * Flush the buffers. This ensures that any data still in them
+ * at this time is not handled by the new transformation. Restrict
+ * this to writable channels. Take care to hide a possible bg-copy
+ * in progress from Tcl_Flush and the CheckForChannelErrors inside.
*/
- interest = pt->interestMask;
-
- pt->interestMask = 0;
-
- if (interest) {
- (pt->typePtr->watchProc) (pt->instanceData, 0);
- }
+ if ((mask & TCL_WRITABLE) != 0) {
+ CopyState *csPtr;
- /*
- * Save some of the current state into the new structure,
- * reinitialize the parts which will stay with the transformation.
- *
- * Remarks:
- * - We cannot discard the buffers, and they cannot be used from the
- * transformation placed later into the 'pt' structure. Save them,
- * and believe that Tcl_SetChannelOption (buffering, none) will do
- * the right thing.
- * - encoding and EOL-translation control information is initialized
- * to values for 'binary'. This is later reinforced via
- * Tcl_SetChanneloption to get the handling of flags and the event
- * system right.
- * - The 'interestMask' of the saved channel is cleared, but the
- * transformations WatchProc is used to establish the connection
- * between transformation and underlying channel. This should
- * reestablish the correct mask.
- * - TTO = Transform Takes Over. The hidden channel no longer
- * needs to perform this function.
- */
-
- chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
- strcpy (chanPtr->channelName, pt->channelName);
-
- chanPtr->flags = pt->flags; /* Save */
-
- chanPtr->encoding = (Tcl_Encoding) NULL; /* == 'binary' */
- chanPtr->inputEncodingState = (Tcl_EncodingState) NULL;
- chanPtr->inputEncodingFlags = TCL_ENCODING_START;
- chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;
- chanPtr->outputEncodingFlags = TCL_ENCODING_START;
-
- chanPtr->inputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
- chanPtr->outputTranslation = TCL_TRANSLATE_LF; /* == 'binary' */
- chanPtr->inEofChar = pt->inEofChar; /* Save */
- chanPtr->outEofChar = pt->outEofChar; /* Save */
-
- chanPtr->unreportedError = pt->unreportedError; /* Save */
- chanPtr->instanceData = pt->instanceData; /* Save */
- chanPtr->typePtr = pt->typePtr; /* Save */
- chanPtr->refCount = 0; /* None, as the structure is covered */
- chanPtr->closeCbPtr = (CloseCallback*) NULL; /* TTO */
-
- chanPtr->outputStage = (char*) NULL;
- chanPtr->curOutPtr = pt->curOutPtr; /* Save */
- chanPtr->outQueueHead = pt->outQueueHead; /* Save */
- chanPtr->outQueueTail = pt->outQueueTail; /* Save */
- chanPtr->saveInBufPtr = pt->saveInBufPtr; /* Save */
- chanPtr->inQueueHead = pt->inQueueHead; /* Save */
- chanPtr->inQueueTail = pt->inQueueTail; /* Save */
-
- chanPtr->chPtr = (ChannelHandler *) NULL; /* TTO */
- chanPtr->interestMask = 0;
- chanPtr->nextChanPtr = (Channel*) NULL; /* Is not in list! */
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; /* TTO */
- chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
- chanPtr->timer = (Tcl_TimerToken) NULL; /* TTO */
- chanPtr->csPtr = (CopyState*) NULL; /* TTO */
+ csPtr = statePtr->csPtr;
+ statePtr->csPtr = (CopyState*) NULL;
- /*
- * Place new block at the head of a possibly existing list of previously
- * stacked channels, then do the missing initializations of translation
- * and buffer system.
- */
-
- chanPtr->supercedes = pt->supercedes;
-
- Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
- "-translation", "binary");
- Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
- "-buffering", "none");
+ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
+ statePtr->csPtr = csPtr;
+ Tcl_AppendResult(interp, "could not flush channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+ return (Tcl_Channel) NULL;
+ }
+ statePtr->csPtr = csPtr;
+ }
/*
- * Save accomplished, now reinitialize the (old) structure for the
- * transformation.
- *
- * - The information about encoding and eol-translation is taken
- * without change. There is no need to fiddle with
- * refCount et. al.
+ * Discard any input in the buffers. They are not yet read by the
+ * user of the channel, so they have to go through the new
+ * transformation before reading. As the buffers contain the
+ * untransformed form their contents are not only useless but actually
+ * distorts our view of the system.
*
- * Don't forget to use the same blocking mode as the old channel.
+ * To preserve the information without having to read them again and
+ * to avoid problems with the location in the channel (seeking might
+ * be impossible) we move the buffers from the common state structure
+ * into the channel itself. We use the buffers in the channel below
+ * the new transformation to hold the data. In the future this allows
+ * us to write transformations which pre-read data and push the unused
+ * part back when they are going away.
*/
- pt->flags = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);
+ if (((mask & TCL_READABLE) != 0) &&
+ (statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
+ /*
+ * Remark: It is possible that the channel buffers contain data from
+ * some earlier push-backs.
+ */
- /*
- * EDITORS NOTE: all the lines with "take it as is" should get
- * deleted once this code has been debugged.
- */
+ statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
+ prevChanPtr->inQueueHead = statePtr->inQueueHead;
- /* pt->encoding, take it as is */
- /* pt->inputEncodingState, take it as is */
- /* pt->inputEncodingFlags, take it as is */
- /* pt->outputEncodingState, take it as is */
- /* pt->outputEncodingFlags, take it as is */
+ if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
+ prevChanPtr->inQueueTail = statePtr->inQueueTail;
+ }
- /* pt->inputTranslation, take it as is */
- /* pt->outputTranslation, take it as is */
-
- /*
- * No special EOF character, that condition is determined by the
- * old channel
- */
-
- pt->inEofChar = 0;
- pt->outEofChar = 0;
-
- pt->unreportedError = 0; /* No errors yet */
- pt->instanceData = instanceData; /* Transformation state */
- pt->typePtr = typePtr; /* Transformation type */
- /* pt->refCount, take it as it is */
- /* pt->closeCbPtr, take it as it is */
-
- /* pt->outputStage, take it as it is */
- pt->curOutPtr = (ChannelBuffer *) NULL;
- pt->outQueueHead = (ChannelBuffer *) NULL;
- pt->outQueueTail = (ChannelBuffer *) NULL;
- pt->saveInBufPtr = (ChannelBuffer *) NULL;
- pt->inQueueHead = (ChannelBuffer *) NULL;
- pt->inQueueTail = (ChannelBuffer *) NULL;
-
- /* pt->chPtr, take it as it is */
- /* pt->interestMask, take it as it is */
- /* pt->nextChanPtr, take it as it is */
- /* pt->scriptRecordPtr, take it as it is */
- pt->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
- /* pt->timer, take it as it is */
- /* pt->csPtr, take it as it is */
-
- /*
- * Have the transformation reference the new structure containing
- * the saved channel.
- */
+ statePtr->inQueueHead = (ChannelBuffer*) NULL;
+ statePtr->inQueueTail = (ChannelBuffer*) NULL;
+ }
- pt->supercedes = chanPtr;
+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
/*
- * Don't forget to reinitialize the output buffer used for encodings.
+ * Save some of the current state into the new structure,
+ * reinitialize the parts which will stay with the transformation.
+ *
+ * Remarks:
*/
- if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
- chanPtr->outputStage = (char *)
- ckalloc((unsigned) (chanPtr->bufSize + 2));
- }
+ chanPtr->state = statePtr;
+ chanPtr->instanceData = instanceData;
+ chanPtr->typePtr = typePtr;
+ chanPtr->downChanPtr = prevChanPtr;
+ chanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
/*
- * Event handling: If the information in the old channel shows
- * that there was interest in some events call the 'WatchProc'
- * of the transformation to establish the proper connection
- * between them.
+ * Place new block at the head of a possibly existing list of previously
+ * stacked channels.
*/
- if (interest) {
- (pt->typePtr->watchProc) (pt->instanceData, interest);
- }
-
- /*
- * The superceded channel is effectively unregistered
- * We cannot decrement its reference count because that
- * can cause it to get garbage collected out from under us.
- * Don't add the following code:
- *
- * chanPtr->supercedes->refCount --;
- */
+ prevChanPtr->upChanPtr = chanPtr;
+ statePtr->topChanPtr = chanPtr;
return (Tcl_Channel) chanPtr;
}
@@ -1636,210 +1233,142 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
*
* Unstacks an entry in the hash table for a Tcl_Channel
* record. This is the reverse to 'Tcl_StackChannel'.
- * The old, superceded channel is uncovered and re-registered
- * in the appropriate data structures.
*
* Results:
- * Returns the old Tcl_Channel, i.e. the one which was stacked over.
+ * A standard Tcl result.
*
* Side effects:
- * See above.
+ * If TCL_ERROR is returned, the posix error code will be set
+ * with Tcl_SetErrno.
*
*----------------------------------------------------------------------
*/
-void
+int
Tcl_UnstackChannel (interp, chan)
- Tcl_Interp* interp; /* The interpreter we are working in */
+ Tcl_Interp *interp; /* The interpreter we are working in */
Tcl_Channel chan; /* The channel to unstack */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel* chanPtr = (Channel*) chan;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state;
+ int result = 0;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
- if (chanPtr->supercedes != (Channel*) NULL) {
+ chanPtr = statePtr->topChanPtr;
+
+ if (chanPtr->downChanPtr != (Channel *) NULL) {
/*
* Instead of manipulating the per-thread / per-interp list/hashtable
* of registered channels we wind down the state of the transformation,
* and then restore the state of underlying channel into the old
* structure.
*/
-
- Tcl_DString dsTrans; /* storage to save option information */
- Tcl_DString dsBuf; /* storage to save option information */
- Channel top; /* Save area for current transformation */
- Channel* chanDownPtr = chanPtr->supercedes;
- int interest; /* interest mask of transformation
- * before destruct. */
- int saveInputEncodingFlags; /* Save area for encoding */
- int saveOutputEncodingFlags; /* related information */
- Tcl_EncodingState saveInputEncodingState;
- Tcl_EncodingState saveOutputEncodingState;
- Tcl_Encoding saveEncoding;
+ Channel *downChanPtr = chanPtr->downChanPtr;
/*
- * Event handling: Disallow the delivery of events from the
- * old, now uncovered channel to the transformation.
- *
- * This is done before everything else to avoid problems
- * after our heavy-duty shuffling of pointers around.
+ * Flush the buffers. This ensures that any data still in them
+ * at this time _is_ handled by the transformation we are unstacking
+ * right now. Restrict this to writable channels. Take care to hide
+ * a possible bg-copy in progress from Tcl_Flush and the
+ * CheckForChannelErrors inside.
*/
- interest = chanPtr->interestMask;
- (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);
-
- /* 1. Swap the information in the top channel (the transformation)
- * and the channel below, with some exceptions. This additionally
- * cuts the top channel out of the chain. Without the latter
- * a Tcl_Close on the transformation would be impossible, as that
- * procedure will free the structure, making 'top' unusable.
- *
- * chanPtr -> top channel, transformation.
- * chanDownPtr -> channel immediately below the transformation.
- */
-
- memcpy ((void*) &top, (void*) chanPtr, sizeof (Channel));
- memcpy ((void*) chanPtr, (void*) chanDownPtr, sizeof (Channel));
- top.supercedes = (Channel*) NULL;
- memcpy ((void*) chanDownPtr, (void*) &top, sizeof (Channel));
-
- /* Now:
- * chanPtr -> channel immediately below the transformation, now top
- * chanDownPtr -> transformation, cut loose.
- *
- * Handle the exceptions mentioned above, i.e. move the information
- * from the transformation into the new top, and reinitialize it to
- * safe values in the transformation.
- */
-
- chanPtr->refCount = chanDownPtr->refCount;
- chanPtr->closeCbPtr = chanDownPtr->closeCbPtr;
- chanPtr->chPtr = chanDownPtr->chPtr;
- chanPtr->nextChanPtr = chanDownPtr->nextChanPtr;
- chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;
- chanPtr->timer = chanDownPtr->timer;
- chanPtr->csPtr = chanDownPtr->csPtr;
-
- chanDownPtr->refCount = 0;
- chanDownPtr->closeCbPtr = (CloseCallback*) NULL;
- chanDownPtr->chPtr = (ChannelHandler*) NULL;
- chanDownPtr->nextChanPtr = (Channel*) NULL;
- chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;
- chanDownPtr->timer = (Tcl_TimerToken) NULL;
- chanDownPtr->csPtr = (CopyState*) NULL;
-
- /* The now uncovered channel still has encoding and eol-translation
- * deactivated, i.e. switched to 'binary'. *Don't* touch this until
- * after the transformation is closed for good, as it may write
- * information into it during that (-> flushing of data waiting in
- * internal buffers!) and rely on these settings. Thanks to Matt
- * Newman <matt@sensus.org> for finding this goof.
- *
- * But we also have to protect the state of the encoding from removal
- * during the close. So we save it in some local variables.
- * Additionally the current value of the options is lost after we
- * close, we have to save them now.
- */
+ if (statePtr->flags & TCL_WRITABLE) {
+ CopyState* csPtr;
- saveEncoding = chanDownPtr->encoding;
- saveInputEncodingState = chanDownPtr->inputEncodingState;
- saveInputEncodingFlags = chanDownPtr->inputEncodingFlags;
- saveOutputEncodingState = chanDownPtr->outputEncodingState;
- saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;
+ csPtr = statePtr->csPtr;
+ statePtr->csPtr = (CopyState*) NULL;
- Tcl_DStringInit (&dsTrans);
- Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
- "-translation", &dsTrans);
+ if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
+ statePtr->csPtr = csPtr;
+ Tcl_AppendResult(interp, "could not flush channel \"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
- Tcl_DStringInit (&dsBuf);
- Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
- "-buffering", &dsBuf);
+ statePtr->csPtr = csPtr;
+ }
/*
- * Prevent the accidential removal of the encoding during
- * the destruction of the transformation channel.
+ * Anything in the input queue and the push-back buffers of
+ * the transformation going away is transformed data, but not
+ * yet read. As unstacking means that the caller does not want
+ * to see transformed data any more we have to discard these
+ * bytes. To avoid writing an analogue to 'DiscardInputQueued'
+ * we move the information in the push back buffers to the
+ * input queue and then call 'DiscardInputQueued' on that.
*/
- chanDownPtr->encoding = (Tcl_Encoding) NULL;
- chanDownPtr->inputEncodingState = (Tcl_EncodingState) NULL;
- chanDownPtr->inputEncodingFlags = TCL_ENCODING_START;
- chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;
- chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;
+ if (((statePtr->flags & TCL_READABLE) != 0) &&
+ ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
+ (chanPtr->inQueueHead != (ChannelBuffer*) NULL))) {
- /*
- * A little trick: Add the transformation structure to the
- * per-thread list of existing channels (which it never were
- * part of so far), or Tcl_Close/FlushChannel will panic
- * ("damaged channel list").
- *
- * Afterward do a regular close upon the transformation.
- * This may cause flushing of data into the old channel (if the
- * transformation remembered its own channel in itself).
- *
- * We know that its refCount dropped to 0.
- */
+ if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
+ (chanPtr->inQueueHead != (ChannelBuffer*) NULL)) {
+ statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ statePtr->inQueueHead = statePtr->inQueueTail;
- chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
- tsdPtr->firstChanPtr = chanDownPtr;
+ } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
+ statePtr->inQueueHead = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ }
+
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+
+ DiscardInputQueued (statePtr, 0);
+ }
- Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
+ statePtr->topChanPtr = downChanPtr;
+ downChanPtr->upChanPtr = (Channel *) NULL;
/*
- * Now it is possible to wind down the transformation (in 'top'),
- * especially to copy the current encoding and translation control
- * information down.
+ * Leave this link intact for closeproc
+ * chanPtr->downChanPtr = (Channel *) NULL;
*/
-
+
/*
- * Move the currently active encoding from the save area
- * to the now uncovered channel. We assume here that this
- * channel uses 'encoding binary' (==> encoding == NULL, etc.
- * This allows us to simply copy the pointers without having to
- * think about refcounts and deallocation of the old encoding.
- *
- * And don't forget to reenable the EOL-translation used by the
- * transformation. Using a DString to do this *is* a bit awkward,
- * but still the best way to handle the complexities here, like
- * flag manipulation and event system.
+ * Close and free the channel driver state.
*/
- chanPtr->encoding = saveEncoding;
- chanPtr->inputEncodingState = saveInputEncodingState;
- chanPtr->inputEncodingFlags = saveInputEncodingFlags;
- chanPtr->outputEncodingState = saveOutputEncodingState;
- chanPtr->outputEncodingFlags = saveOutputEncodingFlags;
-
- Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
- "-translation", dsTrans.string);
-
- Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
- "-buffering", dsBuf.string);
-
- Tcl_DStringFree (&dsTrans);
- Tcl_DStringFree (&dsBuf);
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
+ interp);
+ } else {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+ interp, 0);
+ }
+ chanPtr->typePtr = NULL;
/*
- * Event handling: If the information from the now destroyed
- * transformation shows that there was interest in some events
- * call the 'WatchProc' of the now uncovered channel to renew
- * that interest with underlying channels or the driver.
+ * AK: Tcl_NotifyChannel may hold a reference to this block of memory
*/
+ Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ UpdateInterest(downChanPtr);
- if (interest) {
- chanPtr->interestMask = 0;
- (chanPtr->typePtr->watchProc) (chanPtr->instanceData,
- interest);
- chanPtr->interestMask = interest;
+ if (result != 0) {
+ Tcl_SetErrno(result);
+ return TCL_ERROR;
}
-
} else {
- /* This channel does not cover another one.
+ /*
+ * This channel does not cover another one.
* Simply do a close, if necessary.
*/
- if (chanPtr->refCount <= 0) {
- Tcl_Close (interp, chan);
+ if (statePtr->refCount <= 0) {
+ if (Tcl_Close(interp, chan) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
}
+
+ return TCL_OK;
}
/*
@@ -1847,7 +1376,7 @@ Tcl_UnstackChannel (interp, chan)
*
* Tcl_GetStackedChannel --
*
- * Determines wether the specified channel is stacked upon another.
+ * Determines whether the specified channel is stacked upon another.
*
* Results:
* NULL if the channel is not stacked upon another one, or a reference
@@ -1864,20 +1393,22 @@ Tcl_Channel
Tcl_GetStackedChannel(chan)
Tcl_Channel chan;
{
- Channel* chanPtr = (Channel*) chan;
- return (Tcl_Channel) chanPtr->supercedes;
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+
+ return (Tcl_Channel) chanPtr->downChanPtr;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelMode --
+ * Tcl_GetTopChannel --
*
- * Computes a mask indicating whether the channel is open for
- * reading and writing.
+ * Returns the top channel of a channel stack.
*
* Results:
- * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
+ * NULL if the channel is not stacked upon another one, or a reference
+ * to the channel it is stacked upon. This reference can be used in
+ * queries, but modification is not allowed.
*
* Side effects:
* None.
@@ -1885,28 +1416,24 @@ Tcl_GetStackedChannel(chan)
*----------------------------------------------------------------------
*/
-int
-Tcl_GetChannelMode(chan)
- Tcl_Channel chan; /* The channel for which the mode is
- * being computed. */
+Tcl_Channel
+Tcl_GetTopChannel(chan)
+ Tcl_Channel chan;
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- chanPtr = (Channel *) chan;
- return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
+ return (Tcl_Channel) chanPtr->state->topChanPtr;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelName --
+ * Tcl_GetChannelInstanceData --
*
- * Returns the string identifying the channel name.
+ * Returns the client data associated with a channel.
*
* Results:
- * The string containing the channel name. This memory is
- * owned by the generic layer and should not be modified by
- * the caller.
+ * The client data.
*
* Side effects:
* None.
@@ -1914,14 +1441,13 @@ Tcl_GetChannelMode(chan)
*----------------------------------------------------------------------
*/
-char *
-Tcl_GetChannelName(chan)
- Tcl_Channel chan; /* The channel for which to return the name. */
+ClientData
+Tcl_GetChannelInstanceData(chan)
+ Tcl_Channel chan; /* Channel for which to return client data. */
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- chanPtr = (Channel *) chan;
- return chanPtr->channelName;
+ return chanPtr->instanceData;
}
/*
@@ -1944,22 +1470,21 @@ Tcl_ChannelType *
Tcl_GetChannelType(chan)
Tcl_Channel chan; /* The channel to return type for. */
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- chanPtr = (Channel *) chan;
return chanPtr->typePtr;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelHandle --
+ * Tcl_GetChannelMode --
*
- * Returns an OS handle associated with a channel.
+ * Computes a mask indicating whether the channel is open for
+ * reading and writing.
*
* Results:
- * Returns TCL_OK and places the handle in handlePtr, or returns
- * TCL_ERROR on failure.
+ * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
*
* Side effects:
* None.
@@ -1968,33 +1493,27 @@ Tcl_GetChannelType(chan)
*/
int
-Tcl_GetChannelHandle(chan, direction, handlePtr)
- Tcl_Channel chan; /* The channel to get file from. */
- int direction; /* TCL_WRITABLE or TCL_READABLE. */
- ClientData *handlePtr; /* Where to store handle */
+Tcl_GetChannelMode(chan)
+ Tcl_Channel chan; /* The channel for which the mode is
+ * being computed. */
{
- Channel *chanPtr; /* The actual channel. */
- ClientData handle;
- int result;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of actual channel. */
- chanPtr = (Channel *) chan;
- result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
- direction, &handle);
- if (handlePtr) {
- *handlePtr = handle;
- }
- return result;
+ return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelInstanceData --
+ * Tcl_GetChannelName --
*
- * Returns the client data associated with a channel.
+ * Returns the string identifying the channel name.
*
* Results:
- * The client data.
+ * The string containing the channel name. This memory is
+ * owned by the generic layer and should not be modified by
+ * the caller.
*
* Side effects:
* None.
@@ -2002,14 +1521,50 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
*----------------------------------------------------------------------
*/
-ClientData
-Tcl_GetChannelInstanceData(chan)
- Tcl_Channel chan; /* Channel for which to return client data. */
+char *
+Tcl_GetChannelName(chan)
+ Tcl_Channel chan; /* The channel for which to return the name. */
+{
+ ChannelState *statePtr; /* State of actual channel. */
+
+ statePtr = ((Channel *) chan)->state;
+ return statePtr->channelName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelHandle --
+ *
+ * Returns an OS handle associated with a channel.
+ *
+ * Results:
+ * Returns TCL_OK and places the handle in handlePtr, or returns
+ * TCL_ERROR on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelHandle(chan, direction, handlePtr)
+ Tcl_Channel chan; /* The channel to get file from. */
+ int direction; /* TCL_WRITABLE or TCL_READABLE. */
+ ClientData *handlePtr; /* Where to store handle */
{
Channel *chanPtr; /* The actual channel. */
+ ClientData handle;
+ int result;
- chanPtr = (Channel *) chan;
- return chanPtr->instanceData;
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
+ direction, &handle);
+ if (handlePtr) {
+ *handlePtr = handle;
+ }
+ return result;
}
/*
@@ -2074,8 +1629,8 @@ AllocChannelBuffer(length)
*/
static void
-RecycleBuffer(chanPtr, bufPtr, mustDiscard)
- Channel *chanPtr; /* Channel for which to recycle buffers. */
+RecycleBuffer(statePtr, bufPtr, mustDiscard)
+ ChannelState *statePtr; /* ChannelState in which to recycle buffers. */
ChannelBuffer *bufPtr; /* The buffer to recycle. */
int mustDiscard; /* If nonzero, free the buffer to the
* OS, always. */
@@ -2088,19 +1643,19 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
ckfree((char *) bufPtr);
return;
}
-
+
/*
* Only save buffers for the input queue if the channel is readable.
*/
- if (chanPtr->flags & TCL_READABLE) {
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->inQueueHead = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ if (statePtr->flags & TCL_READABLE) {
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->inQueueHead = bufPtr;
+ statePtr->inQueueTail = bufPtr;
goto keepit;
}
- if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
- chanPtr->saveInBufPtr = bufPtr;
+ if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
+ statePtr->saveInBufPtr = bufPtr;
goto keepit;
}
}
@@ -2109,9 +1664,9 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
* Only save buffers for the output queue if the channel is writable.
*/
- if (chanPtr->flags & TCL_WRITABLE) {
- if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
- chanPtr->curOutPtr = bufPtr;
+ if (statePtr->flags & TCL_WRITABLE) {
+ if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+ statePtr->curOutPtr = bufPtr;
goto keepit;
}
}
@@ -2146,18 +1701,18 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
*/
static void
-DiscardOutputQueued(chanPtr)
- Channel *chanPtr; /* The channel for which to discard output. */
+DiscardOutputQueued(statePtr)
+ ChannelState *statePtr; /* ChannelState for which to discard output. */
{
ChannelBuffer *bufPtr;
- while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
- bufPtr = chanPtr->outQueueHead;
- chanPtr->outQueueHead = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, 0);
+ while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+ bufPtr = statePtr->outQueueHead;
+ statePtr->outQueueHead = bufPtr->nextPtr;
+ RecycleBuffer(statePtr, bufPtr, 0);
}
- chanPtr->outQueueHead = (ChannelBuffer *) NULL;
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
}
/*
@@ -2178,11 +1733,11 @@ DiscardOutputQueued(chanPtr)
*/
static int
-CheckForDeadChannel(interp, chanPtr)
+CheckForDeadChannel(interp, statePtr)
Tcl_Interp *interp; /* For error reporting (can be NULL) */
- Channel *chanPtr; /* The channel to check. */
+ ChannelState *statePtr; /* The channel state to check. */
{
- if (chanPtr->flags & CHANNEL_DEAD) {
+ if (statePtr->flags & CHANNEL_DEAD) {
Tcl_SetErrno(EINVAL);
if (interp) {
Tcl_AppendResult(interp,
@@ -2223,6 +1778,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* called from an asynchronous
* flush callback. */
{
+ ChannelState *statePtr = chanPtr->state;
+ /* State of the channel stack. */
ChannelBuffer *bufPtr; /* Iterates over buffered output
* queue. */
int toWrite; /* Amount of output data in current
@@ -2231,12 +1788,9 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* written in current round. */
int errorCode = 0; /* Stores POSIX error codes from
* channel driver operations. */
- int wroteSome; /* Set to one if any data was
+ int wroteSome = 0; /* Set to one if any data was
* written to the driver. */
- restartFlushChannel:
- wroteSome = 0;
-
/*
* Prevent writing on a dead channel -- a channel that has been closed
* but not yet deallocated. This can occur if the exit handler for the
@@ -2244,7 +1798,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* all interpreters.
*/
- if (CheckForDeadChannel(interp,chanPtr)) return -1;
+ if (CheckForDeadChannel(interp, statePtr)) return -1;
/*
* Loop over the queued buffers and attempt to flush as
@@ -2258,22 +1812,22 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* the current buffer is full, then move the current buffer to the
* queue.
*/
-
- if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
- || ((chanPtr->flags & BUFFER_READY) &&
- (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
- chanPtr->flags &= (~(BUFFER_READY));
- chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
- if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->outQueueHead = chanPtr->curOutPtr;
+
+ if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
+ || ((statePtr->flags & BUFFER_READY) &&
+ (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
+ statePtr->flags &= (~(BUFFER_READY));
+ statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
+ if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->outQueueHead = statePtr->curOutPtr;
} else {
- chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
+ statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
}
- chanPtr->outQueueTail = chanPtr->curOutPtr;
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = statePtr->curOutPtr;
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
}
- bufPtr = chanPtr->outQueueHead;
+ bufPtr = statePtr->outQueueHead;
/*
* If we are not being called from an async flush and an async
@@ -2281,7 +1835,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if ((!calledFromAsyncFlush) &&
- (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ (statePtr->flags & BG_FLUSH_SCHEDULED)) {
return 0;
}
@@ -2296,12 +1850,12 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
/*
* Produce the output on the channel.
*/
-
+
toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
(char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
&errorCode);
-
+
/*
* If the write failed completely attempt to start the asynchronous
* flush mechanism and break out of this loop - do not attempt to
@@ -2331,8 +1885,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* that setting stdin to -blocking 0 has some effect on
* the stdout when it's a tty channel (dup'ed underneath)
*/
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
- chanPtr->flags |= BG_FLUSH_SCHEDULED;
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->flags |= BG_FLUSH_SCHEDULED;
UpdateInterest(chanPtr);
}
errorCode = 0;
@@ -2344,8 +1898,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (calledFromAsyncFlush) {
- if (chanPtr->unreportedError == 0) {
- chanPtr->unreportedError = errorCode;
+ if (statePtr->unreportedError == 0) {
+ statePtr->unreportedError = errorCode;
}
} else {
Tcl_SetErrno(errorCode);
@@ -2360,7 +1914,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* currently queued.
*/
- DiscardOutputQueued(chanPtr);
+ DiscardOutputQueued(statePtr);
continue;
} else {
wroteSome = 1;
@@ -2373,11 +1927,11 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
- chanPtr->outQueueHead = bufPtr->nextPtr;
- if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = bufPtr->nextPtr;
+ if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
}
- RecycleBuffer(chanPtr, bufPtr, 0);
+ RecycleBuffer(statePtr, bufPtr, 0);
}
} /* Closes "while (1)". */
@@ -2388,13 +1942,13 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* pending data has been flushed at the system level.
*/
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
if (wroteSome) {
return errorCode;
- } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
- chanPtr->interestMask);
+ statePtr->interestMask);
}
}
@@ -2404,20 +1958,12 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* in the current output buffer.
*/
- if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
- (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
- ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
- (chanPtr->curOutPtr->nextAdded ==
- chanPtr->curOutPtr->nextRemoved))) {
- /*
- * CloseChannel may side-effect the errno value, so we seed it
- * and retrieve the it once we have closed the final channel.
- */
- Tcl_SetErrno(errorCode);
- if (CloseChannel(interp, chanPtr, errorCode)) {
- goto restartFlushChannel;
- }
- errorCode = Tcl_GetErrno();
+ if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+ (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
+ ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
+ (statePtr->curOutPtr->nextAdded ==
+ statePtr->curOutPtr->nextRemoved))) {
+ return CloseChannel(interp, chanPtr, errorCode);
}
return errorCode;
}
@@ -2454,28 +2000,30 @@ CloseChannel(interp, chanPtr, errorCode)
{
int result = 0; /* Of calling driver close
* operation. */
- Channel *prevChanPtr; /* Preceding channel in list of
- * all channels - used to splice a
+ ChannelState *prevCSPtr; /* Preceding channel state in list of
+ * all states - used to splice a
* channel out of the list on close. */
+ ChannelState *statePtr; /* state of the channel stack. */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (chanPtr == NULL) {
return result;
}
-
+ statePtr = chanPtr->state;
+
/*
* No more input can be consumed so discard any leftover input.
*/
- DiscardInputQueued(chanPtr, 1);
+ DiscardInputQueued(statePtr, 1);
/*
* Discard a leftover buffer in the current output buffer field.
*/
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) chanPtr->curOutPtr);
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ ckfree((char *) statePtr->curOutPtr);
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
}
/*
@@ -2483,7 +2031,7 @@ CloseChannel(interp, chanPtr, errorCode)
* queued for output.
*/
- if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
+ if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
panic("TclFlush, closed channel: queued output left");
}
@@ -2492,55 +2040,74 @@ CloseChannel(interp, chanPtr, errorCode)
* output device.
*/
- if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
+ if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
int dummy;
char c;
- c = (char) chanPtr->outEofChar;
+ c = (char) statePtr->outEofChar;
(chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
}
-
+#if 0
/*
- * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
+ * Remove TCL_READABLE and TCL_WRITABLE from statePtr->flags, so
* that close callbacks can not do input or output (assuming they
* squirreled the channel away in their clientData). This also
* prevents infinite loops if the callback calls any C API that
* could call FlushChannel.
*/
- chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
+ /*
+ * This prevents any data from being flushed from stacked channels.
+ */
+ statePtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
+#endif
/*
* Splice this channel out of the list of all channels.
*/
- if (chanPtr == tsdPtr->firstChanPtr) {
- tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
+ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
+ tsdPtr->firstCSPtr = statePtr->nextCSPtr;
} else {
- for (prevChanPtr = tsdPtr->firstChanPtr;
- prevChanPtr && (prevChanPtr->nextChanPtr != chanPtr);
- prevChanPtr = prevChanPtr->nextChanPtr) {
+ for (prevCSPtr = tsdPtr->firstCSPtr;
+ prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
+ prevCSPtr = prevCSPtr->nextCSPtr) {
/* Empty loop body. */
}
- if (prevChanPtr == (Channel *) NULL) {
+ if (prevCSPtr == (ChannelState *) NULL) {
panic("FlushChannel: damaged channel list");
}
- prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
+ prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
}
/*
* Close and free the channel driver state.
*/
-
+
if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
} else {
result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
0);
}
-
- if (chanPtr->channelName != (char *) NULL) {
- ckfree(chanPtr->channelName);
+
+ /*
+ * Some resources can be cleared only if the bottom channel
+ * in a stack is closed. All the other channels in the stack
+ * are not allowed to remove.
+ */
+
+ if (chanPtr == statePtr->bottomChanPtr) {
+ if (statePtr->channelName != (char *) NULL) {
+ ckfree(statePtr->channelName);
+ statePtr->channelName = NULL;
+ }
+
+ Tcl_FreeEncoding(statePtr->encoding);
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = (char *) NULL;
+ }
}
/*
@@ -2548,8 +2115,8 @@ CloseChannel(interp, chanPtr, errorCode)
* any latent error on the channel or the current error.
*/
- if (chanPtr->unreportedError != 0) {
- errorCode = chanPtr->unreportedError;
+ if (statePtr->unreportedError != 0) {
+ errorCode = statePtr->unreportedError;
}
if (errorCode == 0) {
errorCode = result;
@@ -2562,148 +2129,53 @@ CloseChannel(interp, chanPtr, errorCode)
* Cancel any outstanding timer.
*/
- Tcl_DeleteTimerHandler(chanPtr->timer);
+ Tcl_DeleteTimerHandler(statePtr->timer);
/*
* Mark the channel as deleted by clearing the type structure.
*/
- if (chanPtr->supercedes != (Channel *) NULL) {
- /*
- * Unwind the state of the transformation, and then restore the state
- * of (unstack) the underlying channel into the TOP channel structure.
- */
-
- ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
- NextChannelHandler *nhPtr;
- Channel *chanDownPtr = chanPtr->supercedes;
+ if (chanPtr->downChanPtr != (Channel *) NULL) {
+#if 0
+ int code = TCL_OK;
- /*
- * Insert ourselves upon back into the list of open channels,
- * because we are only eliminating the NEXT channel in the stack.
- */
- chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
- tsdPtr->firstChanPtr = chanPtr;
-
- /*
- * Some initial bits taken from Tcl_Close, to be applied to our
- * underlying channel.
- */
-
- /*
- * Remove any references to channel handlers for this channel that
- * may be about to be invoked.
- */
-
- for (nhPtr = tsdPtr->nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
- nhPtr = nhPtr->nestedHandlerPtr) {
- if (nhPtr->nextHandlerPtr &&
- (nhPtr->nextHandlerPtr->chanPtr == chanDownPtr)) {
- nhPtr->nextHandlerPtr = NULL;
+ while (chanPtr->downChanPtr != (Channel *) NULL) {
+ /*
+ * Unwind the state of the transformation, and then restore the
+ * state of (unstack) the underlying channel into the TOP channel
+ * structure.
+ */
+ code = Tcl_UnstackChannel(interp, (Tcl_Channel) chanPtr);
+ if (code == TCL_ERROR) {
+ errorCode = Tcl_GetErrno();
+ break;
}
+ chanPtr = chanPtr->downChanPtr;
}
+#else
+ Channel *downChanPtr = chanPtr->downChanPtr;
- /*
- * Remove all the channel handler records attached to the channel
- * itself.
- */
-
- for (chPtr = chanDownPtr->chPtr; chPtr != NULL; chPtr = chNext) {
- chNext = chPtr->nextPtr;
- ckfree((char *) chPtr);
- }
- chanDownPtr->chPtr = (ChannelHandler *) NULL;
-
- /*
- * Cancel any pending copy operation.
- */
-
- StopCopy(chanDownPtr->csPtr);
-
- /*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((chanDownPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanDownPtr->curOutPtr->nextAdded >
- chanDownPtr->curOutPtr->nextRemoved)) {
- chanDownPtr->flags |= BUFFER_READY;
- }
-
- /*
- * Free timer associated with the TOP stacked channel, and
- * moving the timer for the NEXT stacked channel to the TOP.
- */
- if (chanDownPtr->timer != NULL) {
- Tcl_DeleteTimerHandler(chanDownPtr->timer);
- chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- (ClientData) chanPtr);
- } else {
- chanPtr->timer = NULL;
- }
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
- /*
- * Bring the information from the NEXT channel into the TOP
- * channel, with some exceptions. This additionally
- * cuts the NEXT channel out of the chain and frees it.
- *
- * We may want to extract unreportedError as well (hobbs).
- */
-
- chanPtr->channelName = chanDownPtr->channelName;
- chanPtr->flags = chanDownPtr->flags | CHANNEL_CLOSED;
-
- Tcl_FreeEncoding(chanDownPtr->encoding);
- chanDownPtr->encoding = NULL;
-
- chanPtr->instanceData = chanDownPtr->instanceData;
- chanPtr->typePtr = chanDownPtr->typePtr;
-
- if (chanDownPtr->outputStage != NULL) {
- ckfree((char *) chanDownPtr->outputStage);
- }
+ statePtr->topChanPtr = downChanPtr;
+ downChanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->typePtr = NULL;
- chanPtr->curOutPtr = chanDownPtr->curOutPtr;
- chanPtr->outQueueHead = chanDownPtr->outQueueHead;
- chanPtr->outQueueTail = chanDownPtr->outQueueTail;
- chanPtr->saveInBufPtr = chanDownPtr->saveInBufPtr;
- chanPtr->inQueueHead = chanDownPtr->inQueueHead;
- chanPtr->inQueueTail = chanDownPtr->inQueueTail;
- chanPtr->supercedes = chanDownPtr->supercedes;
-
- /*
- * Event handling: If the information from the now destroyed
- * transformation shows that there was interest in some events
- * call the 'WatchProc' of the now uncovered channel to renew
- * that interest with underlying channels or the driver.
- */
-
- if (chanDownPtr->interestMask) {
- int interest = chanDownPtr->interestMask;
-
- chanPtr->interestMask = 0;
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData, interest);
- chanPtr->interestMask = interest;
- }
+ Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
+#endif
+ }
- Tcl_EventuallyFree((ClientData) chanDownPtr, TCL_DYNAMIC);
- return 1;
- } else {
- /*
- * There is only the TOP Channel, so we free the remaining
- * pointers we have and then ourselves.
- */
- chanPtr->typePtr = NULL;
+ /*
+ * There is only the TOP Channel, so we free the remaining
+ * pointers we have and then ourselves.
+ */
+ chanPtr->typePtr = NULL;
- Tcl_FreeEncoding(chanPtr->encoding);
- if (chanPtr->outputStage != NULL) {
- ckfree((char *) chanPtr->outputStage);
- }
+ Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- return 0;
- }
+ return errorCode;
}
/*
@@ -2741,6 +2213,7 @@ Tcl_Close(interp, chan)
* for this channel. */
EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
int result; /* Of calling FlushChannel. */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler *nhPtr;
@@ -2748,7 +2221,7 @@ Tcl_Close(interp, chan)
if (chan == (Tcl_Channel) NULL) {
return TCL_OK;
}
-
+
/*
* Perform special handling for standard channels being closed. If the
* refCount is now 1 it means that the last reference to the standard
@@ -2759,8 +2232,15 @@ Tcl_Close(interp, chan)
CheckForStdChannelsBeingClosed(chan);
- chanPtr = (Channel *) chan;
- if (chanPtr->refCount > 0) {
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (statePtr->refCount > 0) {
panic("called Tcl_Close on channel with refCount > 0");
}
@@ -2782,21 +2262,20 @@ Tcl_Close(interp, chan)
* Remove all the channel handler records attached to the channel
* itself.
*/
-
- for (chPtr = chanPtr->chPtr;
+
+ for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chNext) {
chNext = chPtr->nextPtr;
ckfree((char *) chPtr);
}
- chanPtr->chPtr = (ChannelHandler *) NULL;
-
-
+ statePtr->chPtr = (ChannelHandler *) NULL;
+
/*
* Cancel any pending copy operation.
*/
- StopCopy(chanPtr->csPtr);
+ StopCopy(statePtr->csPtr);
/*
* Must set the interest mask now to 0, otherwise infinite loops
@@ -2805,28 +2284,28 @@ Tcl_Close(interp, chan)
* has a background flush active.
*/
- chanPtr->interestMask = 0;
+ statePtr->interestMask = 0;
/*
* Remove any EventScript records for this channel.
*/
- for (ePtr = chanPtr->scriptRecordPtr;
+ for (ePtr = statePtr->scriptRecordPtr;
ePtr != (EventScriptRecord *) NULL;
ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
Tcl_DecrRefCount(ePtr->scriptPtr);
ckfree((char *) ePtr);
}
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
/*
* Invoke the registered close callbacks and delete their records.
*/
- while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
- cbPtr = chanPtr->closeCbPtr;
- chanPtr->closeCbPtr = cbPtr->nextPtr;
+ while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
+ cbPtr = statePtr->closeCbPtr;
+ statePtr->closeCbPtr = cbPtr->nextPtr;
(cbPtr->proc) (cbPtr->clientData);
ckfree((char *) cbPtr);
}
@@ -2835,9 +2314,9 @@ Tcl_Close(interp, chan)
* Ensure that the last output buffer will be flushed.
*/
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
}
/*
@@ -2858,7 +2337,7 @@ Tcl_Close(interp, chan)
* channel to be flushed and closed asynchronously.
*/
- chanPtr->flags |= CHANNEL_CLOSED;
+ statePtr->flags |= CHANNEL_CLOSED;
if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
return TCL_ERROR;
}
@@ -2893,12 +2372,19 @@ Tcl_Write(chan, src, srcLen)
int srcLen; /* Length of data in bytes, or < 0 for
* strlen(). */
{
+ /*
+ * Always use the topmost channel of the stack
+ */
Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
+
if (srcLen < 0) {
srcLen = strlen(src);
}
@@ -2906,6 +2392,61 @@ Tcl_Write(chan, src, srcLen)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WriteRaw --
+ *
+ * Puts a sequence of bytes into an output buffer, may queue the
+ * buffer for output if it gets full, and also remembers whether the
+ * current buffer is ready e.g. if it contains a newline and we are in
+ * line buffering mode.
+ *
+ * Results:
+ * The number of bytes written or -1 in case of error. If -1,
+ * Tcl_GetErrno will return the error code.
+ *
+ * Side effects:
+ * May buffer up output and may cause output to be produced on the
+ * channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WriteRaw(chan, src, srcLen)
+ Tcl_Channel chan; /* The channel to buffer output for. */
+ char *src; /* Data to queue in output buffer. */
+ int srcLen; /* Length of data in bytes, or < 0 for
+ * strlen(). */
+{
+ Channel *chanPtr = ((Channel *) chan);
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int errorCode, written;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
+ return -1;
+ }
+
+ if (srcLen < 0) {
+ srcLen = strlen(src);
+ }
+
+ /*
+ * Go immediately to the driver, do all the error handling by ourselves.
+ * The code was stolen from 'FlushChannel'.
+ */
+
+ written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
+ src, srcLen, &errorCode);
+
+ if (written < 0) {
+ Tcl_SetErrno(errorCode);
+ }
+
+ return written;
+}
+
+/*
*---------------------------------------------------------------------------
*
* Tcl_WriteChars --
@@ -2934,16 +2475,22 @@ Tcl_WriteChars(chan, src, len)
int len; /* Length of string in bytes, or < 0 for
* strlen(). */
{
+ /*
+ * Always use the topmost channel of the stack
+ */
Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
if (len < 0) {
len = strlen(src);
}
- if (chanPtr->encoding == NULL) {
+ if (statePtr->encoding == NULL) {
/*
* Inefficient way to convert UTF-8 to byte-array, but the
* code parallels the way it is done for objects.
@@ -2991,15 +2538,21 @@ Tcl_WriteObj(chan, objPtr)
Tcl_Channel chan; /* The channel to buffer output for. */
Tcl_Obj *objPtr; /* The object to write. */
{
+ /*
+ * Always use the topmost channel of the stack
+ */
Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
char *src;
int srcLen;
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
- if (chanPtr->encoding == NULL) {
+ if (statePtr->encoding == NULL) {
src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
return WriteBytes(chanPtr, src, srcLen);
} else {
@@ -3035,6 +2588,7 @@ WriteBytes(chanPtr, src, srcLen)
CONST char *src; /* Bytes to write. */
int srcLen; /* Number of bytes to write. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
char *dst;
int dstLen, dstMax, sawLF, savedLF, total, toWrite;
@@ -3049,10 +2603,10 @@ WriteBytes(chanPtr, src, srcLen)
*/
while (srcLen + savedLF > 0) {
- bufPtr = chanPtr->curOutPtr;
+ bufPtr = statePtr->curOutPtr;
if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(chanPtr->bufSize);
- chanPtr->curOutPtr = bufPtr;
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
dst = bufPtr->buf + bufPtr->nextAdded;
dstMax = bufPtr->bufLength - bufPtr->nextAdded;
@@ -3074,7 +2628,7 @@ WriteBytes(chanPtr, src, srcLen)
dstLen--;
sawLF++;
}
- sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
+ sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
dstLen += savedLF;
savedLF = 0;
@@ -3122,6 +2676,7 @@ WriteChars(chanPtr, src, srcLen)
CONST char *src; /* UTF-8 string to write. */
int srcLen; /* Length of UTF-8 string in bytes. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
char *dst, *stage;
int saved, savedLF, sawLF, total, toWrite, flags;
@@ -3133,7 +2688,7 @@ WriteChars(chanPtr, src, srcLen)
sawLF = 0;
savedLF = 0;
saved = 0;
- encoding = chanPtr->encoding;
+ encoding = statePtr->encoding;
/*
* Loop over all UTF-8 characters in src, storing them in staging buffer
@@ -3141,8 +2696,8 @@ WriteChars(chanPtr, src, srcLen)
*/
while (srcLen + savedLF > 0) {
- stage = chanPtr->outputStage;
- stageMax = chanPtr->bufSize;
+ stage = statePtr->outputStage;
+ stageMax = statePtr->bufSize;
stageLen = stageMax;
toWrite = stageLen;
@@ -3162,7 +2717,7 @@ WriteChars(chanPtr, src, srcLen)
stageLen--;
sawLF++;
}
- sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
+ sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite);
stage -= savedLF;
stageLen += savedLF;
@@ -3175,7 +2730,7 @@ WriteChars(chanPtr, src, srcLen)
src += toWrite;
srcLen -= toWrite;
- flags = chanPtr->outputEncodingFlags;
+ flags = statePtr->outputEncodingFlags;
if (srcLen == 0) {
flags |= TCL_ENCODING_END;
}
@@ -3186,10 +2741,10 @@ WriteChars(chanPtr, src, srcLen)
*/
while (stageLen + saved > 0) {
- bufPtr = chanPtr->curOutPtr;
+ bufPtr = statePtr->curOutPtr;
if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(chanPtr->bufSize);
- chanPtr->curOutPtr = bufPtr;
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
dst = bufPtr->buf + bufPtr->nextAdded;
dstLen = bufPtr->bufLength - bufPtr->nextAdded;
@@ -3209,7 +2764,7 @@ WriteChars(chanPtr, src, srcLen)
}
Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
- &chanPtr->outputEncodingState, dst,
+ &statePtr->outputEncodingState, dst,
dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
if (stageRead + dstWrote == 0) {
/*
@@ -3293,8 +2848,8 @@ WriteChars(chanPtr, src, srcLen)
*/
static int
-TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
- Channel *chanPtr; /* Channel being read, for translation and
+TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
+ ChannelState *statePtr; /* Channel being read, for translation and
* buffering modes. */
char *dst; /* Output buffer filled with UTF-8 chars by
* applying appropriate EOL translation to
@@ -3313,7 +2868,7 @@ TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
newlineFound = 0;
srcLen = *srcLenPtr;
- switch (chanPtr->outputTranslation) {
+ switch (statePtr->outputTranslation) {
case TCL_TRANSLATE_LF: {
for (dstEnd = dst + srcLen; dst < dstEnd; ) {
if (*src == '\n') {
@@ -3405,6 +2960,7 @@ CheckFlush(chanPtr, bufPtr, newlineFlag)
int newlineFlag; /* Non-zero if a the channel buffer
* contains a newline. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
/*
* The current buffer is ready for output:
* 1. if it is full.
@@ -3412,18 +2968,18 @@ CheckFlush(chanPtr, bufPtr, newlineFlag)
* 3. if it contains any output and this channel is unbuffered.
*/
- if ((chanPtr->flags & BUFFER_READY) == 0) {
+ if ((statePtr->flags & BUFFER_READY) == 0) {
if (bufPtr->nextAdded == bufPtr->bufLength) {
- chanPtr->flags |= BUFFER_READY;
- } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
if (newlineFlag != 0) {
- chanPtr->flags |= BUFFER_READY;
+ statePtr->flags |= BUFFER_READY;
}
- } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
- chanPtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
}
}
- if (chanPtr->flags & BUFFER_READY) {
+ if (statePtr->flags & BUFFER_READY) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -3504,22 +3060,28 @@ Tcl_GetsObj(chan, objPtr)
* object as UTF-8 characters. */
{
GetsState gs;
- Channel *chanPtr;
- int inEofChar, skip, copiedTotal;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
+ int inEofChar, skip, copiedTotal;
Tcl_Encoding encoding;
char *dst, *dstEnd, *eol, *eof;
Tcl_EncodingState oldState;
int oldLength, oldFlags, oldRemoved;
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
copiedTotal = -1;
goto done;
}
- bufPtr = chanPtr->inQueueHead;
- encoding = chanPtr->encoding;
+ bufPtr = statePtr->inQueueHead;
+ encoding = statePtr->encoding;
/*
* Preserved so we can restore the channel's state in case we don't
@@ -3527,8 +3089,8 @@ Tcl_GetsObj(chan, objPtr)
*/
Tcl_GetStringFromObj(objPtr, &oldLength);
- oldFlags = chanPtr->inputEncodingFlags;
- oldState = chanPtr->inputEncodingState;
+ oldFlags = statePtr->inputEncodingFlags;
+ oldState = statePtr->inputEncodingState;
oldRemoved = BUFFER_PADDING;
if (bufPtr != NULL) {
oldRemoved = bufPtr->nextRemoved;
@@ -3564,7 +3126,7 @@ Tcl_GetsObj(chan, objPtr)
skip = 0;
eof = NULL;
- inEofChar = chanPtr->inEofChar;
+ inEofChar = statePtr->inEofChar;
while (1) {
if (dst >= dstEnd) {
@@ -3595,7 +3157,7 @@ Tcl_GetsObj(chan, objPtr)
*/
eol = dst;
- switch (chanPtr->inputTranslation) {
+ switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF: {
for (eol = dst; eol < dstEnd; eol++) {
if (*eol == '\n') {
@@ -3644,8 +3206,8 @@ Tcl_GetsObj(chan, objPtr)
}
case TCL_TRANSLATE_AUTO: {
skip = 1;
- if (chanPtr->flags & INPUT_SAW_CR) {
- chanPtr->flags &= ~INPUT_SAW_CR;
+ if (statePtr->flags & INPUT_SAW_CR) {
+ statePtr->flags &= ~INPUT_SAW_CR;
if (*eol == '\n') {
/*
* Skip the raw bytes that make up the '\n'.
@@ -3657,7 +3219,7 @@ Tcl_GetsObj(chan, objPtr)
bufPtr = gs.bufPtr;
Tcl_ExternalToUtf(NULL, gs.encoding,
bufPtr->buf + bufPtr->nextRemoved,
- gs.rawRead, chanPtr->inputEncodingFlags,
+ gs.rawRead, statePtr->inputEncodingFlags,
&gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
NULL, NULL);
bufPtr->nextRemoved += rawRead;
@@ -3685,7 +3247,7 @@ Tcl_GetsObj(chan, objPtr)
eol = objPtr->bytes + offset;
if (eol >= dstEnd) {
eol--;
- chanPtr->flags |= INPUT_SAW_CR;
+ statePtr->flags |= INPUT_SAW_CR;
goto goteol;
}
}
@@ -3708,10 +3270,10 @@ Tcl_GetsObj(chan, objPtr)
*/
dstEnd = eof;
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (statePtr->flags & CHANNEL_EOF) {
skip = 0;
eol = dstEnd;
if (eol == objPtr->bytes) {
@@ -3740,10 +3302,10 @@ Tcl_GetsObj(chan, objPtr)
goteol:
bufPtr = gs.bufPtr;
- chanPtr->inputEncodingState = gs.state;
+ statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
- gs.rawRead, chanPtr->inputEncodingFlags,
- &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
+ gs.rawRead, statePtr->inputEncodingFlags,
+ &statePtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
&gs.rawRead, NULL, &gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -3753,7 +3315,7 @@ Tcl_GetsObj(chan, objPtr)
Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
CommonGetsCleanup(chanPtr, encoding);
- chanPtr->flags &= ~CHANNEL_BLOCKED;
+ statePtr->flags &= ~CHANNEL_BLOCKED;
copiedTotal = gs.totalChars + gs.charsWrote - skip;
goto done;
@@ -3764,7 +3326,7 @@ Tcl_GetsObj(chan, objPtr)
*/
restore:
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
bufPtr->nextRemoved = oldRemoved;
for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
@@ -3772,8 +3334,8 @@ Tcl_GetsObj(chan, objPtr)
}
CommonGetsCleanup(chanPtr, encoding);
- chanPtr->inputEncodingState = oldState;
- chanPtr->inputEncodingFlags = oldFlags;
+ statePtr->inputEncodingState = oldState;
+ statePtr->inputEncodingFlags = oldFlags;
Tcl_SetObjLength(objPtr, oldLength);
/*
@@ -3787,7 +3349,7 @@ Tcl_GetsObj(chan, objPtr)
* though a read would be able to consume the buffered data.
*/
- chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
+ statePtr->flags |= CHANNEL_NEED_MORE_DATA;
copiedTotal = -1;
done:
@@ -3829,6 +3391,7 @@ FilterInputBytes(chanPtr, gsPtr)
Channel *chanPtr; /* Channel to read. */
GetsState *gsPtr; /* Current state of gets operation. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
char *raw, *rawStart, *rawEnd;
char *dst;
@@ -3865,20 +3428,20 @@ FilterInputBytes(chanPtr, gsPtr)
*/
read:
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
}
- chanPtr->flags &= ~CHANNEL_BLOCKED;
+ statePtr->flags &= ~CHANNEL_BLOCKED;
}
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
}
- bufPtr = chanPtr->inQueueTail;
+ bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
}
@@ -3912,9 +3475,9 @@ FilterInputBytes(chanPtr, gsPtr)
dst = objPtr->bytes + offset;
*gsPtr->dstPtr = dst;
}
- gsPtr->state = chanPtr->inputEncodingState;
+ gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
- chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
&gsPtr->charsWrote);
if (result == TCL_CONVERT_MULTIBYTE) {
@@ -3935,7 +3498,7 @@ FilterInputBytes(chanPtr, gsPtr)
* returning those UTF-8 characters because a EOL might be
* present in them.
*/
- } else if (chanPtr->flags & CHANNEL_EOF) {
+ } else if (statePtr->flags & CHANNEL_EOF) {
/*
* There was a partial character followed by EOF on the
* device. Fall through, returning that nothing was found.
@@ -3952,9 +3515,9 @@ FilterInputBytes(chanPtr, gsPtr)
}
} else {
if (nextPtr == NULL) {
- nextPtr = AllocChannelBuffer(chanPtr->bufSize);
+ nextPtr = AllocChannelBuffer(statePtr->bufSize);
bufPtr->nextPtr = nextPtr;
- chanPtr->inQueueTail = nextPtr;
+ statePtr->inQueueTail = nextPtr;
}
extra = rawLen - gsPtr->rawRead;
memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
@@ -3997,6 +3560,7 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
* of UTF-8 characters. */
GetsState *gsPtr; /* Current state of gets operation. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
Tcl_DriverBlockModeProc *blockModeProc;
int bytesLeft;
@@ -4022,8 +3586,8 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
goto cleanup;
}
- if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
- blockModeProc = chanPtr->typePtr->blockModeProc;
+ if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc == NULL) {
/*
* Don't peek ahead if cannot set non-blocking mode.
@@ -4031,7 +3595,7 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
goto cleanup;
}
- (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
+ StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
}
}
}
@@ -4039,7 +3603,7 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
*dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
}
if (blockModeProc != NULL) {
- (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
+ StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
}
return;
@@ -4073,19 +3637,20 @@ CommonGetsCleanup(chanPtr, encoding)
Channel *chanPtr;
Tcl_Encoding encoding;
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr, *nextPtr;
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
for ( ; bufPtr != NULL; bufPtr = nextPtr) {
nextPtr = bufPtr->nextPtr;
if (bufPtr->nextRemoved < bufPtr->nextAdded) {
break;
}
- RecycleBuffer(chanPtr, bufPtr, 0);
+ RecycleBuffer(statePtr, bufPtr, 0);
}
- chanPtr->inQueueHead = bufPtr;
+ statePtr->inQueueHead = bufPtr;
if (bufPtr == NULL) {
- chanPtr->inQueueTail = NULL;
+ statePtr->inQueueTail = NULL;
} else {
/*
* If any multi-byte characters were split across channel buffer
@@ -4111,7 +3676,7 @@ CommonGetsCleanup(chanPtr, encoding)
bufPtr = nextPtr;
}
}
- if (chanPtr->encoding == NULL) {
+ if (statePtr->encoding == NULL) {
Tcl_FreeEncoding(encoding);
}
}
@@ -4144,10 +3709,16 @@ Tcl_Read(chan, dst, bytesToRead)
char *dst; /* Where to store input read. */
int bytesToRead; /* Maximum number of bytes to read. */
{
- Channel *chanPtr;
-
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
return -1;
}
@@ -4155,6 +3726,127 @@ Tcl_Read(chan, dst, bytesToRead)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ReadRaw --
+ *
+ * Reads a given number of bytes from a channel. EOL and EOF
+ * translation is done on the bytes being read, so the the number
+ * of bytes consumed from the channel may not be equal to the
+ * number of bytes stored in the destination buffer.
+ *
+ * No encoding conversions are applied to the bytes being read.
+ *
+ * Results:
+ * The number of bytes read, or -1 on error. Use Tcl_GetErrno()
+ * to retrieve the error code for the error that occurred.
+ *
+ * Side effects:
+ * May cause input to be buffered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ReadRaw(chan, bufPtr, bytesToRead)
+ Tcl_Channel chan; /* The channel from which to read. */
+ char *bufPtr; /* Where to store input read. */
+ int bytesToRead; /* Maximum number of bytes to read. */
+{
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int nread, result;
+ int copied, copiedNow;
+
+ /*
+ * The check below does too much because it will reject a call to this
+ * function with a channel which is part of an 'fcopy'. But we have to
+ * allow this here or else the chaining in the transformation drivers
+ * will fail with 'file busy' error instead of retrieving and
+ * transforming the data to copy.
+ *
+ * We let the check procedure now believe that there is no fcopy in
+ * progress. A better solution than this might be an additional flag
+ * argument to switch off specific checks.
+ */
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
+ return -1;
+ }
+
+ /*
+ * Check for information in the push-back buffers. If there is
+ * some, use it. Go to the driver only if there is none (anymore)
+ * and the caller requests more bytes.
+ */
+
+ for (copied = 0; copied < bytesToRead; copied += copiedNow) {
+ copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
+ bytesToRead - copied);
+ if (copiedNow == 0) {
+ if (statePtr->flags & CHANNEL_EOF) {
+ goto done;
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ goto done;
+ }
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
+ }
+
+ /*
+ * Now go to the driver to get as much as is possible to
+ * fill the remaining request. Do all the error handling
+ * by ourselves. The code was stolen from 'GetInput' and
+ * slightly adapted (different return value here).
+ *
+ * The case of 'bytesToRead == 0' at this point cannot happen.
+ */
+
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ bufPtr + copied, bytesToRead - copied, &result);
+ if (nread > 0) {
+ /*
+ * If we get a short read, signal up that we may be
+ * BLOCKED. We should avoid calling the driver because
+ * on some platforms we will block in the low level
+ * reading code even though the channel is set into
+ * nonblocking mode.
+ */
+
+ if (nread < (bytesToRead - copied)) {
+ statePtr->flags |= CHANNEL_BLOCKED;
+ }
+ } else if (nread == 0) {
+ statePtr->flags |= CHANNEL_EOF;
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (nread < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ if (copied > 0) {
+ /*
+ * Information that was copied earlier has precedence
+ * over EAGAIN/WOULDBLOCK handling.
+ */
+ return copied;
+ }
+
+ statePtr->flags |= CHANNEL_BLOCKED;
+ result = EAGAIN;
+ }
+
+ Tcl_SetErrno(result);
+ return -1;
+ }
+
+ return copied + nread;
+ }
+ }
+
+done:
+ return copied;
+}
+
+/*
*---------------------------------------------------------------------------
*
* Tcl_ReadChars --
@@ -4189,19 +3881,25 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
* of the object. */
{
- Channel *chanPtr;
- int offset, factor, copied, copiedNow, result;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
+ int offset, factor, copied, copiedNow, result;
Tcl_Encoding encoding;
#define UTF_EXPANSION_FACTOR 1024
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
copied = -1;
goto done;
}
- encoding = chanPtr->encoding;
+ encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
if (appendFlag == 0) {
@@ -4221,11 +3919,11 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
for (copied = 0; (unsigned) toRead > 0; ) {
copiedNow = -1;
- if (chanPtr->inQueueHead != NULL) {
+ if (statePtr->inQueueHead != NULL) {
if (encoding == NULL) {
- copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
+ copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
} else {
- copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
+ copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
&factor);
}
@@ -4233,27 +3931,27 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
* If the current buffer is empty recycle it.
*/
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
ChannelBuffer *nextPtr;
nextPtr = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, 0);
- chanPtr->inQueueHead = nextPtr;
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
if (nextPtr == NULL) {
- chanPtr->inQueueTail = nextPtr;
+ statePtr->inQueueTail = nextPtr;
}
}
}
if (copiedNow < 0) {
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (statePtr->flags & CHANNEL_EOF) {
break;
}
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
break;
}
- chanPtr->flags &= ~CHANNEL_BLOCKED;
+ statePtr->flags &= ~CHANNEL_BLOCKED;
}
result = GetInput(chanPtr);
if (result != 0) {
@@ -4268,7 +3966,7 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
toRead -= copiedNow;
}
}
- chanPtr->flags &= ~CHANNEL_BLOCKED;
+ statePtr->flags &= ~CHANNEL_BLOCKED;
if (encoding == NULL) {
Tcl_SetByteArrayLength(objPtr, offset);
} else {
@@ -4311,8 +4009,8 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
*/
static int
-ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
- Channel *chanPtr; /* The channel to read. */
+ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
+ ChannelState *statePtr; /* State of the channel to read. */
int bytesToRead; /* Maximum number of characters to store,
* or < 0 to get all available characters.
* Characters are obtained from the first
@@ -4337,7 +4035,7 @@ ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
offset = *offsetPtr;
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
src = bufPtr->buf + bufPtr->nextRemoved;
srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
@@ -4362,8 +4060,8 @@ ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
}
dst += offset;
- if (chanPtr->flags & INPUT_NEED_NL) {
- chanPtr->flags &= ~INPUT_NEED_NL;
+ if (statePtr->flags & INPUT_NEED_NL) {
+ statePtr->flags &= ~INPUT_NEED_NL;
if ((srcLen == 0) || (*src != '\n')) {
*dst = '\r';
*offsetPtr += 1;
@@ -4377,7 +4075,7 @@ ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
srcRead = srcLen;
dstWrote = toRead;
- if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
+ if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
if (dstWrote == 0) {
return -1;
}
@@ -4415,8 +4113,8 @@ ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
*/
static int
-ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
- Channel *chanPtr; /* The channel to read. */
+ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
+ ChannelState *statePtr; /* State of channel to read. */
int charsToRead; /* Maximum number of characters to store,
* or -1 to get all available characters.
* Characters are obtained from the first
@@ -4448,7 +4146,7 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
factor = *factorPtr;
offset = *offsetPtr;
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
src = bufPtr->buf + bufPtr->nextRemoved;
srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
@@ -4493,21 +4191,21 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
}
dst = objPtr->bytes + offset;
- oldState = chanPtr->inputEncodingState;
- if (chanPtr->flags & INPUT_NEED_NL) {
+ oldState = statePtr->inputEncodingState;
+ if (statePtr->flags & INPUT_NEED_NL) {
/*
* We want a '\n' because the last character we saw was '\r'.
*/
-
- chanPtr->flags &= ~INPUT_NEED_NL;
- Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
- chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+
+ statePtr->flags &= ~INPUT_NEED_NL;
+ Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
if ((dstWrote > 0) && (*dst == '\n')) {
/*
* The next char was a '\n'. Consume it and produce a '\n'.
*/
-
+
bufPtr->nextRemoved += srcRead;
} else {
/*
@@ -4516,13 +4214,13 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
*dst = '\r';
}
- chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
*offsetPtr += 1;
return 1;
}
- Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
- chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,
+ Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
if (srcRead == 0) {
/*
@@ -4541,19 +4239,19 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
* file event can be delivered.
*/
- chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
+ statePtr->flags |= CHANNEL_NEED_MORE_DATA;
return -1;
}
nextPtr->nextRemoved -= srcLen;
memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
(size_t) srcLen);
- RecycleBuffer(chanPtr, bufPtr, 0);
- chanPtr->inQueueHead = nextPtr;
- return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
}
dstRead = dstWrote;
- if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {
+ if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
/*
* Hit EOF char. How many bytes of src correspond to where the
* EOF was located in dst?
@@ -4562,11 +4260,11 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
if (dstWrote == 0) {
return -1;
}
- chanPtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
- chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+ statePtr->inputEncodingState = oldState;
+ Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
+ TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
}
/*
@@ -4585,15 +4283,15 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
char *eof;
eof = Tcl_UtfAtIndex(dst, toRead);
- chanPtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
- chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+ statePtr->inputEncodingState = oldState;
+ Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
dstRead = dstWrote;
- TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
+ TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
numChars -= (dstRead - dstWrote);
}
- chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
bufPtr->nextRemoved += srcRead;
if (dstWrote > srcRead + 1) {
@@ -4622,8 +4320,8 @@ ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
*/
static int
-TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
- Channel *chanPtr; /* Channel being read, for EOL translation
+TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
+ ChannelState *statePtr; /* Channel being read, for EOL translation
* and EOF character. */
char *dstStart; /* Output buffer filled with chars by
* applying appropriate EOL translation to
@@ -4643,7 +4341,7 @@ TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
dstLen = *dstLenPtr;
eof = NULL;
- inEofChar = chanPtr->inEofChar;
+ inEofChar = statePtr->inEofChar;
if (inEofChar != '\0') {
/*
* Find EOF in translated buffer then compress out the EOL. The
@@ -4667,7 +4365,7 @@ TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
}
}
}
- switch (chanPtr->inputTranslation) {
+ switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF: {
if (dstStart != srcStart) {
memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
@@ -4703,7 +4401,7 @@ TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
if (*src == '\r') {
src++;
if (src >= srcMax) {
- chanPtr->flags |= INPUT_NEED_NL;
+ statePtr->flags |= INPUT_NEED_NL;
} else if (*src == '\n') {
*dst++ = *src++;
} else {
@@ -4726,17 +4424,17 @@ TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
srcEnd = srcStart + dstLen;
srcMax = srcStart + *srcLenPtr;
- if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+ if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
if (*src == '\n') {
src++;
}
- chanPtr->flags &= ~INPUT_SAW_CR;
+ statePtr->flags &= ~INPUT_SAW_CR;
}
for ( ; src < srcEnd; ) {
if (*src == '\r') {
src++;
if (src >= srcMax) {
- chanPtr->flags |= INPUT_SAW_CR;
+ statePtr->flags |= INPUT_SAW_CR;
} else if (*src == '\n') {
if (srcEnd < srcMax) {
srcEnd++;
@@ -4765,9 +4463,9 @@ TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
* EOF character in the output string.
*/
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
- chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
return 1;
}
@@ -4801,21 +4499,29 @@ Tcl_Ungets(chan, str, len, atEnd)
* add at head of queue. */
{
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of actual channel. */
ChannelBuffer *bufPtr; /* Buffer to contain the data. */
int i, flags;
chanPtr = (Channel *) chan;
-
+ statePtr = chanPtr->state;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
/*
* CheckChannelErrors clears too many flag bits in this one case.
*/
- flags = chanPtr->flags;
- if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ flags = statePtr->flags;
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
len = -1;
goto done;
}
- chanPtr->flags = flags;
+ statePtr->flags = flags;
/*
* If we have encountered a sticky EOF, just punt without storing.
@@ -4825,10 +4531,10 @@ Tcl_Ungets(chan, str, len, atEnd)
* in each operation.
*/
- if (chanPtr->flags & CHANNEL_STICKY_EOF) {
+ if (statePtr->flags & CHANNEL_STICKY_EOF) {
goto done;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
+ statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
bufPtr = AllocChannelBuffer(len);
for (i = 0; i < len; i++) {
@@ -4836,17 +4542,17 @@ Tcl_Ungets(chan, str, len, atEnd)
}
bufPtr->nextAdded += len;
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueHead = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ statePtr->inQueueHead = bufPtr;
+ statePtr->inQueueTail = bufPtr;
} else if (atEnd) {
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail->nextPtr = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ statePtr->inQueueTail->nextPtr = bufPtr;
+ statePtr->inQueueTail = bufPtr;
} else {
- bufPtr->nextPtr = chanPtr->inQueueHead;
- chanPtr->inQueueHead = bufPtr;
+ bufPtr->nextPtr = statePtr->inQueueHead;
+ statePtr->inQueueHead = bufPtr;
}
done:
@@ -4880,20 +4586,26 @@ Tcl_Flush(chan)
Tcl_Channel chan; /* The Channel to flush. */
{
int result; /* Of calling FlushChannel. */
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ ChannelState *statePtr = chanPtr->state; /* State of actual channel. */
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
/*
* Force current output buffer to be output also.
*/
-
- if ((chanPtr->curOutPtr != NULL)
- && (chanPtr->curOutPtr->nextAdded > 0)) {
- chanPtr->flags |= BUFFER_READY;
+
+ if ((statePtr->curOutPtr != NULL)
+ && (statePtr->curOutPtr->nextAdded > 0)) {
+ statePtr->flags |= BUFFER_READY;
}
result = FlushChannel(NULL, chanPtr, 0);
@@ -4923,20 +4635,20 @@ Tcl_Flush(chan)
*/
static void
-DiscardInputQueued(chanPtr, discardSavedBuffers)
- Channel *chanPtr; /* Channel on which to discard
+DiscardInputQueued(statePtr, discardSavedBuffers)
+ ChannelState *statePtr; /* Channel on which to discard
* the queued input. */
int discardSavedBuffers; /* If non-zero, discard all buffers including
* last one. */
{
ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
- bufPtr = chanPtr->inQueueHead;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ bufPtr = statePtr->inQueueHead;
+ statePtr->inQueueHead = (ChannelBuffer *) NULL;
+ statePtr->inQueueTail = (ChannelBuffer *) NULL;
for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
nxtPtr = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
+ RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
}
/*
@@ -4945,9 +4657,9 @@ DiscardInputQueued(chanPtr, discardSavedBuffers)
*/
if (discardSavedBuffers) {
- if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) chanPtr->saveInBufPtr);
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
+ if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+ ckfree((char *) statePtr->saveInBufPtr);
+ statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
}
}
}
@@ -4977,6 +4689,7 @@ GetInput(chanPtr)
int result; /* Of calling driver. */
int nread; /* How much was read from channel? */
ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
/*
* Prevent reading from a dead channel -- a channel that has been closed
@@ -4985,34 +4698,62 @@ GetInput(chanPtr)
* interpreter.
*/
- if (CheckForDeadChannel(NULL, chanPtr)) {
+ if (CheckForDeadChannel(NULL, statePtr)) {
return EINVAL;
}
/*
+ * First check for more buffers in the pushback area of the
+ * topmost channel in the stack and use them. They can be the
+ * result of a transformation which went away without reading all
+ * the information placed in the area when it was stacked.
+ *
+ * Two possibilities for the state: No buffers in it, or a single
+ * empty buffer. In the latter case we can recycle it now.
+ */
+
+ if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
+ if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
+ statePtr->inQueueHead = (ChannelBuffer*) NULL;
+ }
+
+ statePtr->inQueueHead = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+ return 0;
+ }
+
+ /*
+ * Nothing in the pushback area, fall back to the usual handling
+ * (driver, etc.)
+ */
+
+ /*
* See if we can fill an existing buffer. If we can, read only
* as much as will fit in it. Otherwise allocate a new buffer,
* add it to the input queue and attempt to fill it to the max.
*/
- bufPtr = chanPtr->inQueueTail;
+ bufPtr = statePtr->inQueueTail;
if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
toRead = bufPtr->bufLength - bufPtr->nextAdded;
} else {
- bufPtr = chanPtr->saveInBufPtr;
- chanPtr->saveInBufPtr = NULL;
+ bufPtr = statePtr->saveInBufPtr;
+ statePtr->saveInBufPtr = NULL;
if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(chanPtr->bufSize);
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
}
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- toRead = chanPtr->bufSize;
- if (chanPtr->inQueueTail == NULL) {
- chanPtr->inQueueHead = bufPtr;
+ toRead = statePtr->bufSize;
+ if (statePtr->inQueueTail == NULL) {
+ statePtr->inQueueHead = bufPtr;
} else {
- chanPtr->inQueueTail->nextPtr = bufPtr;
+ statePtr->inQueueTail->nextPtr = bufPtr;
}
- chanPtr->inQueueTail = bufPtr;
+ statePtr->inQueueTail = bufPtr;
}
/*
@@ -5020,11 +4761,11 @@ GetInput(chanPtr)
* platforms it is impossible to read from a device after EOF.
*/
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (statePtr->flags & CHANNEL_EOF) {
return 0;
}
- nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
bufPtr->buf + bufPtr->nextAdded, toRead, &result);
if (nread > 0) {
@@ -5038,14 +4779,14 @@ GetInput(chanPtr)
*/
if (nread < toRead) {
- chanPtr->flags |= CHANNEL_BLOCKED;
+ statePtr->flags |= CHANNEL_BLOCKED;
}
} else if (nread == 0) {
- chanPtr->flags |= CHANNEL_EOF;
- chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ statePtr->flags |= CHANNEL_EOF;
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
} else if (nread < 0) {
if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- chanPtr->flags |= CHANNEL_BLOCKED;
+ statePtr->flags |= CHANNEL_BLOCKED;
result = EAGAIN;
}
Tcl_SetErrno(result);
@@ -5078,7 +4819,8 @@ Tcl_Seek(chan, offset, mode)
int offset; /* Offset to seek to. */
int mode; /* Relative to which location to seek? */
{
- Channel *chanPtr; /* The real IO channel. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
int inputBuffered, outputBuffered;
int result; /* Of device driver operations. */
@@ -5087,8 +4829,7 @@ Tcl_Seek(chan, offset, mode)
* seek operation? If so, must restore to
* nonblocking mode after the seek. */
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
return -1;
}
@@ -5099,7 +4840,13 @@ Tcl_Seek(chan, offset, mode)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) return -1;
+ if (CheckForDeadChannel(NULL, statePtr)) return -1;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
/*
* Disallow seek on channels whose type does not have a seek procedure
@@ -5116,21 +4863,32 @@ Tcl_Seek(chan, offset, mode)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
+ for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ /*
+ * Don't forget the bytes in the topmost pushback area.
+ */
+
+ for (bufPtr = statePtr->topChanPtr->inQueueHead;
bufPtr != (ChannelBuffer *) NULL;
bufPtr = bufPtr->nextPtr) {
inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
+
+ for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
bufPtr != (ChannelBuffer *) NULL;
bufPtr = bufPtr->nextPtr) {
outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
outputBuffered +=
- (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
+ (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
}
if ((inputBuffered != 0) && (outputBuffered != 0)) {
@@ -5152,14 +4910,14 @@ Tcl_Seek(chan, offset, mode)
* the seek.
*/
- DiscardInputQueued(chanPtr, 0);
+ DiscardInputQueued(statePtr, 0);
/*
* Reset EOF and BLOCKED flags. We invalidate them by moving the
* access point. Also clear CR related flags.
*/
- chanPtr->flags &=
+ statePtr->flags &=
(~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
/*
@@ -5170,20 +4928,15 @@ Tcl_Seek(chan, offset, mode)
*/
wasAsync = 0;
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
wasAsync = 1;
- result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- TCL_MODE_BLOCKING);
- }
- if (result != 0) {
- Tcl_SetErrno(result);
- return -1;
- }
- chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
- chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
+ if (result != 0) {
+ return -1;
+ }
+ statePtr->flags &= (~(CHANNEL_NONBLOCKING));
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
}
}
@@ -5219,16 +4972,11 @@ Tcl_Seek(chan, offset, mode)
*/
if (wasAsync) {
- chanPtr->flags |= CHANNEL_NONBLOCKING;
- result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- TCL_MODE_NONBLOCKING);
- }
- if (result != 0) {
- Tcl_SetErrno(result);
- return -1;
- }
+ statePtr->flags |= CHANNEL_NONBLOCKING;
+ result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
+ if (result != 0) {
+ return -1;
+ }
}
return curPos;
@@ -5257,14 +5005,14 @@ int
Tcl_Tell(chan)
Tcl_Channel chan; /* The channel to return pos for. */
{
- Channel *chanPtr; /* The actual channel to tell on. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
int inputBuffered, outputBuffered;
int result; /* Of calling device driver. */
int curPos; /* Position on device. */
- chanPtr = (Channel *) chan;
- if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
return -1;
}
@@ -5275,11 +5023,17 @@ Tcl_Tell(chan)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) {
+ if (CheckForDeadChannel(NULL, statePtr)) {
return -1;
}
/*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ /*
* Disallow tell on channels whose type does not have a seek procedure
* defined. This means that the channel does not support seeking.
*/
@@ -5294,21 +5048,21 @@ Tcl_Tell(chan)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
+ for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
bufPtr != (ChannelBuffer *) NULL;
bufPtr = bufPtr->nextPtr) {
inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
+ for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
bufPtr != (ChannelBuffer *) NULL;
bufPtr = bufPtr->nextPtr) {
outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
outputBuffered +=
- (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
+ (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
}
if ((inputBuffered != 0) && (outputBuffered != 0)) {
@@ -5352,18 +5106,33 @@ Tcl_Tell(chan)
*/
static int
-CheckChannelErrors(chanPtr, direction)
- Channel *chanPtr; /* Channel to check. */
- int direction; /* Test if channel supports desired operation:
- * TCL_READABLE, TCL_WRITABLE. */
+CheckChannelErrors(statePtr, flags)
+ ChannelState *statePtr; /* Channel to check. */
+ int flags; /* Test if channel supports desired operation:
+ * TCL_READABLE, TCL_WRITABLE. Also indicates
+ * Raw read or write for special close
+ * processing*/
{
+ int direction = flags & (TCL_READABLE|TCL_WRITABLE);
+
/*
* Check for unreported error.
*/
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
+ if (statePtr->unreportedError != 0) {
+ Tcl_SetErrno(statePtr->unreportedError);
+ statePtr->unreportedError = 0;
+ return -1;
+ }
+
+ /*
+ * Only the raw read and write operations are allowed during close
+ * in order to drain data from stacked channels.
+ */
+
+ if ((statePtr->flags & CHANNEL_CLOSED) &&
+ ((flags & CHANNEL_RAW_MODE) == 0)) {
+ Tcl_SetErrno(EACCES);
return -1;
}
@@ -5371,16 +5140,20 @@ CheckChannelErrors(chanPtr, direction)
* Fail if the channel is not opened for desired operation.
*/
- if ((chanPtr->flags & direction) == 0) {
+ if ((statePtr->flags & direction) == 0) {
Tcl_SetErrno(EACCES);
return -1;
}
/*
* Fail if the channel is in the middle of a background copy.
+ *
+ * Don't do this tests for raw channels here or else the chaining in the
+ * transformation drivers will fail with 'file busy' error instead of
+ * retrieving and transforming the data to copy.
*/
- if (chanPtr->csPtr != NULL) {
+ if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) {
Tcl_SetErrno(EBUSY);
return -1;
}
@@ -5393,10 +5166,10 @@ CheckChannelErrors(chanPtr, direction)
* We want to discover these conditions anew in each operation.
*/
- if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
- chanPtr->flags &= ~CHANNEL_EOF;
+ if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
+ statePtr->flags &= ~CHANNEL_EOF;
}
- chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
}
return 0;
@@ -5422,12 +5195,12 @@ int
Tcl_Eof(chan)
Tcl_Channel chan; /* Does this channel have EOF? */
{
- Channel *chanPtr; /* The real channel structure. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
- ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
- ? 1 : 0;
+ return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
+ ((statePtr->flags & CHANNEL_EOF) &&
+ (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
/*
@@ -5450,10 +5223,10 @@ int
Tcl_InputBlocked(chan)
Tcl_Channel chan; /* Is this channel blocked? */
{
- Channel *chanPtr; /* The real channel structure. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+ return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
}
/*
@@ -5462,7 +5235,7 @@ Tcl_InputBlocked(chan)
* Tcl_InputBuffered --
*
* Returns the number of bytes of input currently buffered in the
- * internal buffer of a channel.
+ * common internal buffer of a channel.
*
* Results:
* The number of input bytes buffered, or zero if the channel is not
@@ -5478,16 +5251,63 @@ int
Tcl_InputBuffered(chan)
Tcl_Channel chan; /* The channel to query. */
{
- Channel *chanPtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
+ ChannelBuffer *bufPtr;
int bytesBuffered;
+
+ for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ /*
+ * Don't forget the bytes in the topmost pushback area.
+ */
+
+ for (bufPtr = statePtr->topChanPtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ return bytesBuffered;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelBuffered --
+ *
+ * Returns the number of bytes of input currently buffered in the
+ * internal buffer (push back area) of a channel.
+ *
+ * Results:
+ * The number of input bytes buffered, or zero if the channel is not
+ * open for reading.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ChannelBuffered(chan)
+ Tcl_Channel chan; /* The channel to query. */
+{
+ Channel *chanPtr = (Channel *) chan;
+ /* real channel structure. */
ChannelBuffer *bufPtr;
+ int bytesBuffered;
- chanPtr = (Channel *) chan;
for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
bufPtr != (ChannelBuffer *) NULL;
bufPtr = bufPtr->nextPtr) {
bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
+
return bytesBuffered;
}
@@ -5514,7 +5334,7 @@ Tcl_SetChannelBufferSize(chan, sz)
* to set. */
int sz; /* The size to set. */
{
- Channel *chanPtr;
+ ChannelState *statePtr; /* State of real channel structure. */
/*
* If the buffer size is smaller than 10 bytes or larger than one MByte,
@@ -5528,16 +5348,16 @@ Tcl_SetChannelBufferSize(chan, sz)
return;
}
- chanPtr = (Channel *) chan;
- chanPtr->bufSize = sz;
+ statePtr = ((Channel *) chan)->state;
+ statePtr->bufSize = sz;
- if (chanPtr->outputStage != NULL) {
- ckfree((char *) chanPtr->outputStage);
- chanPtr->outputStage = NULL;
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = NULL;
}
- if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
- chanPtr->outputStage = (char *)
- ckalloc((unsigned) (chanPtr->bufSize + 2));
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
}
}
@@ -5562,10 +5382,10 @@ Tcl_GetChannelBufferSize(chan)
Tcl_Channel chan; /* The channel for which to find the
* buffer size. */
{
- Channel *chanPtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return chanPtr->bufSize;
+ return statePtr->bufSize;
}
/*
@@ -5668,30 +5488,39 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
size_t len; /* Length of optionName string. */
char optionVal[128]; /* Buffer for sprintf. */
Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
int flags;
/*
- * If we are in the middle of a background copy, use the saved flags.
+ * Disallow options on dead channels -- channels that have been closed but
+ * not yet been deallocated. Such channels can be found if the exit
+ * handler for channel cleanup has run but the channel is still
+ * registered in an interpreter.
*/
- if (chanPtr->csPtr) {
- if (chanPtr == chanPtr->csPtr->readPtr) {
- flags = chanPtr->csPtr->readFlags;
- } else {
- flags = chanPtr->csPtr->writeFlags;
- }
- } else {
- flags = chanPtr->flags;
+ if (CheckForDeadChannel(interp, statePtr)) {
+ return TCL_ERROR;
}
/*
- * Disallow options on dead channels -- channels that have been closed but
- * not yet been deallocated. Such channels can be found if the exit
- * handler for channel cleanup has run but the channel is still
- * registered in an interpreter.
+ * This operation should occur at the top of a channel stack.
*/
- if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
+ chanPtr = statePtr->topChanPtr;
+
+ /*
+ * If we are in the middle of a background copy, use the saved flags.
+ */
+
+ if (statePtr->csPtr) {
+ if (chanPtr == statePtr->csPtr->readPtr) {
+ flags = statePtr->csPtr->readFlags;
+ } else {
+ flags = statePtr->csPtr->writeFlags;
+ }
+ } else {
+ flags = statePtr->flags;
+ }
/*
* If the optionName is NULL it means that we want a list of all
@@ -5736,7 +5565,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffersize");
}
- TclFormatInt(optionVal, chanPtr->bufSize);
+ TclFormatInt(optionVal, statePtr->bufSize);
Tcl_DStringAppendElement(dsPtr, optionVal);
if (len > 0) {
return TCL_OK;
@@ -5748,11 +5577,11 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-encoding");
}
- if (chanPtr->encoding == NULL) {
+ if (statePtr->encoding == NULL) {
Tcl_DStringAppendElement(dsPtr, "binary");
} else {
Tcl_DStringAppendElement(dsPtr,
- Tcl_GetEncodingName(chanPtr->encoding));
+ Tcl_GetEncodingName(statePtr->encoding));
}
if (len > 0) {
return TCL_OK;
@@ -5769,22 +5598,22 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
- if (chanPtr->inEofChar == 0) {
+ if (statePtr->inEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
- sprintf(buf, "%c", chanPtr->inEofChar);
+ sprintf(buf, "%c", statePtr->inEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
if (flags & TCL_WRITABLE) {
- if (chanPtr->outEofChar == 0) {
+ if (statePtr->outEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
- sprintf(buf, "%c", chanPtr->outEofChar);
+ sprintf(buf, "%c", statePtr->outEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
@@ -5807,22 +5636,22 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
- if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+ if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
}
}
if (flags & TCL_WRITABLE) {
- if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+ if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
@@ -5881,18 +5710,17 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
char *newValue; /* New value for option. */
{
int newMode; /* New (numeric) mode to sert. */
- Channel *chanPtr; /* The real IO channel. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
size_t len; /* Length of optionName string. */
int argc;
char **argv;
-
- chanPtr = (Channel *) chan;
/*
* If the channel is in the middle of a background copy, fail.
*/
- if (chanPtr->csPtr) {
+ if (statePtr->csPtr) {
if (interp) {
Tcl_AppendResult(interp,
"unable to set channel options: background copy in progress",
@@ -5901,7 +5729,6 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_ERROR;
}
-
/*
* Disallow options on dead channels -- channels that have been closed but
* not yet been deallocated. Such channels can be found if the exit
@@ -5909,8 +5736,16 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
-
+ if (CheckForDeadChannel(NULL, statePtr)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
len = strlen(optionName);
if ((len > 2) && (optionName[1] == 'b') &&
@@ -5928,16 +5763,16 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
(strncmp(optionName, "-buffering", len) == 0)) {
len = strlen(newValue);
if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
- chanPtr->flags &=
+ statePtr->flags &=
(~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
} else if ((newValue[0] == 'l') &&
(strncmp(newValue, "line", len) == 0)) {
- chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
- chanPtr->flags |= CHANNEL_LINEBUFFERED;
+ statePtr->flags &= (~(CHANNEL_UNBUFFERED));
+ statePtr->flags |= CHANNEL_LINEBUFFERED;
} else if ((newValue[0] == 'n') &&
(strncmp(newValue, "none", len) == 0)) {
- chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
- chanPtr->flags |= CHANNEL_UNBUFFERED;
+ statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
+ statePtr->flags |= CHANNEL_UNBUFFERED;
} else {
if (interp) {
Tcl_AppendResult(interp, "bad value for -buffering: ",
@@ -5949,9 +5784,9 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_OK;
} else if ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffersize", len) == 0)) {
- chanPtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
- if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
- chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+ statePtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
+ if ((statePtr->bufSize < 10) || (statePtr->bufSize > (1024 * 1024))) {
+ statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
}
} else if ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-encoding", len) == 0)) {
@@ -5965,13 +5800,13 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_ERROR;
}
}
- Tcl_FreeEncoding(chanPtr->encoding);
- chanPtr->encoding = encoding;
- chanPtr->inputEncodingState = NULL;
- chanPtr->inputEncodingFlags = TCL_ENCODING_START;
- chanPtr->outputEncodingState = NULL;
- chanPtr->outputEncodingFlags = TCL_ENCODING_START;
- chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = encoding;
+ statePtr->inputEncodingState = NULL;
+ statePtr->inputEncodingFlags = TCL_ENCODING_START;
+ statePtr->outputEncodingState = NULL;
+ statePtr->outputEncodingFlags = TCL_ENCODING_START;
+ statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
UpdateInterest(chanPtr);
} else if ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-eofchar", len) == 0)) {
@@ -5979,14 +5814,14 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_ERROR;
}
if (argc == 0) {
- chanPtr->inEofChar = 0;
- chanPtr->outEofChar = 0;
+ statePtr->inEofChar = 0;
+ statePtr->outEofChar = 0;
} else if (argc == 1) {
- if (chanPtr->flags & TCL_WRITABLE) {
- chanPtr->outEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_WRITABLE) {
+ statePtr->outEofChar = (int) argv[0][0];
}
- if (chanPtr->flags & TCL_READABLE) {
- chanPtr->inEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_READABLE) {
+ statePtr->inEofChar = (int) argv[0][0];
}
} else if (argc != 2) {
if (interp) {
@@ -5997,11 +5832,11 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
ckfree((char *) argv);
return TCL_ERROR;
} else {
- if (chanPtr->flags & TCL_READABLE) {
- chanPtr->inEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_READABLE) {
+ statePtr->inEofChar = (int) argv[0][0];
}
- if (chanPtr->flags & TCL_WRITABLE) {
- chanPtr->outEofChar = (int) argv[1][0];
+ if (statePtr->flags & TCL_WRITABLE) {
+ statePtr->outEofChar = (int) argv[1][0];
}
}
if (argv != (char **) NULL) {
@@ -6017,11 +5852,11 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
}
if (argc == 1) {
- readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+ readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
+ writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
} else if (argc == 2) {
- readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+ readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
+ writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -6034,14 +5869,14 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
if (readMode) {
if (*readMode == '\0') {
- newMode = chanPtr->inputTranslation;
+ newMode = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
newMode = TCL_TRANSLATE_AUTO;
} else if (strcmp(readMode, "binary") == 0) {
newMode = TCL_TRANSLATE_LF;
- chanPtr->inEofChar = 0;
- Tcl_FreeEncoding(chanPtr->encoding);
- chanPtr->encoding = NULL;
+ statePtr->inEofChar = 0;
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = NULL;
} else if (strcmp(readMode, "lf") == 0) {
newMode = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
@@ -6067,10 +5902,10 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* complete the line.
*/
- if (newMode != chanPtr->inputTranslation) {
- chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
- chanPtr->flags &= ~(INPUT_SAW_CR);
- chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
+ if (newMode != statePtr->inputTranslation) {
+ statePtr->inputTranslation = (Tcl_EolTranslation) newMode;
+ statePtr->flags &= ~(INPUT_SAW_CR);
+ statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
}
}
@@ -6086,23 +5921,23 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
*/
if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+ statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
}
} else if (strcmp(writeMode, "binary") == 0) {
- chanPtr->outEofChar = 0;
- chanPtr->outputTranslation = TCL_TRANSLATE_LF;
- Tcl_FreeEncoding(chanPtr->encoding);
- chanPtr->encoding = NULL;
+ statePtr->outEofChar = 0;
+ statePtr->outputTranslation = TCL_TRANSLATE_LF;
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = NULL;
} else if (strcmp(writeMode, "lf") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+ statePtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CR;
+ statePtr->outputTranslation = TCL_TRANSLATE_CR;
} else if (strcmp(writeMode, "crlf") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+ statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else if (strcmp(writeMode, "platform") == 0) {
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -6127,17 +5962,17 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* If bufsize changes, need to get rid of old utility buffer.
*/
- if (chanPtr->saveInBufPtr != NULL) {
- RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
- chanPtr->saveInBufPtr = NULL;
+ if (statePtr->saveInBufPtr != NULL) {
+ RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+ statePtr->saveInBufPtr = NULL;
}
- if (chanPtr->inQueueHead != NULL) {
- if ((chanPtr->inQueueHead->nextPtr == NULL)
- && (chanPtr->inQueueHead->nextAdded ==
- chanPtr->inQueueHead->nextRemoved)) {
- RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
- chanPtr->inQueueHead = NULL;
- chanPtr->inQueueTail = NULL;
+ if (statePtr->inQueueHead != NULL) {
+ if ((statePtr->inQueueHead->nextPtr == NULL)
+ && (statePtr->inQueueHead->nextAdded ==
+ statePtr->inQueueHead->nextRemoved)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
}
}
@@ -6145,13 +5980,13 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* If encoding or bufsize changes, need to update output staging buffer.
*/
- if (chanPtr->outputStage != NULL) {
- ckfree((char *) chanPtr->outputStage);
- chanPtr->outputStage = NULL;
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = NULL;
}
- if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
- chanPtr->outputStage = (char *)
- ckalloc((unsigned) (chanPtr->bufSize + 2));
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
}
return TCL_OK;
}
@@ -6181,6 +6016,7 @@ CleanupChannelHandlers(interp, chanPtr)
Tcl_Interp *interp;
Channel *chanPtr;
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/*
@@ -6188,20 +6024,20 @@ CleanupChannelHandlers(interp, chanPtr)
* given interpreter.
*/
- for (sPtr = chanPtr->scriptRecordPtr,
+ for (sPtr = statePtr->scriptRecordPtr,
prevPtr = (EventScriptRecord *) NULL;
sPtr != (EventScriptRecord *) NULL;
sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == (EventScriptRecord *) NULL) {
- chanPtr->scriptRecordPtr = nextPtr;
+ statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, (ClientData) sPtr);
Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
@@ -6238,14 +6074,124 @@ Tcl_NotifyChannel(channel, mask)
* which events were detected. */
{
Channel *chanPtr = (Channel *) channel;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelHandler *chPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
+#ifdef TCL_CHANNEL_VERSION_2
+ Channel* upChanPtr;
+ Tcl_ChannelType* upTypePtr;
+
+ /*
+ * In contrast to the other API functions this procedure walks towards
+ * the top of a stack and not down from it.
+ *
+ * The channel calling this procedure is the one who generated the event,
+ * and thus does not take part in handling it. IOW, its HandlerProc is
+ * not called, instead we begin with the channel above it.
+ *
+ * This behaviour also allows the transformation channels to
+ * generate their own events and pass them upward.
+ */
+
+ while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
+ 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);
+ }
+
+ /* ELSE:
+ * Ignore transformations which are unable to handle the event
+ * coming from below. Assume that they don't change the mask and
+ * pass it on.
+ */
+ chanPtr = upChanPtr;
+ }
+
+ channel = (Tcl_Channel) chanPtr;
+
+ /*
+ * Here we have either reached the top of the stack or the mask is
+ * empty. We break out of the procedure if it is the latter.
+ */
+
+ if (!mask) {
+ return;
+ }
+
+ /*
+ * We are now above the topmost channel in a stack and have events
+ * left. Now call the channel handlers as usual.
+ *
+ * Preserve the channel struct in case the script closes it.
+ */
+
+ Tcl_Preserve((ClientData) channel);
+
+ /*
+ * If we are flushing in the background, be sure to call FlushChannel
+ * for writable events. Note that we have to discard the writable
+ * event so we don't call any write handlers before the flush is
+ * complete.
+ */
+
+ if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ FlushChannel(NULL, chanPtr, 1);
+ mask &= ~TCL_WRITABLE;
+ }
+
+ /*
+ * Add this invocation to the list of recursive invocations of
+ * ChannelHandlerEventProc.
+ */
+
+ nh.nextHandlerPtr = (ChannelHandler *) NULL;
+ nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = &nh;
+
+ for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+
+ /*
+ * If this channel handler is interested in any of the events that
+ * have occurred on the channel, invoke its procedure.
+ */
+
+ if ((chPtr->mask & mask) != 0) {
+ nh.nextHandlerPtr = chPtr->nextPtr;
+ (*(chPtr->proc))(chPtr->clientData, mask);
+ chPtr = nh.nextHandlerPtr;
+ } else {
+ chPtr = chPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Update the notifier interest, since it may have changed after
+ * invoking event handlers. Skip that if the channel was deleted
+ * in the call to the channel handler.
+ */
+
+ if (chanPtr->typePtr != NULL) {
+ UpdateInterest(chanPtr);
+ }
+
+ Tcl_Release((ClientData) channel);
+
+ tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
+#else
/* Walk all channels in a stack ! and notify them in order.
*/
- while (chanPtr != (Channel *) NULL) {
+ while (chanPtr != (Channel *) NULL) {
/*
* Preserve the channel struct in case the script closes it.
*/
@@ -6259,7 +6205,7 @@ Tcl_NotifyChannel(channel, mask)
* complete.
*/
- if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
FlushChannel(NULL, chanPtr, 1);
mask &= ~TCL_WRITABLE;
}
@@ -6272,8 +6218,8 @@ Tcl_NotifyChannel(channel, mask)
nh.nextHandlerPtr = (ChannelHandler *) NULL;
nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
tsdPtr->nestedHandlerPtr = &nh;
-
- for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+
+ for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
/*
* If this channel handler is interested in any of the events that
@@ -6300,11 +6246,11 @@ Tcl_NotifyChannel(channel, mask)
/* Walk down the stack.
*/
- chanPtr = chanPtr->supercedes;
+ chanPtr = chanPtr->downChanPtr;
} else {
/* Stop walking the chain, the whole stack was destroyed!
*/
- chanPtr = (Channel*) NULL;
+ chanPtr = (Channel *) NULL;
}
Tcl_Release((ClientData) channel);
@@ -6313,6 +6259,7 @@ Tcl_NotifyChannel(channel, mask)
channel = (Tcl_Channel) chanPtr;
}
+#endif
}
/*
@@ -6336,14 +6283,15 @@ static void
UpdateInterest(chanPtr)
Channel *chanPtr; /* Channel to update. */
{
- int mask = chanPtr->interestMask;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int mask = statePtr->interestMask;
/*
* If there are flushed buffers waiting to be written, then
* we need to watch for the channel to become writable.
*/
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
mask |= TCL_WRITABLE;
}
@@ -6355,13 +6303,13 @@ UpdateInterest(chanPtr)
*/
if (mask & TCL_READABLE) {
- if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
- && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
- && (chanPtr->inQueueHead->nextRemoved <
- chanPtr->inQueueHead->nextAdded)) {
+ if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+ && (statePtr->inQueueHead->nextRemoved <
+ statePtr->inQueueHead->nextAdded)) {
mask &= ~TCL_READABLE;
- if (!chanPtr->timer) {
- chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+ if (!statePtr->timer) {
+ statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
}
}
@@ -6391,23 +6339,24 @@ ChannelTimerProc(clientData)
ClientData clientData;
{
Channel *chanPtr = (Channel *) clientData;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
- if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
- && (chanPtr->interestMask & TCL_READABLE)
- && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
- && (chanPtr->inQueueHead->nextRemoved <
- chanPtr->inQueueHead->nextAdded)) {
+ if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ && (statePtr->interestMask & TCL_READABLE)
+ && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+ && (statePtr->inQueueHead->nextRemoved <
+ statePtr->inQueueHead->nextAdded)) {
/*
* Restart the timer in case a channel handler reenters the
* event loop before UpdateInterest gets called by Tcl_NotifyChannel.
*/
- chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+ statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
} else {
- chanPtr->timer = NULL;
+ statePtr->timer = NULL;
UpdateInterest(chanPtr);
}
}
@@ -6447,17 +6396,16 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
ClientData clientData; /* Arbitrary data to pass to proc. */
{
ChannelHandler *chPtr;
- Channel *chanPtr;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
- chanPtr = (Channel *) chan;
-
/*
* Check whether this channel handler is not already registered. If
* it is not, create a new record, else reuse existing record (smash
* current values).
*/
- for (chPtr = chanPtr->chPtr;
+ for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
@@ -6471,8 +6419,8 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
chPtr->proc = proc;
chPtr->clientData = clientData;
chPtr->chanPtr = chanPtr;
- chPtr->nextPtr = chanPtr->chPtr;
- chanPtr->chPtr = chPtr;
+ chPtr->nextPtr = statePtr->chPtr;
+ statePtr->chPtr = chPtr;
}
/*
@@ -6488,14 +6436,14 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
* be disabling an existing handler.
*/
- chanPtr->interestMask = 0;
- for (chPtr = chanPtr->chPtr;
+ statePtr->interestMask = 0;
+ for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
- chanPtr->interestMask |= chPtr->mask;
+ statePtr->interestMask |= chPtr->mask;
}
- UpdateInterest(chanPtr);
+ UpdateInterest(statePtr->topChanPtr);
}
/*
@@ -6526,18 +6474,17 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* to delete. */
{
- ChannelHandler *chPtr, *prevChPtr;
- Channel *chanPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ChannelHandler *chPtr, *prevChPtr;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
NextChannelHandler *nhPtr;
- chanPtr = (Channel *) chan;
-
/*
* Find the entry and the previous one in the list.
*/
- for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
+ for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
@@ -6546,7 +6493,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
}
prevChPtr = chPtr;
}
-
+
/*
* If not found, return without doing anything.
*/
@@ -6573,7 +6520,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
*/
if (prevChPtr == (ChannelHandler *) NULL) {
- chanPtr->chPtr = chPtr->nextPtr;
+ statePtr->chPtr = chPtr->nextPtr;
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
@@ -6585,14 +6532,14 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* event.
*/
- chanPtr->interestMask = 0;
- for (chPtr = chanPtr->chPtr;
+ statePtr->interestMask = 0;
+ for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
- chanPtr->interestMask |= chPtr->mask;
+ statePtr->interestMask |= chPtr->mask;
}
- UpdateInterest(chanPtr);
+ UpdateInterest(statePtr->topChanPtr);
}
/*
@@ -6621,21 +6568,22 @@ DeleteScriptRecord(interp, chanPtr, mask)
int mask; /* Events in mask must exactly match mask
* of script to delete. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr;
- for (esPtr = chanPtr->scriptRecordPtr,
+ for (esPtr = statePtr->scriptRecordPtr,
prevEsPtr = (EventScriptRecord *) NULL;
esPtr != (EventScriptRecord *) NULL;
prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
- if (esPtr == chanPtr->scriptRecordPtr) {
- chanPtr->scriptRecordPtr = esPtr->nextPtr;
+ if (esPtr == statePtr->scriptRecordPtr) {
+ statePtr->scriptRecordPtr = esPtr->nextPtr;
} else {
prevEsPtr->nextPtr = esPtr->nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
@@ -6672,9 +6620,10 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
* will be invoked. */
Tcl_Obj *scriptPtr; /* Pointer to script object. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr;
- for (esPtr = chanPtr->scriptRecordPtr;
+ for (esPtr = statePtr->scriptRecordPtr;
esPtr != (EventScriptRecord *) NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
@@ -6687,9 +6636,9 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
esPtr = (EventScriptRecord *) ckalloc((unsigned)
sizeof(EventScriptRecord));
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- esPtr->nextPtr = chanPtr->scriptRecordPtr;
- chanPtr->scriptRecordPtr = esPtr;
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
}
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
@@ -6701,7 +6650,7 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
/*
*----------------------------------------------------------------------
*
- * ChannelEventScriptInvoker --
+ * TclChannelEventScriptInvoker --
*
* Invokes a script scheduled by "fileevent" for when the channel
* becomes ready for IO. This function is invoked by the channel
@@ -6716,8 +6665,8 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
*----------------------------------------------------------------------
*/
-static void
-ChannelEventScriptInvoker(clientData, mask)
+void
+TclChannelEventScriptInvoker(clientData, mask)
ClientData clientData; /* The script+interp record. */
int mask; /* Not used. */
{
@@ -6728,12 +6677,11 @@ ChannelEventScriptInvoker(clientData, mask)
* in. */
int result; /* Result of call to eval script. */
- esPtr = (EventScriptRecord *) clientData;
+ esPtr = (EventScriptRecord *) clientData;
+ chanPtr = esPtr->chanPtr;
+ mask = esPtr->mask;
+ interp = esPtr->interp;
- chanPtr = esPtr->chanPtr;
- mask = esPtr->mask;
- interp = esPtr->interp;
-
/*
* We must preserve the interpreter so we can report errors on it
* later. Note that we do not need to preserve the channel because
@@ -6791,6 +6739,7 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
{
Channel *chanPtr; /* The channel to create
* the handler for. */
+ ChannelState *statePtr; /* state info for channel */
Tcl_Channel chan; /* The opaque type for the channel. */
char *chanName;
int modeIndex; /* Index of mode argument. */
@@ -6813,8 +6762,9 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- chanPtr = (Channel *) chan;
- if ((chanPtr->flags & mask) == 0) {
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ if ((statePtr->flags & mask) == 0) {
Tcl_AppendResult(interp, "channel is not ",
(mask == TCL_READABLE) ? "readable" : "writable",
(char *) NULL);
@@ -6827,7 +6777,7 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
if (objc == 3) {
EventScriptRecord *esPtr;
- for (esPtr = chanPtr->scriptRecordPtr;
+ for (esPtr = statePtr->scriptRecordPtr;
esPtr != (EventScriptRecord *) NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
@@ -6861,539 +6811,6 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclTestChannelCmd --
- *
- * Implements the Tcl "testchannel" debugging command and its
- * subcommands. This is part of the testing environment but must be
- * in this file instead of tclTest.c because it needs access to the
- * fields of struct Channel.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-TclTestChannelCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for result. */
- int argc; /* Count of additional args. */
- char **argv; /* Additional arg strings. */
-{
- char *cmdName; /* Sub command. */
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashSearch hSearch; /* Search variable. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* The actual channel. */
- Tcl_Channel chan; /* The opaque type. */
- size_t len; /* Length of subcommand string. */
- int IOQueued; /* How much IO is queued inside channel? */
- ChannelBuffer *bufPtr; /* For iterating over queued IO. */
- char buf[TCL_INTEGER_SPACE];/* For sprintf. */
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " subcommand ?additional args..?\"", (char *) NULL);
- return TCL_ERROR;
- }
- cmdName = argv[1];
- len = strlen(cmdName);
-
- chanPtr = (Channel *) NULL;
-
- if (argc > 2) {
- chan = Tcl_GetChannel(interp, argv[2], NULL);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
- }
- chanPtr = (Channel *) chan;
- }
-
-
- if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " info channelName\"", (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendElement(interp, argv[2]);
- Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- Tcl_AppendElement(interp, "nonblocking");
- } else {
- Tcl_AppendElement(interp, "blocking");
- }
- if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
- Tcl_AppendElement(interp, "line");
- } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
- Tcl_AppendElement(interp, "none");
- } else {
- Tcl_AppendElement(interp, "full");
- }
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
- Tcl_AppendElement(interp, "async_flush");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_EOF) {
- Tcl_AppendElement(interp, "eof");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- Tcl_AppendElement(interp, "blocked");
- } else {
- Tcl_AppendElement(interp, "unblocked");
- }
- if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- if (chanPtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "saw_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- Tcl_AppendElement(interp, "");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- Tcl_AppendElement(interp, "");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- if (chanPtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "queued_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- }
- if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- }
- for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- IOQueued = 0;
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- IOQueued = chanPtr->curOutPtr->nextAdded -
- chanPtr->curOutPtr->nextRemoved;
- }
- for (bufPtr = chanPtr->outQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, chanPtr->refCount);
- Tcl_AppendElement(interp, buf);
-
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'i') &&
- (strncmp(cmdName, "inputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'o') &&
- (strncmp(cmdName, "outputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- IOQueued = 0;
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- IOQueued = chanPtr->curOutPtr->nextAdded -
- chanPtr->curOutPtr->nextRemoved;
- }
- for (bufPtr = chanPtr->outQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'q') &&
- (strncmp(cmdName, "queuedcr", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- Tcl_AppendResult(interp,
- (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
- (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- TclFormatInt(buf, chanPtr->refCount);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
- }
-
- Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
- "info, open, readable, or writable",
- (char *) NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclTestChannelEventCmd --
- *
- * This procedure implements the "testchannelevent" command. It is
- * used to test the Tcl channel event mechanism. It is present in
- * this file instead of tclTest.c because it needs access to the
- * internal structure of the channel.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Creates, deletes and returns channel event handlers.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-TclTestChannelEventCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
- Tcl_Obj *resultListPtr;
- Channel *chanPtr;
- EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
- char *cmd;
- int index, i, mask, len;
-
- if ((argc < 3) || (argc > 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
- return TCL_ERROR;
- }
- chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
- if (chanPtr == (Channel *) NULL) {
- return TCL_ERROR;
- }
- cmd = argv[2];
- len = strlen(cmd);
- if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName add eventSpec script\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (strcmp(argv[3], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[3], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[3], "none") == 0) {
- mask = 0;
- } else {
- Tcl_AppendResult(interp, "bad event name \"", argv[3],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
-
- esPtr = (EventScriptRecord *) ckalloc((unsigned)
- sizeof(EventScriptRecord));
- esPtr->nextPtr = chanPtr->scriptRecordPtr;
- chanPtr->scriptRecordPtr = esPtr;
-
- esPtr->chanPtr = chanPtr;
- esPtr->interp = interp;
- esPtr->mask = mask;
- esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
- Tcl_IncrRefCount(esPtr->scriptPtr);
-
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
-
- return TCL_OK;
- }
-
- if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = chanPtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
- i++, esPtr = esPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
- if (esPtr == chanPtr->scriptRecordPtr) {
- chanPtr->scriptRecordPtr = esPtr->nextPtr;
- } else {
- for (prevEsPtr = chanPtr->scriptRecordPtr;
- (prevEsPtr != (EventScriptRecord *) NULL) &&
- (prevEsPtr->nextPtr != esPtr);
- prevEsPtr = prevEsPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (prevEsPtr == (EventScriptRecord *) NULL) {
- panic("TclTestChannelEventCmd: damaged event script list");
- }
- prevEsPtr->nextPtr = esPtr->nextPtr;
- }
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
-
- return TCL_OK;
- }
-
- if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName list\"", (char *) NULL);
- return TCL_ERROR;
- }
- resultListPtr = Tcl_GetObjResult(interp);
- for (esPtr = chanPtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = esPtr->nextPtr) {
- if (esPtr->mask) {
- Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
- } else {
- Tcl_ListObjAppendElement(interp, resultListPtr,
- Tcl_NewStringObj("none", -1));
- }
- Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
- }
- Tcl_SetObjResult(interp, resultListPtr);
- return TCL_OK;
- }
-
- if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName removeall\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (esPtr = chanPtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = nextEsPtr) {
- nextEsPtr = esPtr->nextPtr;
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
- }
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- return TCL_OK;
- }
-
- if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index event\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = chanPtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
- i++, esPtr = esPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[4], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[4], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[4], "none") == 0) {
- mask = 0;
- } else {
- Tcl_AppendResult(interp, "bad event name \"", argv[4],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
- esPtr->mask = mask;
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- return TCL_OK;
- }
- Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
- "add, delete, list, set, or removeall", (char *) NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclCopyChannel --
*
* This routine copies data from one channel to another, either
@@ -7422,23 +6839,27 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
{
Channel *inPtr = (Channel *) inChan;
Channel *outPtr = (Channel *) outChan;
+ ChannelState *inStatePtr, *outStatePtr;
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
- if (inPtr->csPtr) {
+ inStatePtr = inPtr->state;
+ outStatePtr = outPtr->state;
+
+ if (inStatePtr->csPtr) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetChannelName(inChan), "\" is busy", NULL);
return TCL_ERROR;
}
- if (outPtr->csPtr) {
+ if (outStatePtr->csPtr) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetChannelName(outChan), "\" is busy", NULL);
return TCL_ERROR;
}
- readFlags = inPtr->flags;
- writeFlags = outPtr->flags;
+ readFlags = inStatePtr->flags;
+ writeFlags = outStatePtr->flags;
/*
* Set up the blocking mode appropriately. Background copies need
@@ -7472,7 +6893,7 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
* Make sure the output side is unbuffered.
*/
- outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
+ outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
| CHANNEL_UNBUFFERED;
/*
@@ -7481,21 +6902,21 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
* completed.
*/
- csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
- csPtr->bufSize = inPtr->bufSize;
- csPtr->readPtr = inPtr;
- csPtr->writePtr = outPtr;
- csPtr->readFlags = readFlags;
+ csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
+ csPtr->bufSize = inStatePtr->bufSize;
+ csPtr->readPtr = inPtr;
+ csPtr->writePtr = outPtr;
+ csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
- csPtr->toRead = toRead;
- csPtr->total = 0;
- csPtr->interp = interp;
+ csPtr->toRead = toRead;
+ csPtr->total = 0;
+ csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
}
csPtr->cmdPtr = cmdPtr;
- inPtr->csPtr = csPtr;
- outPtr->csPtr = csPtr;
+ inStatePtr->csPtr = csPtr;
+ outStatePtr->csPtr = csPtr;
/*
* Start copying data between the channels.
@@ -7529,17 +6950,24 @@ CopyData(csPtr, mask)
Tcl_Interp *interp;
Tcl_Obj *cmdPtr, *errObj = NULL;
Tcl_Channel inChan, outChan;
+ ChannelState *inStatePtr, *outStatePtr;
int result = TCL_OK;
int size;
int total;
- inChan = (Tcl_Channel)csPtr->readPtr;
- outChan = (Tcl_Channel)csPtr->writePtr;
- interp = csPtr->interp;
- cmdPtr = csPtr->cmdPtr;
+ inChan = (Tcl_Channel) csPtr->readPtr;
+ outChan = (Tcl_Channel) csPtr->writePtr;
+ inStatePtr = csPtr->readPtr->state;
+ outStatePtr = csPtr->writePtr->state;
+ interp = csPtr->interp;
+ cmdPtr = csPtr->cmdPtr;
/*
* Copy the data the slow way, using the translation mechanism.
+ *
+ * Note: We have make sure that we use the topmost channel in a stack
+ * for the copying. The caller uses Tcl_GetChannel to access it, and
+ * thus gets the bottom of the stack.
*/
while (csPtr->toRead != 0) {
@@ -7548,14 +6976,14 @@ CopyData(csPtr, mask)
* Check for unreported background errors.
*/
- if (csPtr->readPtr->unreportedError != 0) {
- Tcl_SetErrno(csPtr->readPtr->unreportedError);
- csPtr->readPtr->unreportedError = 0;
+ if (inStatePtr->unreportedError != 0) {
+ Tcl_SetErrno(inStatePtr->unreportedError);
+ inStatePtr->unreportedError = 0;
goto readError;
}
- if (csPtr->writePtr->unreportedError != 0) {
- Tcl_SetErrno(csPtr->writePtr->unreportedError);
- csPtr->writePtr->unreportedError = 0;
+ if (outStatePtr->unreportedError != 0) {
+ Tcl_SetErrno(outStatePtr->unreportedError);
+ outStatePtr->unreportedError = 0;
goto writeError;
}
@@ -7563,13 +6991,12 @@ CopyData(csPtr, mask)
* Read up to bufSize bytes.
*/
- if ((csPtr->toRead == -1)
- || (csPtr->toRead > csPtr->bufSize)) {
+ if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
size = csPtr->bufSize;
} else {
size = csPtr->toRead;
}
- size = DoRead(csPtr->readPtr, csPtr->buffer, size);
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, size);
if (size < 0) {
readError:
@@ -7602,7 +7029,7 @@ CopyData(csPtr, mask)
* Now write the buffer out.
*/
- size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
+ size = DoWrite(outStatePtr->topChanPtr, csPtr->buffer, size);
if (size < 0) {
writeError:
errObj = Tcl_NewObj();
@@ -7617,7 +7044,7 @@ CopyData(csPtr, mask)
* stop copying and wait for the channel to become writable again.
*/
- if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (outStatePtr->flags & BG_FLUSH_SCHEDULED) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc,
@@ -7721,35 +7148,36 @@ DoRead(chanPtr, bufPtr, toRead)
char *bufPtr; /* Where to store input read. */
int toRead; /* Maximum number of bytes to read. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
int copied; /* How many characters were copied into
* the result string? */
int copiedNow; /* How many characters were copied from
* the current input buffer? */
int result; /* Of calling GetInput. */
-
+
/*
* If we have not encountered a sticky EOF, clear the EOF bit. Either
* way clear the BLOCKED bit. We want to discover these anew during
* each operation.
*/
- if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
- chanPtr->flags &= ~CHANNEL_EOF;
+ if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
+ statePtr->flags &= ~CHANNEL_EOF;
}
- chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
+ copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
toRead - copied);
if (copiedNow == 0) {
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (statePtr->flags & CHANNEL_EOF) {
goto done;
}
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
goto done;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
}
result = GetInput(chanPtr);
if (result != 0) {
@@ -7761,7 +7189,7 @@ DoRead(chanPtr, bufPtr, toRead)
}
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
done:
/*
@@ -7793,17 +7221,17 @@ DoRead(chanPtr, bufPtr, toRead)
*/
static int
-CopyAndTranslateBuffer(chanPtr, result, space)
- Channel *chanPtr; /* The channel from which to read input. */
+CopyAndTranslateBuffer(statePtr, result, space)
+ ChannelState *statePtr; /* Channel state from which to read input. */
char *result; /* Where to store the copied input. */
int space; /* How many bytes are available in result
* to store the copied input? */
{
+ ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
int bytesInBuffer; /* How many bytes are available to be
* copied in the current input buffer? */
int copied; /* How many characters were already copied
* into the destination space? */
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
int i; /* Iterates over the copied input looking
* for the input eofChar. */
@@ -7814,14 +7242,14 @@ CopyAndTranslateBuffer(chanPtr, result, space)
* Note also that if the buffer is empty, we leave it in the queue.
*/
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
return 0;
}
- bufPtr = chanPtr->inQueueHead;
+ bufPtr = statePtr->inQueueHead;
bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
copied = 0;
- switch (chanPtr->inputTranslation) {
+ switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF: {
if (bytesInBuffer == 0) {
return 0;
@@ -7878,10 +7306,10 @@ CopyAndTranslateBuffer(chanPtr, result, space)
*/
if (bytesInBuffer == 0) {
- if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
+ if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
(INPUT_SAW_CR | CHANNEL_EOF)) {
result[0] = '\r';
- chanPtr->flags &= ~INPUT_SAW_CR;
+ statePtr->flags &= ~INPUT_SAW_CR;
return 1;
}
return 0;
@@ -7906,14 +7334,14 @@ CopyAndTranslateBuffer(chanPtr, result, space)
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == '\n') {
- chanPtr->flags &= ~INPUT_SAW_CR;
- } else if (chanPtr->flags & INPUT_SAW_CR) {
- chanPtr->flags &= ~INPUT_SAW_CR;
+ statePtr->flags &= ~INPUT_SAW_CR;
+ } else if (statePtr->flags & INPUT_SAW_CR) {
+ statePtr->flags &= ~INPUT_SAW_CR;
*dst = '\r';
dst++;
}
if (curByte == '\r') {
- chanPtr->flags |= INPUT_SAW_CR;
+ statePtr->flags |= INPUT_SAW_CR;
} else {
*dst = (char) curByte;
dst++;
@@ -7949,16 +7377,16 @@ CopyAndTranslateBuffer(chanPtr, result, space)
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == '\r') {
- chanPtr->flags |= INPUT_SAW_CR;
+ statePtr->flags |= INPUT_SAW_CR;
*dst = '\n';
dst++;
} else {
if ((curByte != '\n') ||
- !(chanPtr->flags & INPUT_SAW_CR)) {
+ !(statePtr->flags & INPUT_SAW_CR)) {
*dst = (char) curByte;
dst++;
}
- chanPtr->flags &= ~INPUT_SAW_CR;
+ statePtr->flags &= ~INPUT_SAW_CR;
}
}
copied = dst - result;
@@ -7975,16 +7403,16 @@ CopyAndTranslateBuffer(chanPtr, result, space)
* copy only up to and excluding that character.
*/
- if (chanPtr->inEofChar != 0) {
+ if (statePtr->inEofChar != 0) {
for (i = 0; i < copied; i++) {
- if (result[i] == (char) chanPtr->inEofChar) {
+ if (result[i] == (char) statePtr->inEofChar) {
/*
* Set sticky EOF so that no further input is presented
* to the caller.
*/
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
copied = i;
break;
}
@@ -7996,17 +7424,109 @@ CopyAndTranslateBuffer(chanPtr, result, space)
*/
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ statePtr->inQueueHead = bufPtr->nextPtr;
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ }
+ RecycleBuffer(statePtr, bufPtr, 0);
+ }
+
+ /*
+ * Return the number of characters copied into the result buffer.
+ * This may be different from the number of bytes consumed, because
+ * of EOL translations.
+ */
+
+ return copied;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyBuffer --
+ *
+ * Copy at most one buffer of input to the result space.
+ *
+ * Results:
+ * Number of bytes stored in the result buffer. May return
+ * zero if no input is available.
+ *
+ * Side effects:
+ * Consumes buffered input. May deallocate one buffer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyBuffer(chanPtr, result, space)
+ Channel *chanPtr; /* Channel from which to read input. */
+ char *result; /* Where to store the copied input. */
+ int space; /* How many bytes are available in result
+ * to store the copied input? */
+{
+ ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
+ int bytesInBuffer; /* How many bytes are available to be
+ * copied in the current input buffer? */
+ int copied; /* How many characters were already copied
+ * into the destination space? */
+
+ /*
+ * If there is no input at all, return zero. The invariant is that
+ * either there is no buffer in the queue, or if the first buffer
+ * is empty, it is also the last buffer (and thus there is no
+ * input in the queue). Note also that if the buffer is empty, we
+ * don't leave it in the queue, but recycle it.
+ */
+
+ if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ return 0;
+ }
+ bufPtr = chanPtr->inQueueHead;
+ bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ copied = 0;
+
+ if (bytesInBuffer == 0) {
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+ return 0;
+ }
+
+ /*
+ * Copy the current chunk into the result buffer.
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (size_t) space);
+ bufPtr->nextRemoved += space;
+ copied = space;
+
+ /*
+ * We don't care about in-stream EOF characters here as the data
+ * read here may still flow through one or more transformations,
+ * i.e. is not in its final state yet.
+ */
+
+ /*
+ * If the current buffer is empty recycle it.
+ */
+
+ if (bufPtr->nextRemoved == bufPtr->nextAdded) {
chanPtr->inQueueHead = bufPtr->nextPtr;
if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
chanPtr->inQueueTail = (ChannelBuffer *) NULL;
}
- RecycleBuffer(chanPtr, bufPtr, 0);
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
}
/*
* Return the number of characters copied into the result buffer.
- * This may be different from the number of bytes consumed, because
- * of EOL translations.
*/
return copied;
@@ -8039,6 +7559,7 @@ DoWrite(chanPtr, src, srcLen)
char *src; /* Data to write. */
int srcLen; /* Number of bytes to write. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *outBufPtr; /* Current output buffer. */
int foundNewline; /* Did we find a newline in output? */
char *dPtr;
@@ -8078,11 +7599,11 @@ DoWrite(chanPtr, src, srcLen)
* Make sure there is a current output buffer to accept output.
*/
- if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
- chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
+ if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+ statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
}
- outBufPtr = chanPtr->curOutPtr;
+ outBufPtr = statePtr->curOutPtr;
destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
if (destCopied > srcLen) {
@@ -8090,7 +7611,7 @@ DoWrite(chanPtr, src, srcLen)
}
destPtr = outBufPtr->buf + outBufPtr->nextAdded;
- switch (chanPtr->outputTranslation) {
+ switch (statePtr->outputTranslation) {
case TCL_TRANSLATE_LF:
srcCopied = destCopied;
memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
@@ -8135,10 +7656,10 @@ DoWrite(chanPtr, src, srcLen)
*/
outBufPtr->nextAdded += destCopied;
- if (!(chanPtr->flags & BUFFER_READY)) {
+ if (!(statePtr->flags & BUFFER_READY)) {
if (outBufPtr->nextAdded == outBufPtr->bufLength) {
- chanPtr->flags |= BUFFER_READY;
- } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
for (sPtr = src, i = 0, foundNewline = 0;
(i < srcCopied) && (!foundNewline);
i++, sPtr++) {
@@ -8148,10 +7669,10 @@ DoWrite(chanPtr, src, srcLen)
}
}
if (foundNewline) {
- chanPtr->flags |= BUFFER_READY;
+ statePtr->flags |= BUFFER_READY;
}
- } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
- chanPtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
}
}
@@ -8159,7 +7680,7 @@ DoWrite(chanPtr, src, srcLen)
src += srcCopied;
srcLen -= srcCopied;
- if (chanPtr->flags & BUFFER_READY) {
+ if (statePtr->flags & BUFFER_READY) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -8216,31 +7737,34 @@ static void
StopCopy(csPtr)
CopyState *csPtr; /* State for bg copy to stop . */
{
+ ChannelState *inStatePtr, *outStatePtr;
int nonBlocking;
if (!csPtr) {
return;
}
+ inStatePtr = csPtr->readPtr->state;
+ outStatePtr = csPtr->writePtr->state;
+
/*
* Restore the old blocking mode and output buffering mode.
*/
nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
- if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
+ if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->readPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
- if (csPtr->writePtr != csPtr->writePtr) {
- if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
+ if (csPtr->readPtr != csPtr->writePtr) {
+ if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
}
- csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
- csPtr->writePtr->flags |=
+ outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+ outStatePtr->flags |=
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
-
if (csPtr->cmdPtr) {
Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
@@ -8251,14 +7775,60 @@ StopCopy(csPtr)
}
Tcl_DecrRefCount(csPtr->cmdPtr);
}
- csPtr->readPtr->csPtr = NULL;
- csPtr->writePtr->csPtr = NULL;
+ inStatePtr->csPtr = NULL;
+ outStatePtr->csPtr = NULL;
ckfree((char*) csPtr);
}
/*
*----------------------------------------------------------------------
*
+ * StackSetBlockMode --
+ *
+ * This function sets the blocking mode for a channel, iterating
+ * through each channel in a stack and updates the state flags.
+ *
+ * Results:
+ * 0 if OK, result code from failed blockModeProc otherwise.
+ *
+ * Side effects:
+ * Modifies the blocking mode of the channel and possibly generates
+ * an error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StackSetBlockMode(chanPtr, mode)
+ Channel *chanPtr; /* Channel to modify. */
+ int mode; /* One of TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ int result = 0;
+ Tcl_DriverBlockModeProc *blockModeProc;
+
+ /*
+ * Start at the top of the channel stack
+ */
+
+ chanPtr = chanPtr->state->topChanPtr;
+ while (chanPtr != (Channel *) NULL) {
+ blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
+ if (blockModeProc != NULL) {
+ result = (*blockModeProc) (chanPtr->instanceData, mode);
+ if (result != 0) {
+ Tcl_SetErrno(result);
+ return result;
+ }
+ }
+ chanPtr = chanPtr->downChanPtr;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SetBlockMode --
*
* This function sets the blocking mode for a channel and updates
@@ -8281,13 +7851,11 @@ SetBlockMode(interp, chanPtr, mode)
int mode; /* One of TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
int result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- mode);
- }
+
+ result = StackSetBlockMode(chanPtr, mode);
if (result != 0) {
- Tcl_SetErrno(result);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "error setting blocking mode: ",
Tcl_PosixError(interp), (char *) NULL);
@@ -8295,9 +7863,9 @@ SetBlockMode(interp, chanPtr, mode)
return TCL_ERROR;
}
if (mode == TCL_MODE_BLOCKING) {
- chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+ statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
} else {
- chanPtr->flags |= CHANNEL_NONBLOCKING;
+ statePtr->flags |= CHANNEL_NONBLOCKING;
}
return TCL_OK;
}
@@ -8348,23 +7916,23 @@ Tcl_GetChannelNamesEx(interp, pattern)
Tcl_Interp *interp; /* Interp for error reporting. */
char *pattern; /* pattern to filter on. */
{
- Channel *chanPtr;
+ ChannelState *statePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
char *name;
Tcl_Obj *resultPtr;
resultPtr = Tcl_GetObjResult(interp);
- for (chanPtr = tsdPtr->firstChanPtr;
- chanPtr != NULL;
- chanPtr = chanPtr->nextChanPtr) {
- if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
+ for (statePtr = tsdPtr->firstCSPtr;
+ statePtr != NULL;
+ statePtr = statePtr->nextCSPtr) {
+ if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
name = "stdin";
- } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
name = "stdout";
- } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
name = "stderr";
} else {
- name = chanPtr->channelName;
+ name = statePtr->channelName;
}
if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
(Tcl_ListObjAppendElement(interp, resultPtr,
@@ -8374,3 +7942,337 @@ Tcl_GetChannelNamesEx(interp, pattern)
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelName --
+ *
+ * Return the name of the channel type.
+ *
+ * Results:
+ * A pointer the name of the channel type.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ChannelName(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->typeName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelVersion --
+ *
+ * Return the of version of the channel type.
+ *
+ * Results:
+ * TCL_CHANNEL_VERSION_2 or TCL_CHANNEL_VERSION_1.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ChannelTypeVersion
+Tcl_ChannelVersion(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
+ return TCL_CHANNEL_VERSION_2;
+ } else {
+ /*
+ * In <v2 channel versions, the version field is occupied
+ * by the Tcl_DriverBlockModeProc
+ */
+ return TCL_CHANNEL_VERSION_1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelBlockModeProc --
+ *
+ * Return the Tcl_DriverBlockModeProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * 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);
+ } else {
+ return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelCloseProc --
+ *
+ * Return the Tcl_DriverCloseProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverCloseProc *
+Tcl_ChannelCloseProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->closeProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelClose2Proc --
+ *
+ * Return the Tcl_DriverClose2Proc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverClose2Proc *
+Tcl_ChannelClose2Proc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->close2Proc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelInputProc --
+ *
+ * Return the Tcl_DriverInputProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverInputProc *
+Tcl_ChannelInputProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->inputProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelOutputProc --
+ *
+ * Return the Tcl_DriverOutputProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverOutputProc *
+Tcl_ChannelOutputProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->outputProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelSeekProc --
+ *
+ * Return the Tcl_DriverSeekProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverSeekProc *
+Tcl_ChannelSeekProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->seekProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelSetOptionProc --
+ *
+ * Return the Tcl_DriverSetOptionProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverSetOptionProc *
+Tcl_ChannelSetOptionProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->setOptionProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelGetOptionProc --
+ *
+ * Return the Tcl_DriverGetOptionProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverGetOptionProc *
+Tcl_ChannelGetOptionProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->getOptionProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelWatchProc --
+ *
+ * Return the Tcl_DriverWatchProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverWatchProc *
+Tcl_ChannelWatchProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->watchProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelGetHandleProc --
+ *
+ * Return the Tcl_DriverGetHandleProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverGetHandleProc *
+Tcl_ChannelGetHandleProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->getHandleProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelFlushProc --
+ *
+ * Return the Tcl_DriverFlushProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverFlushProc *
+Tcl_ChannelFlushProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->flushProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelHandlerProc --
+ *
+ * Return the Tcl_DriverHandlerProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverHandlerProc *
+Tcl_ChannelHandlerProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->handlerProc);
+}
diff --git a/generic/tclIO.h b/generic/tclIO.h
new file mode 100644
index 0000000..29d7b15
--- /dev/null
+++ b/generic/tclIO.h
@@ -0,0 +1,379 @@
+/*
+ * tclIO.h --
+ *
+ * This file provides the generic portions (those that are the same on
+ * all platforms and for all channel types) of Tcl's IO facilities.
+ *
+ * Copyright (c) 1998-2000 Ajuba Solutions
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclIO.h,v 1.1.4.1 2000/07/27 01:39:17 hobbs Exp $
+ */
+
+/*
+ * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
+ * compile on systems where neither is defined. We want both defined so
+ * that we can test safely for both. In the code we still have to test for
+ * both because there may be systems on which both are defined and have
+ * different values.
+ */
+
+#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
+# define EWOULDBLOCK EAGAIN
+#endif
+#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
+# define EAGAIN EWOULDBLOCK
+#endif
+#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
+error one of EWOULDBLOCK or EAGAIN must be defined
+#endif
+
+/*
+ * The following structure encapsulates the state for a background channel
+ * copy. Note that the data buffer for the copy will be appended to this
+ * structure.
+ */
+
+typedef struct CopyState {
+ struct Channel *readPtr; /* Pointer to input channel. */
+ struct Channel *writePtr; /* Pointer to output channel. */
+ int readFlags; /* Original read channel flags. */
+ int writeFlags; /* Original write channel flags. */
+ int toRead; /* Number of bytes to copy, or -1. */
+ int total; /* Total bytes transferred (written). */
+ Tcl_Interp *interp; /* Interp that started the copy. */
+ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
+ int bufSize; /* Size of appended buffer. */
+ char buffer[1]; /* Copy buffer, this must be the last
+ * field. */
+} CopyState;
+
+/*
+ * struct ChannelBuffer:
+ *
+ * Buffers data being sent to or from a channel.
+ */
+
+typedef struct ChannelBuffer {
+ int nextAdded; /* The next position into which a character
+ * will be put in the buffer. */
+ int nextRemoved; /* Position of next byte to be removed
+ * from the buffer. */
+ int bufLength; /* How big is the buffer? */
+ struct ChannelBuffer *nextPtr;
+ /* Next buffer in chain. */
+ char buf[4]; /* Placeholder for real buffer. The real
+ * buffer occuppies this space + bufSize-4
+ * bytes. This must be the last field in
+ * the structure. */
+} ChannelBuffer;
+
+#define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
+
+/*
+ * How much extra space to allocate in buffer to hold bytes from previous
+ * buffer (when converting to UTF-8) or to hold bytes that will go to
+ * next buffer (when converting from UTF-8).
+ */
+
+#define BUFFER_PADDING 16
+
+/*
+ * The following defines the *default* buffer size for channels.
+ */
+
+#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
+
+/*
+ * Structure to record a close callback. One such record exists for
+ * each close callback registered for a channel.
+ */
+
+typedef struct CloseCallback {
+ Tcl_CloseProc *proc; /* The procedure to call. */
+ ClientData clientData; /* Arbitrary one-word data to pass
+ * to the callback. */
+ struct CloseCallback *nextPtr; /* For chaining close callbacks. */
+} CloseCallback;
+
+/*
+ * The following structure describes the information saved from a call to
+ * "fileevent". This is used later when the event being waited for to
+ * invoke the saved script in the interpreter designed in this record.
+ */
+
+typedef struct EventScriptRecord {
+ struct Channel *chanPtr; /* The channel for which this script is
+ * registered. This is used only when an
+ * error occurs during evaluation of the
+ * script, to delete the handler. */
+ Tcl_Obj *scriptPtr; /* Script to invoke. */
+ Tcl_Interp *interp; /* In what interpreter to invoke script? */
+ int mask; /* Events must overlap current mask for the
+ * stored script to be invoked. */
+ struct EventScriptRecord *nextPtr;
+ /* Next in chain of records. */
+} EventScriptRecord;
+
+/*
+ * struct Channel:
+ *
+ * One of these structures is allocated for each open channel. It contains data
+ * specific to the channel but which belongs to the generic part of the Tcl
+ * channel mechanism, and it points at an instance specific (and type
+ * specific) * instance data, and at a channel type structure.
+ */
+
+typedef struct Channel {
+ struct ChannelState *state; /* Split out state information */
+
+ ClientData instanceData; /* Instance-specific data provided by
+ * creator of channel. */
+ Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
+
+ struct Channel *downChanPtr;/* Refers to channel this one was stacked
+ * upon. This reference is NULL for normal
+ * channels. See Tcl_StackChannel. */
+ struct Channel *upChanPtr; /* Refers to the channel above stacked this
+ * one. NULL for the top most channel. */
+
+ /*
+ * Intermediate buffers to hold pre-read data for consumption by a
+ * newly stacked transformation. See 'Tcl_StackChannel'.
+ */
+ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
+ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+} Channel;
+
+/*
+ * struct ChannelState:
+ *
+ * One of these structures is allocated for each open channel. It contains data
+ * specific to the channel but which belongs to the generic part of the Tcl
+ * channel mechanism, and it points at an instance specific (and type
+ * specific) * instance data, and at a channel type structure.
+ */
+
+typedef struct ChannelState {
+ char *channelName; /* The name of the channel instance in Tcl
+ * commands. Storage is owned by the generic IO
+ * code, is dynamically allocated. */
+ int flags; /* ORed combination of the flags defined
+ * below. */
+ Tcl_Encoding encoding; /* Encoding to apply when reading or writing
+ * data on this channel. NULL means no
+ * encoding is applied to data. */
+ Tcl_EncodingState inputEncodingState;
+ /* Current encoding state, used when converting
+ * input data bytes to UTF-8. */
+ int inputEncodingFlags; /* Encoding flags to pass to conversion
+ * routine when converting input data bytes to
+ * UTF-8. May be TCL_ENCODING_START before
+ * converting first byte and TCL_ENCODING_END
+ * when EOF is seen. */
+ Tcl_EncodingState outputEncodingState;
+ /* Current encoding state, used when converting
+ * UTF-8 to output data bytes. */
+ int outputEncodingFlags; /* Encoding flags to pass to conversion
+ * routine when converting UTF-8 to output
+ * data bytes. May be TCL_ENCODING_START
+ * before converting first byte and
+ * TCL_ENCODING_END when EOF is seen. */
+ Tcl_EolTranslation inputTranslation;
+ /* What translation to apply for end of line
+ * sequences on input? */
+ Tcl_EolTranslation outputTranslation;
+ /* What translation to use for generating
+ * end of line sequences in output? */
+ int inEofChar; /* If nonzero, use this as a signal of EOF
+ * on input. */
+ int outEofChar; /* If nonzero, append this to the channel
+ * when it is closed if it is open for
+ * writing. */
+ int unreportedError; /* Non-zero if an error report was deferred
+ * because it happened in the background. The
+ * value is the POSIX error code. */
+ int refCount; /* How many interpreters hold references to
+ * this IO channel? */
+
+ CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
+ * channel is closed. */
+ char *outputStage; /* Temporary staging buffer used when
+ * translating EOL before converting from
+ * UTF-8 to external form. */
+ ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
+ ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
+ ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
+
+ ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
+ * need to allocate a new buffer for "gets"
+ * that crosses buffer boundaries. */
+ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
+ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+
+ struct ChannelHandler *chPtr;/* List of channel handlers registered
+ * for this channel. */
+ int interestMask; /* Mask of all events this channel has
+ * handlers for. */
+ EventScriptRecord *scriptRecordPtr;
+ /* Chain of all scripts registered for
+ * event handlers ("fileevent") on this
+ * channel. */
+
+ int bufSize; /* What size buffers to allocate? */
+ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
+ CopyState *csPtr; /* State of background copy, or NULL. */
+ Channel *topChanPtr; /* Refers to topmost channel in a stack.
+ * Never NULL. */
+ Channel *bottomChanPtr; /* Refers to bottommost channel in a stack.
+ * This channel can be relied on to live as
+ * long as the channel state. Never NULL. */
+ struct ChannelState *nextCSPtr;
+ /* Next in list of channels currently open. */
+} ChannelState;
+
+/*
+ * Values for the flags field in Channel. Any ORed combination of the
+ * following flags can be stored in the field. These flags record various
+ * options and state bits about the channel. In addition to the flags below,
+ * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
+ */
+
+#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
+ * nonblocking mode. */
+#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
+ * flushed after every newline. */
+#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
+ * be flushed immediately. */
+#define BUFFER_READY (1<<6) /* Current output buffer (the
+ * curOutPtr field in the
+ * channel structure) should be
+ * output as soon as possible even
+ * though it may not be full. */
+#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
+ * queued output buffers has been
+ * scheduled. */
+#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
+ * further Tcl-level IO on the
+ * channel is allowed. */
+#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
+ * This bit is cleared before every
+ * input operation. */
+#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
+ * we saw the input eofChar. This bit
+ * prevents clearing of the EOF bit
+ * before every input operation. */
+#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
+ * on this channel. This bit is
+ * cleared before every input or
+ * output operation. */
+#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
+ * translation mode and the last
+ * byte seen was a "\r". */
+#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
+ * and there should be a '\n' at
+ * beginning of next buffer. */
+#define CHANNEL_DEAD (1<<13) /* The channel has been closed by
+ * the exit handler (on exit) but
+ * not deallocated. When any IO
+ * operation sees this flag on a
+ * channel, it does not call driver
+ * level functions to avoid referring
+ * to deallocated data. */
+#define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
+ * because there was not enough data
+ * to complete the operation. This
+ * flag is set when gets fails to
+ * get a complete line or when read
+ * fails to get a complete character.
+ * When set, file events will not be
+ * delivered for buffered data until
+ * the state of the channel changes. */
+#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
+ * being used. */
+
+/*
+ * For each channel handler registered in a call to Tcl_CreateChannelHandler,
+ * there is one record of the following type. All of records for a specific
+ * channel are chained together in a singly linked list which is stored in
+ * the channel structure.
+ */
+
+typedef struct ChannelHandler {
+ Channel *chanPtr; /* The channel structure for this channel. */
+ int mask; /* Mask of desired events. */
+ Tcl_ChannelProc *proc; /* Procedure to call in the type of
+ * Tcl_CreateChannelHandler. */
+ ClientData clientData; /* Argument to pass to procedure. */
+ struct ChannelHandler *nextPtr;
+ /* Next one in list of registered handlers. */
+} ChannelHandler;
+
+/*
+ * This structure keeps track of the current ChannelHandler being invoked in
+ * the current invocation of ChannelHandlerEventProc. There is a potential
+ * problem if a ChannelHandler is deleted while it is the current one, since
+ * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * problem, structures of the type below indicate the next handler to be
+ * processed for any (recursively nested) dispatches in progress. The
+ * nextHandlerPtr field is updated if the handler being pointed to is deleted.
+ * The nextPtr field is used to chain together all recursive invocations, so
+ * that Tcl_DeleteChannelHandler can find all the recursively nested
+ * invocations of ChannelHandlerEventProc and compare the handler being
+ * deleted against the NEXT handler to be invoked in that invocation; when it
+ * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
+ * field of the structure to the next handler.
+ */
+
+typedef struct NextChannelHandler {
+ ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
+ * this invocation. */
+ struct NextChannelHandler *nestedHandlerPtr;
+ /* Next nested invocation of
+ * ChannelHandlerEventProc. */
+} NextChannelHandler;
+
+
+/*
+ * The following structure describes the event that is added to the Tcl
+ * event queue by the channel handler check procedure.
+ */
+
+typedef struct ChannelHandlerEvent {
+ Tcl_Event header; /* Standard header for all events. */
+ Channel *chanPtr; /* The channel that is ready. */
+ int readyMask; /* Events that have occurred. */
+} ChannelHandlerEvent;
+
+/*
+ * The following structure is used by Tcl_GetsObj() to encapsulates the
+ * state for a "gets" operation.
+ */
+
+typedef struct GetsState {
+ Tcl_Obj *objPtr; /* The object to which UTF-8 characters
+ * will be appended. */
+ char **dstPtr; /* Pointer into objPtr's string rep where
+ * next character should be stored. */
+ Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
+ * to UTF-8. */
+ ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
+ * emptied. */
+ Tcl_EncodingState state; /* The encoding state just before the last
+ * external to UTF-8 conversion in
+ * FilterInputBytes(). */
+ int rawRead; /* The number of bytes removed from bufPtr
+ * in the last call to FilterInputBytes(). */
+ int bytesWrote; /* The number of bytes of UTF-8 data
+ * appended to objPtr during the last call to
+ * FilterInputBytes(). */
+ int charsWrote; /* The corresponding number of UTF-8
+ * characters appended to objPtr during the
+ * last call to FilterInputBytes(). */
+ int totalChars; /* The total number of UTF-8 characters
+ * appended to objPtr so far, just before the
+ * last call to FilterInputBytes(). */
+} GetsState;
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
new file mode 100644
index 0000000..5050603
--- /dev/null
+++ b/generic/tclIOGT.c
@@ -0,0 +1,1361 @@
+/*
+ * tclIOGT.c --
+ *
+ * Implements a generic transformation exposing the underlying API
+ * at the script level. Contributed by Andreas Kupries.
+ *
+ * Copyright (c) 2000 Ajuba Solutions
+ * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
+ *
+ * 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.1.4.1 2000/07/27 01:39:18 hobbs Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclIO.h"
+
+
+/*
+ * Forward declarations of internal procedures.
+ * First the driver procedures of the transformation.
+ */
+
+static int TransformBlockModeProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mode));
+static int TransformCloseProc _ANSI_ARGS_ ((
+ ClientData instanceData, Tcl_Interp* interp));
+static int TransformInputProc _ANSI_ARGS_ ((
+ ClientData instanceData,
+ char* buf, int toRead, int* errorCodePtr));
+static int TransformOutputProc _ANSI_ARGS_ ((
+ ClientData instanceData,
+ char* buf, int toWrite, int* errorCodePtr));
+static int TransformSeekProc _ANSI_ARGS_ ((
+ ClientData instanceData, long offset,
+ int mode, int* errorCodePtr));
+static int TransformSetOptionProc _ANSI_ARGS_((
+ ClientData instanceData, Tcl_Interp *interp,
+ char *optionName, char *value));
+static int TransformGetOptionProc _ANSI_ARGS_((
+ ClientData instanceData, Tcl_Interp *interp,
+ char *optionName, Tcl_DString *dsPtr));
+static void TransformWatchProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mask));
+static int TransformGetFileHandleProc _ANSI_ARGS_ ((
+ ClientData instanceData, int direction,
+ ClientData* handlePtr));
+static int TransformNotifyProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mask));
+
+/*
+ * Forward declarations of internal procedures.
+ * Secondly the procedures for handling and generating fileeevents.
+ */
+
+static void TransformChannelHandlerTimer _ANSI_ARGS_ ((
+ ClientData clientData));
+
+/*
+ * Forward declarations of internal procedures.
+ * Third, helper procedures encapsulating essential tasks.
+ */
+
+typedef struct TransformChannelData TransformChannelData;
+
+static int ExecuteCallback _ANSI_ARGS_ ((
+ TransformChannelData* ctrl, Tcl_Interp* interp,
+ unsigned char* op, unsigned char* buf,
+ int bufLen, int transmit, int preserve));
+
+/*
+ * Action codes to give to 'ExecuteCallback' (argument 'transmit')
+ * confering to the procedure what to do with the result of the script
+ * it calls.
+ */
+
+#define TRANSMIT_DONT (0) /* No transfer to do */
+#define TRANSMIT_DOWN (1) /* Transfer to the underlying channel */
+#define TRANSMIT_SELF (2) /* Transfer into our channel. */
+#define TRANSMIT_IBUF (3) /* Transfer to internal input buffer */
+#define TRANSMIT_NUM (4) /* Transfer number to 'maxRead' */
+
+/*
+ * Codes for 'preserve' of 'ExecuteCallback'
+ */
+
+#define P_PRESERVE (1)
+#define P_NO_PRESERVE (0)
+
+/*
+ * Strings for the action codes delivered to the script implementing
+ * a transformation. Argument 'op' of 'ExecuteCallback'.
+ */
+
+#define A_CREATE_WRITE (UCHARP ("create/write"))
+#define A_DELETE_WRITE (UCHARP ("delete/write"))
+#define A_FLUSH_WRITE (UCHARP ("flush/write"))
+#define A_WRITE (UCHARP ("write"))
+
+#define A_CREATE_READ (UCHARP ("create/read"))
+#define A_DELETE_READ (UCHARP ("delete/read"))
+#define A_FLUSH_READ (UCHARP ("flush/read"))
+#define A_READ (UCHARP ("read"))
+
+#define A_QUERY_MAXREAD (UCHARP ("query/maxRead"))
+#define A_CLEAR_READ (UCHARP ("clear/read"))
+
+/*
+ * Management of a simple buffer.
+ */
+
+typedef struct ResultBuffer ResultBuffer;
+
+static void ResultClear _ANSI_ARGS_ ((ResultBuffer* r));
+static void ResultInit _ANSI_ARGS_ ((ResultBuffer* r));
+static int ResultLength _ANSI_ARGS_ ((ResultBuffer* r));
+static int ResultCopy _ANSI_ARGS_ ((ResultBuffer* r,
+ unsigned char* buf, int toRead));
+static void ResultAdd _ANSI_ARGS_ ((ResultBuffer* r,
+ unsigned char* buf, int toWrite));
+
+/*
+ * This structure describes the channel type structure for tcl based
+ * transformations.
+ */
+
+static Tcl_ChannelType transformChannelType = {
+ "transform", /* Type name. */
+ TCL_CHANNEL_VERSION_2,
+ TransformCloseProc, /* Close proc. */
+ TransformInputProc, /* Input proc. */
+ TransformOutputProc, /* Output proc. */
+ TransformSeekProc, /* Seek proc. */
+ TransformSetOptionProc, /* Set option proc. */
+ TransformGetOptionProc, /* Get option proc. */
+ TransformWatchProc, /* Initialize notifier. */
+ TransformGetFileHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc */
+ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
+ NULL, /* Flush proc. */
+ TransformNotifyProc, /* Handling of events bubbling up */
+};
+
+/*
+ * Possible values for 'flags' field in control structure, see below.
+ */
+
+#define CHANNEL_ASYNC (1<<0) /* non-blocking mode */
+
+/*
+ * Definition of the structure containing the information about the
+ * internal input buffer.
+ */
+
+struct ResultBuffer {
+ unsigned char* buf; /* Reference to the buffer area */
+ int allocated; /* Allocated size of the buffer area */
+ int used; /* Number of bytes in the buffer, <= allocated */
+};
+
+/*
+ * Additional bytes to allocate during buffer expansion
+ */
+
+#define INCREMENT (512)
+
+/*
+ * Number of milliseconds to wait before firing an event to flush
+ * out information waiting in buffers (fileevent support).
+ */
+
+#define DELAY (5)
+
+/*
+ * Convenience macro to make some casts easier to use.
+ */
+
+#define UCHARP(x) ((unsigned char*) (x))
+#define NO_INTERP ((Tcl_Interp*) NULL)
+
+/*
+ * Definition of a structure used by all transformations generated here to
+ * maintain their local state.
+ */
+
+struct TransformChannelData {
+
+ /*
+ * General section. Data to integrate the transformation into the channel
+ * system.
+ */
+
+ Tcl_Channel self; /* Our own Channel handle */
+ int readIsFlushed; /* Flag to note wether in.flushProc was called or not
+ */
+ int flags; /* Currently CHANNEL_ASYNC or zero */
+ int watchMask; /* Current watch/event/interest mask */
+ int mode; /* mode of parent channel, OR'ed combination of
+ * TCL_READABLE, TCL_WRITABLE */
+ Tcl_TimerToken timer; /* Timer for automatic flushing of information
+ * sitting in an internal buffer. Required for full
+ * fileevent support */
+ /*
+ * Transformation specific data.
+ */
+
+ int maxRead; /* Maximum allowed number of bytes to read, as
+ * given to us by the tcl script implementing the
+ * transformation. */
+ Tcl_Interp* interp; /* Reference to the interpreter which created the
+ * transformation. Used to execute the code
+ * below. */
+ Tcl_Obj* command; /* Tcl code to execute for a buffer */
+ ResultBuffer result; /* Internal buffer used to store the result of a
+ * transformation of incoming data. Additionally
+ * serves as buffer of all data not yet consumed by
+ * the reader. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChannelTransform --
+ *
+ * Implements the Tcl "testchannel transform" debugging command.
+ * This is part of the testing environment. This sets up a tcl
+ * script (cmdObjPtr) to be used as a transform on the channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclChannelTransform(interp, chan, cmdObjPtr)
+ Tcl_Interp *interp; /* Interpreter for result. */
+ Tcl_Channel chan; /* Channel to transform. */
+ Tcl_Obj *cmdObjPtr; /* Script to use for transform. */
+{
+ Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* state info for channel */
+ int mode; /* rw mode of the channel */
+ TransformChannelData *dataPtr;
+ int res;
+ Tcl_DString ds;
+
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+ chan = (Tcl_Channel) chanPtr;
+ mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+
+ /*
+ * Now initialize the transformation state and stack it upon the
+ * specified channel. One of the necessary things to do is to
+ * retrieve the blocking regime of the underlying channel and to
+ * use the same for us too.
+ */
+
+ dataPtr = (TransformChannelData*) ckalloc(sizeof(TransformChannelData));
+
+ Tcl_DStringInit (&ds);
+ Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
+
+ dataPtr->readIsFlushed = 0;
+ dataPtr->flags = 0;
+
+ if (ds.string[0] == '0') {
+ dataPtr->flags |= CHANNEL_ASYNC;
+ }
+
+ Tcl_DStringFree (&ds);
+
+ dataPtr->self = chan;
+ dataPtr->watchMask = 0;
+ dataPtr->mode = mode;
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ dataPtr->maxRead = 4096; /* Initial value not relevant */
+ dataPtr->interp = interp;
+ dataPtr->command = cmdObjPtr;
+
+ Tcl_IncrRefCount(dataPtr->command);
+
+ ResultInit(&dataPtr->result);
+
+ dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
+ (ClientData) dataPtr, mode, chan);
+ if (dataPtr->self == (Tcl_Channel) NULL) {
+ Tcl_AppendResult(interp, "\nfailed to stack channel \"",
+ Tcl_GetChannelName(chan), "\"", (char *) NULL);
+ goto cleanup;
+ }
+
+ /*
+ * At last initialize the transformation at the script level.
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_WRITE,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ Tcl_UnstackChannel(interp, chan);
+ goto cleanup;
+ }
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_READ,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ ExecuteCallback (dataPtr, NO_INTERP, A_DELETE_WRITE,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ Tcl_UnstackChannel(interp, chan);
+ goto cleanup;
+ }
+ }
+
+ return TCL_OK;
+
+ cleanup:
+ Tcl_DecrRefCount(dataPtr->command);
+ ResultClear(&dataPtr->result);
+ ckfree((VOID *) dataPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ExecuteCallback --
+ *
+ * Executes the defined callback for buffer and
+ * operation.
+ *
+ * Sideeffects:
+ * As of the executed tcl script.
+ *
+ * Result:
+ * A standard TCL error code. In case of an
+ * error a message is left in the result area
+ * of the specified interpreter.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
+ TransformChannelData* dataPtr; /* Transformation with the callback */
+ Tcl_Interp* interp; /* Current interpreter, possibly NULL */
+ unsigned char* op; /* Operation invoking the callback */
+ unsigned char* buf; /* Buffer to give to the script. */
+ int bufLen; /* Ands its length */
+ int transmit; /* Flag, determines whether the result
+ * of the callback is sent to the
+ * underlying channel or not. */
+ int preserve; /* Flag. If true the procedure will
+ * preserver the result state of all
+ * accessed interpreters. */
+{
+ /*
+ * Step 1, create the complete command to execute. Do this by appending
+ * operation and buffer to operate upon to a copy of the callback
+ * definition. We *cannot* create a list containing 3 objects and then use
+ * 'Tcl_EvalObjv', because the command may contain additional prefixed
+ * arguments. Feather's curried commands would come in handy here.
+ */
+
+ Tcl_Obj* resObj; /* See below, switch (transmit) */
+ int resLen;
+ unsigned char* resBuf;
+ Tcl_SavedResult ciSave;
+
+ int res = TCL_OK;
+ Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);
+ Tcl_Obj* temp;
+
+
+ if (preserve) {
+ Tcl_SaveResult (dataPtr->interp, &ciSave);
+ }
+
+ if (command == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ Tcl_IncrRefCount(command);
+
+ temp = Tcl_NewStringObj((char*) op, -1);
+
+ if (temp == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
+
+ if (res != TCL_OK)
+ goto cleanup;
+
+ /*
+ * Use a byte-array to prevent the misinterpretation of binary data
+ * coming through as UTF while at the tcl level.
+ */
+
+ temp = Tcl_NewByteArrayObj(buf, bufLen);
+
+ if (temp == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ res = Tcl_ListObjAppendElement (dataPtr->interp, command, temp);
+
+ if (res != TCL_OK)
+ goto cleanup;
+
+ /*
+ * Step 2, execute the command at the global level of the interpreter
+ * used to create the transformation. Destroy the command afterward.
+ * If an error occured and the current interpreter is defined and not
+ * equal to the interpreter for the callback, then copy the error
+ * message into current interpreter. Don't copy if in preservation mode.
+ */
+
+ res = Tcl_GlobalEvalObj (dataPtr->interp, command);
+ Tcl_DecrRefCount (command);
+ command = (Tcl_Obj*) NULL;
+
+ if ((res != TCL_OK) && (interp != NO_INTERP) &&
+ (dataPtr->interp != interp) && !preserve) {
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ return res;
+ }
+
+ /*
+ * Step 3, transmit a possible conversion result to the underlying
+ * channel, or ourselves.
+ */
+
+ switch (transmit) {
+ case TRANSMIT_DONT:
+ /* nothing to do */
+ break;
+
+ case TRANSMIT_DOWN:
+ resObj = Tcl_GetObjResult(dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),
+ (char*) resBuf, resLen);
+ break;
+
+ case TRANSMIT_SELF:
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(dataPtr->self, (char*) resBuf, resLen);
+ break;
+
+ case TRANSMIT_IBUF:
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ ResultAdd(&dataPtr->result, resBuf, resLen);
+ break;
+
+ case TRANSMIT_NUM:
+ /* Interpret result as integer number */
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ break;
+ }
+
+ Tcl_ResetResult(dataPtr->interp);
+
+ if (preserve) {
+ Tcl_RestoreResult(dataPtr->interp, &ciSave);
+ }
+
+ return res;
+
+ cleanup:
+ if (preserve) {
+ Tcl_RestoreResult(dataPtr->interp, &ciSave);
+ }
+
+ if (command != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount(command);
+ }
+
+ return res;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformBlockModeProc --
+ *
+ * Trap handler. Called by the generic IO system
+ * during option processing to change the blocking
+ * mode of the channel.
+ *
+ * Sideeffects:
+ * Forwards the request to the underlying
+ * channel.
+ *
+ * Result:
+ * 0 if successful, errno when failed.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformBlockModeProc (instanceData, mode)
+ ClientData instanceData; /* State of transformation */
+ int mode; /* New blocking mode */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ dataPtr->flags |= CHANNEL_ASYNC;
+ } else {
+ dataPtr->flags &= ~(CHANNEL_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformCloseProc --
+ *
+ * Trap handler. Called by the generic IO system
+ * during destruction of the transformation channel.
+ *
+ * Sideeffects:
+ * Releases the memory allocated in
+ * 'Tcl_TransformObjCmd'.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformCloseProc (instanceData, interp)
+ ClientData instanceData;
+ Tcl_Interp* interp;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ /*
+ * Important: In this procedure 'dataPtr->self' already points to
+ * the underlying channel.
+ */
+
+ /*
+ * There is no need to cancel an existing channel handler, this is already
+ * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
+ * 'Tcl_Close'.
+ *
+ * But we have to cancel an active timer to prevent it from firing on the
+ * removed channel.
+ */
+
+ if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /*
+ * Now flush data waiting in internal buffers to output and input. The
+ * input must be done despite the fact that there is no real receiver
+ * for it anymore. But the scripts might have sideeffects other parts
+ * of the system rely on (f.e. signaling the close to interested parties).
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,
+ NULL, 0, TRANSMIT_DOWN, 1);
+ }
+
+ if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
+ dataPtr->readIsFlushed = 1;
+ ExecuteCallback (dataPtr, interp, A_FLUSH_READ,
+ NULL, 0, TRANSMIT_IBUF, 1);
+ }
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,
+ NULL, 0, TRANSMIT_DONT, 1);
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback (dataPtr, interp, A_DELETE_READ,
+ NULL, 0, TRANSMIT_DONT, 1);
+ }
+
+ /*
+ * General cleanup
+ */
+
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree((VOID*) dataPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformInputProc --
+ *
+ * Called by the generic IO system to convert read data.
+ *
+ * Sideeffects:
+ * As defined by the conversion.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformInputProc (instanceData, buf, toRead, errorCodePtr)
+ ClientData instanceData;
+ char* buf;
+ int toRead;
+ int* errorCodePtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ int gotBytes, read, res, copied;
+ Tcl_Channel downChan;
+
+ /* should assert (dataPtr->mode & TCL_READABLE) */
+
+ if (toRead == 0) {
+ /* Catch a no-op.
+ */
+ return 0;
+ }
+
+ gotBytes = 0;
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ while (toRead > 0) {
+ /*
+ * Loop until the request is satisfied (or no data is available from
+ * below, possibly EOF).
+ */
+
+ copied = ResultCopy (&dataPtr->result, UCHARP (buf), toRead);
+
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
+
+ if (toRead == 0) {
+ /* The request was completely satisfied from our buffers.
+ * We can break out of the loop and return to the caller.
+ */
+ return gotBytes;
+ }
+
+ /*
+ * Length (dataPtr->result) == 0, toRead > 0 here . Use the incoming
+ * 'buf'! as target to store the intermediary information read
+ * from the underlying channel.
+ *
+ * Ask the tcl level how much data it allows us to read from
+ * the underlying channel. This feature allows the transform to
+ * signal EOF upstream although there is none downstream. Useful
+ * to control an unbounded 'fcopy', either through counting bytes,
+ * or by pattern matching.
+ */
+
+ ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,
+ NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
+
+ if (dataPtr->maxRead >= 0) {
+ if (dataPtr->maxRead < toRead) {
+ toRead = dataPtr->maxRead;
+ }
+ } /* else: 'maxRead < 0' == Accept the current value of toRead */
+
+ if (toRead <= 0) {
+ return gotBytes;
+ }
+
+ read = Tcl_ReadRaw(downChan, buf, toRead);
+
+ if (read < 0) {
+ /* Report errors to caller. EAGAIN is a special situation.
+ * If we had some data before we report that instead of the
+ * request to re-try.
+ */
+
+ if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+ return gotBytes;
+ }
+
+ *errorCodePtr = Tcl_GetErrno();
+ return -1;
+ }
+
+ if (read == 0) {
+ /*
+ * Check wether we hit on EOF in the underlying channel or
+ * not. If not differentiate between blocking and
+ * non-blocking modes. In non-blocking mode we ran
+ * temporarily out of data. Signal this to the caller via
+ * EWOULDBLOCK and error return (-1). In the other cases
+ * we simply return what we got and let the caller wait
+ * for more. On the other hand, if we got an EOF we have
+ * to convert and flush all waiting partial data.
+ */
+
+ if (! Tcl_Eof (downChan)) {
+ if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ } else {
+ return gotBytes;
+ }
+ } else {
+ if (dataPtr->readIsFlushed) {
+ /* Already flushed, nothing to do anymore
+ */
+ return gotBytes;
+ }
+
+ dataPtr->readIsFlushed = 1;
+
+ ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,
+ NULL, 0, TRANSMIT_IBUF, P_PRESERVE);
+
+ if (ResultLength (&dataPtr->result) == 0) {
+ /* we had nothing to flush */
+ return gotBytes;
+ }
+
+ continue; /* at: while (toRead > 0) */
+ }
+ } /* read == 0 */
+
+ /* Transform the read chunk and add the result to our
+ * read buffer (dataPtr->result)
+ */
+
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
+ UCHARP (buf), read, TRANSMIT_IBUF,
+ P_PRESERVE);
+
+ if (res != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+ } /* while toRead > 0 */
+
+ return gotBytes;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformOutputProc --
+ *
+ * Called by the generic IO system to convert data
+ * waiting to be written.
+ *
+ * Sideeffects:
+ * As defined by the transformation.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData;
+ char* buf;
+ int toWrite;
+ int* errorCodePtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ int res;
+
+ /* should assert (dataPtr->mode & TCL_WRITABLE) */
+
+ if (toWrite == 0) {
+ /* Catch a no-op.
+ */
+ return 0;
+ }
+
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,
+ UCHARP (buf), toWrite,
+ TRANSMIT_DOWN, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+
+ return toWrite;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformSeekProc --
+ *
+ * This procedure is called by the generic IO level
+ * to move the access point in a channel.
+ *
+ * Sideeffects:
+ * 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 int
+TransformSeekProc (instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* The channel to manipulate */
+ long offset; /* Size of movement. */
+ int mode; /* How to move */
+ int* errorCodePtr; /* Location of error flag. */
+{
+ int result;
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_ChannelType* parentType = Tcl_GetChannelType(parent);
+ Tcl_DriverSeekProc* parentSeekProc = Tcl_ChannelSeekProc(parentType);
+
+ if ((offset == 0) && (mode == SEEK_CUR)) {
+ /* This is no seek but a request to tell the caller the current
+ * location. Simply pass the request down.
+ */
+
+ result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ offset, mode, errorCodePtr);
+ return result;
+ }
+
+ /*
+ * 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;
+ }
+
+ result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ offset, mode, errorCodePtr);
+ return result;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformSetOptionProc --
+ *
+ * Called by generic layer to handle the reconfi-
+ * guration of channel specific options. As this
+ * channel type does not have such, it simply passes
+ * all requests downstream.
+ *
+ * Sideeffects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformSetOptionProc (instanceData, interp, optionName, value)
+ ClientData instanceData;
+ Tcl_Interp *interp;
+ char *optionName;
+ char *value;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverSetOptionProc *setOptionProc;
+
+ setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
+ if (setOptionProc != NULL) {
+ return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
+ interp, optionName, value);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformGetOptionProc --
+ *
+ * Called by generic layer to handle requests for
+ * the values of channel specific options. As this
+ * channel type does not have such, it simply passes
+ * all requests downstream.
+ *
+ * Sideeffects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
+ ClientData instanceData;
+ Tcl_Interp* interp;
+ char* optionName;
+ Tcl_DString* dsPtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverGetOptionProc *getOptionProc;
+
+ getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
+ if (getOptionProc != NULL) {
+ return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
+ interp, optionName, dsPtr);
+ } else if (optionName == (char*) NULL) {
+ /*
+ * Request is query for all options, this is ok.
+ */
+ return TCL_OK;
+ }
+ /*
+ * Request for a specific option has to fail, we don't have any.
+ */
+ return TCL_ERROR;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformWatchProc --
+ *
+ * Initialize the notifier to watch for events from
+ * this channel.
+ *
+ * Sideeffects:
+ * Sets up the notifier so that a future
+ * event on the channel will be seen by Tcl.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+ /* ARGSUSED */
+static void
+TransformWatchProc (instanceData, mask)
+ ClientData instanceData; /* Channel to watch */
+ int mask; /* Events of interest */
+{
+ /* The caller expressed interest in events occuring for this
+ * channel. We are forwarding the call to the underlying
+ * channel now.
+ */
+
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan;
+
+ dataPtr->watchMask = mask;
+
+ /* No channel handlers any more. We will be notified automatically
+ * about events on the channel below via a call to our
+ * 'TransformNotifyProc'. But we have to pass the interest down now.
+ * We are allowed to add additional 'interest' to the mask if we want
+ * to. But this transformation has no such interest. It just passes
+ * the request down, unchanged.
+ */
+
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ (Tcl_GetChannelType(downChan))
+ ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
+
+ /*
+ * Management of the internal timer.
+ */
+
+ if ((dataPtr->timer != (Tcl_TimerToken) NULL) &&
+ (!(mask & TCL_READABLE) || (ResultLength(&dataPtr->result) == 0))) {
+
+ /* A pending timer exists, but either is there no (more)
+ * interest in the events it generates or nothing is availablee
+ * for reading, so remove it.
+ */
+
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ if ((dataPtr->timer == (Tcl_TimerToken) NULL) &&
+ (mask & TCL_READABLE) && (ResultLength (&dataPtr->result) > 0)) {
+
+ /* There is no pending timer, but there is interest in readable
+ * events and we actually have data waiting, so generate a timer
+ * to flush that.
+ */
+
+ dataPtr->timer = Tcl_CreateTimerHandler (DELAY,
+ TransformChannelHandlerTimer, (ClientData) dataPtr);
+ }
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformGetFileHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve
+ * OS specific file handle from inside this channel.
+ *
+ * Sideeffects:
+ * None.
+ *
+ * Result:
+ * The appropriate Tcl_File or NULL if not
+ * present.
+ *
+ *------------------------------------------------------*
+ */
+static int
+TransformGetFileHandleProc (instanceData, direction, handlePtr)
+ ClientData instanceData; /* Channel to query */
+ int direction; /* Direction of interest */
+ ClientData* handlePtr; /* Place to store the handle into */
+{
+ /*
+ * Return the handle belonging to parent channel.
+ * IOW, pass the request down and the result up.
+ */
+
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
+ direction, handlePtr);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformNotifyProc --
+ *
+ * ------------------------------------------------*
+ * Handler called by Tcl to inform us of activity
+ * on the underlying channel.
+ * ------------------------------------------------*
+ *
+ * Sideeffects:
+ * May process the incoming event by itself.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformNotifyProc (clientData, mask)
+ ClientData clientData; /* The state of the notified transformation */
+ int mask; /* The mask of occuring events */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+
+ /*
+ * An event occured in the underlying channel. This
+ * transformation doesn't process such events thus returns the
+ * incoming mask unchanged.
+ */
+
+ if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+ /*
+ * Delete an existing timer. It was not fired, yet we are
+ * here, so the channel below generated such an event and we
+ * don't have to. The renewal of the interest after the
+ * execution of channel handlers will eventually cause us to
+ * recreate the timer (in TransformWatchProc).
+ */
+
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ return mask;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformChannelHandlerTimer --
+ *
+ * Called by the notifier (-> timer) to flush out
+ * information waiting in the input buffer.
+ *
+ * Sideeffects:
+ * As of 'Tcl_NotifyChannel'.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+TransformChannelHandlerTimer (clientData)
+ ClientData clientData; /* Transformation to query */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+
+ if (!(dataPtr->watchMask & TCL_READABLE) ||
+ (ResultLength (&dataPtr->result) == 0)) {
+ /* The timer fired, but either is there no (more)
+ * interest in the events it generates or nothing is available
+ * for reading, so ignore it and don't recreate it.
+ */
+
+ return;
+ }
+
+ Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultClear --
+ *
+ * Deallocates any memory allocated by 'ResultAdd'.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultClear (r)
+ ResultBuffer* r; /* Reference to the buffer to clear out */
+{
+ r->used = 0;
+
+ if (r->allocated) {
+ ckfree((char*) r->buf);
+ r->buf = UCHARP (NULL);
+ r->allocated = 0;
+ }
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultInit --
+ *
+ * Initializes the specified buffer structure. The
+ * structure will contain valid information for an
+ * emtpy buffer.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultInit (r)
+ ResultBuffer* r; /* Reference to the structure to initialize */
+{
+ r->used = 0;
+ r->allocated = 0;
+ r->buf = UCHARP (NULL);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultLength --
+ *
+ * Returns the number of bytes stored in the buffer.
+ *
+ * Sideeffects:
+ * None.
+ *
+ * Result:
+ * An integer, see above too.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ResultLength (r)
+ ResultBuffer* r; /* The structure to query */
+{
+ return r->used;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultCopy --
+ *
+ * Copies the requested number of bytes from the
+ * buffer into the specified array and removes them
+ * from the buffer afterward. Copies less if there
+ * is not enough data in the buffer.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * The number of actually copied bytes,
+ * possibly less than 'toRead'.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ResultCopy (r, buf, toRead)
+ ResultBuffer* r; /* The buffer to read from */
+ unsigned char* buf; /* The buffer to copy into */
+ int toRead; /* Number of requested bytes */
+{
+ if (r->used == 0) {
+ /* Nothing to copy in the case of an empty buffer.
+ */
+
+ return 0;
+ }
+
+ if (r->used == toRead) {
+ /* We have just enough. Copy everything to the caller.
+ */
+
+ memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
+ r->used = 0;
+ return toRead;
+ }
+
+ if (r->used > toRead) {
+ /* The internal buffer contains more than requested.
+ * Copy the requested subset to the caller, and shift
+ * the remaining bytes down.
+ */
+
+ memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
+ memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead),
+ (size_t) r->used - toRead);
+
+ r->used -= toRead;
+ return toRead;
+ }
+
+ /* There is not enough in the buffer to satisfy the caller, so
+ * take everything.
+ */
+
+ memcpy((VOID*) buf, (VOID*) r->buf, (size_t) r->used);
+ toRead = r->used;
+ r->used = 0;
+ return toRead;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultAdd --
+ *
+ * Adds the bytes in the specified array to the
+ * buffer, by appending it.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultAdd (r, buf, toWrite)
+ ResultBuffer* r; /* The buffer to extend */
+ unsigned char* buf; /* The buffer to read from */
+ int toWrite; /* The number of bytes in 'buf' */
+{
+ if ((r->used + toWrite) > r->allocated) {
+ /* Extension of the internal buffer is required.
+ */
+
+ if (r->allocated == 0) {
+ r->allocated = toWrite + INCREMENT;
+ r->buf = UCHARP (ckalloc((unsigned) r->allocated));
+ } else {
+ r->allocated += toWrite + INCREMENT;
+ r->buf = UCHARP (ckrealloc((char*) r->buf,
+ (unsigned) r->allocated));
+ }
+ }
+
+ /* now copy data */
+ memcpy(r->buf + r->used, buf, (size_t) toWrite);
+ r->used += toWrite;
+}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index b9ca659..e0c812d 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.20 2000/03/31 08:52:04 hobbs Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.20.2.1 2000/07/27 01:39:18 hobbs Exp $
library tcl
@@ -577,14 +577,16 @@ declare 153 generic {
Tcl_Obj *TclGetLibraryPath(void)
}
-declare 154 generic {
- int TclTestChannelCmd(ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv)
-}
-declare 155 generic {
- int TclTestChannelEventCmd(ClientData clientData, \
- Tcl_Interp *interp, int argc, char **argv)
-}
+# moved to tclTest.c in 8.3.2/8.4a2
+#declare 154 generic {
+# int TclTestChannelCmd(ClientData clientData,
+# Tcl_Interp *interp, int argc, char **argv)
+#}
+#declare 155 generic {
+# int TclTestChannelEventCmd(ClientData clientData, \
+# Tcl_Interp *interp, int argc, char **argv)
+#}
+
declare 156 generic {
void TclRegError (Tcl_Interp *interp, char *msg, \
int status)
@@ -603,6 +605,15 @@ declare 160 generic {
Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
}
+# new in 8.3.2/8.4a2
+declare 161 generic {
+ int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, \
+ Tcl_Obj *cmdObjPtr)
+}
+declare 162 generic {
+ void TclChannelEventScriptInvoker(ClientData clientData, int flags)
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 082066b..21ef8ba 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.19 1999/12/12 22:46:42 hobbs Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.19.2.1 2000/07/27 01:39:18 hobbs Exp $
*/
#ifndef _TCLINTDECLS
@@ -506,13 +506,8 @@ EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
EXTERN void TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj * pathPtr));
/* 153 */
EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void));
-/* 154 */
-EXTERN int TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int argc, char ** argv));
-/* 155 */
-EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp * interp,
- int argc, char ** argv));
+/* Slot 154 is reserved */
+/* Slot 155 is reserved */
/* 156 */
EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
char * msg, int status));
@@ -529,6 +524,12 @@ EXTERN int TclpMatchFilesTypes _ANSI_ARGS_((Tcl_Interp * interp,
char * separators, Tcl_DString * dirPtr,
char * pattern, char * tail,
GlobTypeData * types));
+/* 161 */
+EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan, Tcl_Obj * cmdObjPtr));
+/* 162 */
+EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_((
+ ClientData clientData, int flags));
typedef struct TclIntStubs {
int magic;
@@ -720,13 +721,15 @@ typedef struct TclIntStubs {
void (*tclRegExpRangeUniChar) _ANSI_ARGS_((Tcl_RegExp re, int index, int * startPtr, int * endPtr)); /* 151 */
void (*tclSetLibraryPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 152 */
Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */
- int (*tclTestChannelCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 154 */
- int (*tclTestChannelEventCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 155 */
+ void *reserved154;
+ void *reserved155;
void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
int (*tclpMatchFilesTypes) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail, GlobTypeData * types)); /* 160 */
+ int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
+ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
} TclIntStubs;
#ifdef __cplusplus
@@ -1352,14 +1355,8 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetLibraryPath \
(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
#endif
-#ifndef TclTestChannelCmd
-#define TclTestChannelCmd \
- (tclIntStubsPtr->tclTestChannelCmd) /* 154 */
-#endif
-#ifndef TclTestChannelEventCmd
-#define TclTestChannelEventCmd \
- (tclIntStubsPtr->tclTestChannelEventCmd) /* 155 */
-#endif
+/* Slot 154 is reserved */
+/* Slot 155 is reserved */
#ifndef TclRegError
#define TclRegError \
(tclIntStubsPtr->tclRegError) /* 156 */
@@ -1380,6 +1377,14 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclpMatchFilesTypes \
(tclIntStubsPtr->tclpMatchFilesTypes) /* 160 */
#endif
+#ifndef TclChannelTransform
+#define TclChannelTransform \
+ (tclIntStubsPtr->tclChannelTransform) /* 161 */
+#endif
+#ifndef TclChannelEventScriptInvoker
+#define TclChannelEventScriptInvoker \
+ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 78f57ea..87c270e 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.35 2000/04/09 16:04:18 kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.35.2.1 2000/07/27 01:39:19 hobbs Exp $
*/
#include "tclInt.h"
@@ -229,13 +229,15 @@ TclIntStubs tclIntStubs = {
TclRegExpRangeUniChar, /* 151 */
TclSetLibraryPath, /* 152 */
TclGetLibraryPath, /* 153 */
- TclTestChannelCmd, /* 154 */
- TclTestChannelEventCmd, /* 155 */
+ NULL, /* 154 */
+ NULL, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
TclpMatchFilesTypes, /* 160 */
+ TclChannelTransform, /* 161 */
+ TclChannelEventScriptInvoker, /* 162 */
};
TclIntPlatStubs tclIntPlatStubs = {
@@ -791,6 +793,24 @@ TclStubs tclStubs = {
Tcl_ConditionFinalize, /* 391 */
Tcl_MutexFinalize, /* 392 */
Tcl_CreateThread, /* 393 */
+ Tcl_ReadRaw, /* 394 */
+ Tcl_WriteRaw, /* 395 */
+ Tcl_GetTopChannel, /* 396 */
+ Tcl_ChannelBuffered, /* 397 */
+ Tcl_ChannelName, /* 398 */
+ Tcl_ChannelVersion, /* 399 */
+ Tcl_ChannelBlockModeProc, /* 400 */
+ Tcl_ChannelCloseProc, /* 401 */
+ Tcl_ChannelClose2Proc, /* 402 */
+ Tcl_ChannelInputProc, /* 403 */
+ Tcl_ChannelOutputProc, /* 404 */
+ Tcl_ChannelSeekProc, /* 405 */
+ Tcl_ChannelSetOptionProc, /* 406 */
+ Tcl_ChannelGetOptionProc, /* 407 */
+ Tcl_ChannelWatchProc, /* 408 */
+ Tcl_ChannelGetHandleProc, /* 409 */
+ Tcl_ChannelFlushProc, /* 410 */
+ Tcl_ChannelHandlerProc, /* 411 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 2eccc08..1e98921 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -8,12 +8,12 @@
*
* Copyright (c) 1993-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.17 1999/10/13 02:22:18 hobbs Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.17.2.1 2000/07/27 01:39:19 hobbs Exp $
*/
#define TCL_TEST
@@ -21,6 +21,7 @@
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
+#include "tclIO.h"
#include <locale.h>
/*
@@ -276,6 +277,10 @@ static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestupvarCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestChannelCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestChannelEventCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
/*
* External (platform specific) initialization routine, these declarations
@@ -329,9 +334,9 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testchannel", TclTestChannelCmd,
+ Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testchannelevent", TclTestChannelEventCmd,
+ Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
@@ -4242,3 +4247,575 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
return (NULL);
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestChannelCmd --
+ *
+ * Implements the Tcl "testchannel" debugging command and its
+ * subcommands. This is part of the testing environment.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TestChannelCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Interpreter for result. */
+ int argc; /* Count of additional args. */
+ char **argv; /* Additional arg strings. */
+{
+ char *cmdName; /* Sub command. */
+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* state info for channel */
+ Tcl_Channel chan; /* The opaque type. */
+ size_t len; /* Length of subcommand string. */
+ int IOQueued; /* How much IO is queued inside channel? */
+ ChannelBuffer *bufPtr; /* For iterating over queued IO. */
+ char buf[TCL_INTEGER_SPACE];/* For sprintf. */
+ int mode; /* rw mode of the channel */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " subcommand ?additional args..?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ cmdName = argv[1];
+ len = strlen(cmdName);
+
+ chanPtr = (Channel *) NULL;
+
+ if (argc > 2) {
+ chan = Tcl_GetChannel(interp, argv[2], &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+ chan = (Tcl_Channel) chanPtr;
+ }
+
+ if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " info channelName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, argv[2]);
+ Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ Tcl_AppendElement(interp, "nonblocking");
+ } else {
+ Tcl_AppendElement(interp, "blocking");
+ }
+ if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+ Tcl_AppendElement(interp, "line");
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ Tcl_AppendElement(interp, "none");
+ } else {
+ Tcl_AppendElement(interp, "full");
+ }
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ Tcl_AppendElement(interp, "async_flush");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_EOF) {
+ Tcl_AppendElement(interp, "eof");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ Tcl_AppendElement(interp, "blocked");
+ } else {
+ Tcl_AppendElement(interp, "unblocked");
+ }
+ if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "saw_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "queued_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ }
+ if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ }
+ for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
+
+ IOQueued = 0;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ IOQueued = statePtr->curOutPtr->nextAdded -
+ statePtr->curOutPtr->nextRemoved;
+ }
+ for (bufPtr = statePtr->outQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendElement(interp, buf);
+
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'i') &&
+ (strncmp(cmdName, "inputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'o') &&
+ (strncmp(cmdName, "outputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ IOQueued = 0;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ IOQueued = statePtr->curOutPtr->nextAdded -
+ statePtr->curOutPtr->nextRemoved;
+ }
+ for (bufPtr = statePtr->outQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'q') &&
+ (strncmp(cmdName, "queuedcr", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendResult(interp,
+ (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
+ (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, chanPtr->typePtr->typeName,
+ (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
+ /*
+ * Syntax: transform channel -command command
+ */
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " transform channelId -command cmd\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "-command") != 0) {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": should be \"-command\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TclChannelTransform(interp, chan,
+ Tcl_NewStringObj(argv[4], -1));
+ }
+
+ if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
+ /*
+ * Syntax: unstack channel
+ */
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " unstack channel\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tcl_UnstackChannel(interp, chan);
+ }
+
+ Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
+ "info, open, readable, writable, transform, unstack",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestChannelEventCmd --
+ *
+ * This procedure implements the "testchannelevent" command. It is
+ * used to test the Tcl channel event mechanism.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Creates, deletes and returns channel event handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TestChannelEventCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_Obj *resultListPtr;
+ Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
+ EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
+ char *cmd;
+ int index, i, mask, len;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
+ if (chanPtr == (Channel *) NULL) {
+ return TCL_ERROR;
+ }
+ statePtr = chanPtr->state;
+
+ cmd = argv[2];
+ len = strlen(cmd);
+ if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName add eventSpec script\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[3], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[3], "none") == 0) {
+ mask = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad event name \"", argv[3],
+ "\": must be readable, writable, or none", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ esPtr = (EventScriptRecord *) ckalloc((unsigned)
+ sizeof(EventScriptRecord));
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
+
+ esPtr->chanPtr = chanPtr;
+ esPtr->interp = interp;
+ esPtr->mask = mask;
+ esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
+ Tcl_IncrRefCount(esPtr->scriptPtr);
+
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ i++, esPtr = esPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (esPtr == (EventScriptRecord *) NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (esPtr == statePtr->scriptRecordPtr) {
+ statePtr->scriptRecordPtr = esPtr->nextPtr;
+ } else {
+ for (prevEsPtr = statePtr->scriptRecordPtr;
+ (prevEsPtr != (EventScriptRecord *) NULL) &&
+ (prevEsPtr->nextPtr != esPtr);
+ prevEsPtr = prevEsPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (prevEsPtr == (EventScriptRecord *) NULL) {
+ panic("TestChannelEventCmd: damaged event script list");
+ }
+ prevEsPtr->nextPtr = esPtr->nextPtr;
+ }
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
+ ckfree((char *) esPtr);
+
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName list\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ resultListPtr = Tcl_GetObjResult(interp);
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != (EventScriptRecord *) NULL;
+ esPtr = esPtr->nextPtr) {
+ if (esPtr->mask) {
+ Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
+ } else {
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ Tcl_NewStringObj("none", -1));
+ }
+ Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName removeall\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != (EventScriptRecord *) NULL;
+ esPtr = nextEsPtr) {
+ nextEsPtr = esPtr->nextPtr;
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
+ ckfree((char *) esPtr);
+ }
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index event\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ i++, esPtr = esPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (esPtr == (EventScriptRecord *) NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[4], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[4], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[4], "none") == 0) {
+ mask = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad event name \"", argv[4],
+ "\": must be readable, writable, or none", (char *) NULL);
+ return TCL_ERROR;
+ }
+ esPtr->mask = mask;
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
+ "add, delete, list, set, or removeall", (char *) NULL);
+ return TCL_ERROR;
+}
diff --git a/tests/all.tcl b/tests/all.tcl
index df5cb3d..da89ff2 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -4,10 +4,10 @@
# tests. Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: all.tcl,v 1.10 2000/04/10 17:18:56 ericm Exp $
+# RCS: @(#) $Id: all.tcl,v 1.10.2.1 2000/07/27 01:39:20 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/iogt.test b/tests/iogt.test
new file mode 100644
index 0000000..293fd00
--- /dev/null
+++ b/tests/iogt.test
@@ -0,0 +1,940 @@
+# -*- tcl -*-
+# Commands covered: transform, and stacking in general
+#
+# This file contains a collection of tests for Giot
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2000 Ajuba Solutions.
+# Copyright (c) 2000 Andreas Kupries.
+# All rights reserved.
+#
+# RCS: @(#) $Id: iogt.test,v 1.1.4.1 2000/07/27 01:39:20 hobbs Exp $
+
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {[info commands testchannel] == ""} {
+ puts "Skipping io tests. This application does not seem to have the"
+ puts "testchannel command that is needed to run these tests."
+ return
+}
+
+::tcltest::saveState
+
+#::tcltest::makeFile contents name
+
+::tcltest::makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy
+
+# " capture coloring of quotes
+
+::tcltest::makeFile {} dummyout
+
+::tcltest::makeFile {
+#!/usr/local/bin/tclsh
+# -*- tcl -*-
+# echo server
+#
+# arguments, options: port to listen on for connections.
+# delay till echo of first block
+# delay between blocks
+# blocksize ...
+
+set port [lindex $argv 0]
+set fdelay [lindex $argv 1]
+set idelay [lindex $argv 2]
+set bsizes [lrange $argv 3 end]
+set c 0
+
+proc newconn {sock rhost rport} {
+ global c fdelay
+ incr c
+
+ #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
+
+ upvar #0 c$c conn
+ set conn(after) {}
+ set conn(state) 0
+ set conn(size) 0
+ set conn(data) ""
+ set conn(delay) $fdelay
+
+ fileevent $sock readable [list echoGet $c $sock]
+ fconfigure $sock -translation binary -buffering none -blocking 0
+}
+
+proc echoGet {c sock} {
+ global fdelay
+ upvar #0 c$c conn
+
+ if {[eof $sock]} {
+ # one-shot echo
+ exit
+ }
+
+ append conn(data) [read $sock]
+
+ #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
+
+ if {$conn(after) == {}} {
+ set conn(after) [after $conn(delay) [list echoPut $c $sock]]
+ }
+}
+
+proc echoPut {c sock} {
+ global idelay fdelay bsizes
+ upvar #0 c$c conn
+
+ if {[string length $conn(data)] == 0} {
+ #puts stdout "C $c $sock" ; flush stdout
+ # auto terminate
+ close $sock
+ exit
+ #set conn(delay) $fdelay
+ return
+ }
+
+
+ set conn(delay) $idelay
+
+ set n [lindex $bsizes $conn(size)]
+
+ #puts stdout "P $c $sock $n >>" ; flush stdout
+
+ #puts __________________________________________
+ #parray conn
+ #puts n=<$n>
+
+
+ if {[string length $conn(data)] >= $n} {
+ puts -nonewline $sock [string range $conn(data) 0 $n]
+ set conn(data) [string range $conn(data) [incr n] end]
+ }
+
+ incr conn(size)
+ if {$conn(size) >= [llength $bsizes]} {
+ set conn(size) [expr {[llength $bsizes]-1}]
+ }
+
+ set conn(after) [after $conn(delay) [list echoPut $c $sock]]
+}
+
+#fileevent stdin readable {exit ;#cut}
+
+# main
+socket -server newconn $port
+vwait forever
+} __echo_srv__.tcl
+
+
+########################################################################
+
+proc fevent {fdelay idelay blocks script data} {
+ # start and initialize an echo server, prepare data
+ # transmission, then hand over to the test script.
+ # this has to start real transmission via 'flush'.
+ # The server is stopped after completion of the test.
+
+ # fixed port, not so good. lets hope for the best, for now.
+ set port 4000
+
+ eval exec tclsh __echo_srv__.tcl \
+ $port $fdelay $idelay $blocks >@stdout &
+
+ after 500
+
+ #puts stdout "> $port" ; flush stdout
+
+ set sk [socket localhost $port]
+ fconfigure $sk \
+ -blocking 0 \
+ -buffering full \
+ -buffersize [expr {10+[llength $data]}]
+
+ puts -nonewline $sk $data
+
+ # The channel is prepared to go off.
+
+ #puts stdout ">>>>>" ; flush stdout
+
+ uplevel #0 set sock $sk
+ set res [uplevel #0 $script]
+
+ catch {close $sk}
+ return $res
+}
+
+# --------------------------------------------------------------
+# utility transformations ...
+
+proc id {op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read -
+ write -
+ read {
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
+proc id_optrail {var op data} {
+ upvar #0 $var trail
+
+ lappend trail $op
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ flush/read -
+ clear/read { #ignore }
+ flush/write -
+ write -
+ read {
+ return $data
+ }
+ query/maxRead {
+ return -1
+ }
+ default {
+ lappend trail "error $op"
+ error $op
+ }
+ }
+}
+
+
+proc id_fulltrail {var op data} {
+ upvar #0 $var trail
+
+ #puts stdout ">> $var $op $data" ; flush stdout
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set res *ignored*
+ }
+ flush/write - flush/read -
+ write -
+ read {
+ set res $data
+ }
+ query/maxRead {
+ set res -1
+ }
+ }
+
+ #catch {puts stdout "\t>* $res" ; flush stdout}
+ #catch {puts stdout "x$res"} msg
+
+ lappend trail [list $op $data $res]
+ return $res
+}
+
+proc counter {var op data} {
+ upvar #0 $var n
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {;#ignore}
+ flush/write - flush/read {return {}}
+ write {
+ return $data
+ }
+ read {
+ if {$n > 0} {
+ incr n -[string length $data]
+ if {$n < 0} {
+ set n 0
+ }
+ }
+ return $data
+ }
+ query/maxRead {
+ return $n
+ }
+ }
+}
+
+
+proc counter_audit {var vtrail op data} {
+ upvar #0 $var n $vtrail trail
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set res {}
+ }
+ flush/write - flush/read {
+ set res {}
+ }
+ write {
+ set res $data
+ }
+ read {
+ if {$n > 0} {
+ incr n -[string length $data]
+ if {$n < 0} {
+ set n 0
+ }
+ }
+ set res $data
+ }
+ query/maxRead {
+ set res $n
+ }
+ }
+
+ lappend trail [list counter:$op $data $res]
+ return $res
+}
+
+
+proc rblocks {var vtrail n op data} {
+ upvar #0 $var buf $vtrail trail
+
+ set res {}
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set buf {}
+ }
+ flush/write {
+ }
+ flush/read {
+ set res $buf
+ set buf {}
+ }
+ write {
+ set data
+ }
+ read {
+ append buf $data
+
+ set b [expr {$n * ([string length $buf] / $n)}]
+
+ append op " $n [string length $buf] :- $b"
+
+ set res [string range $buf 0 [incr b -1]]
+ set buf [string range $buf [incr b] end]
+ #return $res
+ }
+ query/maxRead {
+ set res -1
+ }
+ }
+
+ lappend trail [list rblock | $op $data $res | $buf]
+ return $res
+}
+
+
+# --------------------------------------------------------------
+# ... and convenience procedures to stack them
+
+proc identity {-attach channel} {
+ testchannel transform $channel -command id
+}
+
+proc audit_ops {var -attach channel} {
+ testchannel transform $channel -command [list id_optrail $var]
+}
+
+proc audit_flow {var -attach channel} {
+ testchannel transform $channel -command [list id_fulltrail $var]
+}
+
+proc stopafter {var n -attach channel} {
+ upvar #0 $var vn
+ set vn $n
+ testchannel transform $channel -command [list counter $var]
+}
+
+proc stopafter_audit {var trail n -attach channel} {
+ upvar #0 $var vn
+ set vn $n
+ testchannel transform $channel -command [list counter_audit $var $trail]
+}
+
+proc rblocks_t {var trail n -attach channel} {
+ testchannel transform $channel -command [list rblocks $var $trail $n]
+}
+
+# --------------------------------------------------------------
+# serialize an array, with keys in sorted order.
+
+proc array_sget {v} {
+ upvar $v a
+
+ set res [list]
+ foreach n [lsort [array names a]] {
+ lappend res $n $a($n)
+ }
+ set res
+}
+
+proc asort {alist} {
+ # sort a list of key/value pairs by key, removes duplicates too.
+
+ array set a $alist
+ array_sget a
+}
+
+########################################################################
+
+
+test iogt-1.1 {stack/unstack} {
+ set fh [open dummy r]
+ identity -attach $fh
+ testchannel unstack $fh
+ close $fh
+} {}
+
+test iogt-1.2 {stack/close} {
+ set fh [open dummy r]
+ identity -attach $fh
+ close $fh
+} {}
+
+test iogt-1.3 {stack/unstack, configuration, options} {
+ set fh [open dummy r]
+ set ca [asort [fconfigure $fh]]
+ identity -attach $fh
+ set cb [asort [fconfigure $fh]]
+ testchannel unstack $fh
+ set cc [asort [fconfigure $fh]]
+ close $fh
+
+ # With this system none of the buffering, translation and
+ # encoding option may change their values with channels
+ # stacked upon each other or not.
+
+ # cb == ca == cc
+
+ list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
+} {1 1 1}
+
+test iogt-1.4 {stack/unstack, configuration} {
+ set fh [open dummy r]
+ set ca [asort [fconfigure $fh]]
+ identity -attach $fh
+ fconfigure $fh \
+ -buffering line \
+ -translation cr \
+ -encoding shiftjis
+ testchannel unstack $fh
+ set cc [asort [fconfigure $fh]]
+
+ set res [list \
+ [string equal $ca $cc] \
+ [fconfigure $fh -buffering] \
+ [fconfigure $fh -translation] \
+ [fconfigure $fh -encoding] \
+ ]
+
+ close $fh
+ set res
+} {0 line cr shiftjis}
+
+test iogt-2.0 {basic I/O going through transform} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ identity -attach $fin
+ identity -attach $fout
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set fin [open dummy r]
+ set fout [open dummyout r]
+
+ set res [string equal [set in [read $fin]] [set out [read $fout]]]
+ lappend res [string length $in] [string length $out]
+
+ close $fin
+ close $fout
+
+ set res
+} {1 71 71}
+
+
+test iogt-2.1 {basic I/O, operation trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set ain [list] ; set aout [list]
+ audit_ops ain -attach $fin
+ audit_ops aout -attach $fout
+
+ fconfigure $fin -buffersize 10
+ fconfigure $fout -buffersize 5
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set res "[join $ain \n]\n--------\n[join $aout \n]"
+} {create/read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+flush/read
+query/maxRead
+delete/read
+--------
+create/write
+write
+write
+write
+write
+write
+write
+write
+write
+flush/write
+delete/write}
+
+test iogt-2.2 {basic I/O, data trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set ain [list] ; set aout [list]
+ audit_flow ain -attach $fin
+ audit_flow aout -attach $fout
+
+ fconfigure $fin -buffersize 10
+ fconfigure $fout -buffersize 5
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set res "[join $ain \n]\n--------\n[join $aout \n]"
+} {create/read {} *ignored*
+query/maxRead {} -1
+read abcdefghij abcdefghij
+query/maxRead {} -1
+read klmnopqrst klmnopqrst
+query/maxRead {} -1
+read uvwxyz0123 uvwxyz0123
+query/maxRead {} -1
+read 456789,./? 456789,./?
+query/maxRead {} -1
+read {><;'\|":[]} {><;'\|":[]}
+query/maxRead {} -1
+read {\}\{`~!@#$} {\}\{`~!@#$}
+query/maxRead {} -1
+read %^&*()_+-= %^&*()_+-=
+query/maxRead {} -1
+read {
+} {
+}
+query/maxRead {} -1
+flush/read {} {}
+query/maxRead {} -1
+delete/read {} *ignored*
+--------
+create/write {} *ignored*
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+test iogt-2.3 {basic I/O, mixed trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set trail [list]
+ audit_flow trail -attach $fin
+ audit_flow trail -attach $fout
+
+ fconfigure $fin -buffersize 20
+ fconfigure $fout -buffersize 10
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ join $trail \n
+} {create/read {} *ignored*
+create/write {} *ignored*
+query/maxRead {} -1
+read abcdefghijklmnopqrst abcdefghijklmnopqrst
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+query/maxRead {} -1
+read uvwxyz0123456789,./? uvwxyz0123456789,./?
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+query/maxRead {} -1
+read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+query/maxRead {} -1
+read {%^&*()_+-=
+} {%^&*()_+-=
+}
+query/maxRead {} -1
+flush/read {} {}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+query/maxRead {} -1
+delete/read {} *ignored*
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
+ {unknownFailure} {
+ # This test to check the validity of aquired Tcl_Channel references is
+ # not possible because even a backgrounded fcopy will immediately start
+ # to copy data, without waiting for the event loop. This is done only in
+ # case of an underflow on the read size!. So stacking transforms after the
+ # fcopy will miss information, or are not used at all.
+ #
+ # I was able to circumvent this by using the echo.tcl server with a big
+ # delay, causing the fcopy to underflow immediately.
+
+ proc DoneCopy {n {err {}}} {
+ global copy ; set copy 1
+ }
+
+ set fin [open dummy r]
+
+ fevent 1000 500 {20 20 20 10 1 1} {
+ close $fin
+
+ set fout [open dummyout w]
+
+ flush $sock ; # now, or fcopy will error us out
+ # But the 1 second delay should be enough to
+ # initialize everything else here.
+
+ fcopy $sock $fout -command DoneCopy
+
+ # transform after fcopy got its handles !
+ # They should be still valid for fcopy.
+
+ set trail [list]
+ audit_ops trail -attach $fout
+
+ vwait copy
+ } [read $fin] ; # {}
+
+ close $fout
+
+ rename DoneCopy {}
+
+ # Check result of copy.
+
+ set fin [open dummy r]
+ set fout [open dummyout r]
+
+ set res [string equal [read $fin] [read $fout]]
+
+ close $fin
+ close $fout
+
+ list $res $trail
+} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
+
+
+test iogt-4.0 {fileevent readable, after transform} {unknownFailure} {
+ set fin [open dummy r]
+ set data [read $fin]
+ close $fin
+
+ set trail [list]
+ set got [list]
+
+ proc Done {args} {
+ global stop
+ set stop 1
+ }
+
+ proc Get {sock} {
+ global trail got
+ if {[eof $sock]} {
+ Done
+ lappend trail "xxxxxxxxxxxxx"
+ close $sock
+ return
+ }
+ lappend trail "vvvvvvvvvvvvv"
+ lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
+ lappend trail "============="
+ #puts stdout $__ ; flush stdout
+ #read $sock
+ }
+
+ fevent 1000 500 {20 20 20 10 1} {
+ audit_flow trail -attach $sock
+ rblocks_t rbuf trail 23 -attach $sock
+
+ fileevent $sock readable [list Get $sock]
+
+ flush $sock ; # now, or fcopy will error us out
+ # But the 1 second delay should be enough to
+ # initialize everything else here.
+
+ vwait stop
+ } $data
+
+
+ rename Done {}
+ rename Get {}
+
+ join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
+} {[[]]
+[[abcdefghijklmnopqrstuvw]]
+[[xyz0123456789,./?><;'\|]]
+[[]]
+[[]]
+[[":[]\}\{`~!@#$%^&*()]]
+[[]]
+~~~~~~~~
+create/write {} *ignored*
+create/read {} *ignored*
+rblock | create/write {} {} | {}
+rblock | create/read {} {} | {}
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+read abcdefghijklmnopqrstu abcdefghijklmnopqrstu
+query/maxRead {} -1
+rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu
+rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
+query/maxRead {} -1
+ got: {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
+query/maxRead {} -1
+read vwxyz0123456789,./?>< vwxyz0123456789,./?><
+query/maxRead {} -1
+rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><
+rblock | query/maxRead {} -1 | xyz0123456789,./?><
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | xyz0123456789,./?><
+query/maxRead {} -1
+read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+read *( *(
+query/maxRead {} -1
+rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
+query/maxRead {} -1
+read ) )
+query/maxRead {} -1
+rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
+query/maxRead {} -1
+flush/read {} {}
+rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
+xxxxxxxxxxxxx
+rblock | flush/write {} {} | {}
+rblock | delete/write {} {} | {}
+rblock | delete/read {} {} | {}
+flush/write {} {}
+delete/write {} *ignored*
+delete/read {} *ignored*} ; # catch unescaped quote "
+
+
+test iogt-5.0 {EOF simulation} {unknownFailure} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set trail [list]
+
+ audit_flow trail -attach $fin
+ stopafter_audit d trail 20 -attach $fin
+ audit_flow trail -attach $fout
+
+ fconfigure $fin -buffersize 20
+ fconfigure $fout -buffersize 10
+
+ fcopy $fin $fout
+ testchannel unstack $fin
+
+ # now copy the rest in the channel
+ lappend trail {**after unstack**}
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ join $trail \n
+} {create/read {} *ignored*
+counter:create/read {} {}
+create/write {} *ignored*
+counter:query/maxRead {} 20
+query/maxRead {} -1
+read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
+} {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
+}
+query/maxRead {} -1
+flush/read {} {}
+counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+counter:query/maxRead {} 0
+counter:flush/read {} {}
+counter:delete/read {} {}
+**after unstack**
+query/maxRead {} -1
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+query/maxRead {} -1
+delete/read {} *ignored*
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+
+
+
+proc constX {op data} {
+ # replace anything coming in with a same-length string of x'es.
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {;#ignore}
+ flush/write - flush/read -
+ write -
+ read {
+ return [string repeat x [string length $data]]
+ }
+ query/maxRead {return -1}
+ }
+}
+
+proc constx {-attach channel} {
+ testchannel transform $channel -command constX
+}
+
+test iogt-6.0 {Push back} {
+ set f [open dummy r]
+
+ # contents of dummy = "abcdefghi..."
+ read $f 3 ; # skip behind "abc"
+
+ constx -attach $f
+
+ # expect to get "xxx" from the transform because
+ # of unread "def" input to transform which returns "xxx".
+ #
+ # Actually the IO layer pre-read the whole file and will
+ # read "def" directly from the buffer without bothering
+ # to consult the newly stacked transformation. This is
+ # wrong.
+
+ set res [read $f 3]
+ close $f
+ set res
+} {xxx}
+
+test iogt-6.1 {Push back and up} {knownBug} {
+ set f [open dummy r]
+
+ # contents of dummy = "abcdefghi..."
+ read $f 3 ; # skip behind "abc"
+
+ constx -attach $f
+ set res [read $f 3]
+
+ testchannel unstack $f
+ append res [read $f 3]
+ close $f
+ set res
+} {xxxghi}
+
+
+# cleanup
+foreach file [list dummy dummyout __echo_srv__.tcl] {
+ ::tcltest::removeFile $file
+}
+::tcltest::restoreState
+::tcltest::cleanupTests
+return
diff --git a/tests/socket.test b/tests/socket.test
index ba25211..f55ecc9 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -5,12 +5,12 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: socket.test,v 1.14 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: socket.test,v 1.14.2.1 2000/07/27 01:39:21 hobbs Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -67,10 +67,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-# Some tests require the testthread command
+# Some tests require the testthread and exec commands
set ::tcltest::testConstraints(testthread) \
[expr {[info commands testthread] != {}}]
+set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
#
# If remoteServerIP or remoteServerPort are not set, check in the
@@ -551,19 +552,19 @@ test socket-2.11 {detecting new data} {socket} {
flush $s2
after 500
fconfigure $sock -blocking 0
- set result [gets $sock]
- lappend result [gets $sock]
+ set result a:[gets $sock]
+ lappend result b:[gets $sock]
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
fconfigure $sock -blocking 0
- lappend result [gets $sock]
+ lappend result c:[gets $sock]
fconfigure $sock -blocking 1
close $s2
close $s
close $sock
set result
-} {one {} two}
+} {a:one b: c:two}
test socket-3.1 {socket conflict} {socket stdio} {
@@ -1276,6 +1277,7 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
sendCommand {close $socket10_13_test_server}
list $spurious $len
} {0 2690}
+
test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
set counter 0
set done 0
@@ -1303,12 +1305,13 @@ test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
}
}
set c [socket $remoteServerIP 2836]
- fileevent $c readable "count_up $c"
+ fileevent $c readable [list count_up $c]
set after_id [after 1000 timed_out]
vwait done
sendCommand {close $socket10_14_test_server}
set done
} {EOF is sticky}
+
test socket-11.13 {testing async write, async flush, async close} \
{socket doTestsWithRemoteServer} {
proc readit {s} {
@@ -1363,8 +1366,7 @@ test socket-11.13 {testing async write, async flush, async close} \
set count
} 65566
-test socket-12.1 {testing inheritance of server sockets} \
- {socket doTestsWithRemoteServer} {
+test socket-12.1 {testing inheritance of server sockets} {socket exec} {
removeFile script1
removeFile script2
@@ -1383,14 +1385,13 @@ test socket-12.1 {testing inheritance of server sockets} \
# be closed unless script1 inherited it.
set f [open script2 w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tclsh $::tcltest::tcltest]
puts $f {
- package require tcltest
set f [socket -server accept 2828]
proc accept { file addr port } {
close $file
}
- exec $::tcltest::tcltest script1 &
+ exec $tclsh script1 &
close $f
after 1000 exit
vwait forever
@@ -1416,8 +1417,7 @@ test socket-12.1 {testing inheritance of server sockets} \
removeFile script2
set x
} {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} \
- {socket doTestsWithRemoteServer} {
+test socket-12.2 {testing inheritance of client sockets} {socket exec} {
removeFile script1
removeFile script2
@@ -1436,10 +1436,10 @@ test socket-12.2 {testing inheritance of client sockets} \
# client socket, the socket will still be open.
set f [open script2 w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tclsh $::tcltest::tcltest]
puts $f {
set f [socket 127.0.0.1 2829]
- exec $::tcltest::tcltest script1 &
+ exec $tclsh script1 &
puts $f testing
flush $f
after 1000 exit
@@ -1451,7 +1451,6 @@ test socket-12.2 {testing inheritance of client sockets} \
set server [socket -server accept 2829]
proc accept { file host port } {
-
# When the client connects, establish the read handler
global server
close $server
@@ -1460,7 +1459,6 @@ test socket-12.2 {testing inheritance of client sockets} \
return
}
proc getdata { file } {
-
# Read handler on the accepted socket.
global x
global failed
@@ -1502,8 +1500,7 @@ test socket-12.2 {testing inheritance of client sockets} \
removeFile script2
set x
} {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} \
- {socket doTestsWithRemoteServer} {
+test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
removeFile script1
removeFile script2
@@ -1515,13 +1512,13 @@ test socket-12.3 {testing inheritance of accepted sockets} \
close $f
set f [open script2 w]
- puts $f [list set tcltest $::tcltest::tcltest]
+ puts $f [list set tclsh $::tcltest::tcltest]
puts $f {
- set server [socket -server accept 2930]
+ set server [socket -server accept 2931]
proc accept { file host port } {
- global tcltest
+ global tclsh
puts $file {test data on socket}
- exec $::tcltest::tcltest script1 &
+ exec $tclsh script1 &
after 1000 exit
}
vwait forever
@@ -1536,7 +1533,7 @@ test socket-12.3 {testing inheritance of accepted sockets} \
after 1000 set ok_to_proceed 1
vwait ok_to_proceed
- set f [socket 127.0.0.1 2930]
+ set f [socket 127.0.0.1 2931]
fconfigure $f -buffering full -blocking 0
fileevent $f readable [list getdata $f]
@@ -1547,7 +1544,6 @@ test socket-12.3 {testing inheritance of accepted sockets} \
after 5000 set failed 1
proc getdata { file } {
-
# Read handler on the client socket.
global x
global failed
@@ -1642,14 +1638,3 @@ catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in
index f7a16a5..9ca4b0f 100644
--- a/tools/tcl.wse.in
+++ b/tools/tcl.wse.in
@@ -12,7 +12,7 @@ item: Global
Log Pathname=%MAINDIR%\INSTALL.LOG
Message Font=MS Sans Serif
Font Size=8
- Disk Label=tcl8.3.1
+ Disk Label=tcl8.3.2
Disk Filename=setup
Patch Flags=0000000000000001
Patch Threshold=85
diff --git a/unix/Makefile.in b/unix/Makefile.in
index df69f9c..c89acd0 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.63 2000/04/25 20:58:48 hobbs Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.63.2.1 2000/07/27 01:39:22 hobbs Exp $
VERSION = @TCL_VERSION@
@@ -266,8 +266,8 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
tclCompCmds.o tclCompExpr.o tclCompile.o tclDate.o tclEncoding.o \
tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
- tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o \
- tclIOCmd.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
+ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
+ tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPipe.o \
tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o tclRegexp.o \
@@ -324,6 +324,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclInterp.c \
$(GENERIC_DIR)/tclIO.c \
$(GENERIC_DIR)/tclIOCmd.c \
+ $(GENERIC_DIR)/tclIOGT.c \
$(GENERIC_DIR)/tclIOSock.c \
$(GENERIC_DIR)/tclIOUtil.c \
$(GENERIC_DIR)/tclLink.c \
@@ -473,7 +474,7 @@ topDirName:
gendate:
yacc -l $(GENERIC_DIR)/tclGetDate.y
sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
- -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.63 2000/04/25 20:58:48 hobbs Exp $$?' \
+ -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.63.2.1 2000/07/27 01:39:22 hobbs Exp $$?' \
-e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
-e '/TclDatenewstate:/d' -e '/#pragma/d' \
-e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
@@ -782,6 +783,9 @@ tclIO.o: $(GENERIC_DIR)/tclIO.c
tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c
+tclIOGT.o: $(GENERIC_DIR)/tclIOGT.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOGT.c
+
tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c
diff --git a/unix/configure.in b/unix/configure.in
index c8a342c..26cd939 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -3,12 +3,12 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
AC_INIT(../generic/tcl.h)
-# RCS: @(#) $Id: configure.in,v 1.57 2000/04/19 08:32:45 hobbs Exp $
+# RCS: @(#) $Id: configure.in,v 1.57.2.1 2000/07/27 01:39:22 hobbs Exp $
TCL_VERSION=8.3
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".1"
+TCL_PATCH_LEVEL=".2"
VERSION=${TCL_VERSION}
#------------------------------------------------------------------------
diff --git a/unix/tcl.spec b/unix/tcl.spec
index 40b187f..d8f5ae0 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -1,7 +1,7 @@
-# $Id: tcl.spec,v 1.4 2000/04/26 17:31:21 hobbs Exp $
+# $Id: tcl.spec,v 1.4.2.1 2000/07/27 01:39:23 hobbs Exp $
# This file is the basis for a binary Tcl RPM for Linux.
-%define version 8.3.1
+%define version 8.3.2
%define directory /usr/local
Summary: Tcl scripting language development environment
diff --git a/win/Makefile.in b/win/Makefile.in
index 2f3a639..a7f7525 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.33.2.1 2000/07/13 01:08:46 welch Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.33.2.2 2000/07/27 01:39:23 hobbs Exp $
VERSION = @TCL_VERSION@
@@ -229,6 +229,7 @@ GENERIC_OBJS = \
tclInterp.$(OBJEXT) \
tclIO.$(OBJEXT) \
tclIOCmd.$(OBJEXT) \
+ tclIOGT.$(OBJEXT) \
tclIOSock.$(OBJEXT) \
tclIOUtil.$(OBJEXT) \
tclLink.$(OBJEXT) \
diff --git a/win/README.binary b/win/README.binary
index 5536e80..7bdeca8 100644
--- a/win/README.binary
+++ b/win/README.binary
@@ -1,11 +1,11 @@
Tcl/Tk 8.3 for Windows, Binary Distribution
-RCS: @(#) $Id: README.binary,v 1.19 2000/04/26 17:31:22 hobbs Exp $
+RCS: @(#) $Id: README.binary,v 1.19.2.1 2000/07/27 01:39:23 hobbs Exp $
1. Introduction
---------------
-This directory contains the binary distribution of Tcl/Tk 8.3.1 for
+This directory contains the binary distribution of Tcl/Tk 8.3.2 for
Windows. It was compiled with Microsoft Visual C++ 5.0 using Win32
API, so that it will run under Windows NT, 95, 98 and 2000.
@@ -29,7 +29,7 @@ The home page for the Tcl/Tk 8.3 release is
http://dev.scriptics.com/software/tcltk/8.3.html
Detailed release notes can be found at
- http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.1.txt
+ http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.2.txt
Information about Tcl itself can be found at
http://dev.scriptics.com/scripting/
diff --git a/win/configure.in b/win/configure.in
index d4a2a24..22d209f 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -2,14 +2,14 @@
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.20 2000/04/19 08:32:46 hobbs Exp $
+# RCS: @(#) $Id: configure.in,v 1.20.2.1 2000/07/27 01:39:24 hobbs Exp $
AC_INIT(../generic/tcl.h)
TCL_VERSION=8.3
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".1"
+TCL_PATCH_LEVEL=".2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
#--------------------------------------------------------------------
diff --git a/win/makefile.vc b/win/makefile.vc
index 8fe5cda..72ce802 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -6,7 +6,7 @@
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# RCS: @(#) $Id: makefile.vc,v 1.50 2000/04/25 20:58:48 hobbs Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.50.2.1 2000/07/27 01:39:24 hobbs Exp $
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -152,6 +152,7 @@ TCLOBJS = \
$(TMPDIR)\tclInterp.obj \
$(TMPDIR)\tclIO.obj \
$(TMPDIR)\tclIOCmd.obj \
+ $(TMPDIR)\tclIOGT.obj \
$(TMPDIR)\tclIOSock.obj \
$(TMPDIR)\tclIOUtil.obj \
$(TMPDIR)\tclLink.obj \
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 70bf804..d6fa836 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.10 2000/04/20 01:30:20 hobbs Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.10.2.1 2000/07/27 01:39:24 hobbs Exp $
*/
#include "tclWinInt.h"
@@ -101,7 +101,7 @@ static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- FileBlockProc, /* Set blocking or non-blocking mode.*/
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -110,6 +110,10 @@ static Tcl_ChannelType fileChannelType = {
NULL, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
FileGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ FileBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 7d62a5a..579900e 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.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: tclWinConsole.c,v 1.3 1999/07/27 01:42:25 redman Exp $
+ * RCS: @(#) $Id: tclWinConsole.c,v 1.3.10.1 2000/07/27 01:39:25 hobbs Exp $
*/
#include "tclWinInt.h"
@@ -171,7 +171,7 @@ static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
static Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
- ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
ConsoleCloseProc, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
@@ -180,6 +180,10 @@ static Tcl_ChannelType consoleChannelType = {
NULL, /* Get option proc. */
ConsoleWatchProc, /* Set up notifier to watch the channel. */
ConsoleGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index b21a692..0f3793a 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.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: tclWinPipe.c,v 1.11 2000/04/11 21:42:12 ericm Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.11.2.1 2000/07/27 01:39:25 hobbs Exp $
*/
#include "tclWinInt.h"
@@ -209,7 +209,7 @@ static int WaitForRead(PipeInfo *infoPtr, int blocking);
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
- PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
@@ -218,7 +218,10 @@ static Tcl_ChannelType pipeChannelType = {
NULL, /* Get option proc. */
PipeWatchProc, /* Set up notifier to watch the channel. */
PipeGetHandleProc, /* Get an OS handle from channel. */
- PipeClose2Proc
+ PipeClose2Proc, /* close2proc */
+ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 8503ac2..8e1da0a 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -10,7 +10,7 @@
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
* Changes by Rolf.Schroedter@dlr.de June 25-27, 1999
*
- * RCS: @(#) $Id: tclWinSerial.c,v 1.9 1999/11/24 20:55:17 hobbs Exp $
+ * RCS: @(#) $Id: tclWinSerial.c,v 1.9.2.1 2000/07/27 01:39:26 hobbs Exp $
*/
#include "tclWinInt.h"
@@ -154,16 +154,20 @@ static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
*/
static Tcl_ChannelType serialChannelType = {
- "serial", /* Type name. */
- SerialBlockProc, /* Set blocking or non-blocking mode.*/
- SerialCloseProc, /* Close proc. */
- SerialInputProc, /* Input proc. */
- SerialOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- SerialSetOptionProc, /* Set option proc. */
- SerialGetOptionProc, /* Get option proc. */
- SerialWatchProc, /* Set up notifier to watch the channel. */
- SerialGetHandleProc, /* Get an OS handle from channel. */
+ "serial", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ SerialCloseProc, /* Close proc. */
+ SerialInputProc, /* Input proc. */
+ SerialOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ SerialSetOptionProc, /* Set option proc. */
+ SerialGetOptionProc, /* Get option proc. */
+ SerialWatchProc, /* Set up notifier to watch the channel. */
+ SerialGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 957f72c..24429f4 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.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: tclWinSock.c,v 1.18 1999/12/09 14:44:11 hobbs Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.18.2.1 2000/07/27 01:39:26 hobbs Exp $
*/
#include "tclWinInt.h"
@@ -215,16 +215,20 @@ static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg));
*/
static Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TcpBlockProc, /* Set socket into blocking/non-blocking mode. */
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier to watch this channel. */
- TcpGetHandleProc, /* Get an OS handle from channel. */
+ "tcp", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TcpCloseProc, /* Close proc. */
+ TcpInputProc, /* Input proc. */
+ TcpOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ TcpGetOptionProc, /* Get option proc. */
+ TcpWatchProc, /* Set up notifier to watch this channel. */
+ TcpGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ TcpBlockProc, /* Set blocking/non-blocking mode. */
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*