Attachment "tcl8.4_all_002.diff" to
ticket [875701ffff]
added by
andreas_kupries
2005-01-28 05:51:23.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1453.2.398
diff -w -u -r1.1453.2.398 ChangeLog
--- ChangeLog 25 Jan 2005 17:58:38 -0000 1.1453.2.398
+++ ChangeLog 27 Jan 2005 22:49:18 -0000
@@ -1,3 +1,26 @@
+2005-01-27 Andreas Kupries <[email protected]>
+
+ TIP#218 IMPLEMENTATION
+
+ * generic/tclDecls.h: Regenerated from tcl.decls.
+ * generic/tclStubInit.c:
+
+ * doc/CrtChannel.3: Documentation of extended API,
+ * generic/tcl.decls: extended testsuite, and
+ * generic/tcl.h: implementation. Removal of old
+ * generic/tclIO.c: driver-specific TclpCut/Splice
+ * generic/tclInt.h: functions. Replaced with generic
+ * tests/io.test: thread-action calls through the
+ * unix/tclUnixChan.c: new hooks. Update of all builtin
+ * unix/tclUnixPipe.c: channel drivers to version 4.
+ * unix/tclUnixSock.c: Windows drivers extended to
+ * win/tclWinChan.c: manage thread state in a thread
+ * win/tclWinConsole.c: action handler.
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+ * mac/tclMacChan.c:
+
2005-01-25 Don Porter <[email protected]>
* library/auto.tcl: Updated [auto_reset] to clear auto-loaded
Index: doc/CrtChannel.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtChannel.3,v
retrieving revision 1.16.2.2
diff -w -u -r1.16.2.2 CrtChannel.3
--- doc/CrtChannel.3 2 Nov 2004 09:21:25 -0000 1.16.2.2
+++ doc/CrtChannel.3 27 Jan 2005 22:49:18 -0000
@@ -7,11 +7,11 @@
'\"
'\" RCS: @(#) $Id: CrtChannel.3,v 1.16.2.2 2004/11/02 09:21:25 dkf Exp $
.so man.macros
-.TH Tcl_CreateChannel 3 8.3 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
+Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -99,6 +99,9 @@
.VS 8.4
Tcl_DriverWideSeekProc *
\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverThreadActionProc *
+\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
.VE 8.4
.sp
Tcl_DriverSetOptionProc *
@@ -289,10 +292,20 @@
(thread)global list of all channels (of the current thread).
Application to a channel still registered in some interpreter
is not allowed.
+.VS 8.4
+Also notifies the driver if the \fBTcl_ChannelType\fR version is
+\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
+\fBTcl_DriverThreadActionProc\fR is defined for it.
+.VE 8.4
.PP
\fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the
(thread)global list of all channels (of the current thread).
Application to a channel registered in some interpreter is not allowed.
+.VS 8.4
+Also notifies the driver if the \fBTcl_ChannelType\fR version is
+\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
+\fBTcl_DriverThreadActionProc\fR is defined for it.
+.VE 8.4
.PP
\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
scripts associated with the specified \fIchannel\fR, thus shutting
@@ -326,6 +339,7 @@
Tcl_DriverFlushProc *\fIflushProc\fR;
Tcl_DriverHandlerProc *\fIhandlerProc\fR;
Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
+ Tcl_DriverThreadActionProc *\fIthreadActionProc\fR;
} Tcl_ChannelType;
.CE
.PP
@@ -346,6 +360,7 @@
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
.VS 8.4
\fBTcl_ChannelWideSeekProc\fR,
+\fBTcl_ChannelThreadActionProc\fR,
.VE 8.4
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
@@ -367,18 +382,27 @@
.SH VERSION
.PP
-The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR.
-If it is not set to this value \fBTCL_CHANNEL_VERSION_3\fR, then this
-\fBTcl_ChannelType\fR is assumed to have the older structure. See
+
+The \fIversion\fR field should be set to the version of the structure
+that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended.
+.VS 8.4
+\fBTCL_CHANNEL_VERSION_3\fR must be set to specifiy the \fIwideSeekProc\fR member.
+.VE 8.4
+.VS 8.4
+\fBTCL_CHANNEL_VERSION_4\fR must be set to specifiy the
+\fIthreadActionProc\fR member (includes \fIwideSeekProc\fR).
+.VE 8.4
+If it is not set to any of these, then this
+\fBTcl_ChannelType\fR is assumed to have the original structure. See
\fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize
-and function with either structure, stacked channels must be of at
+and function with either structures, stacked channels must be of at
least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
.PP
This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
.VS 8.4
-one of \fBTCL_CHANNEL_VERSION_3\fR,
+one of \fBTCL_CHANNEL_VERSION_4\fR, \fBTCL_CHANNEL_VERSION_3\fR,
.VE 8.4
-\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
+\fBTCL_CHANNEL_VERSION_2\fR, or \fBTCL_CHANNEL_VERSION_1\fR.
.SH BLOCKMODEPROC
.PP
@@ -790,6 +814,35 @@
This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns
a pointer to the function.
+.VS 8.4
+.SH "THREADACTIONPROC"
+.PP
+The \fthreadActionProc\fR field contains the address of the function
+called by the generic layer when a channel is created, closed, or
+going to move to a different thread, i.e. whenever thread-specific
+driver state might have to initialized or updated. It can be NULL.
+The action \fITCL_CHANNEL_THREAD_REMOVE\fR is used to notify the
+driver that it should update or remove any thread-specific data it
+might be maintaining for the channel.
+.PP
+The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
+driver that it should update or initialize any thread-specific data it
+might be maintaining using the calling thread as the associate. See
+\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
+.PP
+.CS
+typedef void Tcl_DriverThreadActionProc(
+ ClientData \fIinstanceData\fR,
+ int \fIaction\fR);
+.CE
+.PP
+\fIInstanceData\fR is the same as the value passed to
+\fBTcl_CreateChannel\fR when this channel was created.
+.PP
+These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
+which returns a pointer to the function.
+.VE 8.4
+
.SH TCL_BADCHANNELOPTION
.PP
This procedure generates a "bad option" error message in an
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.94.2.2
diff -w -u -r1.94.2.2 tcl.decls
--- generic/tcl.decls 13 May 2003 09:57:40 -0000 1.94.2.2
+++ generic/tcl.decls 27 Jan 2005 22:49:18 -0000
@@ -1754,6 +1754,24 @@
Tcl_ChannelType *chanTypePtr)
}
+# Slots 494 to 553 are taken already by 8.5
+# #111 - Dicts (494 ... 504)
+# #59 - Config (505)
+# #139 - Namespace API (506 ... 517)
+# #137 - source -encoding (518)
+# #121 - ExitProc (519)
+# #121 - Resource Limits (520 ... 534)
+# #226 - S/R Interp State (535 ... 537)
+# #227 - S/G Return Opts (538 ... 539)
+# #235 - Ensemble C API (540 ... 551)
+# #233 - Virtualized Time (552 ... 553)
+
+# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
+# These slots are used by 8.5 as well.
+declare 554 generic {
+ Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.153.2.16
diff -w -u -r1.153.2.16 tcl.h
--- generic/tcl.h 25 Nov 2004 00:19:27 -0000 1.153.2.16
+++ generic/tcl.h 27 Jan 2005 22:49:18 -0000
@@ -1425,6 +1425,14 @@
#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1)
#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3)
+#define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4)
+
+/*
+ * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
+ */
+
+#define TCL_CHANNEL_THREAD_INSERT (0)
+#define TCL_CHANNEL_THREAD_REMOVE (1)
/*
* Typedefs for the various operations in a channel type:
@@ -1460,6 +1468,9 @@
ClientData instanceData, Tcl_WideInt offset,
int mode, int *errorCodePtr));
+ /* TIP #218, Channel Thread Actions */
+typedef void (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
/*
* The following declarations either map ckalloc and ckfree to
@@ -1550,6 +1561,16 @@
* handle 64-bit offsets. May be
* NULL, and must be NULL if
* seekProc is NULL. */
+
+ /*
+ * Only valid in TCL_CHANNEL_VERSION_4 channels or later
+ * TIP #218, Channel Thread Actions
+ */
+ Tcl_DriverThreadActionProc *threadActionProc;
+ /* Procedure to call to notify
+ * the driver of thread specific
+ * activity for a channel.
+ * May be NULL. */
} Tcl_ChannelType;
/*
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.93.2.5
diff -w -u -r1.93.2.5 tclDecls.h
--- generic/tclDecls.h 10 Jun 2004 17:17:42 -0000 1.93.2.5
+++ generic/tclDecls.h 27 Jan 2005 22:49:18 -0000
@@ -1564,6 +1564,69 @@
/* 493 */
EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
Tcl_ChannelType * chanTypePtr));
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+/* Slot 500 is reserved */
+/* Slot 501 is reserved */
+/* Slot 502 is reserved */
+/* Slot 503 is reserved */
+/* Slot 504 is reserved */
+/* Slot 505 is reserved */
+/* Slot 506 is reserved */
+/* Slot 507 is reserved */
+/* Slot 508 is reserved */
+/* Slot 509 is reserved */
+/* Slot 510 is reserved */
+/* Slot 511 is reserved */
+/* Slot 512 is reserved */
+/* Slot 513 is reserved */
+/* Slot 514 is reserved */
+/* Slot 515 is reserved */
+/* Slot 516 is reserved */
+/* Slot 517 is reserved */
+/* Slot 518 is reserved */
+/* Slot 519 is reserved */
+/* Slot 520 is reserved */
+/* Slot 521 is reserved */
+/* Slot 522 is reserved */
+/* Slot 523 is reserved */
+/* Slot 524 is reserved */
+/* Slot 525 is reserved */
+/* Slot 526 is reserved */
+/* Slot 527 is reserved */
+/* Slot 528 is reserved */
+/* Slot 529 is reserved */
+/* Slot 530 is reserved */
+/* Slot 531 is reserved */
+/* Slot 532 is reserved */
+/* Slot 533 is reserved */
+/* Slot 534 is reserved */
+/* Slot 535 is reserved */
+/* Slot 536 is reserved */
+/* Slot 537 is reserved */
+/* Slot 538 is reserved */
+/* Slot 539 is reserved */
+/* Slot 540 is reserved */
+/* Slot 541 is reserved */
+/* Slot 542 is reserved */
+/* Slot 543 is reserved */
+/* Slot 544 is reserved */
+/* Slot 545 is reserved */
+/* Slot 546 is reserved */
+/* Slot 547 is reserved */
+/* Slot 548 is reserved */
+/* Slot 549 is reserved */
+/* Slot 550 is reserved */
+/* Slot 551 is reserved */
+/* Slot 552 is reserved */
+/* Slot 553 is reserved */
+/* 554 */
+EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -2117,6 +2180,67 @@
Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */
+ void *reserved494;
+ void *reserved495;
+ void *reserved496;
+ void *reserved497;
+ void *reserved498;
+ void *reserved499;
+ void *reserved500;
+ void *reserved501;
+ void *reserved502;
+ void *reserved503;
+ void *reserved504;
+ void *reserved505;
+ void *reserved506;
+ void *reserved507;
+ void *reserved508;
+ void *reserved509;
+ void *reserved510;
+ void *reserved511;
+ void *reserved512;
+ void *reserved513;
+ void *reserved514;
+ void *reserved515;
+ void *reserved516;
+ void *reserved517;
+ void *reserved518;
+ void *reserved519;
+ void *reserved520;
+ void *reserved521;
+ void *reserved522;
+ void *reserved523;
+ void *reserved524;
+ void *reserved525;
+ void *reserved526;
+ void *reserved527;
+ void *reserved528;
+ void *reserved529;
+ void *reserved530;
+ void *reserved531;
+ void *reserved532;
+ void *reserved533;
+ void *reserved534;
+ void *reserved535;
+ void *reserved536;
+ void *reserved537;
+ void *reserved538;
+ void *reserved539;
+ void *reserved540;
+ void *reserved541;
+ void *reserved542;
+ void *reserved543;
+ void *reserved544;
+ void *reserved545;
+ void *reserved546;
+ void *reserved547;
+ void *reserved548;
+ void *reserved549;
+ void *reserved550;
+ void *reserved551;
+ void *reserved552;
+ void *reserved553;
+ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
} TclStubs;
#ifdef __cplusplus
@@ -4133,6 +4257,70 @@
#define Tcl_ChannelWideSeekProc \
(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
#endif
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+/* Slot 500 is reserved */
+/* Slot 501 is reserved */
+/* Slot 502 is reserved */
+/* Slot 503 is reserved */
+/* Slot 504 is reserved */
+/* Slot 505 is reserved */
+/* Slot 506 is reserved */
+/* Slot 507 is reserved */
+/* Slot 508 is reserved */
+/* Slot 509 is reserved */
+/* Slot 510 is reserved */
+/* Slot 511 is reserved */
+/* Slot 512 is reserved */
+/* Slot 513 is reserved */
+/* Slot 514 is reserved */
+/* Slot 515 is reserved */
+/* Slot 516 is reserved */
+/* Slot 517 is reserved */
+/* Slot 518 is reserved */
+/* Slot 519 is reserved */
+/* Slot 520 is reserved */
+/* Slot 521 is reserved */
+/* Slot 522 is reserved */
+/* Slot 523 is reserved */
+/* Slot 524 is reserved */
+/* Slot 525 is reserved */
+/* Slot 526 is reserved */
+/* Slot 527 is reserved */
+/* Slot 528 is reserved */
+/* Slot 529 is reserved */
+/* Slot 530 is reserved */
+/* Slot 531 is reserved */
+/* Slot 532 is reserved */
+/* Slot 533 is reserved */
+/* Slot 534 is reserved */
+/* Slot 535 is reserved */
+/* Slot 536 is reserved */
+/* Slot 537 is reserved */
+/* Slot 538 is reserved */
+/* Slot 539 is reserved */
+/* Slot 540 is reserved */
+/* Slot 541 is reserved */
+/* Slot 542 is reserved */
+/* Slot 543 is reserved */
+/* Slot 544 is reserved */
+/* Slot 545 is reserved */
+/* Slot 546 is reserved */
+/* Slot 547 is reserved */
+/* Slot 548 is reserved */
+/* Slot 549 is reserved */
+/* Slot 550 is reserved */
+/* Slot 551 is reserved */
+/* Slot 552 is reserved */
+/* Slot 553 is reserved */
+#ifndef Tcl_ChannelThreadActionProc
+#define Tcl_ChannelThreadActionProc \
+ (tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.61.2.8
diff -w -u -r1.61.2.8 tclIO.c
--- generic/tclIO.c 10 Sep 2004 20:06:41 -0000 1.61.2.8
+++ generic/tclIO.c 27 Jan 2005 22:49:18 -0000
@@ -1208,18 +1208,19 @@
* in the list on exit.
*
* JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
+ *
+ * TIP #218.
+ * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
+ * We need Tcl_SpliceChannel, for the threadAction calls.
+ * There is no real reason to duplicate all of this.
+ * NOTE: All drivers using thread actions now have to perform their TSD
+ * manipulation only in their thread action proc. Doing it when
+ * creating their instance structures will collide with the thread
+ * action activity and lead to damaged lists.
*/
- statePtr->nextCSPtr = tsdPtr->firstCSPtr;
- tsdPtr->firstCSPtr = statePtr;
-
- /*
- * TIP #10. Mark the current thread as the one managing the new
- * channel. Note: 'Tcl_GetCurrentThread' returns sensible
- * values even for a non-threaded core.
- */
-
- statePtr->managingThread = Tcl_GetCurrentThread ();
+ statePtr->nextCSPtr = (ChannelState *) NULL;
+ Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
/*
* Install this channel in the first empty standard channel slot, if
@@ -2378,7 +2379,7 @@
* Resets the field 'nextCSPtr' of the specified channel state to NULL.
*
* NOTE:
- * The channel to splice out of the list must not be referenced
+ * The channel to cut out of the list must not be referenced
* in any interpreter. This is something this procedure cannot
* check (despite the refcount) because the caller usually wants
* fiddle with the channel (like transfering it to a different
@@ -2400,6 +2401,7 @@
* channel out of the list on close. */
ChannelState *statePtr = ((Channel *) chan)->state;
/* state of the channel stack. */
+ Tcl_DriverThreadActionProc *threadActionProc;
/*
* Remove this channel from of the list of all channels
@@ -2422,7 +2424,12 @@
statePtr->nextCSPtr = (ChannelState *) NULL;
- TclpCutFileChannel(chan);
+ /* TIP #218, Channel Thread Actions */
+ threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+ if (threadActionProc != NULL) {
+ (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+ TCL_CHANNEL_THREAD_REMOVE);
+ }
}
/*
@@ -2441,7 +2448,7 @@
* Nothing.
*
* NOTE:
- * The channel to add to the list must not be referenced in any
+ * The channel to splice into the list must not be referenced in any
* interpreter. This is something this procedure cannot check
* (despite the refcount) because the caller usually wants figgle
* with the channel (like transfering it to a different thread)
@@ -2459,6 +2466,7 @@
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelState *statePtr = ((Channel *) chan)->state;
+ Tcl_DriverThreadActionProc *threadActionProc;
if (statePtr->nextCSPtr != (ChannelState *) NULL) {
panic("Tcl_SpliceChannel: trying to add channel used in different list");
@@ -2475,7 +2483,12 @@
statePtr->managingThread = Tcl_GetCurrentThread ();
- TclpSpliceFileChannel(chan);
+ /* TIP #218, Channel Thread Actions */
+ threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+ if (threadActionProc != NULL) {
+ (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+ TCL_CHANNEL_THREAD_INSERT);
+ }
}
/*
@@ -8902,6 +8915,8 @@
return TCL_CHANNEL_VERSION_2;
} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
return TCL_CHANNEL_VERSION_3;
+ } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
+ return TCL_CHANNEL_VERSION_4;
} else {
/*
* In <v2 channel versions, the version field is occupied
@@ -9255,6 +9270,33 @@
}
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelThreadActionProc --
+ *
+ * Return the Tcl_DriverThreadActionProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverThreadActionProc *
+Tcl_ChannelThreadActionProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
+ return chanTypePtr->threadActionProc;
+ } else {
+ return NULL;
+ }
+}
+
#if 0
/* For future debugging work, a simple function to print the flags of
* a channel in semi-readable form.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118.2.7
diff -w -u -r1.118.2.7 tclInt.h
--- generic/tclInt.h 21 Jul 2004 01:30:57 -0000 1.118.2.7
+++ generic/tclInt.h 27 Jan 2005 22:49:18 -0000
@@ -1749,8 +1749,6 @@
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *pathPtr, int mode,
int permissions));
-EXTERN void TclpCutFileChannel _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN void TclpSpliceFileChannel _ANSI_ARGS_((Tcl_Channel chan));
EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
format));
EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName,
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.79.2.8
diff -w -u -r1.79.2.8 tclStubInit.c
--- generic/tclStubInit.c 14 Oct 2004 15:30:52 -0000 1.79.2.8
+++ generic/tclStubInit.c 27 Jan 2005 22:49:19 -0000
@@ -953,6 +953,67 @@
Tcl_Seek, /* 491 */
Tcl_Tell, /* 492 */
Tcl_ChannelWideSeekProc, /* 493 */
+ NULL, /* 494 */
+ NULL, /* 495 */
+ NULL, /* 496 */
+ NULL, /* 497 */
+ NULL, /* 498 */
+ NULL, /* 499 */
+ NULL, /* 500 */
+ NULL, /* 501 */
+ NULL, /* 502 */
+ NULL, /* 503 */
+ NULL, /* 504 */
+ NULL, /* 505 */
+ NULL, /* 506 */
+ NULL, /* 507 */
+ NULL, /* 508 */
+ NULL, /* 509 */
+ NULL, /* 510 */
+ NULL, /* 511 */
+ NULL, /* 512 */
+ NULL, /* 513 */
+ NULL, /* 514 */
+ NULL, /* 515 */
+ NULL, /* 516 */
+ NULL, /* 517 */
+ NULL, /* 518 */
+ NULL, /* 519 */
+ NULL, /* 520 */
+ NULL, /* 521 */
+ NULL, /* 522 */
+ NULL, /* 523 */
+ NULL, /* 524 */
+ NULL, /* 525 */
+ NULL, /* 526 */
+ NULL, /* 527 */
+ NULL, /* 528 */
+ NULL, /* 529 */
+ NULL, /* 530 */
+ NULL, /* 531 */
+ NULL, /* 532 */
+ NULL, /* 533 */
+ NULL, /* 534 */
+ NULL, /* 535 */
+ NULL, /* 536 */
+ NULL, /* 537 */
+ NULL, /* 538 */
+ NULL, /* 539 */
+ NULL, /* 540 */
+ NULL, /* 541 */
+ NULL, /* 542 */
+ NULL, /* 543 */
+ NULL, /* 544 */
+ NULL, /* 545 */
+ NULL, /* 546 */
+ NULL, /* 547 */
+ NULL, /* 548 */
+ NULL, /* 549 */
+ NULL, /* 550 */
+ NULL, /* 551 */
+ NULL, /* 552 */
+ NULL, /* 553 */
+ Tcl_ChannelThreadActionProc, /* 554 */
};
/* !END!: Do not edit above this line. */
Index: mac/tclMacChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/Attic/tclMacChan.c,v
retrieving revision 1.21
diff -w -u -r1.21 tclMacChan.c
--- mac/tclMacChan.c 3 Mar 2003 20:22:42 -0000 1.21
+++ mac/tclMacChan.c 27 Jan 2005 22:49:19 -0000
@@ -102,6 +102,8 @@
long offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
+static void FileThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
static Tcl_Channel OpenFileChannel _ANSI_ARGS_((CONST char *fileName,
int mode, int permissions, int *errorCodePtr));
static int StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
@@ -123,7 +125,7 @@
static Tcl_ChannelType consoleChannelType = {
"file", /* Type name. */
- (Tcl_ChannelTypeVersion)StdIOBlockMode, /* Set blocking/nonblocking mode.*/
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
StdIOClose, /* Close proc. */
StdIOInput, /* Input proc. */
StdIOOutput, /* Output proc. */
@@ -132,6 +134,12 @@
NULL, /* Get option proc. */
CommonWatch, /* Initialize notifier. */
CommonGetHandle /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ StdIOBlockMode, /* Set blocking/nonblocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc. */
+ NULL, /* thread actions */
};
/*
@@ -140,8 +148,7 @@
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- (Tcl_ChannelTypeVersion)FileBlockMode, /* Set blocking or
- * non-blocking mode.*/
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
FileClose, /* Close proc. */
FileInput, /* Input proc. */
FileOutput, /* Output proc. */
@@ -150,6 +157,12 @@
NULL, /* Get option proc. */
CommonWatch, /* Initialize notifier. */
CommonGetHandle /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ FileBlockMode, /* Set blocking/nonblocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc. */
+ FileThreadActionProc, /* thread actions */
};
@@ -1212,10 +1225,9 @@
/*
*----------------------------------------------------------------------
*
- * TclpCutFileChannel --
+ * FileThreadActionProc --
*
- * Remove any thread local refs to this channel. See
- * Tcl_CutChannel for more info.
+ * Insert or remove any thread local refs to this channel.
*
* Results:
* None.
@@ -1226,23 +1238,21 @@
*----------------------------------------------------------------------
*/
-void
-TclpCutFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
+static void
+FileThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileState *infoPtr;
+ FileState *infoPtr = (FileState *) instanceData;
+
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
+ } else {
FileState **nextPtrPtr;
int removed = 0;
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- infoPtr = (FileState *) chanPtr->instanceData;
-
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
@@ -1258,43 +1268,8 @@
* local data in each thread.
*/
- if (!removed)
+ if (!removed) {
panic("file info ptr not on thread channel list");
-
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceFileChannel --
- *
- * Insert thread local ref for this channel.
- * Tcl_SpliceChannel for more info.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSpliceFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileState *infoPtr;
-
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- infoPtr = (FileState *) chanPtr->instanceData;
-
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
+ }
}
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.40.2.8
diff -w -u -r1.40.2.8 io.test
--- tests/io.test 11 Nov 2004 01:16:20 -0000 1.40.2.8
+++ tests/io.test 27 Jan 2005 22:49:19 -0000
@@ -1712,6 +1712,12 @@
set f [open "|[list [interpreter] $path(script) [array get path]]" r]
set c [gets $f]
close $f
+ # Added delay to give Windows time to stop the spawned process and clean
+ # up its grip on the file test1. Added delete as proper test cleanup.
+ # The failing tests were 18.1 and 18.2 as first re-users of file "test1".
+ after 10000
+ file delete $path(script)
+ file delete $path(test1)
set c
} hello
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.42.2.4
diff -w -u -r1.42.2.4 tclUnixChan.c
--- unix/tclUnixChan.c 17 Nov 2004 02:52:25 -0000 1.42.2.4
+++ unix/tclUnixChan.c 27 Jan 2005 22:49:19 -0000
@@ -250,6 +250,10 @@
int toWrite, int *errorCode));
static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
+#ifdef DEPRECATED
+static void FileThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
+#endif
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
Tcl_WideInt offset, int mode, int *errorCode));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
@@ -305,7 +309,7 @@
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_3, /* v3 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -319,6 +323,11 @@
NULL, /* flush proc. */
NULL, /* handler proc. */
FileWideSeekProc, /* wide seek proc. */
+#ifdef DEPRECATED
+ FileThreadActionProc, /* thread actions */
+#else
+ NULL,
+#endif
};
#ifdef SUPPORTS_TTY
@@ -329,7 +338,7 @@
static Tcl_ChannelType ttyChannelType = {
"tty", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
TtyCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
#if BAD_TIP35_FLUSH
@@ -346,6 +355,8 @@
FileBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc. */
+ NULL, /* thread action proc. */
};
#endif /* SUPPORTS_TTY */
@@ -356,7 +367,7 @@
static Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
TcpCloseProc, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
@@ -369,6 +380,8 @@
TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc. */
+ NULL, /* thread action proc. */
};
@@ -1840,8 +1853,11 @@
#ifdef DEPRECATED
if (channelTypePtr == &fileChannelType) {
- fsPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = fsPtr;
+ /* TIP #218. Removed the code inserting the new structure
+ * into the global list. This is now handled in the thread
+ * action callbacks, and only there.
+ */
+ fsPtr->nextPtr = NULL;
}
#endif /* DEPRECATED */
fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
@@ -3281,13 +3297,13 @@
return result;
}
+#ifdef DEPRECATED
/*
*----------------------------------------------------------------------
*
- * TclpCutFileChannel --
+ * FileThreadActionProc --
*
- * Remove any thread local refs to this channel. See
- * Tcl_CutChannel for more info.
+ * Insert or remove any thread local refs to this channel.
*
* Results:
* None.
@@ -3298,24 +3314,21 @@
*----------------------------------------------------------------------
*/
-void
-TclpCutFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
+static void
+FileThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
{
-#ifdef DEPRECATED
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileState *fsPtr;
+ FileState *fsPtr = (FileState *) instanceData;
+
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ fsPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = fsPtr;
+ } else {
FileState **nextPtrPtr;
int removed = 0;
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- fsPtr = (FileState *) chanPtr->instanceData;
-
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == fsPtr) {
@@ -3326,51 +3339,15 @@
}
/*
- * This could happen if the channel was created in one thread
- * and then moved to another without updating the thread
- * local data in each thread.
+ * This could happen if the channel was created in one
+ * thread and then moved to another without updating
+ * the thread local data in each thread.
*/
- if (!removed)
+ if (!removed) {
panic("file info ptr not on thread channel list");
-
-#endif /* DEPRECATED */
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceFileChannel --
- *
- * Insert thread local ref for this channel.
- * Tcl_SpliceChannel for more info.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSpliceFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
-{
-#ifdef DEPRECATED
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileState *fsPtr;
-
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- fsPtr = (FileState *) chanPtr->instanceData;
-
- fsPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = fsPtr;
-#endif /* DEPRECATED */
}
+}
+#endif /* DEPRECATED */
+
Index: unix/tclUnixPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPipe.c,v
retrieving revision 1.23.2.2
diff -w -u -r1.23.2.2 tclUnixPipe.c
--- unix/tclUnixPipe.c 8 Jun 2004 20:43:33 -0000 1.23.2.2
+++ unix/tclUnixPipe.c 27 Jan 2005 22:49:19 -0000
@@ -72,7 +72,7 @@
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
PipeCloseProc, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
@@ -85,6 +85,8 @@
PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ NULL, /* thread action proc */
};
/*
Index: win/tclWinChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinChan.c,v
retrieving revision 1.30.2.2
diff -w -u -r1.30.2.2 tclWinChan.c
--- win/tclWinChan.c 19 Jan 2005 22:09:58 -0000 1.30.2.2
+++ win/tclWinChan.c 27 Jan 2005 22:49:19 -0000
@@ -98,6 +98,8 @@
int flags));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
+static void FileThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
/*
@@ -106,7 +108,7 @@
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_3, /* v3 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -120,6 +122,7 @@
NULL, /* flush proc. */
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
+ FileThreadActionProc, /* Thread action proc. */
};
#if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)
@@ -436,11 +439,11 @@
if (infoPtr == fileInfoPtr) {
/*
* This channel exists on the thread local list. It should
- * have been removed by an earlier call to TclpCutFileChannel,
+ * have been removed by an earlier Thread Action call,
* but do that now since just deallocating fileInfoPtr would
* leave an deallocated pointer on the thread local list.
*/
- TclpCutFileChannel(fileInfoPtr->channel);
+ FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
break;
}
}
@@ -1319,8 +1322,11 @@
}
infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
+ /* TIP #218. Removed the code inserting the new structure
+ * into the global list. This is now handled in the thread
+ * action callbacks, and only there.
+ */
+ infoPtr->nextPtr = NULL;
infoPtr->validMask = permissions;
infoPtr->watchMask = 0;
infoPtr->flags = appendMode;
@@ -1389,10 +1395,9 @@
/*
*----------------------------------------------------------------------
*
- * TclpCutFileChannel --
+ * FileThreadActionProc --
*
- * Remove any thread local refs to this channel. See
- * Tcl_CutChannel for more info.
+ * Insert or remove any thread local refs to this channel.
*
* Results:
* None.
@@ -1403,23 +1408,21 @@
*----------------------------------------------------------------------
*/
-void
-TclpCutFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
+static void
+FileThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileInfo *infoPtr;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
+ } else {
FileInfo **nextPtrPtr;
int removed = 0;
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- infoPtr = (FileInfo *) chanPtr->instanceData;
-
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
@@ -1435,43 +1438,8 @@
* local data in each thread.
*/
- if (!removed)
+ if (!removed) {
panic("file info ptr not on thread channel list");
-
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceFileChannel --
- *
- * Insert thread local ref for this channel.
- * Tcl_SpliceChannel for more info.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSpliceFileChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = (Channel *) chan;
- FileInfo *infoPtr;
-
- if (chanPtr->typePtr != &fileChannelType)
- return;
-
- infoPtr = (FileInfo *) chanPtr->instanceData;
-
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
+ }
}
Index: win/tclWinConsole.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinConsole.c,v
retrieving revision 1.11
diff -w -u -r1.11 tclWinConsole.c
--- win/tclWinConsole.c 26 Nov 2002 22:41:58 -0000 1.11
+++ win/tclWinConsole.c 27 Jan 2005 22:49:19 -0000
@@ -148,7 +148,7 @@
static void ConsoleExitHandler(ClientData clientData);
static int ConsoleGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
-static ThreadSpecificData *ConsoleInit(void);
+static void ConsoleInit(void);
static int ConsoleInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int ConsoleOutputProc(ClientData instanceData,
@@ -160,6 +160,9 @@
static void ProcExitHandler(ClientData clientData);
static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
+static void ConsoleThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
+
/*
* This structure describes the channel type structure for command console
* based IO.
@@ -167,7 +170,7 @@
static Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
ConsoleCloseProc, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
@@ -180,6 +183,8 @@
ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ ConsoleThreadActionProc, /* thread action proc */
};
/*
@@ -198,7 +203,7 @@
*----------------------------------------------------------------------
*/
-static ThreadSpecificData *
+static void
ConsoleInit()
{
ThreadSpecificData *tsdPtr;
@@ -224,7 +229,6 @@
Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
}
- return tsdPtr;
}
/*
@@ -1170,7 +1174,10 @@
*/
Tcl_MutexLock(&consoleMutex);
+ if (infoPtr->threadId != NULL) {
+ /* TIP #218. When in flight ignore the event, no one will receive it anyway */
Tcl_ThreadAlert(infoPtr->threadId);
+ }
Tcl_MutexUnlock(&consoleMutex);
}
@@ -1256,7 +1263,10 @@
*/
Tcl_MutexLock(&consoleMutex);
+ if (infoPtr->threadId != NULL) {
+ /* TIP #218. When in flight ignore the event, no one will receive it anyway */
Tcl_ThreadAlert(infoPtr->threadId);
+ }
Tcl_MutexUnlock(&consoleMutex);
}
@@ -1291,10 +1301,9 @@
{
char encoding[4 + TCL_INTEGER_SPACE];
ConsoleInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
DWORD id, modes;
- tsdPtr = ConsoleInit();
+ ConsoleInit();
/*
* See if a channel with this handle already exists.
@@ -1305,9 +1314,12 @@
infoPtr->validMask = permissions;
infoPtr->handle = handle;
+ infoPtr->channel = (Tcl_Channel) NULL;
wsprintfA(encoding, "cp%d", GetConsoleCP());
+ infoPtr->threadId = Tcl_GetCurrentThread();
+
/*
* Use the pointer for the name of the result channel.
* This keeps the channel names unique, since some may share
@@ -1319,8 +1331,6 @@
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
(ClientData) infoPtr, permissions);
- infoPtr->threadId = Tcl_GetCurrentThread();
-
if (permissions & TCL_READABLE) {
/*
* Make sure the console input buffer is ready for only character
@@ -1361,3 +1371,51 @@
return infoPtr->channel;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleThreadActionProc --
+ *
+ * Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+ /* We do not access firstConsolePtr in the thread structures. This is
+ * not for all serials managed by the thread, but only those we are
+ * watching. Removal of the filevent handlers before transfer thus
+ * takes care of this structure.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ /* We can't copy the thread information from the channel when
+ * the channel is created. At this time the channel back
+ * pointer has not been set yet. However in that case the
+ * threadId has already been set by TclpCreateCommandChannel
+ * itself, so the structure is still good.
+ */
+
+ ConsoleInit ();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ }
+ } else {
+ infoPtr->threadId = NULL;
+ }
+ Tcl_MutexUnlock(&consoleMutex);
+}
Index: win/tclWinPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPipe.c,v
retrieving revision 1.33.2.8
diff -w -u -r1.33.2.8 tclWinPipe.c
--- win/tclWinPipe.c 10 May 2004 20:55:44 -0000 1.33.2.8
+++ win/tclWinPipe.c 27 Jan 2005 22:49:19 -0000
@@ -205,6 +205,9 @@
static int TempFileName(WCHAR name[MAX_PATH]);
static int WaitForRead(PipeInfo *infoPtr, int blocking);
+static void PipeThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
+
/*
* This structure describes the channel type structure for command pipe
* based IO.
@@ -212,7 +215,7 @@
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
@@ -225,6 +228,8 @@
PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ PipeThreadActionProc, /* thread action proc */
};
/*
@@ -1689,6 +1694,7 @@
infoPtr->writeBuf = 0;
infoPtr->writeBufLen = 0;
infoPtr->writeError = 0;
+ infoPtr->channel = (Tcl_Channel) NULL;
/*
* Use one of the fds associated with the channel as the
@@ -2931,7 +2937,10 @@
*/
Tcl_MutexLock(&pipeMutex);
+ if (infoPtr->threadId != NULL) {
+ /* TIP #218. When in flight ignore the event, no one will receive it anyway */
Tcl_ThreadAlert(infoPtr->threadId);
+ }
Tcl_MutexUnlock(&pipeMutex);
}
@@ -3019,10 +3028,60 @@
*/
Tcl_MutexLock(&pipeMutex);
+ if (infoPtr->threadId != NULL) {
+ /* TIP #218. When in flight ignore the event, no one will receive it anyway */
Tcl_ThreadAlert(infoPtr->threadId);
+ }
Tcl_MutexUnlock(&pipeMutex);
}
return 0;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeThreadActionProc --
+ *
+ * Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
+{
+ PipeInfo *infoPtr = (PipeInfo *) instanceData;
+
+ /* We do not access firstPipePtr in the thread structures. This is
+ * not for all pipes managed by the thread, but only those we are
+ * watching. Removal of the filevent handlers before transfer thus
+ * takes care of this structure.
+ */
+
+ Tcl_MutexLock(&pipeMutex);
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ /* We can't copy the thread information from the channel when
+ * the channel is created. At this time the channel back
+ * pointer has not been set yet. However in that case the
+ * threadId has already been set by TclpCreateCommandChannel
+ * itself, so the structure is still good.
+ */
+
+ PipeInit ();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ }
+ } else {
+ infoPtr->threadId = NULL;
+ }
+ Tcl_MutexUnlock(&pipeMutex);
+}
Index: win/tclWinSerial.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinSerial.c,v
retrieving revision 1.25.2.1
diff -w -u -r1.25.2.1 tclWinSerial.c
--- win/tclWinSerial.c 11 May 2003 00:31:41 -0000 1.25.2.1
+++ win/tclWinSerial.c 27 Jan 2005 22:49:19 -0000
@@ -190,6 +190,9 @@
CONST char *value));
static DWORD WINAPI SerialWriterThread(LPVOID arg);
+static void SerialThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
+
/*
* This structure describes the channel type structure for command serial
* based IO.
@@ -197,7 +200,7 @@
static Tcl_ChannelType serialChannelType = {
"serial", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
SerialCloseProc, /* Close proc. */
SerialInputProc, /* Input proc. */
SerialOutputProc, /* Output proc. */
@@ -210,6 +213,8 @@
SerialBlockProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ SerialThreadActionProc, /* thread action proc */
};
/*
@@ -1346,7 +1351,10 @@
*/
Tcl_MutexLock(&serialMutex);
+ if (infoPtr->threadId != NULL) {
+ /* TIP #218. When in flight ignore the event, no one will receive it anyway */
Tcl_ThreadAlert(infoPtr->threadId);
+ }
Tcl_MutexUnlock(&serialMutex);
}
@@ -1419,16 +1427,25 @@
int permissions;
{
SerialInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
DWORD id;
- tsdPtr = SerialInit();
+ SerialInit();
infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions;
infoPtr->handle = handle;
+ infoPtr->channel = (Tcl_Channel) NULL;
+ infoPtr->readable = 0;
+ infoPtr->writable = 1;
+ infoPtr->toWrite = infoPtr->writeQueue = 0;
+ infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
+ infoPtr->lastEventTime = 0;
+ infoPtr->lastError = infoPtr->error = 0;
+ infoPtr->threadId = Tcl_GetCurrentThread();
+ infoPtr->sysBufRead = 4096;
+ infoPtr->sysBufWrite = 4096;
/*
* Use the pointer to keep the channel names unique, in case
@@ -1440,14 +1457,6 @@
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
(ClientData) infoPtr, permissions);
- infoPtr->readable = 0;
- infoPtr->writable = 1;
- infoPtr->toWrite = infoPtr->writeQueue = 0;
- infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
- infoPtr->lastEventTime = 0;
- infoPtr->lastError = infoPtr->error = 0;
- infoPtr->threadId = Tcl_GetCurrentThread();
- infoPtr->sysBufRead = infoPtr->sysBufWrite = 4096;
SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
@@ -2107,3 +2116,51 @@
"mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialThreadActionProc --
+ *
+ * Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ /* We do not access firstSerialPtr in the thread structures. This is
+ * not for all serials managed by the thread, but only those we are
+ * watching. Removal of the filevent handlers before transfer thus
+ * takes care of this structure.
+ */
+
+ Tcl_MutexLock(&serialMutex);
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ /* We can't copy the thread information from the channel when
+ * the channel is created. At this time the channel back
+ * pointer has not been set yet. However in that case the
+ * threadId has already been set by TclpCreateCommandChannel
+ * itself, so the structure is still good.
+ */
+
+ SerialInit ();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ }
+ } else {
+ infoPtr->threadId = NULL;
+ }
+ Tcl_MutexUnlock(&serialMutex);
+}
Index: win/tclWinSock.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinSock.c,v
retrieving revision 1.36.2.2
diff -w -u -r1.36.2.2 tclWinSock.c
--- win/tclWinSock.c 6 May 2004 01:03:56 -0000 1.36.2.2
+++ win/tclWinSock.c 27 Jan 2005 22:49:19 -0000
@@ -265,6 +265,10 @@
int *errorCodePtr));
static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg));
+static void TcpThreadActionProc _ANSI_ARGS_ ((
+ ClientData instanceData, int action));
+
+
/*
* This structure describes the channel type structure for TCP socket
* based IO.
@@ -272,7 +276,7 @@
static Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
TcpCloseProc, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
@@ -285,6 +289,8 @@
TcpBlockProc, /* Set socket into (non-)blocking mode. */
NULL, /* flush proc. */
NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ TcpThreadActionProc, /* thread action proc */
};
@@ -970,7 +976,7 @@
Tcl_Interp *interp; /* Unused. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
- SocketInfo **nextPtrPtr;
+ /* TIP #218 */
int errorCode = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -995,20 +1001,12 @@
}
}
- /*
- * Remove the socket from socketList.
+ /* TIP #218. Removed the code removing the structure
+ * from the global socket list. This is now done by
+ * the thread action callbacks, and only there. This
+ * happens before this code is called. We can free
+ * without fear of damanging the list.
*/
-
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
- nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
- if ((*nextPtrPtr) == infoPtr) {
- (*nextPtrPtr) = infoPtr->nextPtr;
- break;
- }
- }
-
- SetEvent(tsdPtr->socketListLock);
ckfree((char *) infoPtr);
return errorCode;
}
@@ -1025,7 +1023,7 @@
* Returns a newly allocated SocketInfo.
*
* Side effects:
- * Adds the socket to the global socket list.
+ * None, except for allocation of memory.
*
*----------------------------------------------------------------------
*/
@@ -1047,10 +1045,11 @@
infoPtr->acceptProc = NULL;
infoPtr->lastError = 0;
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- infoPtr->nextPtr = tsdPtr->socketList;
- tsdPtr->socketList = infoPtr;
- SetEvent(tsdPtr->socketListLock);
+ /* TIP #218. Removed the code inserting the new structure
+ * into the global list. This is now handled in the thread
+ * action callbacks, and only there.
+ */
+ infoPtr->nextPtr = NULL;
return infoPtr;
}
@@ -1067,7 +1066,7 @@
* Returns a new SocketInfo, or NULL with an error in interp.
*
* Side effects:
- * Adds a new socket to the socketList.
+ * None, except for allocation of memory.
*
*----------------------------------------------------------------------
*/
@@ -2660,4 +2659,84 @@
return winSock.getservbyname(name, proto);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpThreadActionProc --
+ *
+ * Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpThreadActionProc (instanceData, action)
+ ClientData instanceData;
+ int action;
+{
+ ThreadSpecificData *tsdPtr;
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ int notifyCmd;
+
+ if (action == TCL_CHANNEL_THREAD_INSERT) {
+ /*
+ * Ensure that socket subsystem is initialized in this thread, or
+ * else sockets will not work.
+ */
+
+ Tcl_MutexLock(&socketMutex);
+ InitSockets();
+ Tcl_MutexUnlock(&socketMutex);
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ infoPtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = infoPtr;
+ SetEvent(tsdPtr->socketListLock);
+
+ notifyCmd = SELECT;
+ } else {
+ SocketInfo **nextPtrPtr;
+ int removed = 0;
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /* TIP #218, Bugfix: All access to socketList has to be protected by the lock */
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
+ nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+ if ((*nextPtrPtr) == infoPtr) {
+ (*nextPtrPtr) = infoPtr->nextPtr;
+ removed = 1;
+ break;
+ }
+ }
+ SetEvent(tsdPtr->socketListLock);
+
+ /*
+ * This could happen if the channel was created in one thread
+ * and then moved to another without updating the thread
+ * local data in each thread.
+ */
+ if (!removed) {
+ Tcl_Panic("file info ptr not on thread channel list");
+ }
+
+ notifyCmd = UNSELECT;
+ }
+
+ /*
+ * Ensure that, or stop, notifications for the socket occur in this thread.
+ */
+
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) notifyCmd, (LPARAM) infoPtr);
+}
