/* 

 * 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.11 2001/10/11 22:28:01 msofer Exp $

 */

#include "tclInt.h"

#include "tclCompile.h"

#include "tclPort.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)) {

	/*

	 * From here we use the objPtr, because it is NULL terminated

	 */

	if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {

	    TclFormatInt(buf, n);

	    if (strcmp(objPtr->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;

}

/*

 *----------------------------------------------------------------------

 *

 * TclHideLiteral --

 *

 *	Remove a literal entry from the literal hash tables, leaving it in

 *	the literal array so existing references continue to function.

 *	This makes it possible to turn a shared literal into a private

 *	literal that cannot be shared.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	Removes the literal from the local hash table and decrements the

 *	global hash entry's reference count.

 *

 *----------------------------------------------------------------------

 */

void

TclHideLiteral(interp, envPtr, index)

    Tcl_Interp *interp;		 /* Interpreter for which objPtr was created

                                  * to hold a literal. */

    register CompileEnv *envPtr; /* Points to CompileEnv whose literal array

				  * contains the entry being hidden. */

    int index;			 /* The index of the entry in the literal

				  * array. */

{

    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;

    LiteralTable *localTablePtr = &(envPtr->localLitTable);

    int localHash, length;

    char *bytes;

    Tcl_Obj *newObjPtr;

    lPtr = &(envPtr->literalArrayPtr[index]);

    /*

     * To avoid unwanted sharing we need to copy the object and remove it from

     * the local and global literal tables.  It still has a slot in the literal

     * array so it can be referred to by byte codes, but it will not be matched

     * by literal searches.

     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);

    Tcl_IncrRefCount(newObjPtr);

    TclReleaseLiteral(interp, lPtr->objPtr);

    lPtr->objPtr = newObjPtr;

    bytes = Tcl_GetStringFromObj(newObjPtr, &length);

    localHash = (HashString(bytes, length) & localTablePtr->mask);

    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) {

	if (entryPtr == lPtr) {

	    *nextPtrPtr = lPtr->nextPtr;

	    lPtr->nextPtr = NULL;

	    localTablePtr->numEntries--;

	    break;

	}

	nextPtrPtr = &entryPtr->nextPtr;

    }

}

/*

 *----------------------------------------------------------------------

 *

 * TclAddLiteralObj --

 *

 *	Add a single literal object to the literal array.  This

 *	function does not add the literal to the local or global

 *	literal tables.  The caller is expected to add the entry

 *	to whatever tables are appropriate.

 *

 * Results:

 *	The index in the CompileEnv's literal array that references the

 *	literal.  Stores the pointer to the new literal entry in the

 *	location referenced by the localPtrPtr argument.

 *

 * Side effects:

 *	Expands the literal array if necessary.  Increments the refcount

 *	on the literal object.

 *

 *----------------------------------------------------------------------

 */

int

TclAddLiteralObj(envPtr, objPtr, litPtrPtr)

    register CompileEnv *envPtr; /* Points to CompileEnv in whose literal

				  * array the object is to be inserted. */

    Tcl_Obj *objPtr;		 /* The object to insert into the array. */

    LiteralEntry **litPtrPtr;	 /* The location where the pointer to the

				  * new literal entry should be stored.

				  * May be NULL. */

{

    register LiteralEntry *lPtr;

    int objIndex;

    if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {

	ExpandLocalLiteralArray(envPtr);

    }

    objIndex = envPtr->literalArrayNext;

    envPtr->literalArrayNext++;

    lPtr = &(envPtr->literalArrayPtr[objIndex]);

    lPtr->objPtr = objPtr;

    Tcl_IncrRefCount(objPtr);

    lPtr->refCount = -1;	/* i.e., unused */

    lPtr->nextPtr = NULL;

    if (litPtrPtr) {

	*litPtrPtr = lPtr;

    }

    return objIndex;

}

/*

 *----------------------------------------------------------------------

 *

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

    LiteralEntry *localPtr;

    int objIndex;

    objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);

    /*

     * Add the literal to the local table.

     */

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

    /*

     * Check to see if the object is in the global literal table and 

     * remove this reference.  The object may not be in the table if

     * it is a hidden local literal.

     */

    for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];

	    entryPtr != NULL;

	    prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {

	if (entryPtr->objPtr == objPtr) {

	    entryPtr->refCount--;

	    /*

	     * If the literal is no longer being used by any ByteCode,

	     * delete the entry then remove the reference corresponding 

	     * to the global literal table entry (decrement the ref count 

	     * of the object).

	     */

	    if (entryPtr->refCount == 0) {

		if (prevPtr == NULL) {

		    globalTablePtr->buckets[index] = entryPtr->nextPtr;

		} else {

		    prevPtr->nextPtr = entryPtr->nextPtr;

		}

		ckfree((char *) entryPtr);

		globalTablePtr->numEntries--;

		TclDecrRefCount(objPtr);

		/*

		 * Check if the LiteralEntry is only being kept alive by 

		 * a circular reference from a ByteCode stored as its 

		 * internal rep. In that case, set the ByteCode object array 

		 * entry NULL to signal to TclCleanupByteCode to not try to 

		 * release this about to be freed literal again.

		 */

		if (objPtr->typePtr == &tclByteCodeType) {

		    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;

		    if ((codePtr->numLitObjects == 1)

		            && (codePtr->objArrayPtr[0] == objPtr)) {			

			codePtr->objArrayPtr[0] = NULL;

		    }

		}

#ifdef TCL_COMPILE_STATS

		iPtr->stats.currentLitStringBytes -= (double) (length + 1);

#endif /*TCL_COMPILE_STATS*/

	    }

	    break;

	}

    }

    /*

     * Remove the reference corresponding to the local literal table

     * entry.

     */

    Tcl_DecrRefCount(objPtr);

}

/*

 *----------------------------------------------------------------------

 *

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

	    }