summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIOCmd.c77
1 files changed, 59 insertions, 18 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b2e883f..8e5796d 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.49 2007/12/06 16:14:33 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.50 2007/12/07 21:05:28 hobbs Exp $
*/
#include "tclInt.h"
@@ -23,9 +23,22 @@ typedef struct AcceptCallback {
} AcceptCallback;
/*
+ * Thread local storage used to maintain a per-thread stdout channel obj.
+ * It must be per-thread because of std channel limitations.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized; /* Set to 1 when the module is initialized. */
+ Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
* Static functions for this file:
*/
+static void FinalizeIOCmdTSD(ClientData clientData);
static void AcceptCallbackProc(ClientData callbackData,
Tcl_Channel chan, char *address, int port);
static int ChanPendingObjCmd(ClientData unused,
@@ -46,6 +59,35 @@ static void UnregisterTcpServerInterpCleanupProc(
/*
*----------------------------------------------------------------------
*
+ * FinalizeIOCmdTSD --
+ *
+ * Release the storage associated with the per-thread cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeIOCmdTSD(
+ ClientData clientData) /* Not used. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->stdoutObjPtr != NULL) {
+ Tcl_DecrRefCount(tsdPtr->stdoutObjPtr);
+ tsdPtr->stdoutObjPtr = NULL;
+ }
+ tsdPtr->initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_PutsObjCmd --
*
* This function is invoked to process the "puts" Tcl command. See the
@@ -72,24 +114,21 @@ Tcl_PutsObjCmd(
Tcl_Obj *string; /* String to write. */
Tcl_Obj *chanObjPtr = NULL; /* channel object. */
int newline; /* Add a newline at end? */
- const char *channelId; /* Name of channel for puts. */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
+ ThreadSpecificData *tsdPtr;
switch (objc) {
case 2: /* [puts $x] */
string = objv[1];
newline = 1;
- channelId = "stdout";
break;
case 3: /* [puts -nonewline $x] or [puts $chan $x] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
- channelId = "stdout";
} else {
newline = 1;
- channelId = TclGetString(objv[1]);
chanObjPtr = objv[1];
}
string = objv[2];
@@ -97,7 +136,6 @@ Tcl_PutsObjCmd(
case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
- channelId = TclGetString(objv[2]);
chanObjPtr = objv[2];
string = objv[3];
} else {
@@ -117,7 +155,6 @@ Tcl_PutsObjCmd(
"\": should be \"nonewline\"", NULL);
return TCL_ERROR;
}
- channelId = TclGetString(objv[1]);
chanObjPtr = objv[1];
string = objv[2];
}
@@ -130,19 +167,22 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
- if (chanObjPtr != NULL) {
- if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0)
- != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == NULL) {
- return TCL_ERROR;
+ if (chanObjPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout");
+ Tcl_IncrRefCount(tsdPtr->stdoutObjPtr);
+ Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL);
}
+ chanObjPtr = tsdPtr->stdoutObjPtr;
+ }
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
+ return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", channelId,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
@@ -168,7 +208,8 @@ Tcl_PutsObjCmd(
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
+ Tcl_AppendResult(interp, "error writing \"",
+ TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;