VarReform [Patch 1750051]

	*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)

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);
 	}