merged tcl 8.1 branch back into the main trunk

1 files changed, 929 insertions, 0 deletions

diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
new file mode 100644
index 0000000..eb199bb
--- /dev/null
+++ b/generic/tclLiteral.c
@@ -0,0 +1,929 @@
+/* 
+ * tclLiteral.c --
+ *
+ *	Implementation of the global and ByteCode-local literal tables
+ *	used to manage the Tcl objects created for literal values during
+ *	compilation of Tcl scripts. This implementation borrows heavily
+ *	from the more general hashtable implementation of Tcl hash tables
+ *	that appears in tclHash.c.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * 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.2 1999/04/16 00:46:50 stanton Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * When there are this many entries per bucket, on average, rebuild
+ * a literal's hash table to make it larger.
+ */
+
+#define REBUILD_MULTIPLIER	3
+
+/*
+ * Procedure prototypes for static procedures in this file:
+ */
+
+static int		AddLocalLiteralEntry _ANSI_ARGS_((
+			    CompileEnv *envPtr, LiteralEntry *globalPtr,
+			    int localHash));
+static void		ExpandLocalLiteralArray _ANSI_ARGS_((
+			    CompileEnv *envPtr));
+static unsigned int	HashString _ANSI_ARGS_((CONST char *bytes,
+			    int length));
+static void		RebuildLiteralTable _ANSI_ARGS_((
+			    LiteralTable *tablePtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitLiteralTable --
+ *
+ *	This procedure is called to initialize the fields of a literal table
+ *	structure for either an interpreter or a compilation's CompileEnv
+ *	structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The literal table is made ready for use.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitLiteralTable(tablePtr)
+    register LiteralTable *tablePtr; /* Pointer to table structure, which
+				      * is supplied by the caller. */
+{
+#if (TCL_SMALL_HASH_TABLE != 4) 
+    panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+	    TCL_SMALL_HASH_TABLE);
+#endif
+    
+    tablePtr->buckets = tablePtr->staticBuckets;
+    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
+    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
+    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
+    tablePtr->numEntries = 0;
+    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+    tablePtr->mask = 3;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteLiteralTable --
+ *
+ *	This procedure frees up everything associated with a literal table
+ *	except for the table's structure itself.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Each literal in the table is released: i.e., its reference count
+ *	in the global literal table is decremented and, if it becomes zero,
+ *	the literal is freed. In addition, the table's bucket array is
+ *	freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteLiteralTable(interp, tablePtr)
+    Tcl_Interp *interp;		/* Interpreter containing shared literals
+				 * referenced by the table to delete. */
+    LiteralTable *tablePtr;	/* Points to the literal table to delete. */
+{
+    LiteralEntry *entryPtr;
+    int i, start;
+
+    /*
+     * Release remaining literals in the table. Note that releasing a
+     * literal might release other literals, modifying the table, so we
+     * restart the search from the bucket chain we last found an entry.
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    TclVerifyGlobalLiteralTable((Interp *) interp);
+#endif /*TCL_COMPILE_DEBUG*/
+
+    start = 0;
+    while (tablePtr->numEntries > 0) {
+	for (i = start;  i < tablePtr->numBuckets;  i++) {
+	    entryPtr = tablePtr->buckets[i];
+	    if (entryPtr != NULL) {
+		TclReleaseLiteral(interp, entryPtr->objPtr);
+		start = i;
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Free up the table's bucket array if it was dynamically allocated.
+     */
+
+    if (tablePtr->buckets != tablePtr->staticBuckets) {
+	ckfree((char *) tablePtr->buckets);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(envPtr, bytes, length, onHeap)
+    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 onHeap;			/* If 1 then the caller already malloc'd
+				 * bytes and ownership is passed to this
+				 * procedure. */
+{
+    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;
+    long n;
+    char buf[TCL_INTEGER_SPACE];
+
+    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 (onHeap) {
+		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. 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)
+		|| ((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.
+	     */
+	    
+	    if (onHeap) {
+		ckfree(bytes);
+	    }
+	    objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
+#ifdef TCL_COMPILE_DEBUG
+	    if (globalPtr->refCount < 1) {
+		panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+		        (length>60? 60 : length), bytes,
+		        globalPtr->refCount);
+	    }
+	    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/ 
+	    return objIndex;
+	}
+    }
+
+    /*
+     * 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.
+     */
+
+    TclNewObj(objPtr);
+    Tcl_IncrRefCount(objPtr);
+    if (onHeap) {
+	objPtr->bytes = bytes;
+	objPtr->length = length;
+    } else {
+	TclInitStringRep(objPtr, bytes, length);
+    }
+    if (TclLooksLikeInt(bytes, length)) {
+	if (TclGetLong((Tcl_Interp *) NULL, bytes, &n) == TCL_OK) {
+	    TclFormatInt(buf, n);
+	    if (strcmp(bytes, buf) == 0) {
+		objPtr->internalRep.longValue = n;
+		objPtr->typePtr = &tclIntType;
+	    }
+	}
+    }
+    
+#ifdef TCL_COMPILE_DEBUG
+    if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
+	panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
+	        (length>60? 60 : length), bytes);
+    }
+#endif
+
+    globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
+    globalPtr->objPtr = objPtr;
+    globalPtr->refCount = 0;
+    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
+    globalTablePtr->buckets[globalHash] = globalPtr;
+    globalTablePtr->numEntries++;
+
+    /*
+     * If the global literal table has exceeded a decent size, rebuild it
+     * with more buckets.
+     */
+
+    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;
+	found = 0;
+	for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
+	    for (entryPtr = globalTablePtr->buckets[i];
+		    entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
+		if ((entryPtr == globalPtr)
+		        && (entryPtr->objPtr == objPtr)) {
+		    found = 1;
+		}
+	    }
+	}
+	if (!found) {
+	    panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
+	            (length>60? 60 : length), bytes);
+	}
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+#ifdef TCL_COMPILE_STATS   
+    iPtr->stats.numLiteralsCreated++;
+    iPtr->stats.totalLitStringBytes   += (double) (length + 1);
+    iPtr->stats.currentLitStringBytes += (double) (length + 1);
+    iPtr->stats.literalCount[TclLog2(length)]++;
+#endif /*TCL_COMPILE_STATS*/
+    return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupLiteralEntry --
+ *
+ *	Finds the LiteralEntry that corresponds to a literal Tcl object
+ *      holding a literal.
+ *
+ * Results:
+ *      Returns the matching LiteralEntry if found, otherwise NULL.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+LiteralEntry *
+TclLookupLiteralEntry(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter for which objPtr was created
+                                 * to hold a literal. */
+    register Tcl_Obj *objPtr;	/* Points to a Tcl object holding a
+                                 * literal that was previously created by a
+                                 * call to TclRegisterLiteral. */
+{
+    Interp *iPtr = (Interp *) interp;
+    LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    register LiteralEntry *entryPtr;
+    char *bytes;
+    int length, globalHash;
+
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
+    for (entryPtr = globalTablePtr->buckets[globalHash];
+            entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
+        if (entryPtr->objPtr == objPtr) {
+            return entryPtr;
+        }
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddLocalLiteralEntry --
+ *
+ *	Insert a new literal into a CompileEnv's local literal array.
+ *
+ * Results:
+ *	The index in the CompileEnv's literal array that references the
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddLocalLiteralEntry(envPtr, globalPtr, localHash)
+    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. */
+    int localHash;		 /* Hash value for the literal's string. */
+{
+    register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    register LiteralEntry *localPtr;
+    int objIndex;
+    
+    if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
+	ExpandLocalLiteralArray(envPtr);
+    }
+    objIndex = envPtr->literalArrayNext;
+    envPtr->literalArrayNext++;
+
+    localPtr = &(envPtr->literalArrayPtr[objIndex]);
+    localPtr->objPtr = globalPtr->objPtr;
+    localPtr->refCount = -1;	/* i.e., unused */
+    localPtr->nextPtr = localTablePtr->buckets[localHash];
+    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.
+     */
+
+    if (localTablePtr->numEntries >= localTablePtr->rebuildSize) {
+	RebuildLiteralTable(localTablePtr);
+    }
+
+#ifdef TCL_COMPILE_DEBUG
+    TclVerifyLocalLiteralTable(envPtr);
+    {
+	char *bytes;
+	int length, found, i;
+	found = 0;
+	for (i = 0;  i < localTablePtr->numBuckets;  i++) {
+	    for (localPtr = localTablePtr->buckets[i];
+		    localPtr != NULL;  localPtr = localPtr->nextPtr) {
+		if (localPtr->objPtr == globalPtr->objPtr) {
+		    found = 1;
+		}
+	    }
+	}
+	if (!found) {
+	    bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+	    panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
+	            (length>60? 60 : length), bytes);
+	}
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExpandLocalLiteralArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *	CompileEnv's local literal array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The literal array in *envPtr is reallocated to a new array of
+ *	double the size, and if envPtr->mallocedLiteralArray is non-zero
+ *	the old array is freed. Entries are copied from the old array
+ *	to the new one. The local literal table is updated to refer to
+ *	the new entries.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ExpandLocalLiteralArray(envPtr)
+    register CompileEnv *envPtr; /* Points to the CompileEnv whose object
+				  * array must be enlarged. */
+{
+    /*
+     * The current allocated local literal entries are stored between
+     * elements 0 and (envPtr->literalArrayNext - 1) [inclusive].
+     */
+
+    LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    int currElems = envPtr->literalArrayNext;
+    size_t currBytes = (currElems * sizeof(LiteralEntry));
+    register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+    register LiteralEntry *newArrayPtr =
+	    (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
+    int i;
+    
+    /*
+     * Copy from the old literal array to the new, then update the local
+     * literal table's bucket array.
+     */
+
+    memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
+    for (i = 0;  i < currElems;  i++) {
+	if (currArrayPtr[i].nextPtr == NULL) {
+	    newArrayPtr[i].nextPtr = NULL;
+	} else {
+	    newArrayPtr[i].nextPtr = newArrayPtr
+		    + (currArrayPtr[i].nextPtr - currArrayPtr);
+	}
+    }
+    for (i = 0;  i < localTablePtr->numBuckets;  i++) {
+	if (localTablePtr->buckets[i] != NULL) {
+	    localTablePtr->buckets[i] = newArrayPtr
+	            + (localTablePtr->buckets[i] - currArrayPtr);
+	}
+    }
+
+    /*
+     * Free the old literal array if needed, and mark the new literal
+     * array as malloced.
+     */
+    
+    if (envPtr->mallocedLiteralArray) {
+	ckfree((char *) currArrayPtr);
+    }
+    envPtr->literalArrayPtr = newArrayPtr;
+    envPtr->literalArrayEnd = (2 * currElems);
+    envPtr->mallocedLiteralArray = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclReleaseLiteral --
+ *
+ *	This procedure releases a reference to one of the shared Tcl objects
+ *	that hold literals. It is called to release the literals referenced
+ *	by a ByteCode that is being destroyed, and it is also called by
+ *	TclDeleteLiteralTable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The reference count for the global LiteralTable entry that 
+ *	corresponds to the literal is decremented. If no other reference
+ *	to a global literal object remains, it is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclReleaseLiteral(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter for which objPtr was created
+				 * to hold a literal. */
+    register Tcl_Obj *objPtr;	/* Points to a literal object that was
+				 * previously created by a call to
+				 * TclRegisterLiteral. */
+{
+    Interp *iPtr = (Interp *) interp;
+    LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    register LiteralEntry *entryPtr, *prevPtr;
+    ByteCode* codePtr;
+    char *bytes;
+    int length, index;
+
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    index = (HashString(bytes, length) & globalTablePtr->mask);
+    for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
+	    entryPtr != NULL;
+	    prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+	if (entryPtr->objPtr == objPtr) {
+	    entryPtr->refCount--;
+
+	    /*
+	     * We found the matching LiteralEntry. Check if it's only being
+	     * kept alive only by a circular reference from a ByteCode
+	     * stored as its internal rep.
+	     */
+	    
+	    if ((entryPtr->refCount == 1)
+		    && (objPtr->typePtr == &tclByteCodeType)) {
+		codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+		if ((codePtr->numLitObjects == 1)
+		        && (codePtr->objArrayPtr[0] == objPtr)) {
+		    entryPtr->refCount = 0;
+
+		    /*
+		     * Set the ByteCode object array entry NULL to signal
+		     * to TclCleanupByteCode to not try to release this
+		     * about to be freed literal again.
+		     */
+
+		    codePtr->objArrayPtr[0] = NULL;
+		}
+	    }
+
+	    /*
+	     * If the literal is no longer being used by any ByteCode,
+	     * delete the entry then decrement the ref count of its object.
+	     */
+		
+	    if (entryPtr->refCount == 0) {
+		if (prevPtr == NULL) {
+		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
+		} else {
+		    prevPtr->nextPtr = entryPtr->nextPtr;
+		}
+#ifdef TCL_COMPILE_STATS
+		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
+#endif /*TCL_COMPILE_STATS*/
+		ckfree((char *) entryPtr);
+		globalTablePtr->numEntries--;
+		TclDecrRefCount(objPtr);
+	    }
+	    return;
+	}
+    }
+#ifdef TCL_COMPILE_DEBUG
+    panic("TclReleaseLiteral: literal \"%.*s\" not found",
+	    (length>60? 60 : length), bytes);
+#endif /*TCL_COMPILE_DEBUG*/
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HashString --
+ *
+ *	Compute a one-word summary of a text string, which can be
+ *	used to generate a hash index.
+ *
+ * Results:
+ *	The return value is a one-word summary of the information in
+ *	string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+HashString(bytes, length)
+    register CONST char *bytes; /* String for which to compute hash
+				 * value. */
+    int length;			/* Number of bytes in the string. */
+{
+    register unsigned int result;
+    register int i;
+
+    /*
+     * I tried a zillion different hash functions and asked many other
+     * people for advice.  Many people had their own favorite functions,
+     * all different, but no-one had much idea why they were good ones.
+     * I chose the one below (multiply by 9 and add new character)
+     * because of the following reasons:
+     *
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
+     *    and multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
+     *    character's bits hang around in the low-order bits of the
+     *    hash value for ever, plus they spread fairly rapidly up to
+     *    the high-order bits to fill out the hash value.  This seems
+     *    works well both for decimal and non-decimal strings.
+     */
+
+    result = 0;
+    for (i = 0;  i < length;  i++) {
+	result += (result<<3) + *bytes++;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RebuildLiteralTable --
+ *
+ *	This procedure is invoked when the ratio of entries to hash buckets
+ *	becomes too large in a local or global literal table. It allocates
+ *	a larger bucket array and moves the entries into the new buckets.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets reallocated and entries get rehashed into new buckets.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RebuildLiteralTable(tablePtr)
+    register LiteralTable *tablePtr; /* Local or global table to enlarge. */
+{
+    LiteralEntry **oldBuckets;
+    register LiteralEntry **oldChainPtr, **newChainPtr;
+    register LiteralEntry *entryPtr;
+    LiteralEntry **bucketPtr;
+    char *bytes;
+    int oldSize, count, index, length;
+
+    oldSize = tablePtr->numBuckets;
+    oldBuckets = tablePtr->buckets;
+
+    /*
+     * Allocate and initialize the new bucket array, and set up
+     * hashing constants for new array size.
+     */
+
+    tablePtr->numBuckets *= 4;
+    tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
+	    (tablePtr->numBuckets * sizeof(LiteralEntry *)));
+    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
+	    count > 0;
+	    count--, newChainPtr++) {
+	*newChainPtr = NULL;
+    }
+    tablePtr->rebuildSize *= 4;
+    tablePtr->mask = (tablePtr->mask << 2) + 3;
+
+    /*
+     * Rehash all of the existing entries into the new bucket array.
+     */
+
+    for (oldChainPtr = oldBuckets;
+	    oldSize > 0;
+	    oldSize--, oldChainPtr++) {
+	for (entryPtr = *oldChainPtr;  entryPtr != NULL;
+	        entryPtr = *oldChainPtr) {
+	    bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+	    index = (HashString(bytes, length) & tablePtr->mask);
+	    
+	    *oldChainPtr = entryPtr->nextPtr;
+	    bucketPtr = &(tablePtr->buckets[index]);
+	    entryPtr->nextPtr = *bucketPtr;
+	    *bucketPtr = entryPtr;
+	}
+    }
+
+    /*
+     * Free up the old bucket array, if it was dynamically allocated.
+     */
+
+    if (oldBuckets != tablePtr->staticBuckets) {
+	ckfree((char *) oldBuckets);
+    }
+}
+
+#ifdef TCL_COMPILE_STATS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLiteralStats --
+ *
+ *	Return statistics describing the layout of the hash table
+ *	in its hash buckets.
+ *
+ * Results:
+ *	The return value is a malloc-ed string containing information
+ *	about tablePtr.  It is the caller's responsibility to free
+ *	this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclLiteralStats(tablePtr)
+    LiteralTable *tablePtr;	/* Table for which to produce stats. */
+{
+#define NUM_COUNTERS 10
+    int count[NUM_COUNTERS], overflow, i, j;
+    double average, tmp;
+    register LiteralEntry *entryPtr;
+    char *result, *p;
+
+    /*
+     * Compute a histogram of bucket usage. For each bucket chain i,
+     * j is the number of entries in the chain.
+     */
+
+    for (i = 0;  i < NUM_COUNTERS;  i++) {
+	count[i] = 0;
+    }
+    overflow = 0;
+    average = 0.0;
+    for (i = 0;  i < tablePtr->numBuckets;  i++) {
+	j = 0;
+	for (entryPtr = tablePtr->buckets[i];  entryPtr != NULL;
+	        entryPtr = entryPtr->nextPtr) {
+	    j++;
+	}
+	if (j < NUM_COUNTERS) {
+	    count[j]++;
+	} else {
+	    overflow++;
+	}
+	tmp = j;
+	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+    }
+
+    /*
+     * Print out the histogram and a few other pieces of information.
+     */
+
+    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+    sprintf(result, "%d entries in table, %d buckets\n",
+	    tablePtr->numEntries, tablePtr->numBuckets);
+    p = result + strlen(result);
+    for (i = 0; i < NUM_COUNTERS; i++) {
+	sprintf(p, "number of buckets with %d entries: %d\n",
+		i, count[i]);
+	p += strlen(p);
+    }
+    sprintf(p, "number of buckets with %d or more entries: %d\n",
+	    NUM_COUNTERS, overflow);
+    p += strlen(p);
+    sprintf(p, "average search distance for entry: %.1f", average);
+    return result;
+}
+#endif /*TCL_COMPILE_STATS*/
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclVerifyLocalLiteralTable --
+ *
+ *	Check a CompileEnv's local literal table for consistency.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Panics if problems are found.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclVerifyLocalLiteralTable(envPtr)
+    CompileEnv *envPtr;		/* Points to CompileEnv whose literal
+				 * table is to be validated. */
+{
+    register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    register LiteralEntry *localPtr;
+    char *bytes;
+    register int i;
+    int length, count;
+
+    count = 0;
+    for (i = 0;  i < localTablePtr->numBuckets;  i++) {
+	for (localPtr = localTablePtr->buckets[i];
+	        localPtr != NULL;  localPtr = localPtr->nextPtr) {
+	    count++;
+	    if (localPtr->refCount != -1) {
+		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
+		panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+		        (length>60? 60 : length), bytes,
+		        localPtr->refCount);
+	    }
+	    if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
+		    localPtr->objPtr) == NULL) {
+		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
+		panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+		         (length>60? 60 : length), bytes);
+	    }
+	    if (localPtr->objPtr->bytes == NULL) {
+		panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+	    }
+	}
+    }
+    if (count != localTablePtr->numEntries) {
+	panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
+	      count, localTablePtr->numEntries);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclVerifyGlobalLiteralTable --
+ *
+ *	Check an interpreter's global literal table literal for consistency.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Panics if problems are found.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclVerifyGlobalLiteralTable(iPtr)
+    Interp *iPtr;		/* Points to interpreter whose global
+				 * literal table is to be validated. */
+{
+    register LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    register LiteralEntry *globalPtr;
+    char *bytes;
+    register int i;
+    int length, count;
+
+    count = 0;
+    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
+	for (globalPtr = globalTablePtr->buckets[i];
+	        globalPtr != NULL;  globalPtr = globalPtr->nextPtr) {
+	    count++;
+	    if (globalPtr->refCount < 1) {
+		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+		panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+		        (length>60? 60 : length), bytes,
+		        globalPtr->refCount);
+	    }
+	    if (globalPtr->objPtr->bytes == NULL) {
+		panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+	    }
+	}
+    }
+    if (count != globalTablePtr->numEntries) {
+	panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
+	      count, globalTablePtr->numEntries);
+    }
+}
+#endif /*TCL_COMPILE_DEBUG*/