Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,158 @@ +2000-07-25 Brent Welch + + * unix/Makefile.in: Need to install all the Tcl headers because + Itcl depends on internal headers. + +2000-07-25 Andreas Kupries + + * 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 + + * 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 + + * win/Makefile.in: Added rules for static tcldde and tclreg libraries. + +2000-07-17 Jeff Hobbs + + * 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 + + * 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 + + * win/tclConfig.sh.in: Cleaned up unix-specific autoconf variables. + +2000-07-11 Jeff Hobbs + + * 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 + + * 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 + + * 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 * generic/tclIO.c (CloseChannel): removed the &ing out of (TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does this on the next pass through for the top channel, and it appeared Index: README ================================================================== --- README +++ README @@ -1,13 +1,13 @@ 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/.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.4.1 2000/07/17 23:09:53 hobbs Exp $ Contents -------- 1. Introduction 2. Documentation @@ -47,11 +47,11 @@ Extensive documentation is available at our website. 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/ There are many Tcl books on the market. Most are listed at DELETED doc/DumpActiveMemory.3 Index: doc/DumpActiveMemory.3 ================================================================== --- doc/DumpActiveMemory.3 +++ /dev/null @@ -1,68 +0,0 @@ -'\" -'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans. -'\" Copyright (c) 2000 by Scriptics Corporation. -'\" All rights reserved. -'\" -'\" RCS: @(#) $Id: DumpActiveMemory.3,v 1.2 2000/04/28 00:47:48 ericm Exp $ -'\" -.so man.macros -.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures" -.BS -.SH NAME -Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface. -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -int -\fBTcl_DumpActiveMemory\fR(\fIfileName\fR) -.sp -void -\fBTcl_InitMemory\fR(\fIinterp\fR) -.sp -void -\fBTcl_ValidateAllMemory\fR(\fIfileName, line\fR) - -.SH ARGUMENTS -.AP Tcl_Interp *interp in -Tcl interpreter in which to add commands. -.AP char *fileName in -For \fBTcl_DumpActiveMemory\fR, name of the file to which memory -information will be written. For \fBTcl_ValidateAllMemory\fR, name of -the file from which the call is being made (normally \fB__FILE__\fR). -.AP int line in -Line number at which the call to \fBTcl_ValidateAllMemory\fR is made -(normally \fB__LINE__\fR). -.BE - -.SH DESCRIPTION -These functions provide access to Tcl memory debugging information. -They are only available when Tcl has been compiled with -\fBTCL_MEM_DEBUG\fR defined at compile-time. -.PP -\fBTcl_DumpActiveMemory\fR will output a list of all currently -allocated memory to the specified file. The information output for -each allocated block of memory is: starting and ending addresses -(excluding guard zone), size, source file where \fBckalloc\fR was -called to allocate the block and line number in that file. It is -especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl -interpreter has been deleted. -.PP -\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the -interpreter given by \fIinterp\fR. It is called by \fBTcl_Main\fR -when Tcl has been compiled with \fBTCL_MEM_DEBUG\fR defined. -.PP -\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of -all currently allocated blocks of memory. Normally validation of a -block occurs when its freed, unless full validation is enabled, in -which case validation of all blocks occurs when \fBckalloc\fR and -\fBckfree\fR are called. This function forces the validation to occur -at any point. - -.SH "SEE ALSO" -TCL_MEM_DEBUG, memory - -.SH KEYWORDS -memory, debug - - DELETED doc/Init.3 Index: doc/Init.3 ================================================================== --- doc/Init.3 +++ /dev/null @@ -1,37 +0,0 @@ -'\" -'\" Copyright (c) 1998-2000 by Scriptics Corporation. -'\" All rights reserved. -'\" -'\" RCS: @(#) $Id: Init.3,v 1.1 2000/04/28 00:47:48 ericm Exp $ -'\" -.so man.macros -.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures" -.BS -.SH NAME -Tcl_Init \- find and source initialization script -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -int -\fBTcl_Init\fR(\fIinterp\fR) -.SH ARGUMENTS -.AP Tcl_Interp *interp in -Interpreter to initialize. -.BE - -.SH DESCRIPTION -.PP -\fBTcl_Init\fR is a helper procedure that finds and \fBsource\fR's the -\fBinit.tcl\fR script, which should exist somewhere on the Tcl library -path. On Macintosh systems, it additionally checks for an \fBInit\fR -resource and sources the contents of that resource if \fBinit.tcl\fR -cannot be found. -.PP -\fBTcl_Init\fR is typically called from \fBTcl_AppInit\fR procedures. - -.SH "SEE ALSO" -Tcl_AppInit, Tcl_Main - -.SH KEYWORDS -application, initialization, interpreter DELETED doc/TCL_MEM_DEBUG.3 Index: doc/TCL_MEM_DEBUG.3 ================================================================== --- doc/TCL_MEM_DEBUG.3 +++ /dev/null @@ -1,81 +0,0 @@ -'\" -'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans. -'\" Copyright (c) 2000 by Scriptics Corporation. -'\" All rights reserved. -'\" -'\" RCS: @(#) $Id: TCL_MEM_DEBUG.3,v 1.2 2000/04/28 00:47:49 ericm Exp $ -'\" -.so man.macros -.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures" -.BS -.SH NAME -TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging. - -.SH DESCRIPTION -When Tcl is compiled with \fBTCL_MEM_DEBUG\fR defined, a powerful set -of memory debugging aids are included in the compiled binary. This -includes C and Tcl functions which can aid with debugging -memory leaks, memory allocation overruns, and other memory related -errors. - -.SH ENABLING MEMORY DEBUGGING -.PP -To enable memory debugging, Tcl should be recompiled from scratch with -\fBTCL_MEM_DEBUG\fR defined. This will also compile in a non-stub -version of \fBTcl_InitMemory\fR to add the \fBmemory\fR command to Tcl. -.PP -\fBTCL_MEM_DEBUG\fR must be either left defined for all modules or undefined -for all modules that are going to be linked together. If they are not, link -errors will occur, with either \fBTclDbCkfree\fR and \fBTcl_DbCkalloc\fR or -\fBTcl_Ckalloc\fR and \fBTcl_Ckfree\fR being undefined. -.PP -Once memory debugging support has been compiled into Tcl, the C -functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR, -and the Tcl \fBmemory\fR command can be used to validate and examine -memory usage. - -.SH GUARD ZONES -.PP -When memory debugging is enabled, whenever a call to \fBckalloc\fR is -made, slightly more memory than requested is allocated so the memory debugging -code can keep track of the allocated memory, and eight-byte ``guard -zones'' are placed in front of and behind the space that will be -returned to the caller. (The size of the guard zone is defined by the -C #define \fBGUARD_SIZE\fR in \fIbaseline/src/ckalloc.c\fR -- it can -be extended if you suspect large overwrite problems, at some cost in -performance.) A known pattern is written into the guard zones and, on -a call to \fBckfree\fR, the guard zones of the space being freed are -checked to see if either zone has been modified in any way. If one -has been, the guard bytes and their new contents are identified, and a -``low guard failed'' or ``high guard failed'' message is issued. The -``guard failed'' message includes the address of the memory packet and -the file name and line number of the code that called \fBckfree\fR. -This allows you to detect the common sorts of one-off problems, where -not enough space was allocated to contain the data written, for -example. - -.SH DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS -.PP -Normally, Tcl compiled with memory debugging enabled will make it easy -to isolate a corruption problem. Turning on memory validation with -the memory command can help isolate difficult problems. If you -suspect (or know) that corruption is occurring before the Tcl -interpreter comes up far enough for you to issue commands, you can set -\fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl. -This will enable memory validation from the first call to -\fBckalloc\fR, again, at a large performance impact. -.PP -If you are desperate and validating memory on every call to -\fBckalloc\fR and \fBckfree\fR isn't enough, you can explicitly call -\fBTcl_ValidateAllMemory\fR directly at any point. It takes a \fIchar -*\fR and an \fIint\fR which are normally the filename and line number -of the caller, but they can actually be anything you want. Remember -to remove the calls after you find the problem. - -.SH "SEE ALSO" -memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory - -.SH KEYWORDS -memory, debug - - DELETED doc/memory.n Index: doc/memory.n ================================================================== --- doc/memory.n +++ /dev/null @@ -1,82 +0,0 @@ -'\" -'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans -'\" Copyright (c) 2000 by Scriptics Corporation. -'\" All rights reserved. -'\" -'\" RCS: @(#) $Id: memory.n,v 1.2 2000/04/28 00:47:49 ericm Exp $ -'\" -.so man.macros -.TH memory n 8.1 Tcl "Tcl Built-In Commands" -.BS -.SH NAME -memory \- Control Tcl memory debugging capabilities. -.SH SYNOPSIS -\fBmemory \fIoption \fR?\fIarg arg ...\fR? - -.SH DESCRIPTION -.PP -The \fBmemory\fR command gives the Tcl developer control of Tcl's memory -debugging capabilities. The memory command has several suboptions, which are -described below. It is only available when Tcl has been compiled with -memory debugging enabled (when \fBTCL_MEM_DEBUG\fR is defined at -compile time). -.TP -\fBmemory info\fR -Produces a report containing the total allocations and frees since -Tcl began, the current packets allocated (the current -number of calls to \fBckalloc\fR not met by a corresponding call -to \fBckfree\fR), the current bytes allocated, and the maximum number -of packets and bytes allocated. -.TP -\fBmemory trace [on|off]\fR -.br -Turns memory tracing on or off. When memory tracing is on, every call -to \fBckalloc\fR causes a line of trace information to be written to -\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the -address returned, the amount of memory allocated, and the C filename -and line number of the code performing the allocation. For example: -.CS -ckalloc 40e478 98 tclProc.c 1406 -.CE -Calls to \fBckfree\fR are traced in the same manner. -.TP -\fBmemory validate [on|off]\fR -Turns memory validation on or off. When memory validation is enabled, -on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are -checked for every piece of memory currently in existence that was -allocated by \fBckalloc\fR. This has a large performance impact and -should only be used when overwrite problems are strongly suspected. -The advantage of enabling memory validation is that a guard zone -overwrite can be detected on the first call to \fBckalloc\fR or -\fBckfree\fR after the overwrite occurred, rather than when the -specific memory with the overwritten guard zone(s) is freed, which may -occur long after the overwrite occurred. -.TP -\fBmemory trace_on_at_malloc\fR \fIcount\fR -Enable memory tracing after \fIcount\fR \fBckalloc\fR's have been performed. -For example, if you enter \fBmemory trace_on_at_malloc 100\fR, -after the 100th call to \fBckalloc\fR, memory trace information will begin -being displayed for all allocations and frees. Since there can be a lot -of memory activity before a problem occurs, judicious use of this option -can reduce the slowdown caused by tracing (and the amount of trace information -produced), if you can identify a number of allocations that occur before -the problem sets in. The current number of memory allocations that have -occurred since Tcl started is printed on a guard zone failure. -.TP -\fBmemory break_on_malloc\fR \fIcount\fR -After the \fBcount\fR allocations have been performed, \fBckalloc\fR's -output a message to this effect and that it is now attempting to enter -the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself. -If you are running Tcl under a C debugger, it should then enter the debugger -command mode. -.TP -\fB memory display\fR \fIfile\fR -Write a list of all currently allocated memory to the specified file. - -.SH "SEE ALSO" -ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG - -.SH KEYWORDS -memory, debug - - Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -8,11 +8,11 @@ # # Copyright (c) 1998-1999 by Scriptics Corporation. # 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.4.3 2000/07/25 16:54:47 kupries Exp $ library tcl # Define the tcl interface with several sub interfaces: # tclPlat - platform specific public @@ -985,11 +985,11 @@ Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, \ Tcl_ChannelType *typePtr, ClientData instanceData, \ 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) } # Reserved for future use (8.0.x vs. 8.1) @@ -1355,10 +1355,23 @@ } declare 393 generic { int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \ 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) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are # only available on the designated platform. Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -10,11 +10,11 @@ * Copyright (c) 1998-2000 by Scriptics Corporation. * * 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.4.2 2000/07/17 23:09:54 hobbs Exp $ */ #ifndef _TCL #define _TCL @@ -57,14 +57,14 @@ */ #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 * compilers. We use this method because there is no autoconf equivalent. */ @@ -384,10 +384,11 @@ typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey; 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_ChannelVersion_ *Tcl_ChannelVersion; /* * Definition of the interface to procedures implementing threads. * A procedure following this definition is given to each call of * 'Tcl_CreateThread' and will be called as the main fuction of @@ -1138,19 +1139,26 @@ * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel * should be closed. */ #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 * close2Proc interface. */ #define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1) +/* + * Channel version tag. This was introduced in 8.3.2/8.4. + */ + +#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelVersion) 0x1) +#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelVersion) 0x2) + /* * Typedefs for the various operations in a channel type: */ typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_(( @@ -1174,10 +1182,14 @@ typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_(( ClientData instanceData, int mask)); 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 * malloc and free, or they map them to procedures with all sorts * of debugging hooks defined in tclCkalloc.c. @@ -1226,48 +1238,82 @@ * part of the specific channel type. */ 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_ChannelVersion version; /* Version of the channel. */ 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; +/* + * The following macros are provided as convenience functions + * for accessing the internals of the Tcl_ChannelType + */ + +#define Tcl_ChannelName(chanTypePtr) ((chanTypePtr)->typeName) +#define Tcl_ChannelVersion(chanTypePtr) \ + (((chanTypePtr)->version == TCL_CHANNEL_VERSION_2) ? \ + TCL_CHANNEL_VERSION_2 : TCL_CHANNEL_VERSION_1) +#define Tcl_ChannelBlockModeProc(chanTypePtr) \ + (((chanTypePtr)->version == TCL_CHANNEL_VERSION_2) ? \ + (chanTypePtr)->blockModeProc : \ + (Tcl_DriverBlockModeProc *) (chanTypePtr)->version) +#define Tcl_ChannelCloseProc(chanTypePtr) ((chanTypePtr)->closeProc) +#define Tcl_ChannelClose2Proc(chanTypePtr) ((chanTypePtr)->close2Proc) +#define Tcl_ChannelInputProc(chanTypePtr) ((chanTypePtr)->inputProc) +#define Tcl_ChannelOutputProc(chanTypePtr) ((chanTypePtr)->outputProc) +#define Tcl_ChannelSeekProc(chanTypePtr) ((chanTypePtr)->seekProc) +#define Tcl_ChannelSetOptionProc(chanTypePtr) ((chanTypePtr)->setOptionProc) +#define Tcl_ChannelGetOptionProc(chanTypePtr) ((chanTypePtr)->getOptionProc) +#define Tcl_ChannelWatchProc(chanTypePtr) ((chanTypePtr)->watchProc) +#define Tcl_ChannelGetHandleProc(chanTypePtr) ((chanTypePtr)->getHandleProc) +#define Tcl_ChannelFlushProc(chanTypePtr) ((chanTypePtr)->flushProc) +#define Tcl_ChannelHandlerProc(chanTypePtr) ((chanTypePtr)->handlerProc) + /* * The following flags determine whether the blockModeProc above should * set the channel into blocking or nonblocking mode. They are passed * 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. */ /* * Enum for different types of file paths. */ Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -6,11 +6,11 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * * 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.4.3 2000/07/25 16:54:48 kupries Exp $ */ #ifndef _TCLDECLS #define _TCLDECLS @@ -907,11 +907,11 @@ EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, 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)); /* Slot 284 is reserved */ /* Slot 285 is reserved */ @@ -1226,10 +1226,20 @@ /* 393 */ 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)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; struct TclIntStubs *tclIntStubs; struct TclIntPlatStubs *tclIntPlatStubs; @@ -1575,11 +1585,11 @@ void *reserved278; #endif /* MAC_TCL */ 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; void (*tcl_AppendObjToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) _ANSI_ARGS_((Tcl_EncodingType * typePtr)); /* 287 */ @@ -1687,10 +1697,14 @@ int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp * interp, char * pattern)); /* 389 */ int (*tcl_ProcObjCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 390 */ 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 */ } TclStubs; #ifdef __cplusplus extern "C" { #endif @@ -3308,12 +3322,28 @@ #endif #ifndef Tcl_CreateThread #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 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLDECLS */ Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -2,355 +2,24 @@ * tclIO.c -- * * 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.3.2.6 2000/07/25 16:54:49 kupries Exp $ */ #include "tclInt.h" #include "tclPort.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; - +#include "tclIO.h" + + /* * All static variables used in this file are collected into a single * instance of the following structure. For multi-threaded implementations, * there is one instance of this structure for each thread. * @@ -365,13 +34,14 @@ * invocations. */ 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? */ int channelExitHandlerCreated; @@ -400,77 +70,82 @@ /* * Static functions in this file: */ 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)); /* *--------------------------------------------------------------------------- * @@ -520,16 +195,17 @@ void 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 * for all data to flush out. */ @@ -544,14 +220,14 @@ /* * Decrement the refcount which was earlier artificially bumped * 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 * referenced from any interpreter. If it is, that interpreter will * close the channel when it gets destroyed. @@ -586,11 +262,11 @@ * channel with CHANNEL_DEAD to prevent any further IO operations * on it. */ chanPtr->instanceData = (ClientData) NULL; - chanPtr->flags |= CHANNEL_DEAD; + statePtr->flags |= CHANNEL_DEAD; } } } @@ -735,21 +411,21 @@ Tcl_CloseProc *proc; /* The callback routine to call when the * channel will be closed. */ 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; } /* *---------------------------------------------------------------------- * @@ -776,20 +452,20 @@ Tcl_CloseProc *proc; /* The procedure for the callback to * remove. */ 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; } else { cbPrevPtr = cbPtr; @@ -885,16 +561,17 @@ Tcl_Interp *interp; /* The interpreter being deleted. */ { 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. */ @@ -902,29 +579,30 @@ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != (Tcl_HashEntry *) NULL; 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); } else { prevPtr = sPtr; @@ -937,13 +615,13 @@ * be inaccessible from the interpreter structure. Instead, we * emulate the behavior of Tcl_UnregisterChannel directly here. */ 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); } } } Tcl_DeleteHashTable(hTblPtr); @@ -974,28 +652,30 @@ 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; } } } @@ -1026,42 +706,36 @@ { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ 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 , 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++; } /* *---------------------------------------------------------------------- * @@ -1086,19 +760,26 @@ Tcl_Channel chan; /* Channel to delete. */ { 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. */ - 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 (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; } if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { return TCL_OK; @@ -1114,11 +795,11 @@ */ CleanupChannelHandlers(interp, chanPtr); } - chanPtr->refCount--; + statePtr->refCount--; /* * Perform special handling for standard channels being closed. If the * refCount is now 1 it means that the last reference to the standard * channel is being explicitly closed, so bump the refCount down @@ -1130,24 +811,24 @@ /* * 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; } } } @@ -1199,32 +880,39 @@ name = chanName; 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) { Tcl_AppendResult(interp, "can not find channel named \"", chanName, "\"", (char *) NULL); 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; } @@ -1253,98 +941,120 @@ ClientData instanceData; /* Instance specific data. */ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate * 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 * accept "\n", "\r" and "\r\n". Output translation mode is set to * a platform specific default value. The eofChar is set to 0 for both * input and output, so that Tcl does not look for an in-file EOF * 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); - Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); - } 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); + 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); + Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); + } 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; } @@ -1377,57 +1087,40 @@ *---------------------------------------------------------------------- */ 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 */ -{ - 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. - */ + Tcl_Channel prevChan; /* The channel structure to replace */ +{ + 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; } /* * Here we check if the given "mask" matches the "flags" @@ -1440,193 +1133,97 @@ * W | | | + | + | restrict the capabilities of the * RW| | + | + | + | superceded one ! * --+---+---+---+----+ */ - 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; + if ((mask & TCL_WRITABLE) != 0) { + CopyState *csPtr; - pt->interestMask = 0; + csPtr = statePtr->csPtr; + statePtr->csPtr = (CopyState*) NULL; - if (interest) { - (pt->typePtr->watchProc) (pt->instanceData, 0); + 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; } + /* + * 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. + * + * 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. + */ + + if (((mask & TCL_READABLE) != 0) && + (statePtr->inQueueHead != (ChannelBuffer*) NULL)) { + /* + * Remark: It is possible that the channel buffers contain data from + * some earlier push-backs. + */ + + statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead; + prevChanPtr->inQueueHead = statePtr->inQueueHead; + + if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) { + prevChanPtr->inQueueTail = statePtr->inQueueTail; + } + + statePtr->inQueueHead = (ChannelBuffer*) NULL; + statePtr->inQueueTail = (ChannelBuffer*) NULL; + } + + chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); /* * 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 */ + chanPtr->state = statePtr; + chanPtr->instanceData = instanceData; + chanPtr->typePtr = typePtr; + chanPtr->downChanPtr = prevChanPtr; + chanPtr->upChanPtr = (Channel *) NULL; + chanPtr->inQueueHead = (ChannelBuffer*) NULL; + chanPtr->inQueueTail = (ChannelBuffer*) 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"); - - /* - * 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. - * - * Don't forget to use the same blocking mode as the old channel. - */ - - pt->flags = mask | (chanPtr->flags & CHANNEL_NONBLOCKING); - - /* - * EDITORS NOTE: all the lines with "take it as is" should get - * deleted once this code has been debugged. - */ - - /* 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 */ - - /* 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. - */ - - pt->supercedes = chanPtr; - - /* - * Don't forget to reinitialize the output buffer used for encodings. - */ - - if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { - chanPtr->outputStage = (char *) - ckalloc((unsigned) (chanPtr->bufSize + 2)); - } - - /* - * 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. - */ - - 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 --; - */ + * stacked channels. + */ + + prevChanPtr->upChanPtr = chanPtr; + statePtr->topChanPtr = chanPtr; return (Tcl_Channel) chanPtr; } /* @@ -1634,222 +1231,154 @@ * * Tcl_UnstackChannel -- * * 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; - if (chanPtr->supercedes != (Channel*) NULL) { + /* + * This operation should occur at the top of a channel stack. + */ + + 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; - - /* - * 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. - */ - - 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 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. - */ - - saveEncoding = chanDownPtr->encoding; - saveInputEncodingState = chanDownPtr->inputEncodingState; - saveInputEncodingFlags = chanDownPtr->inputEncodingFlags; - saveOutputEncodingState = chanDownPtr->outputEncodingState; - saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags; - - Tcl_DStringInit (&dsTrans); - Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr, - "-translation", &dsTrans); - - Tcl_DStringInit (&dsBuf); - Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr, - "-buffering", &dsBuf); - - /* - * Prevent the accidential removal of the encoding during - * the destruction of the transformation channel. - */ - - 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; - - /* - * 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. - */ - - chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanDownPtr; - - Tcl_Close (interp, (Tcl_Channel)chanDownPtr); - - /* - * Now it is possible to wind down the transformation (in 'top'), - * especially to copy the current encoding and translation control - * information down. - */ - - /* - * 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. - */ - - 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); - - /* - * 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 (interest) { - chanPtr->interestMask = 0; - (chanPtr->typePtr->watchProc) (chanPtr->instanceData, - interest); - chanPtr->interestMask = interest; - } - - } else { - /* This channel does not cover another one. + Channel *downChanPtr = chanPtr->downChanPtr; + + /* + * 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. + */ + + if (statePtr->flags & TCL_WRITABLE) { + CopyState* csPtr; + + csPtr = statePtr->csPtr; + statePtr->csPtr = (CopyState*) NULL; + + 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; + } + + statePtr->csPtr = csPtr; + } + + /* + * 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. + */ + + if (((statePtr->flags & TCL_READABLE) != 0) && + ((statePtr->inQueueHead != (ChannelBuffer*) NULL) || + (chanPtr->inQueueHead != (ChannelBuffer*) NULL))) { + + if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) && + (chanPtr->inQueueHead != (ChannelBuffer*) NULL)) { + statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead; + statePtr->inQueueTail = chanPtr->inQueueTail; + statePtr->inQueueHead = statePtr->inQueueTail; + + } 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); + } + + statePtr->topChanPtr = downChanPtr; + downChanPtr->upChanPtr = (Channel *) NULL; + + /* + * Leave this link intact for closeproc + * chanPtr->downChanPtr = (Channel *) NULL; + */ + + /* + * 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); + } + + chanPtr->typePtr = NULL; + /* + * AK: Tcl_NotifyChannel may hold a reference to this block of memory + */ + Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); + UpdateInterest(downChanPtr); + + if (result != 0) { + Tcl_SetErrno(result); + return TCL_ERROR; + } + } else { + /* + * 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; } /* *---------------------------------------------------------------------- * * 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 * to the channel it is stacked upon. This reference can be used in * queries, but modification is not allowed. @@ -1862,12 +1391,90 @@ 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_GetTopChannel -- + * + * Returns the top channel of a channel stack. + * + * Results: + * 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. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +Tcl_GetTopChannel(chan) + Tcl_Channel chan; +{ + Channel *chanPtr = (Channel *) chan; /* The actual channel. */ + + return (Tcl_Channel) chanPtr->state->topChanPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetChannelInstanceData -- + * + * Returns the client data associated with a channel. + * + * Results: + * The client data. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +ClientData +Tcl_GetChannelInstanceData(chan) + Tcl_Channel chan; /* Channel for which to return client data. */ +{ + Channel *chanPtr = (Channel *) chan; /* The actual channel. */ + + return chanPtr->instanceData; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetChannelType -- + * + * Given a channel structure, returns the channel type structure. + * + * Results: + * Returns a pointer to the channel type structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_ChannelType * +Tcl_GetChannelType(chan) + Tcl_Channel chan; /* The channel to return type for. */ +{ + Channel *chanPtr = (Channel *) chan; /* The actual channel. */ + + return chanPtr->typePtr; } /* *---------------------------------------------------------------------- * @@ -1888,14 +1495,14 @@ int Tcl_GetChannelMode(chan) Tcl_Channel chan; /* The channel for which the mode is * being computed. */ { - Channel *chanPtr; /* The actual channel. */ + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of actual channel. */ - chanPtr = (Channel *) chan; - return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE)); + return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE)); } /* *---------------------------------------------------------------------- * @@ -1916,40 +1523,14 @@ char * Tcl_GetChannelName(chan) Tcl_Channel chan; /* The channel for which to return the name. */ { - Channel *chanPtr; /* The actual channel. */ - - chanPtr = (Channel *) chan; - return chanPtr->channelName; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetChannelType -- - * - * Given a channel structure, returns the channel type structure. - * - * Results: - * Returns a pointer to the channel type structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_ChannelType * -Tcl_GetChannelType(chan) - Tcl_Channel chan; /* The channel to return type for. */ -{ - Channel *chanPtr; /* The actual channel. */ - - chanPtr = (Channel *) chan; - return chanPtr->typePtr; + ChannelState *statePtr; /* State of actual channel. */ + + statePtr = ((Channel *) chan)->state; + return statePtr->channelName; } /* *---------------------------------------------------------------------- * @@ -1975,44 +1556,18 @@ { Channel *chanPtr; /* The actual channel. */ ClientData handle; int result; - chanPtr = (Channel *) chan; + chanPtr = ((Channel *) chan)->state->bottomChanPtr; result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData, direction, &handle); if (handlePtr) { *handlePtr = handle; } return result; } - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetChannelInstanceData -- - * - * Returns the client data associated with a channel. - * - * Results: - * The client data. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -ClientData -Tcl_GetChannelInstanceData(chan) - Tcl_Channel chan; /* Channel for which to return client data. */ -{ - Channel *chanPtr; /* The actual channel. */ - - chanPtr = (Channel *) chan; - return chanPtr->instanceData; -} /* *--------------------------------------------------------------------------- * * AllocChannelBuffer -- @@ -2072,12 +1627,12 @@ * *---------------------------------------------------------------------- */ 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. */ { /* @@ -2086,34 +1641,34 @@ if (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; } } /* * 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; } } /* @@ -2144,22 +1699,22 @@ * *---------------------------------------------------------------------- */ 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; } /* *---------------------------------------------------------------------- * @@ -2176,15 +1731,15 @@ * *---------------------------------------------------------------------- */ 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, "unable to access channel: invalid channel", (char *) NULL); @@ -2221,32 +1776,31 @@ Channel *chanPtr; /* The channel to flush on. */ int calledFromAsyncFlush; /* If nonzero then we are being * 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 * buffer available to be written. */ int written; /* Amount of output data actually * 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 * channel deallocation runs before all channels are deregistered in * all interpreters. */ - if (CheckForDeadChannel(interp,chanPtr)) return -1; + if (CheckForDeadChannel(interp, statePtr)) return -1; /* * Loop over the queued buffers and attempt to flush as * much as possible of the queued output to the channel. */ @@ -2256,34 +1810,34 @@ /* * If the queue is empty and there is a ready current buffer, OR if * 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 * flush is active, we just return without producing any output. */ if ((!calledFromAsyncFlush) && - (chanPtr->flags & BG_FLUSH_SCHEDULED)) { + (statePtr->flags & BG_FLUSH_SCHEDULED)) { return 0; } /* * If the output queue is still empty, break out of the while loop. @@ -2294,16 +1848,16 @@ } /* * 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 * write any more output at this time. */ @@ -2329,12 +1883,12 @@ * This used to check for CHANNEL_NONBLOCKING, and panic * if the channel was blocking. However, it appears * 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; break; } @@ -2342,12 +1896,12 @@ /* * Decide whether to report the error upwards or defer it. */ if (calledFromAsyncFlush) { - if (chanPtr->unreportedError == 0) { - chanPtr->unreportedError = errorCode; + if (statePtr->unreportedError == 0) { + statePtr->unreportedError = errorCode; } } else { Tcl_SetErrno(errorCode); if (interp != NULL) { Tcl_SetResult(interp, @@ -2358,11 +1912,11 @@ /* * When we get an error we throw away all the output * currently queued. */ - DiscardOutputQueued(chanPtr); + DiscardOutputQueued(statePtr); continue; } else { wroteSome = 1; } @@ -2371,15 +1925,15 @@ /* * If this buffer is now empty, recycle it. */ 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)". */ /* * If we wrote some data while flushing in the background, we are done. @@ -2386,40 +1940,32 @@ * We can't finish the background flush until we run out of data and * the channel becomes writable again. This ensures that all of the * 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); } } /* * If the channel is flagged as closed, delete it when the refCount * drops to zero, the output queue is empty and there is no output * 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; } /* @@ -2452,106 +1998,127 @@ Channel *chanPtr; /* The channel to close. */ int errorCode; /* Status of operation so far. */ { 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; } /* * The caller guarantees that there are no more buffers * queued for output. */ - if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) { + if (statePtr->outQueueHead != (ChannelBuffer *) NULL) { panic("TclFlush, closed channel: queued output left"); } /* * If the EOF character is set in the channel, append that to the * 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; + } } /* * If we are being called synchronously, report either * 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; if (errorCode != 0) { Tcl_SetErrno(errorCode); @@ -2560,152 +2127,57 @@ /* * 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; - - /* - * 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; - } - } - - /* - * 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; - } - - /* - * 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); - } - - 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) 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; - - Tcl_FreeEncoding(chanPtr->encoding); - if (chanPtr->outputStage != NULL) { - ckfree((char *) chanPtr->outputStage); - } + if (chanPtr->downChanPtr != (Channel *) NULL) { +#if 0 + int code = TCL_OK; + + 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; + + statePtr->nextCSPtr = tsdPtr->firstCSPtr; + tsdPtr->firstCSPtr = statePtr; + + statePtr->topChanPtr = downChanPtr; + downChanPtr->upChanPtr = (Channel *) NULL; + chanPtr->typePtr = NULL; Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); - return 0; + return Tcl_Close(interp, (Tcl_Channel) downChanPtr); +#endif } + + /* + * There is only the TOP Channel, so we free the remaining + * pointers we have and then ourselves. + */ + chanPtr->typePtr = NULL; + + Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); + + return errorCode; } /* *---------------------------------------------------------------------- * @@ -2739,18 +2211,19 @@ ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ CloseCallback *cbPtr; /* Iterate over close callbacks * 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; 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 * channel is being explicitly closed, so bump the refCount down * artificially to 0. This will ensure that the channel is actually @@ -2757,12 +2230,19 @@ * closed, below. Also set the static pointer to NULL for the channel. */ 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"); } /* * Remove any references to channel handlers for this channel that @@ -2780,66 +2260,65 @@ /* * 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 * will occur if Tcl_DoOneEvent is called before the channel is * finally deleted in FlushChannel. This can happen if the channel * 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); } /* * 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; } /* * If this channel supports it, close the read side, since we don't need it * anymore and this will help avoid deadlocks on some channel types. @@ -2856,11 +2335,11 @@ * The call to FlushChannel will flush any queued output and invoke * the close function of the channel driver, or it will set up the * 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; } return TCL_OK; } @@ -2891,21 +2370,83 @@ 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(). */ { + /* + * 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); } return DoWrite(chanPtr, 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 -- @@ -2932,20 +2473,26 @@ Tcl_Channel chan; /* The channel to buffer output for. */ CONST char *src; /* UTF-8 characters to queue in output buffer. */ 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. */ @@ -2989,19 +2536,25 @@ int 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 { src = Tcl_GetStringFromObj(objPtr, &srcLen); return WriteChars(chanPtr, src, srcLen); @@ -3033,10 +2586,11 @@ WriteBytes(chanPtr, src, srcLen) Channel *chanPtr; /* The channel to buffer output for. */ 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; total = 0; @@ -3047,14 +2601,14 @@ * Loop over all bytes in src, storing them in output buffer with * proper EOL translation. */ 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; dstLen = dstMax; @@ -3072,11 +2626,11 @@ *dst++ = '\n'; dstLen--; sawLF++; } - sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite); + sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite); dstLen += savedLF; savedLF = 0; if (dstLen > dstMax) { savedLF = 1; @@ -3120,10 +2674,11 @@ WriteChars(chanPtr, src, srcLen) Channel *chanPtr; /* The channel to buffer output for. */ 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; int dstWrote, dstLen, stageLen, stageMax, stageRead; Tcl_Encoding encoding; @@ -3131,20 +2686,20 @@ total = 0; 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 * with proper EOL translation. */ while (srcLen + savedLF > 0) { - stage = chanPtr->outputStage; - stageMax = chanPtr->bufSize; + stage = statePtr->outputStage; + stageMax = statePtr->bufSize; stageLen = stageMax; toWrite = stageLen; if (toWrite > srcLen) { toWrite = srcLen; @@ -3160,11 +2715,11 @@ *stage++ = '\n'; stageLen--; sawLF++; } - sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite); + sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite); stage -= savedLF; stageLen += savedLF; savedLF = 0; @@ -3173,11 +2728,11 @@ stageLen = stageMax; } src += toWrite; srcLen -= toWrite; - flags = chanPtr->outputEncodingFlags; + flags = statePtr->outputEncodingFlags; if (srcLen == 0) { flags |= TCL_ENCODING_END; } /* @@ -3184,14 +2739,14 @@ * Loop over all UTF-8 characters in staging buffer, converting them * to external encoding, storing them in output buffer. */ 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; if (saved != 0) { @@ -3207,11 +2762,11 @@ dstLen -= saved; saved = 0; } Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags, - &chanPtr->outputEncodingState, dst, + &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL); if (stageRead + dstWrote == 0) { /* * We have an incomplete UTF-8 character at the end of the * staging buffer. It will get moved to the beginning of the @@ -3291,12 +2846,12 @@ * *--------------------------------------------------------------------------- */ 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 * source characters. */ CONST char *src; /* Source UTF-8 characters. */ @@ -3311,11 +2866,11 @@ int srcLen, newlineFound; newlineFound = 0; srcLen = *srcLenPtr; - switch (chanPtr->outputTranslation) { + switch (statePtr->outputTranslation) { case TCL_TRANSLATE_LF: { for (dstEnd = dst + srcLen; dst < dstEnd; ) { if (*src == '\n') { newlineFound = 1; } @@ -3403,29 +2958,30 @@ Channel *chanPtr; /* Channel being read, for buffering mode. */ ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */ 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. * 2. if it contains a newline and this channel is line-buffered. * 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; } } return 0; @@ -3502,35 +3058,41 @@ Tcl_Channel chan; /* Channel from which to read. */ Tcl_Obj *objPtr; /* The line read will be appended to this * 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 * find a newline in the available input. */ 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; } @@ -3562,11 +3124,11 @@ dst = objPtr->bytes + oldLength; dstEnd = dst; skip = 0; eof = NULL; - inEofChar = chanPtr->inEofChar; + inEofChar = statePtr->inEofChar; while (1) { if (dst >= dstEnd) { if (FilterInputBytes(chanPtr, &gs) != 0) { goto restore; @@ -3593,11 +3155,11 @@ * On EOL, leave current file position pointing after the EOL, but * don't store the EOL in the output string. */ eol = dst; - switch (chanPtr->inputTranslation) { + switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: { for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\n') { skip = 1; goto goteol; @@ -3642,12 +3204,12 @@ } break; } 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'. */ @@ -3655,11 +3217,11 @@ int rawRead; 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; gs.rawRead -= rawRead; gs.bytesWrote--; @@ -3683,11 +3245,11 @@ dst = dstEnd; PeekAhead(chanPtr, &dstEnd, &gs); eol = objPtr->bytes + offset; if (eol >= dstEnd) { eol--; - chanPtr->flags |= INPUT_SAW_CR; + statePtr->flags |= INPUT_SAW_CR; goto goteol; } } if (*eol == '\n') { skip++; @@ -3706,14 +3268,14 @@ * pointing at the EOF character, but don't store the EOF * character in the output string. */ 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) { /* * If we didn't produce any bytes before encountering EOF, @@ -3738,24 +3300,24 @@ * remove the correct number of bytes from the channel buffer. */ 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; /* * Recycle all the emptied buffers. */ 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; /* * Couldn't get a complete line. This only happens if we get a error @@ -3762,20 +3324,20 @@ * reading from the channel or we are non-blocking and there wasn't * an EOL or EOF in the data available. */ restore: - bufPtr = chanPtr->inQueueHead; + bufPtr = statePtr->inQueueHead; bufPtr->nextRemoved = oldRemoved; for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bufPtr->nextRemoved = BUFFER_PADDING; } CommonGetsCleanup(chanPtr, encoding); - chanPtr->inputEncodingState = oldState; - chanPtr->inputEncodingFlags = oldFlags; + statePtr->inputEncodingState = oldState; + statePtr->inputEncodingFlags = oldFlags; Tcl_SetObjLength(objPtr, oldLength); /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing @@ -3785,11 +3347,11 @@ * on the channel (e.g. gets, read, fconfigure) that changes the blocking * state. Note that this means a file event will not be delivered even * 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: /* * Update the notifier state so we don't block while there is still @@ -3827,10 +3389,11 @@ static int 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; int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length; Tcl_Obj *objPtr; @@ -3863,24 +3426,24 @@ * seen EOL. Need to read more bytes from the channel device. * Side effect is to allocate another channel buffer. */ 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; } /* * Convert some of the bytes from the channel buffer to UTF-8. Space in @@ -3910,13 +3473,13 @@ Tcl_SetObjLength(objPtr, length); spaceLeft = length - offset; 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) { /* * The last few bytes in this channel buffer were the start of a @@ -3933,11 +3496,11 @@ /* * Some raw bytes were converted to UTF-8. Fall through, * 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. */ @@ -3950,13 +3513,13 @@ goto read; } } 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), (VOID *) (raw + gsPtr->rawRead), (size_t) extra); nextPtr->nextRemoved -= extra; @@ -3995,10 +3558,11 @@ Channel *chanPtr; /* The channel to read. */ char **dstEndPtr; /* Filled with pointer to end of new range * 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; bufPtr = gsPtr->bufPtr; @@ -4020,28 +3584,28 @@ * Don't peek ahead if last read was short read. */ 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. */ goto cleanup; } - (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING); + StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); } } } if (FilterInputBytes(chanPtr, gsPtr) == 0) { *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote; } if (blockModeProc != NULL) { - (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING); + StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); } return; cleanup: bufPtr->nextRemoved += gsPtr->rawRead; @@ -4071,23 +3635,24 @@ static void 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 * boundaries, the split-up bytes were moved to the next channel * buffer by FilterInputBytes(). Move the bytes back to their @@ -4109,11 +3674,11 @@ nextPtr->nextRemoved = BUFFER_PADDING; } bufPtr = nextPtr; } } - if (chanPtr->encoding == NULL) { + if (statePtr->encoding == NULL) { Tcl_FreeEncoding(encoding); } } /* @@ -4142,19 +3707,146 @@ Tcl_Read(chan, dst, bytesToRead) Tcl_Channel chan; /* The channel from which to read. */ 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; } return DoRead(chanPtr, 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 -- @@ -4187,23 +3879,29 @@ * will be appended to the object. Otherwise, * the data will replace the existing contents * 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) { if (encoding == NULL) { Tcl_SetByteArrayLength(objPtr, 0); @@ -4219,43 +3917,43 @@ } } 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); } /* * 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) { if (result == EAGAIN) { break; @@ -4266,11 +3964,11 @@ } else { copied += copiedNow; toRead -= copiedNow; } } - chanPtr->flags &= ~CHANNEL_BLOCKED; + statePtr->flags &= ~CHANNEL_BLOCKED; if (encoding == NULL) { Tcl_SetByteArrayLength(objPtr, offset); } else { Tcl_SetObjLength(objPtr, offset); } @@ -4309,12 +4007,12 @@ * *--------------------------------------------------------------------------- */ 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 * buffer in the queue -- even if this number * is larger than the number of characters @@ -4335,11 +4033,11 @@ ChannelBuffer *bufPtr; char *src, *dst; offset = *offsetPtr; - bufPtr = chanPtr->inQueueHead; + bufPtr = statePtr->inQueueHead; src = bufPtr->buf + bufPtr->nextRemoved; srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; toRead = bytesToRead; if ((unsigned) toRead > (unsigned) srcLen) { @@ -4360,12 +4058,12 @@ } dst = (char *) Tcl_SetByteArrayLength(objPtr, length); } 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; return 1; } @@ -4375,11 +4073,11 @@ toRead--; } 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; } } bufPtr->nextRemoved += srcRead; @@ -4413,12 +4111,12 @@ * *--------------------------------------------------------------------------- */ 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 * buffer in the queue -- even if this number * is larger than the number of characters @@ -4446,11 +4144,11 @@ Tcl_EncodingState oldState; factor = *factorPtr; offset = *offsetPtr; - bufPtr = chanPtr->inQueueHead; + bufPtr = statePtr->inQueueHead; src = bufPtr->buf + bufPtr->nextRemoved; srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; toRead = charsToRead; if ((unsigned) toRead > (unsigned) srcLen) { @@ -4491,40 +4189,40 @@ dstNeeded = spaceLeft; } 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 { /* * The next char was not a '\n'. Produce a '\r'. */ *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) { /* * Not enough bytes in src buffer to make a complete char. Copy * the bytes to the next buffer to make a new contiguous string, @@ -4539,36 +4237,36 @@ * There isn't enough data in the buffers to complete the next * character, so we need to wait for more data before the next * 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? */ 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); } /* * The number of characters that we got may be less than the number * that we started with because "\r\n" sequences may have been @@ -4583,19 +4281,19 @@ */ 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) { *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead; } @@ -4620,12 +4318,12 @@ * *--------------------------------------------------------------------------- */ 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 * source characters. */ CONST char *srcStart; /* Source characters. */ @@ -4641,11 +4339,11 @@ CONST char *eof; dstLen = *dstLenPtr; eof = NULL; - inEofChar = chanPtr->inEofChar; + inEofChar = statePtr->inEofChar; if (inEofChar != '\0') { /* * Find EOF in translated buffer then compress out the EOL. The * source buffer may be much longer than the destination buffer -- * we only want to return EOF if the EOF has been copied to the @@ -4665,11 +4363,11 @@ *srcLenPtr = srcLen; break; } } } - switch (chanPtr->inputTranslation) { + switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: { if (dstStart != srcStart) { memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen); } srcLen = dstLen; @@ -4701,11 +4399,11 @@ for ( ; src < srcEnd; ) { if (*src == '\r') { src++; if (src >= srcMax) { - chanPtr->flags |= INPUT_NEED_NL; + statePtr->flags |= INPUT_NEED_NL; } else if (*src == '\n') { *dst++ = *src++; } else { *dst++ = '\r'; } @@ -4724,21 +4422,21 @@ dst = dstStart; src = srcStart; 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++; } src++; @@ -4763,13 +4461,13 @@ * EOF character was seen in EOL translated range. Leave current * file position pointing at the EOF character, but don't store the * 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; } *srcLenPtr = srcLen; return 0; @@ -4799,56 +4497,64 @@ int len; /* The length of the input. */ int atEnd; /* If non-zero, add at end of queue; otherwise * 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. * (sticky EOF is set if we have seen the input eofChar, to prevent * reading beyond the eofChar). Otherwise, clear the EOF flags, and * clear the BLOCKED bit. We want to discover these conditions anew * 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++) { bufPtr->buf[i] = str[i]; } 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: /* * Update the notifier state so we don't block while there is still @@ -4878,24 +4584,30 @@ int 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); if (result != 0) { return TCL_ERROR; @@ -4921,35 +4633,35 @@ * *---------------------------------------------------------------------- */ 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); } /* * If discardSavedBuffers is nonzero, must also discard any previously * saved buffer in the saveInBufPtr field. */ 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; } } } /* @@ -4975,58 +4687,87 @@ { int toRead; /* How much to read? */ 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 * but not yet deallocated, which can happen if the exit handler for * channel cleanup has run but the channel is still registered in some * 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; } /* * If EOF is set, we should avoid calling the driver because on some * 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) { bufPtr->nextAdded += nread; @@ -5036,18 +4777,18 @@ * will block in the low level reading code even though the * channel is set into nonblocking mode. */ 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); return result; } @@ -5076,21 +4817,21 @@ Tcl_Seek(chan, offset, mode) Tcl_Channel chan; /* The channel on which to seek. */ 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. */ int curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the * 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; } /* * Disallow seek on dead channels -- channels that have been closed but @@ -5097,11 +4838,17 @@ * 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 (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 * defined. This means that the channel does not support seeking. */ @@ -5114,25 +4861,36 @@ /* * Compute how much input and output is buffered. If both input and * 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)) { Tcl_SetErrno(EFAULT); return -1; @@ -5150,18 +4908,18 @@ /* * Discard any queued input - this input should not be read after * 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)); /* * If the channel is in asynchronous output mode, switch it back * to synchronous mode and cancel any async flush that may be @@ -5168,24 +4926,19 @@ * scheduled. After the flush, the channel will be put back into * asynchronous output 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)); } } /* * If the flush fails we cannot recover the original position. In @@ -5217,20 +4970,15 @@ * NOTE: Even if there was an async flush active we do not restore * it now because we already flushed all the queued output, above. */ 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; } @@ -5255,18 +5003,18 @@ 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; } /* * Disallow tell on dead channels -- channels that have been closed but @@ -5273,14 +5021,20 @@ * 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 (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. */ @@ -5292,25 +5046,25 @@ /* * Compute how much input and output is buffered. If both input and * 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)) { Tcl_SetErrno(EFAULT); return -1; @@ -5350,39 +5104,58 @@ * *--------------------------------------------------------------------------- */ 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; } /* * 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; } if (direction == TCL_READABLE) { @@ -5391,14 +5164,14 @@ * (sticky EOF is set if we have seen the input eofChar, to prevent * reading beyond the eofChar). Also, always clear the BLOCKED bit. * 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; } @@ -5420,16 +5193,16 @@ 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; } /* *---------------------------------------------------------------------- * @@ -5448,23 +5221,23 @@ 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; } /* *---------------------------------------------------------------------- * * 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 * open for reading. * @@ -5476,20 +5249,67 @@ 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; + /* State of 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; } /* *---------------------------------------------------------------------- @@ -5512,11 +5332,11 @@ Tcl_SetChannelBufferSize(chan, sz) Tcl_Channel chan; /* The channel whose buffer size * 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, * do not accept the requested size and leave the current buffer size. */ @@ -5526,20 +5346,20 @@ } if (sz > (1024 * 1024)) { return; } - chanPtr = (Channel *) chan; - chanPtr->bufSize = sz; - - if (chanPtr->outputStage != NULL) { - ckfree((char *) chanPtr->outputStage); - chanPtr->outputStage = NULL; - } - if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { - chanPtr->outputStage = (char *) - ckalloc((unsigned) (chanPtr->bufSize + 2)); + statePtr = ((Channel *) chan)->state; + statePtr->bufSize = sz; + + if (statePtr->outputStage != NULL) { + ckfree((char *) statePtr->outputStage); + statePtr->outputStage = NULL; + } + if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { + statePtr->outputStage = (char *) + ckalloc((unsigned) (statePtr->bufSize + 2)); } } /* *---------------------------------------------------------------------- @@ -5560,14 +5380,14 @@ int 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; } /* *---------------------------------------------------------------------- * @@ -5666,34 +5486,43 @@ Tcl_DString *dsPtr; /* Where to store value(s). */ { 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. - */ - - if (chanPtr->csPtr) { - if (chanPtr == chanPtr->csPtr->readPtr) { - flags = chanPtr->csPtr->readFlags; - } else { - flags = chanPtr->csPtr->writeFlags; - } - } else { - flags = chanPtr->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 (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR; + if (CheckForDeadChannel(interp, statePtr)) { + return TCL_ERROR; + } + + /* + * This operation should occur at the top of a channel stack. + */ + + 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 * options and values. */ @@ -5734,11 +5563,11 @@ if ((len == 0) || ((len > 7) && (optionName[1] == 'b') && (strncmp(optionName, "-buffersize", len) == 0))) { 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; } } @@ -5746,15 +5575,15 @@ ((len > 2) && (optionName[1] == 'e') && (strncmp(optionName, "-encoding", len) == 0))) { 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; } } @@ -5767,26 +5596,26 @@ if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { 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); } } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { @@ -5805,26 +5634,26 @@ if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { 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"); } } @@ -5879,40 +5708,46 @@ Tcl_Channel chan; /* Channel on which to set mode. */ char *optionName; /* Which option to set? */ 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", (char *) NULL); } 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. */ - 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') && (strncmp(optionName, "-blocking", len) == 0)) { if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) { @@ -5926,20 +5761,20 @@ return SetBlockMode(interp, chanPtr, newMode); } else if ((len > 7) && (optionName[1] == 'b') && (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: ", "must be one of full, line, or none", (char *) NULL); @@ -5947,13 +5782,13 @@ } } 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)) { Tcl_Encoding encoding; @@ -5963,32 +5798,32 @@ encoding = Tcl_GetEncoding(interp, newValue); if (encoding == NULL) { 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)) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { 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) { Tcl_AppendResult(interp, "bad value for -eofchar: should be a list of one or", @@ -5995,15 +5830,15 @@ " two elements", (char *) NULL); } 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) { ckfree((char *) argv); } @@ -6015,15 +5850,15 @@ if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } 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, "bad value for -translation: must be a one or two", " element list", (char *) NULL); @@ -6032,18 +5867,18 @@ return TCL_ERROR; } 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) { newMode = TCL_TRANSLATE_CR; } else if (strcmp(readMode, "crlf") == 0) { @@ -6065,14 +5900,14 @@ * Reset the EOL flags since we need to look at any buffered * data to see if the new translation mode allows us to * 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); } } if (writeMode) { if (*writeMode == '\0') { @@ -6084,27 +5919,27 @@ * A better solution for achieving this effect will be * coded later. */ 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, "bad value for -translation: ", "must be one of auto, binary, cr, lf, crlf,", @@ -6125,35 +5960,35 @@ /* * If bufsize changes, need to get rid of old utility buffer. */ - if (chanPtr->saveInBufPtr != NULL) { - RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1); - chanPtr->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->saveInBufPtr != NULL) { + RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1); + statePtr->saveInBufPtr = 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; } } /* * 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; } /* @@ -6179,31 +6014,32 @@ static void CleanupChannelHandlers(interp, chanPtr) Tcl_Interp *interp; Channel *chanPtr; { + ChannelState *statePtr = chanPtr->state; /* state info for channel */ EventScriptRecord *sPtr, *prevPtr, *nextPtr; /* * Remove fileevent records on this channel that refer to the * 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); } else { prevPtr = sPtr; @@ -6236,18 +6072,128 @@ int mask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * 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. */ Tcl_Preserve((ClientData) channel); @@ -6257,11 +6203,11 @@ * 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 ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { + if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { FlushChannel(NULL, chanPtr, 1); mask &= ~TCL_WRITABLE; } /* @@ -6270,12 +6216,12 @@ */ 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 * have occurred on the channel, invoke its procedure. */ @@ -6298,23 +6244,24 @@ if (chanPtr->typePtr != NULL) { UpdateInterest(chanPtr); /* 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); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; channel = (Tcl_Channel) chanPtr; } +#endif } /* *---------------------------------------------------------------------- * @@ -6334,18 +6281,19 @@ 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; } /* * If there is data in the input queue, and we aren't waiting for more @@ -6353,17 +6301,17 @@ * notifier. Also, cancel the read interest so we don't get duplicate * events. */ 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); } } } (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask); @@ -6389,27 +6337,28 @@ static void 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); } } /* @@ -6445,21 +6394,20 @@ Tcl_ChannelProc *proc; /* Procedure to call for each * selected event. */ 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) && (chPtr->clientData == clientData)) { break; @@ -6469,12 +6417,12 @@ chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler)); chPtr->mask = 0; chPtr->proc = proc; chPtr->clientData = clientData; chPtr->chanPtr = chanPtr; - chPtr->nextPtr = chanPtr->chPtr; - chanPtr->chPtr = chPtr; + chPtr->nextPtr = statePtr->chPtr; + statePtr->chPtr = chPtr; } /* * The remainder of the initialization below is done regardless of * whether or not this is a new record or a modification of an old @@ -6486,18 +6434,18 @@ /* * Recompute the interest mask for the channel - this call may actually * 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); } /* *---------------------------------------------------------------------- * @@ -6524,31 +6472,30 @@ Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */ ClientData clientData; /* The client data in the callback * 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) && (chPtr->proc == proc)) { break; } prevChPtr = chPtr; } - + /* * If not found, return without doing anything. */ if (chPtr == (ChannelHandler *) NULL) { @@ -6571,11 +6518,11 @@ /* * Splice it out of the list of channel handlers. */ if (prevChPtr == (ChannelHandler *) NULL) { - chanPtr->chPtr = chPtr->nextPtr; + statePtr->chPtr = chPtr->nextPtr; } else { prevChPtr->nextPtr = chPtr->nextPtr; } ckfree((char *) chPtr); @@ -6583,18 +6530,18 @@ * Recompute the interest list for the channel, so that infinite loops * will not result if Tcl_DeleteChannelHandler is called inside an * 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); } /* *---------------------------------------------------------------------- * @@ -6619,25 +6566,26 @@ Channel *chanPtr; /* The channel for which to delete the * script record (if any). */ 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); break; @@ -6670,13 +6618,14 @@ * be stored. */ int mask; /* Set of events for which script * 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)) { Tcl_DecrRefCount(esPtr->scriptPtr); esPtr->scriptPtr = (Tcl_Obj *) NULL; @@ -6685,13 +6634,13 @@ } if (esPtr == (EventScriptRecord *) NULL) { 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; esPtr->mask = mask; Tcl_IncrRefCount(scriptPtr); @@ -6699,11 +6648,11 @@ } /* *---------------------------------------------------------------------- * - * ChannelEventScriptInvoker -- + * TclChannelEventScriptInvoker -- * * Invokes a script scheduled by "fileevent" for when the channel * becomes ready for IO. This function is invoked by the channel * handler which was created by the Tcl "fileevent" command. * @@ -6714,12 +6663,12 @@ * Whatever the script does. * *---------------------------------------------------------------------- */ -static void -ChannelEventScriptInvoker(clientData, mask) +void +TclChannelEventScriptInvoker(clientData, mask) ClientData clientData; /* The script+interp record. */ int mask; /* Not used. */ { Tcl_Interp *interp; /* Interpreter in which to eval the script. */ Channel *chanPtr; /* The channel for which this handler is @@ -6726,16 +6675,15 @@ * registered. */ EventScriptRecord *esPtr; /* The event script + interpreter to eval it * 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 * that is done by Tcl_NotifyChannel before calling channel handlers. */ @@ -6789,10 +6737,11 @@ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { 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. */ int mask; static char *modeOptions[] = {"readable", "writable", NULL}; @@ -6811,12 +6760,13 @@ chanName = Tcl_GetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); 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); return TCL_ERROR; } @@ -6825,11 +6775,11 @@ * If we are supposed to return the script, do so. */ 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)) { Tcl_SetObjResult(interp, esPtr->scriptPtr); break; @@ -6859,543 +6809,10 @@ } /* *---------------------------------------------------------------------- * - * 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 * synchronously or asynchronously. If a command script is * supplied, the operation runs in the background. The script @@ -7420,27 +6837,31 @@ int toRead; /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr; /* Pointer to script to execute or NULL. */ { 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 * non-blocking channels. Foreground copies need blocking channels. * If there is an error, restore the old blocking mode. @@ -7470,34 +6891,34 @@ /* * Make sure the output side is unbuffered. */ - outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED)) + outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED)) | CHANNEL_UNBUFFERED; /* * Allocate a new CopyState to maintain info about the current copy in * progress. This structure will be deallocated when the copy is * 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. */ @@ -7527,51 +6948,57 @@ int mask; /* Current channel event flags. */ { 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) { /* * 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; } /* * 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: errObj = Tcl_NewObj(); Tcl_AppendStringsToObj(errObj, "error reading \"", @@ -7600,11 +7027,11 @@ /* * 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(); Tcl_AppendStringsToObj(errObj, "error writing \"", Tcl_GetChannelName(outChan), "\": ", @@ -7615,11 +7042,11 @@ /* * Check to see if the write is happening in the background. If so, * 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, (ClientData) csPtr); } @@ -7719,39 +7146,40 @@ DoRead(chanPtr, bufPtr, toRead) Channel *chanPtr; /* The channel from which to read. */ 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) { if (result != EAGAIN) { copied = -1; @@ -7759,11 +7187,11 @@ goto done; } } } - chanPtr->flags &= (~(CHANNEL_BLOCKED)); + statePtr->flags &= (~(CHANNEL_BLOCKED)); done: /* * Update the notifier state so we don't block while there is still * data in the buffers. @@ -7791,21 +7219,21 @@ * *---------------------------------------------------------------------- */ 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. */ /* * If there is no input at all, return zero. The invariant is that either @@ -7812,18 +7240,18 @@ * 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 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; } @@ -7876,14 +7304,14 @@ /* * If there is a held-back "\r" at EOF, produce it now. */ 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; } @@ -7904,18 +7332,18 @@ end = result + copied; dst = result; 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++; } } @@ -7947,20 +7375,20 @@ end = result + copied; dst = result; 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; break; } @@ -7973,20 +7401,20 @@ * If an in-stream EOF character is set for this channel, check that * the input we copied so far does not contain the EOF char. If it does, * 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; } } } @@ -7994,22 +7422,114 @@ /* * 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; + statePtr->inQueueHead = bufPtr->nextPtr; + if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { + statePtr->inQueueTail = (ChannelBuffer *) NULL; } - RecycleBuffer(chanPtr, bufPtr, 0); + 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->state, bufPtr, 0); + } + + /* + * Return the number of characters copied into the result buffer. + */ return copied; } /* @@ -8037,10 +7557,11 @@ DoWrite(chanPtr, src, srcLen) Channel *chanPtr; /* The channel to buffer output for. */ 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; char *sPtr; /* Search variables for newline. */ int crsent; /* In CRLF eol translation mode, @@ -8076,23 +7597,23 @@ /* * 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) { destCopied = 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); break; case TCL_TRANSLATE_CR: @@ -8133,35 +7654,35 @@ * contains a newline and this channel is line-buffered, or if it * contains any output and this channel is unbuffered. */ 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++) { if (*sPtr == '\n') { foundNewline = 1; break; } } 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; } } totalDestCopied += srcCopied; src += srcCopied; srcLen -= srcCopied; - if (chanPtr->flags & BUFFER_READY) { + if (statePtr->flags & BUFFER_READY) { if (FlushChannel(NULL, chanPtr, 0) != 0) { return -1; } } } /* Closes "while" */ @@ -8214,35 +7735,38 @@ 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, (ClientData)csPtr); if (csPtr->readPtr != csPtr->writePtr) { @@ -8249,14 +7773,60 @@ Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr, CopyEventProc, (ClientData)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 -- @@ -8279,27 +7849,25 @@ Tcl_Interp *interp; /* Interp for error reporting. */ Channel *chanPtr; /* Channel to modify. */ 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); } 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; } /* @@ -8346,31 +7914,31 @@ int 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, Tcl_NewStringObj(name, -1)) != TCL_OK)) { return TCL_ERROR; } } return TCL_OK; } ADDED generic/tclIO.h Index: generic/tclIO.h ================================================================== --- /dev/null +++ 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.2.2 2000/07/25 16:54:52 kupries 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; ADDED generic/tclIOGT.c Index: generic/tclIOGT.c ================================================================== --- /dev/null +++ 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.2.1 2000/07/17 22:59:40 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; +} Index: generic/tclInt.decls ================================================================== --- generic/tclInt.decls +++ generic/tclInt.decls @@ -8,11 +8,11 @@ # # Copyright (c) 1998-1999 by Scriptics Corporation. # 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.4.1 2000/07/17 22:59:41 hobbs Exp $ library tcl # Define the unsupported generic interfaces. @@ -575,18 +575,20 @@ } 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) } declare 157 generic { @@ -600,10 +602,19 @@ } declare 160 generic { int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \ 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 # only available on the designated platform. Index: generic/tclIntDecls.h ================================================================== --- generic/tclIntDecls.h +++ generic/tclIntDecls.h @@ -9,11 +9,11 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * * 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.4.1 2000/07/17 22:59:42 hobbs Exp $ */ #ifndef _TCLINTDECLS #define _TCLINTDECLS @@ -504,17 +504,12 @@ int index, int * startPtr, int * endPtr)); /* 152 */ 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)); /* 157 */ EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp, @@ -527,10 +522,16 @@ /* 160 */ 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; struct TclIntStubHooks *hooks; @@ -718,17 +719,19 @@ void (*tclHandleRelease) _ANSI_ARGS_((TclHandle handle)); /* 149 */ int (*tclRegAbout) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp re)); /* 150 */ 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 extern "C" { #endif @@ -1350,18 +1353,12 @@ #endif #ifndef TclGetLibraryPath #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 */ #endif #ifndef TclVarTraceExists @@ -1378,11 +1375,19 @@ #endif #ifndef TclpMatchFilesTypes #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) */ /* !END!: Do not edit above this line. */ #endif /* _TCLINTDECLS */ Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -6,11 +6,11 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * * 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.4.4 2000/07/25 16:54:52 kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" @@ -227,17 +227,19 @@ TclHandleRelease, /* 149 */ TclRegAbout, /* 150 */ 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 = { TCL_STUB_MAGIC, NULL, @@ -789,8 +791,12 @@ Tcl_GetChannelNamesEx, /* 389 */ Tcl_ProcObjCmd, /* 390 */ Tcl_ConditionFinalize, /* 391 */ Tcl_MutexFinalize, /* 392 */ Tcl_CreateThread, /* 393 */ + Tcl_ReadRaw, /* 394 */ + Tcl_WriteRaw, /* 395 */ + Tcl_GetTopChannel, /* 396 */ + Tcl_ChannelBuffered, /* 397 */ }; /* !END!: Do not edit above this line. */ Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -6,23 +6,24 @@ * These commands are not normally included in Tcl applications; * they're only used for testing. * * 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.4.1 2000/07/17 22:59:44 hobbs Exp $ */ #define TCL_TEST #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" +#include "tclIO.h" #include /* * Declare external functions used in Windows tests. */ @@ -274,10 +275,14 @@ Tcl_Interp *interp, int argc, char **argv)); 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 * explicitly don't use EXTERN since this code does not get compiled * into the library: @@ -327,13 +332,13 @@ (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, (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); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); @@ -4240,5 +4245,577 @@ modeString, permissions)); } else { 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; +} Index: tests/all.tcl ================================================================== --- tests/all.tcl +++ tests/all.tcl @@ -5,11 +5,11 @@ # in this directory. # # Copyright (c) 1998-1999 by Scriptics Corporation. # 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.4.1 2000/07/25 16:54:53 kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } @@ -17,10 +17,13 @@ set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] # We need to ensure that the testsDirectory is absolute ::tcltest::normalizePath ::tcltest::testsDirectory + +set ::tcltest::matchFiles iogt*.test +set ::tcltest::match iogt-3.0x puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]" puts stdout "Tests running in working dir: $::tcltest::testsDirectory" if {[llength $::tcltest::skip] > 0} { puts stdout "Skipping tests that match: $::tcltest::skip" ADDED tests/iogt.test Index: tests/iogt.test ================================================================== --- /dev/null +++ tests/iogt.test @@ -0,0 +1,934 @@ +# -*- 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. + + +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} { + 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} { + 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} { + 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 Index: tests/socket.test ================================================================== --- tests/socket.test +++ tests/socket.test @@ -3,16 +3,16 @@ # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # 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.4.1 2000/07/21 05:08:52 hobbs Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to @@ -65,14 +65,15 @@ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 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 # environment variables for externally set values. # @@ -549,23 +550,23 @@ vwait sock puts $s2 one 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} { removeFile script set f [open script w] @@ -1274,10 +1275,11 @@ vwait done after cancel $timer 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 proc count_up {s} { global counter done after_id @@ -1301,16 +1303,17 @@ proc accept {s a p} { after 100 close $s } } 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} { global count done set l [read $s] @@ -1361,12 +1364,11 @@ after cancel $timer sendCommand {close $l} 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 # Script1 is just a 10 second delay. If the server socket # is inherited, it will be held open for 10 seconds @@ -1381,18 +1383,17 @@ # Script2 creates the server socket, launches script1, # waits a second, and exits. The server socket will now # 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 } close $f @@ -1414,12 +1415,11 @@ removeFile script1 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 # Script1 is just a 10 second delay. If the server socket # is inherited, it will be held open for 10 seconds @@ -1434,14 +1434,14 @@ # Script2 opens the client socket and writes to it. It then # launches script1 and exits. If the child process inherited the # 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 vwait forever } @@ -1449,20 +1449,18 @@ # Create the server socket set server [socket -server accept 2829] proc accept { file host port } { - # When the client connects, establish the read handler global server close $server fileevent $file readable [list getdata $file] fconfigure $file -buffering line -blocking 0 return } proc getdata { file } { - # Read handler on the accepted socket. global x global failed set status [catch {read $file} data] if {$status != 0} { @@ -1500,12 +1498,11 @@ } removeFile script1 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 set f [open script1 w] puts $f { @@ -1513,17 +1510,17 @@ vwait forever } 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 } close $f @@ -1534,11 +1531,11 @@ exec $::tcltest::tcltest script2 & 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] # If the socket is still open after 5 seconds, the script1 process # must have inherited the accepted socket. @@ -1545,11 +1542,10 @@ set failed 0 after 5000 set failed 1 proc getdata { file } { - # Read handler on the client socket. global x global failed set status [catch {read $file} data] if {$status != 0} { @@ -1640,16 +1636,5 @@ catch {close $commandSocket} catch {close $remoteProcChan} ::tcltest::cleanupTests flush stdout return - - - - - - - - - - - Index: tools/tcl.wse.in ================================================================== --- tools/tcl.wse.in +++ tools/tcl.wse.in @@ -10,11 +10,11 @@ End Gradient=0 0 0 Windows Flags=00000000000000010010110000001000 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 Patch Memory=4000 Variable Name1=_SYS_ Index: unix/Makefile.in ================================================================== --- unix/Makefile.in +++ unix/Makefile.in @@ -3,11 +3,11 @@ # then it is a template for a Makefile; to generate the actual Makefile, # run "./configure", which is a configuration script generated by the # "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.4.2 2000/07/26 04:57:08 welch Exp $ VERSION = @TCL_VERSION@ #---------------------------------------------------------------- # Things you can change to personalize the Makefile for your own @@ -264,12 +264,12 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAsync.o tclBasic.o tclBinary.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 \ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \ tclStubInit.o tclStubLib.o tclTimer.o tclUtf.o tclUtil.o tclVar.o @@ -290,10 +290,12 @@ $(GENERIC_DIR)/tclIntPlatDecls.h \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ $(GENERIC_DIR)/tclRegexp.h + +INSTALL_HDRS = $(GENERIC_HDRS) GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ $(GENERIC_DIR)/regexec.c \ $(GENERIC_DIR)/regfree.c \ @@ -322,10 +324,11 @@ $(GENERIC_DIR)/tclHistory.c \ $(GENERIC_DIR)/tclIndexObj.c \ $(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 \ $(GENERIC_DIR)/tclListObj.c \ $(GENERIC_DIR)/tclLiteral.c \ @@ -471,11 +474,11 @@ # so that make doesn't try to automatically regenerate the .c file. gendate: yacc -l $(GENERIC_DIR)/tclGetDate.y sed -e 's/yy/TclDate/g' -e '/^#include /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.4.2 2000/07/26 04:57:08 welch Exp $$?' \ -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \ -e '/TclDatenewstate:/d' -e '/#pragma/d' \ -e '/#include /d' -e 's/const /CONST /g' \ $(GENERIC_DIR)/tclDate.c rm y.tab.c @@ -560,11 +563,11 @@ done; @if test ! -x $(SRC_DIR)/install-sh; then \ chmod +x $(SRC_DIR)/install-sh; \ fi @echo "Installing header files"; - @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h ; \ + @for i in $(INSTALL_HDRS) ; \ do \ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \ @@ -780,10 +783,13 @@ $(CC) -c $(CC_SWITCHES) $(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 tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c Index: unix/configure.in ================================================================== --- unix/configure.in +++ unix/configure.in @@ -1,16 +1,16 @@ #! /bin/bash -norc 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.4.1 2000/07/17 23:09:56 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} #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ Index: unix/tcl.spec ================================================================== --- unix/tcl.spec +++ unix/tcl.spec @@ -1,9 +1,9 @@ -# $Id: tcl.spec,v 1.4 2000/04/26 17:31:21 hobbs Exp $ +# $Id: tcl.spec,v 1.4.4.1 2000/07/17 23:09:56 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 Name: tcl Version: %{version} Index: win/Makefile.in ================================================================== --- win/Makefile.in +++ win/Makefile.in @@ -3,11 +3,11 @@ # then it is a template for a Makefile; to generate the actual Makefile, # run "./configure", which is a configuration script generated by the # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.33 2000/04/25 20:58:48 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.33.4.2 2000/07/19 01:08:19 welch Exp $ VERSION = @TCL_VERSION@ #---------------------------------------------------------------- # Things you can change to personalize the Makefile for your own @@ -132,11 +132,11 @@ REG_LIB_FILE = tclreg$(VER)${LIBSUFFIX} PIPE_DLL_FILE = tclpip$(VER).dll SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) -STATIC_LIBRARIES = $(TCL_LIB_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -227,10 +227,11 @@ tclHistory.$(OBJEXT) \ tclIndexObj.$(OBJEXT) \ tclInterp.$(OBJEXT) \ tclIO.$(OBJEXT) \ tclIOCmd.$(OBJEXT) \ + tclIOGT.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ tclLiteral.$(OBJEXT) \ tclListObj.$(OBJEXT) \ @@ -342,14 +343,22 @@ @MAKE_LIB@ ${TCL_OBJS} ${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${DDE_DLL_FILE} @MAKE_DLL@ ${DDE_OBJS} ${TCL_STUB_LIB_FILE} + +${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE} + @$(RM) ${DDE_LIB_FILE} + @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE} ${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${REG_DLL_FILE} @MAKE_DLL@ ${REG_OBJS} ${TCL_STUB_LIB_FILE} + +${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} + @$(RM) ${REG_LIB_FILE} + @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} # PIPE_DLL_FILE is actually an executable, don't build it # like a DLL. ${PIPE_DLL_FILE}: ${PIPE_OBJS} Index: win/README.binary ================================================================== --- win/README.binary +++ win/README.binary @@ -1,13 +1,13 @@ 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.4.1 2000/07/17 23:09:56 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. Tcl provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and @@ -27,11 +27,11 @@ 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/ There are many Tcl books on the market. Most are listed at Index: win/configure.in ================================================================== --- win/configure.in +++ win/configure.in @@ -1,17 +1,17 @@ # This file is an input file used by the GNU "autoconf" program to # 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.4.1 2000/07/17 23:09:57 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 #-------------------------------------------------------------------- # Check whether --enable-gcc or --disable-gcc was given. Do this # before AC_PROG_CC and AC_CYGWIN are called so the compiler can Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -4,11 +4,11 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # 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.4.1 2000/07/17 22:58:48 hobbs Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from # location of the compiler directories. @@ -150,10 +150,11 @@ $(TMPDIR)\tclHistory.obj \ $(TMPDIR)\tclIndexObj.obj \ $(TMPDIR)\tclInterp.obj \ $(TMPDIR)\tclIO.obj \ $(TMPDIR)\tclIOCmd.obj \ + $(TMPDIR)\tclIOGT.obj \ $(TMPDIR)\tclIOSock.obj \ $(TMPDIR)\tclIOUtil.obj \ $(TMPDIR)\tclLink.obj \ $(TMPDIR)\tclLiteral.obj \ $(TMPDIR)\tclListObj.obj \ Index: win/tclWinChan.c ================================================================== --- win/tclWinChan.c +++ win/tclWinChan.c @@ -7,11 +7,11 @@ * 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: tclWinChan.c,v 1.10 2000/04/20 01:30:20 hobbs Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.10.4.1 2000/07/14 04:16:30 hobbs Exp $ */ #include "tclWinInt.h" /* @@ -99,19 +99,23 @@ * This structure describes the channel type structure for file based IO. */ 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. */ FileSeekProc, /* Seek proc. */ NULL, /* Set option proc. */ 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. */ }; /* *---------------------------------------------------------------------- Index: win/tclWinConsole.c ================================================================== --- win/tclWinConsole.c +++ win/tclWinConsole.c @@ -7,11 +7,11 @@ * Copyright (c) 1999 by Scriptics Corp. * * 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.12.1 2000/07/14 04:16:30 hobbs Exp $ */ #include "tclWinInt.h" #include @@ -169,19 +169,23 @@ * based IO. */ 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. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ 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. */ }; /* *---------------------------------------------------------------------- * Index: win/tclWinPipe.c ================================================================== --- win/tclWinPipe.c +++ win/tclWinPipe.c @@ -7,11 +7,11 @@ * Copyright (c) 1996-1997 by 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: tclWinPipe.c,v 1.11 2000/04/11 21:42:12 ericm Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.11.4.1 2000/07/14 04:16:30 hobbs Exp $ */ #include "tclWinInt.h" #include @@ -207,20 +207,23 @@ * based IO. */ 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. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ 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. */ }; /* *---------------------------------------------------------------------- * Index: win/tclWinSerial.c ================================================================== --- win/tclWinSerial.c +++ win/tclWinSerial.c @@ -8,11 +8,11 @@ * * See the file "license.terms" for information on usage and redistribution * 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.4.1 2000/07/14 04:16:31 hobbs Exp $ */ #include "tclWinInt.h" #include @@ -152,20 +152,24 @@ * This structure describes the channel type structure for command serial * based IO. */ 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. */ }; /* *---------------------------------------------------------------------- * Index: win/tclWinSock.c ================================================================== --- win/tclWinSock.c +++ win/tclWinSock.c @@ -6,11 +6,11 @@ * 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: tclWinSock.c,v 1.18 1999/12/09 14:44:11 hobbs Exp $ + * RCS: @(#) $Id: tclWinSock.c,v 1.18.4.1 2000/07/14 04:16:31 hobbs Exp $ */ #include "tclWinInt.h" /* @@ -213,20 +213,24 @@ * This structure describes the channel type structure for TCP socket * based IO. */ 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. */ }; /* * Define version of Winsock required by Tcl. */