diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclIOCmd.c | 77 |
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; |