summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclCompile.c23
-rw-r--r--generic/tclCompile.h24
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclInt.h7
-rw-r--r--generic/tclLiteral.c49
-rw-r--r--generic/tclProc.c4
7 files changed, 85 insertions, 37 deletions
diff --git a/ChangeLog b/ChangeLog
index 2d2512d..8f18544 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2004-12-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclLiteral.c:
+ * generic/tclProc.c:
+ Avoid sharing cmdName literals accross namespaces, and generalise
+ usage of the TclRegisterNewLiteral macro [Patch 1090905]
+
2004-12-20 Miguel Sofer <msofer@users.sf.net>
* generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 243cc14..f732f36 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.80 2004/12/20 18:27:18 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.81 2004/12/24 18:06:56 msofer Exp $
*/
#include "tclInt.h"
@@ -1146,10 +1146,11 @@ TclCompileScript(interp, script, numBytes, envPtr)
/*
* No compile procedure so push the word. If the
* command was found, push a CmdName object to
- * reduce runtime lookups.
+ * reduce runtime lookups. Avoid sharing this literal
+ * among different namespaces to reduce shimmering.
*/
- objIndex = TclRegisterNewLiteral(envPtr,
+ objIndex = TclRegisterNewNSLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
@@ -1318,9 +1319,9 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
- literal = TclRegisterLiteral(envPtr,
+ literal = TclRegisterNewLiteral(envPtr,
Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
@@ -1339,9 +1340,9 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
- literal = TclRegisterLiteral(envPtr,
+ literal = TclRegisterNewLiteral(envPtr,
Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
@@ -1433,8 +1434,8 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
- literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
+ Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
}
@@ -1456,7 +1457,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
if (envPtr->codeNext == entryCodeNext) {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0),
envPtr);
}
Tcl_DStringFree(&textBuffer);
@@ -1573,7 +1574,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
for (i = 0; i < numWords; i++) {
TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
if (i < (numWords - 1)) {
- TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
+ TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1),
envPtr);
}
wordPtr += (wordPtr->numComponents + 1);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a50409b..ae4c39c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.52 2004/12/10 13:09:14 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.53 2004/12/24 18:06:58 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -842,7 +842,7 @@ MODULE_SCOPE void TclPrintSource _ANSI_ARGS_((FILE *outFile,
CONST char *string, int maxChars));
MODULE_SCOPE void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
MODULE_SCOPE int TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
- char *bytes, int length, int onHeap));
+ char *bytes, int length, int flags));
MODULE_SCOPE void TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
MODULE_SCOPE void TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp,
@@ -860,11 +860,13 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
/*
*----------------------------------------------------------------
- * Macros used by Tcl bytecode compilation and execution modules
- * inside the Tcl core but not used outside.
+ * Macros and flag values used by Tcl bytecode compilation and execution
+ * modules inside the Tcl core but not used outside.
*----------------------------------------------------------------
*/
+#define LITERAL_ON_HEAP 0x01
+#define LITERAL_NS_SCOPE 0x02
/*
* Form of TclRegisterLiteral with onHeap == 0.
* In that case, it is safe to cast away CONSTness, and it
@@ -872,7 +874,19 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclRegisterNewLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, \
+ /*flags*/ 0)
+
+/*
+ * Form of TclRegisterNSLiteral with onHeap == 0.
+ * In that case, it is safe to cast away CONSTness, and it
+ * is cleanest to do that here, all in one place.
+ */
+
+#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, \
+ /*flags*/ LITERAL_NS_SCOPE)
+
/*
* Macro used to manually adjust the stack requirements; used
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index afbb4aa..a2b608c 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.168 2004/12/15 20:44:36 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.169 2004/12/24 18:06:58 msofer Exp $
*/
#include "tclInt.h"
@@ -885,7 +885,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
*/
if (compEnv.codeNext == compEnv.codeStart) {
- TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
+ TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
&compEnv);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5f10b46..0bd71f0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,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.208 2004/12/16 19:36:34 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.209 2004/12/24 18:07:00 msofer Exp $
*/
#ifndef _TCLINT
@@ -973,6 +973,11 @@ typedef struct LiteralEntry {
* entry can be freed when refCount
* drops to 0. If in a local literal
* table, -1. */
+ Namespace *nsPtr; /* Namespace in which this literal is
+ * used. We try to avoid sharing
+ * literal non-FQ command names among
+ * different namespaces to reduce
+ * shimmering.*/
} LiteralEntry;
typedef struct LiteralTable {
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index f5af52d..3f9f079 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.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: tclLiteral.c,v 1.20 2004/08/02 15:33:36 dgp Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.21 2004/12/24 18:07:01 msofer Exp $
*/
#include "tclInt.h"
@@ -238,17 +238,17 @@ TclDeleteLiteralTable(interp, tablePtr)
* in the global table. We then add a reference to the shared
* literal in the CompileEnv's literal array.
*
- * If onHeap is 1, this procedure is given ownership of the string: if
- * an object is created then its string representation is set directly
- * from string, otherwise the string is freed. Typically, a caller sets
- * onHeap 1 if "string" is an already heap-allocated buffer holding the
- * result of backslash substitutions.
+ * If LITERAL_ON_HEAP is set in flags, this procedure is given ownership
+ * of the string: if an object is created then its string representation
+ * is set directly from string, otherwise the string is freed. Typically,
+ * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ * buffer holding the result of backslash substitutions.
*
*----------------------------------------------------------------------
*/
int
-TclRegisterLiteral(envPtr, bytes, length, onHeap)
+TclRegisterLiteral(envPtr, bytes, length, flags)
CompileEnv *envPtr; /* Points to the CompileEnv in whose object
* array an object is found or created. */
register char *bytes; /* Points to string for which to find or
@@ -257,9 +257,11 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
int length; /* Number of bytes in the string. If < 0,
* the string consists of all bytes up to
* the first null character. */
- int onHeap; /* If 1 then the caller already malloc'd
- * bytes and ownership is passed to this
- * procedure. */
+ int flags; /* If LITERAL_ON_HEAP then the caller already
+ * malloc'd bytes and ownership is passed to
+ * this procedure. If LITERAL_NS_SCOPE then
+ * the literal shouldnot be shared accross
+ * namespaces. */
{
Interp *iPtr = envPtr->iPtr;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
@@ -270,6 +272,7 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
int localHash, globalHash, objIndex;
long n;
char buf[TCL_INTEGER_SPACE];
+ Namespace *nsPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
@@ -289,7 +292,7 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length)
== 0)))) {
- if (onHeap) {
+ if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
objIndex = (localPtr - envPtr->literalArrayPtr);
@@ -302,15 +305,28 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
}
/*
- * The literal is new to this CompileEnv. Is it in the interpreter's
- * global literal table?
+ * The literal is new to this CompileEnv. Should it be shared accross
+ * namespaces? If it is a fully qualified name, the namespace
+ * specification is not needed to avoid sharing.
+ */
+
+ if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
+ && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
+ nsPtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ nsPtr = NULL;
+ }
+
+ /*
+ * Is it in the interpreter's global literal table?
*/
globalHash = (hash & globalTablePtr->mask);
for (globalPtr = globalTablePtr->buckets[globalHash];
globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
- if ((objPtr->length == length) && ((length == 0)
+ if ((globalPtr->nsPtr == nsPtr)
+ && (objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length)
== 0)))) {
@@ -319,7 +335,7 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
* local literal array.
*/
- if (onHeap) {
+ if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
@@ -343,7 +359,7 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
- if (onHeap) {
+ if (flags & LITERAL_ON_HEAP) {
objPtr->bytes = bytes;
objPtr->length = length;
} else {
@@ -373,6 +389,7 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
globalPtr->refCount = 0;
+ globalPtr->nsPtr = nsPtr;
globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
globalTablePtr->buckets[globalHash] = globalPtr;
globalTablePtr->numEntries++;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 89434b3..54e1572 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.71 2004/12/20 21:20:06 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.72 2004/12/24 18:07:01 msofer Exp $
*/
#include "tclInt.h"
@@ -1837,6 +1837,6 @@ TclCompileNoOp(interp, parsePtr, envPtr)
}
}
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
return TCL_OK;
}