summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-11-09 21:35:16 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-11-09 21:35:16 (GMT)
commitb4735e76da5d332e785a396168efb7230a88d8fe (patch)
treeeb56f5290785cb8ac4ee8de28f240ced1a4fe001
parent2ebefee1b05df6c41125e6bc8ed768c0cc4f50dc (diff)
downloadtcl-b4735e76da5d332e785a396168efb7230a88d8fe.zip
tcl-b4735e76da5d332e785a396168efb7230a88d8fe.tar.gz
tcl-b4735e76da5d332e785a396168efb7230a88d8fe.tar.bz2
* generic/tclAsync.c:
* generic/tclBasic.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclUnixInit.c: * generic/tclUnixPort.h: new fields in interp (ekeko!) to cache TSD data that is accessed at each command invocation, access macros to replace Tcl_AsyncReady and TclpCheckStackSpace by much faster variants [Patch 1829248]
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclAsync.c8
-rw-r--r--generic/tclBasic.c53
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclInt.h39
-rw-r--r--unix/tclUnixInit.c117
-rw-r--r--unix/tclUnixPort.h5
7 files changed, 188 insertions, 50 deletions
diff --git a/ChangeLog b/ChangeLog
index 52d7f8f..783e267 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2007-11-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclAsync.c:
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclUnixInit.c:
+ * generic/tclUnixPort.h: new fields in interp (ekeko!) to cache
+ TSD data that is accessed at each command invocation, access
+ macros to replace Tcl_AsyncReady and TclpCheckStackSpace by much
+ faster variants [Patch 1829248]
+
2007-11-09 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclInt.decls, generic/tclIntDecls.h: Use unsigned char for
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index f53e9fa..73c5073 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAsync.c,v 1.10 2006/07/11 14:29:14 vasiljevic Exp $
+ * RCS: @(#) $Id: tclAsync.c,v 1.11 2007/11/09 21:35:17 msofer Exp $
*/
#include "tclInt.h"
@@ -324,6 +324,12 @@ Tcl_AsyncReady(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return tsdPtr->asyncReady;
}
+
+int *
+TclGetAsyncReadyPtr(void) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return &(tsdPtr->asyncReady);
+}
/*
* Local Variables:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 69f1e98..222261a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.270 2007/09/25 20:27:17 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.271 2007/11/09 21:35:17 msofer Exp $
*/
#include "tclInt.h"
@@ -333,6 +333,35 @@ static const OpCmdInfo mathOpCmds[] = {
{ NULL, NULL, NULL,
{0}, NULL }
};
+
+
+#ifdef TCL_NO_STACK_CHECK
+#define CheckStackSpace(interp, localIntPtr) 1
+#else /* stack checlk enabled */
+#ifdef _TCLUNIXPORT
+/*
+ * A unix system: cache the stack check parameters.
+ */
+
+static int stackGrowsDown = 1;
+
+#define CheckStackSpace(iPtr, localIntPtr) \
+ (stackGrowsDown \
+ ? ((localIntPtr) > (iPtr)->stackBound) \
+ : ((localIntPtr) < (iPtr)->stackBound) \
+ )
+#else /* not unix */
+/*
+ * FIXME: can we do something similar for other platforms, especially windows?
+ */
+
+#define TclpGetCStackParams(foo) 1;
+#define CheckStackSpace(interp, localIntPtr) \
+ TclpCheckStackSpace()
+#endif
+#endif
+
+
/*
*----------------------------------------------------------------------
@@ -572,6 +601,20 @@ Tcl_CreateInterp(void)
TclInitLimitSupport(interp);
/*
+ * Initialise the thread-specific data ekeko.
+ */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ iPtr->allocCache = TclpGetAllocCache();
+#else
+ iPtr->allocCache = NULL;
+#endif
+ iPtr->pendingObjDataPtr = NULL;
+ iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
+
+ stackGrowsDown = TclpGetCStackParams(&iPtr->stackBound);
+
+ /*
* Create the core commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to check for a
* pre-existing command by the same name). If a command has a Tcl_CmdProc
@@ -3376,6 +3419,7 @@ int
TclInterpReady(
Tcl_Interp *interp)
{
+ int localInt; /* used for checking the stack */
register Interp *iPtr = (Interp *) interp;
/*
@@ -3404,7 +3448,7 @@ TclInterpReady(
*/
if (((iPtr->numLevels) > iPtr->maxNestingDepth)
- || (TclpCheckStackSpace() == 0)) {
+ || (CheckStackSpace(iPtr, &localInt) == 0)) {
Tcl_AppendResult(interp,
"too many nested evaluations (infinite loop?)", NULL);
return TCL_ERROR;
@@ -3471,7 +3515,7 @@ TclEvalObjvInternal(
Namespace *savedNsPtr = NULL;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
Tcl_Obj *commandPtr = NULL;
-
+
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -3615,7 +3659,8 @@ TclEvalObjvInternal(
TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
}
}
- if (Tcl_AsyncReady()) {
+
+ if (TclAsyncReady(iPtr)) {
code = Tcl_AsyncInvoke(interp, code);
}
if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6971a0a..79fe487 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.342 2007/11/09 18:55:14 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.343 2007/11/09 21:35:18 msofer Exp $
*/
#include "tclInt.h"
@@ -1734,7 +1734,7 @@ TclExecuteByteCode(
* ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
*/
- if (Tcl_AsyncReady()) {
+ if (TclAsyncReady(iPtr)) {
int localResult;
DECACHE_STACK_INFO();
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 03e14c6..af62562 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.337 2007/10/27 13:15:58 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.338 2007/11/09 21:35:18 msofer Exp $
*/
#ifndef _TCLINT
@@ -1837,17 +1837,51 @@ typedef struct Interp {
Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's
* active searches list; varPtr is the key */
/*
+ * The thread-specific data ekeko: cache pointers or values that
+ * (a) do not change during the thread's lifetime
+ * (b) require access to TSD to determine at runtime
+ * (c) are accessed very often (eg, at each command call)
+ *
+ * Note that these are the same for all interps in the same thread. They
+ * just have to be initialised for the thread's master interp, slaves
+ * inherit the value.
+ *
+ * They are used by the macros defined below.
+ */
+
+ void *allocCache;
+ void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData
+ * structs for this interp's thread; see
+ * tclObj.c and tclThreadAlloc.c */
+ int *asyncReadyPtr; /* Pointer to the asyncReady indicator for
+ * this interp's thread; see tclAsync.c */
+ int *stackBound; /* Pointer to the limit stack address
+ * allowable for invoking a new command
+ * without "risking" a C-stack overflow;
+ * see TclpCheckStackSpace in the
+ * platform's directory. */
+
+
+#ifdef TCL_COMPILE_STATS
+ /*
* Statistical information about the bytecode compiler and interpreter's
* operation.
*/
-#ifdef TCL_COMPILE_STATS
ByteCodeStats stats; /* Holds compilation and execution statistics
* for this interpreter. */
#endif /* TCL_COMPILE_STATS */
} Interp;
/*
+ * Macros that use the TSD-ekeko
+ */
+
+#define TclAsyncReady(iPtr) \
+ *((iPtr)->asyncReadyPtr)
+
+
+/*
* General list of interpreters. Doubly linked for easier removal of items
* deep in the list.
*/
@@ -2381,6 +2415,7 @@ MODULE_SCOPE double TclFloor(mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
CONST char *attributeName, int *indexPtr);
+MODULE_SCOPE int * TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, ClientData *clientDataPtr,
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 3d554d9..6554a3f 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclUnixInit.c,v 1.71 2007/07/31 10:04:28 dkf Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.72 2007/11/09 21:35:19 msofer Exp $
*/
#include "tclInt.h"
@@ -343,6 +343,15 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp,
MODULE_SCOPE long tclMacOSXDarwinRelease;
long tclMacOSXDarwinRelease = 0;
#endif
+
+/*
+ * Auxiliary function to compute the direction of stack growth, and a static
+ * variable to cache the result.
+ */
+
+static stackGrowsDown = -1;
+static int StackGrowsDown(int *parent);
+
/*
*---------------------------------------------------------------------------
@@ -1017,6 +1026,7 @@ TclpFindVariable(
* Side effects:
* None.
*
+ * Remark: Unused in the core, to be removed.
*----------------------------------------------------------------------
*/
@@ -1034,25 +1044,59 @@ TclpCheckStackSpace(void)
#else
+ int localInt, *stackBound;
+
+ TclpGetCStackParams(&stackBound);
+
+ if (stackGrowsDown) {
+ return (&localInt > stackBound) ;
+ } else {
+ return (&localInt > stackBound) ;
+ }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetStackParams --
+ *
+ * Determine tha stack params for the current thread: in which
+ * direction does the stack grow, and what is the stack lower (resp
+ * upper) bound for safe invocation of a new command. This is used to
+ * cache the values needed for an efficient computation of
+ * TclpCheckStackSpace() when the interp is known.
+ *
+ * Results:
+ * Returns 1 if the stack grows down, in which case a stack lower bound
+ * is stored at stackBoundPtr. If the stack grows up, 0 is returned and
+ * an upper bound is stored at stackBoundPtr. If a bound cannot be
+ * determined NULL is stored at stackBoundPtr.
+ */
+
+int
+TclpGetCStackParams(
+ int **stackBoundPtr)
+{
+#ifdef TCL_NO_STACK_CHECK
+ *stackBoundPtr = NULL;
+ return 0;
+#else
+ int localVar;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/* Most variables are actually in a
* thread-specific data block to minimise the
* impact on the stack. */
- register size_t stackUsed;
- int localVar; /* Reference to somewhere on the local stack.
- * This is declared last so it's as "deep" as
- * possible. */
-
- if (tsdPtr == NULL) {
+
+ if (stackGrowsDown == -1) {
/*
- * This should probably be a panic(); if we're out of stack, we might
- * have virtually no room to manoeuver at all.
+ * Not initialised!
*/
- Tcl_Panic("failed to get thread specific stack check data");
+ stackGrowsDown = StackGrowsDown(&localVar);
}
- /*
+ /*
* The first time through, we record the "outermost" stack frame.
*/
@@ -1073,41 +1117,34 @@ TclpCheckStackSpace(void)
tsdPtr->initialised = 1;
}
- switch (tsdPtr->stackDetermineResult) {
- case TCL_BREAK:
- STACK_DEBUG(("skipping stack check with failure\n"));
- return 0;
- case TCL_CONTINUE:
- STACK_DEBUG(("skipping stack check with success\n"));
- return 1;
+ if (tsdPtr->stackDetermineResult != TCL_OK) {
+ switch (tsdPtr->stackDetermineResult) {
+ case TCL_BREAK:
+ STACK_DEBUG(("skipping stack checks with failure\n"));
+ case TCL_CONTINUE:
+ STACK_DEBUG(("skipping stack checks with success\n"));
+ }
+ *stackBoundPtr = NULL;
+ return 1; /* so that check always succeeds */
}
- /*
- * Sanity check to see if somehow the stack started going the
- * other way.
- */
-
- if (&localVar > tsdPtr->outerVarPtr) {
- stackUsed = (char *)&localVar - (char *)tsdPtr->outerVarPtr;
+ if (stackGrowsDown) {
+ *stackBoundPtr = tsdPtr->outerVarPtr - tsdPtr->stackSize;
} else {
- stackUsed = (char *)tsdPtr->outerVarPtr - (char *)&localVar;
+ *stackBoundPtr = tsdPtr->outerVarPtr + tsdPtr->stackSize;
}
+ return stackGrowsDown;
+#endif
+}
- /*
- * Now we perform the actual check. Are we about to blow our stack frame?
- */
-
- if (stackUsed < tsdPtr->stackSize) {
- STACK_DEBUG(("stack OK\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
- &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
- return 1;
- } else {
- STACK_DEBUG(("stack OVERFLOW\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
- &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
- return 0;
- }
-#endif /* TCL_NO_STACK_CHECK */
+int
+StackGrowsDown(
+ int *parent)
+{
+ int here;
+ return (&here < parent);
}
+
/*
*----------------------------------------------------------------------
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index baa17f9..ce834f0 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPort.h,v 1.58 2007/10/11 21:35:03 dgp Exp $
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.59 2007/11/09 21:35:19 msofer Exp $
*/
#ifndef _TCLUNIXPORT
@@ -679,4 +679,7 @@ MODULE_SCOPE struct group* TclpGetGrGid(gid_t gid);
MODULE_SCOPE struct hostent* TclpGetHostByName(const char *name);
MODULE_SCOPE struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
+
+MODULE_SCOPE int TclpGetCStackParams(int **stackBound);
+
#endif /* _TCLUNIXPORT */