diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompile.c | 23 | ||||
| -rw-r--r-- | generic/tclCompile.h | 24 | ||||
| -rw-r--r-- | generic/tclExecute.c | 4 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclLiteral.c | 49 | ||||
| -rw-r--r-- | generic/tclProc.c | 4 |
6 files changed, 74 insertions, 37 deletions
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; } |