tclliteral.c

tcl是工具命令语言

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