summaryrefslogtreecommitdiffstats
path: root/generic/tclLiteral.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-07-31 17:03:34 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-07-31 17:03:34 (GMT)
commitc78aef8e3103f916ede55e36edd8f5fb876ab0f6 (patch)
tree6bef95f9839cbc6e08ab7040bd9bbd6c9925a5f8 /generic/tclLiteral.c
parent4de8702e9bdf3ad59efdba5918502f6b9f23c827 (diff)
downloadtcl-c78aef8e3103f916ede55e36edd8f5fb876ab0f6.zip
tcl-c78aef8e3103f916ede55e36edd8f5fb876ab0f6.tar.gz
tcl-c78aef8e3103f916ede55e36edd8f5fb876ab0f6.tar.bz2
VarReform [Patch 1750051]
*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)
Diffstat (limited to 'generic/tclLiteral.c')
-rw-r--r--generic/tclLiteral.c270
1 files changed, 166 insertions, 104 deletions
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 3f1d059..ba9b812 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.30 2007/03/21 16:25:28 dgp Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.31 2007/07/31 17:03:39 msofer Exp $
*/
#include "tclInt.h"
@@ -31,7 +31,7 @@
*/
static int AddLocalLiteralEntry(CompileEnv *envPtr,
- LiteralEntry *globalPtr, int localHash);
+ Tcl_Obj *objPtr, int localHash);
static void ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned int HashString(const char *bytes, int length);
static void RebuildLiteralTable(LiteralTable *tablePtr);
@@ -216,21 +216,20 @@ TclDeleteLiteralTable(
/*
*----------------------------------------------------------------------
*
- * TclRegisterLiteral --
+ * TclCreateLiteral --
*
- * Find, or if necessary create, an object in a CompileEnv literal array
- * that has a string representation matching the argument string.
+ * Find, or if necessary create, an object in the interpreter's literal
+ * table that has a string representation matching the argument
+ * string. If nsPtr!=NULL then only literals stored for the namespace are
+ * considered.
*
* Results:
- * The index in the CompileEnv's literal array that references a shared
- * literal matching the string. The object is created if necessary.
+ * The literal object. If it was created in this call *newPtr is set to
+ * 1, else 0. NULL is returned if newPtr==NULL and no literal is found.
*
* Side effects:
- * To maximize sharing, we look up the string in the interpreter's global
- * literal table. If not found, we create a new shared literal in the
- * global table. We then add a reference to the shared literal in the
- * CompileEnv's literal array.
- *
+ * Increments the ref count of the global LiteralEntry since the caller
+ * now holds a reference.
* If LITERAL_ON_HEAP is set in flags, this function 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,
@@ -240,77 +239,29 @@ TclDeleteLiteralTable(
*----------------------------------------------------------------------
*/
-int
-TclRegisterLiteral(
- 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
- * create an object in CompileEnv's object
- * array. */
- int length, /* Number of bytes in the string. If < 0, the
- * string consists of all bytes up to the
- * first null character. */
- int flags) /* If LITERAL_ON_HEAP then the caller already
- * malloc'd bytes and ownership is passed to
- * this function. If LITERAL_NS_SCOPE then
- * the literal shouldnot be shared accross
- * namespaces. */
+Tcl_Obj *
+TclCreateLiteral(
+ Interp *iPtr,
+ char *bytes,
+ int length,
+ unsigned int hash, /* The string's hash. If -1, it will be computed here */
+ int *newPtr,
+ Namespace *nsPtr,
+ int flags,
+ LiteralEntry **globalPtrPtr)
{
- Interp *iPtr = envPtr->iPtr;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
- LiteralTable *localTablePtr = &(envPtr->localLitTable);
- register LiteralEntry *globalPtr, *localPtr;
- register Tcl_Obj *objPtr;
- unsigned int hash;
- int localHash, globalHash, objIndex;
- Namespace *nsPtr;
-
- if (length < 0) {
- length = (bytes ? strlen(bytes) : 0);
- }
- hash = HashString(bytes, length);
-
- /*
- * Is the literal already in the CompileEnv's local literal array? If so,
- * just return its index.
- */
-
- localHash = (hash & localTablePtr->mask);
- for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
- localPtr = localPtr->nextPtr) {
- objPtr = localPtr->objPtr;
- if ((objPtr->length == length) && ((length == 0)
- || ((objPtr->bytes[0] == bytes[0])
- && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
- if (flags & LITERAL_ON_HEAP) {
- ckfree(bytes);
- }
- objIndex = (localPtr - envPtr->literalArrayPtr);
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- return objIndex;
- }
- }
-
- /*
- * 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;
- }
-
+ LiteralEntry *globalPtr;
+ int globalHash;
+ Tcl_Obj *objPtr;
+
/*
* Is it in the interpreter's global literal table?
*/
+ if (hash == (unsigned int) -1) {
+ hash = HashString(bytes, length);
+ }
globalHash = (hash & globalTablePtr->mask);
for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
globalPtr = globalPtr->nextPtr) {
@@ -320,29 +271,32 @@ TclRegisterLiteral(
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
/*
- * A global literal was found. Add an entry to the CompileEnv's
- * local literal array.
+ * A literal was found: return it
*/
+ if (newPtr) {
+ *newPtr = 0;
+ }
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
+ }
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
-#ifdef TCL_COMPILE_DEBUG
- if (globalPtr->refCount < 1) {
- Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
- (length>60? 60 : length), bytes, globalPtr->refCount);
- }
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
- return objIndex;
+ globalPtr->refCount++;
+ return objPtr;
}
}
+ if (!newPtr) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ return NULL;
+ }
/*
* The literal is new to the interpreter. Add it to the global literal
- * table then add an entry to the CompileEnv's local literal array.
- * Convert the object to an integer object if possible.
+ * table.
*/
TclNewObj(objPtr);
@@ -363,7 +317,7 @@ TclRegisterLiteral(
globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
- globalPtr->refCount = 0;
+ globalPtr->refCount = 1;
globalPtr->nsPtr = nsPtr;
globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
globalTablePtr->buckets[globalHash] = globalPtr;
@@ -377,11 +331,9 @@ TclRegisterLiteral(
if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
RebuildLiteralTable(globalTablePtr);
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
- TclVerifyLocalLiteralTable(envPtr);
{
LiteralEntry *entryPtr;
int found, i;
@@ -409,6 +361,121 @@ TclRegisterLiteral(
iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
+ }
+ *newPtr = 1;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ * Find, or if necessary create, an object in a CompileEnv literal array
+ * that has a string representation matching the argument string.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references a shared
+ * literal matching the string. The object is created if necessary.
+ *
+ * Side effects:
+ * To maximize sharing, we look up the string in the interpreter's global
+ * literal table. If not found, we create a new shared literal in the
+ * global table. We then add a reference to the shared literal in the
+ * CompileEnv's literal array.
+ *
+ * If LITERAL_ON_HEAP is set in flags, this function 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(
+ 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
+ * create an object in CompileEnv's object
+ * array. */
+ int length, /* Number of bytes in the string. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
+ int flags) /* If LITERAL_ON_HEAP then the caller already
+ * malloc'd bytes and ownership is passed to
+ * this function. If LITERAL_NS_SCOPE then
+ * the literal shouldnot be shared accross
+ * namespaces. */
+{
+ Interp *iPtr = envPtr->iPtr;
+ LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ LiteralEntry *globalPtr, *localPtr;
+ Tcl_Obj *objPtr;
+ unsigned int hash;
+ int localHash, objIndex, new;
+ Namespace *nsPtr;
+
+ if (length < 0) {
+ length = (bytes ? strlen(bytes) : 0);
+ }
+ hash = HashString(bytes, length);
+
+ /*
+ * Is the literal already in the CompileEnv's local literal array? If so,
+ * just return its index.
+ */
+
+ localHash = (hash & localTablePtr->mask);
+ for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+ localPtr = localPtr->nextPtr) {
+ objPtr = localPtr->objPtr;
+ if ((objPtr->length == length) && ((length == 0)
+ || ((objPtr->bytes[0] == bytes[0])
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ return objIndex;
+ }
+ }
+
+ /*
+ * 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? If not, create it.
+ */
+
+ objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
+ flags, &globalPtr);
+ objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+ if (globalPtr->refCount < 1) {
+ Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes, globalPtr->refCount);
+ }
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
return objIndex;
}
@@ -582,10 +649,8 @@ TclAddLiteralObj(
* literal.
*
* Side effects:
- * Increments the ref count of the global LiteralEntry since the
- * CompileEnv now refers to the literal. Expands the literal array if
- * necessary. May rebuild the hash bucket array of the CompileEnv's
- * literal array if it becomes too large.
+ * Expands the literal array if necessary. May rebuild the hash bucket
+ * array of the CompileEnv's literal array if it becomes too large.
*
*----------------------------------------------------------------------
*/
@@ -594,15 +659,14 @@ static int
AddLocalLiteralEntry(
register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
- LiteralEntry *globalPtr, /* Points to the global LiteralEntry for the
- * literal to add to the CompileEnv. */
+ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */
int localHash) /* Hash value for the literal's string. */
{
register LiteralTable *localTablePtr = &(envPtr->localLitTable);
LiteralEntry *localPtr;
int objIndex;
- objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+ objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
/*
* Add the literal to the local table.
@@ -612,8 +676,6 @@ AddLocalLiteralEntry(
localTablePtr->buckets[localHash] = localPtr;
localTablePtr->numEntries++;
- globalPtr->refCount++;
-
/*
* If the CompileEnv's local literal table has exceeded a decent size,
* rebuild it with more buckets.
@@ -633,14 +695,14 @@ AddLocalLiteralEntry(
for (i=0 ; i<localTablePtr->numBuckets ; i++) {
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
localPtr=localPtr->nextPtr) {
- if (localPtr->objPtr == globalPtr->objPtr) {
+ if (localPtr->objPtr == objPtr) {
found = 1;
}
}
}
if (!found) {
- bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
(length>60? 60 : length), bytes);
}