tclliteral.c

tcl是工具命令语言

 */

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).
	     */