From 82facaaadc38055a533bb63ecd26a98eccac0373 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 27 Feb 2010 12:07:04 +0000 Subject: * generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding of the client-installed main loop function into thread-specific data. ***POTENTIAL INCOMPATIBILITY*** Code that previously tried to set the main loop from another thread will now fail. On the other hand, there is a fairly high probability that such programs would have been failing before due to the lack of any kind of inter-thread memory barriers guarding accesses to this part of Tcl's state. --- ChangeLog | 12 +++++++ generic/tclMain.c | 104 ++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 82 insertions(+), 34 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7be6e8d..ce4e1aa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2010-02-27 Donal K. Fellows + + * generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding + of the client-installed main loop function into thread-specific data. + + ***POTENTIAL INCOMPATIBILITY*** + Code that previously tried to set the main loop from another thread + will now fail. On the other hand, there is a fairly high probability + that such programs would have been failing before due to the lack of + any kind of inter-thread memory barriers guarding accesses to this + part of Tcl's state. + 2010-02-26 Donal K. Fellows * generic/tclCompCmds.c: Split this file into two pieces to make it diff --git a/generic/tclMain.c b/generic/tclMain.c index 60425d9..39bacc1 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMain.c,v 1.48 2010/02/24 10:32:17 dkf Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.49 2010/02/27 12:07:04 dkf Exp $ */ #include "tclInt.h" @@ -32,16 +32,21 @@ extern CRTIMPORT int isatty(int fd); -typedef struct StartupScript { - Tcl_Obj *path; /* The filename of the script for *_Main() routines - * to [source] as a startup script, or NULL for - * none set, meaning enter interactive mode. */ - Tcl_Obj *encoding; /* The encoding of the startup script file. */ -} StartupScript; - -static Tcl_ThreadDataKey startupScriptKey; +/* + * The thread-local variables for this file's functions. + */ -static Tcl_MainLoopProc *mainLoopProc = NULL; +typedef struct { + Tcl_Obj *path; /* The filename of the script for *_Main() + * routines to [source] as a startup script, + * or NULL for none set, meaning enter + * interactive mode. */ + Tcl_Obj *encoding; /* The encoding of the startup script file. */ + Tcl_MainLoopProc *mainLoopProc; + /* Any installed main loop handler. The main + * extension that installs these is Tk. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Structure definition for information used to keep the state of an @@ -72,6 +77,7 @@ typedef struct InteractiveState { * Forward declarations for functions defined later in this file. */ +static Tcl_MainLoopProc * GetMainLoop(void); static void Prompt(Tcl_Interp *interp, PromptType *promptPtr); static void StdinProc(ClientData clientData, int mask); @@ -96,28 +102,27 @@ Tcl_SetStartupScript( Tcl_Obj *path, /* Filesystem path of startup script file */ const char *encoding) /* Encoding of the data in that file */ { - StartupScript *scriptPtr = Tcl_GetThreadData(&startupScriptKey, - (int) sizeof(StartupScript)); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_Obj *newEncoding = NULL; if (encoding != NULL) { newEncoding = Tcl_NewStringObj(encoding, -1); } - if (scriptPtr->path != NULL) { - Tcl_DecrRefCount(scriptPtr->path); + if (tsdPtr->path != NULL) { + Tcl_DecrRefCount(tsdPtr->path); } - scriptPtr->path = path; - if (scriptPtr->path != NULL) { - Tcl_IncrRefCount(scriptPtr->path); + tsdPtr->path = path; + if (tsdPtr->path != NULL) { + Tcl_IncrRefCount(tsdPtr->path); } - if (scriptPtr->encoding != NULL) { - Tcl_DecrRefCount(scriptPtr->encoding); + if (tsdPtr->encoding != NULL) { + Tcl_DecrRefCount(tsdPtr->encoding); } - scriptPtr->encoding = newEncoding; - if (scriptPtr->encoding != NULL) { - Tcl_IncrRefCount(scriptPtr->encoding); + tsdPtr->encoding = newEncoding; + if (tsdPtr->encoding != NULL) { + Tcl_IncrRefCount(tsdPtr->encoding); } } @@ -146,19 +151,18 @@ Tcl_GetStartupScript( const char **encodingPtr) /* When not NULL, points to storage for the * (const char *) that points to the * registered encoding name for the startup - * script */ + * script. */ { - StartupScript *scriptPtr = Tcl_GetThreadData(&startupScriptKey, - (int) sizeof(StartupScript)); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (encodingPtr != NULL) { - if (scriptPtr->encoding == NULL) { + if (tsdPtr->encoding == NULL) { *encodingPtr = NULL; } else { - *encodingPtr = Tcl_GetString(scriptPtr->encoding); + *encodingPtr = Tcl_GetString(tsdPtr->encoding); } } - return scriptPtr->path; + return tsdPtr->path; } /*---------------------------------------------------------------------- @@ -251,6 +255,7 @@ Tcl_Main( const char *encodingName = NULL; PromptType prompt = PROMPT_START; int code, length, tty, exitCode = 0; + Tcl_MainLoopProc *mainLoopProc; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; Tcl_DString appName; @@ -399,6 +404,7 @@ Tcl_Main( inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) { + mainLoopProc = GetMainLoop(); if (mainLoopProc == NULL) { if (tty) { Prompt(interp, &prompt); @@ -509,7 +515,7 @@ Tcl_Main( isPtr->interp = interp; Tcl_UnlinkVar(interp, "tcl_interactive"); - Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty), + Tcl_LinkVar(interp, "tcl_interactive", (char *) &isPtr->tty, TCL_LINK_BOOLEAN); Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, @@ -517,7 +523,7 @@ Tcl_Main( } mainLoopProc(); - mainLoopProc = NULL; + Tcl_SetMainLoop(NULL); if (inChannel) { tty = isPtr->tty; @@ -543,13 +549,14 @@ Tcl_Main( */ if (tclMemDumpFileName != NULL) { - mainLoopProc = NULL; + Tcl_SetMainLoop(NULL); Tcl_DeleteInterp(interp); } #endif } done: + mainLoopProc = GetMainLoop(); if ((exitCode == 0) && (mainLoopProc != NULL) && !Tcl_LimitExceeded(interp)) { /* @@ -559,7 +566,7 @@ Tcl_Main( */ mainLoopProc(); - mainLoopProc = NULL; + Tcl_SetMainLoop(NULL); } if (commandPtr != NULL) { Tcl_DecrRefCount(commandPtr); @@ -610,7 +617,7 @@ Tcl_Main( * Sets an alternative main loop function. * * Results: - * Returns the previously defined main loop function. + * None. * * Side effects: * This function will be called before Tcl exits, allowing for the @@ -623,7 +630,36 @@ void Tcl_SetMainLoop( Tcl_MainLoopProc *proc) { - mainLoopProc = proc; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->mainLoopProc = proc; +} + +/* + *--------------------------------------------------------------- + * + * GetMainLoop -- + * + * Returns the current alternative main loop function. + * + * Results: + * Returns the previously defined main loop function, or NULL to indicate + * that no such function has been installed and standard tclsh behaviour + * (i.e., exit once the script is evaluated if not interactive) is + * requested.. + * + * Side effects: + * None (other than possible creation of this file's TSD block). + * + *--------------------------------------------------------------- + */ + +static Tcl_MainLoopProc * +GetMainLoop(void) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return tsdPtr->mainLoopProc; } /* -- cgit v0.12