summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-27 12:07:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-27 12:07:04 (GMT)
commit82facaaadc38055a533bb63ecd26a98eccac0373 (patch)
tree1aaa5d6521e6d4a7ce00f2946959568149489c9d
parent2d6c9719837b34ab16c25970b47c1ab1f84e7f02 (diff)
downloadtcl-82facaaadc38055a533bb63ecd26a98eccac0373.zip
tcl-82facaaadc38055a533bb63ecd26a98eccac0373.tar.gz
tcl-82facaaadc38055a533bb63ecd26a98eccac0373.tar.bz2
* 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.
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclMain.c104
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 <dkf@users.sf.net>
+
+ * 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 <dkf@users.sf.net>
* 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;
}
/*