Tcl Source Code

 */

void
TclCleanupCommand(
    register Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{

    if (cmdPtr->refCount-- <= 1) {
	ckfree(cmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *

    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the

		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);

	if (!hPtr) {
	    continue;
	}
	cfwPtr = Tcl_GetHashValue(hPtr);


	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	ckfree(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

    codePtr->refCount++;
}

void
TclReleaseByteCode(
    register ByteCode *codePtr)
{
    if (codePtr->refCount-- > 1) {
	return;
    }

    /* Just dropped to refcount==0.  Clean up. */
    CleanupByteCode(codePtr);
}

typedef struct ByteCode {
    TclHandle interpHandle;	/* Handle for interpreter containing the
				 * compiled code. Commands and their compile
				 * procs are specific to an interpreter so the
				 * code emitted will depend on the
				 * interpreter. */
    size_t compileEpoch;	/* Value of iPtr->compileEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when, e.g., commands with compile
				 * procs are redefined. */
    Namespace *nsPtr;		/* Namespace context in which this code was
				 * compiled. If the code is executed if a
				 * different namespace, it must be
				 * recompiled. */
    size_t nsEpoch;		/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    size_t refCount;		/* Reference count: set 1 when created plus 1
				 * for each execution of the code currently
				 * active. This structure can be freed when
				 * refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
				 * this variable holds ORed values from the
				 * TCL_BYTECODE_ masks defined above */
    const char *source;		/* The source string from which this ByteCode

    /*
     * Print header lines describing the ByteCode.
     */

    sprintf(ptrBuf1, "%p", codePtr);
    sprintf(ptrBuf2, "%p", iPtr);
    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode 0x%s, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%s (epoch %" TCL_LL_MODIFIER "u)\n",
	    ptrBuf1, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, ptrBuf2,
	    (Tcl_WideInt)iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
    if (line > -1 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		Tcl_GetString(fileObj), line);

/*
 * The internal rep for caching ensemble subcommand lookups and
 * spell corrections.
 */

typedef struct {
    size_t epoch;               /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Command *token;             /* Reference to the command for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand
                                 * hash table. */

				 * the transformation. Used to execute the
				 * code below. */
    Tcl_Obj *command;		/* Tcl code to execute for a buffer */
    ResultBuffer result;	/* Internal buffer used to store the result of
				 * a transformation of incoming data. Also
				 * serves as buffer of all data not yet
				 * consumed by the reader. */
    size_t refCount;
};

static void
PreserveData(
    TransformChannelData *dataPtr)
{
    dataPtr->refCount++;
}

static void
ReleaseData(
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    ckfree(dataPtr);
}


				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
    size_t nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;	/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    int activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    size_t refCount;		/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
				 * registered in the namespace. Indexed by
				 * strings; values have type (Command *).
				 * Commands imported by Tcl_Import have
				 * Command structures that point (via an

				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;	/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
				 * resolution rules change for this namespace
				 * or (b) a newly added command shadows a
				 * command that is compiled to bytecodes. This
				 * invalidates all byte codes compiled in the
				 * namespace, causing the code to be
				 * recompiled under the new rules.*/
    Tcl_ResolveCmdProc *cmdResProc;

    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* If non-null, this procedure overrides the
				 * usual variable resolution mechanism in Tcl.
				 * This procedure is invoked within
				 * LookupCompiledLocal to resolve variable
				 * references within the namespace at compile
				 * time. */
    size_t exportLookupEpoch;	/* Incremented whenever a command is added to
				 * a namespace, removed from a namespace or
				 * the exports of a namespace are changed.
				 * Allows TIP#112-driven command lists to be
				 * validated efficiently. */
    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
				 * of the ensembles that are implemented on
				 * top of this namespace. */

typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namspace backing this ensemble up. */
    Tcl_Command token;		/* The token for the command that provides
				 * ensemble support for the namespace, or NULL
				 * if the command has been deleted (or never
				 * existed; the global namespace never has an
				 * ensemble command.) */
    size_t epoch;		/* The epoch at which this ensemble's table of
				 * exported commands is valid. */
    char **subcommandArrayPtr;	/* Array of ensemble subcommand names. At all
				 * consistent points, this will have the same
				 * number of entries as there are entries in
				 * the subcommandTable hash. */
    Tcl_HashTable subcommandTable;
				/* Hash table of ensemble subcommand names,

				 * from its Tcl_Command handle. NULL means
				 * that the hash table entry has been removed
				 * already (this can happen if deleteProc
				 * causes the command to be deleted or
				 * recreated). */
    Namespace *nsPtr;		/* Points to the namespace containing this
				 * command. */
    size_t refCount;		/* 1 if in command hashtable plus 1 for each
				 * reference from a CmdName Tcl object
				 * representing a command's name in a ByteCode
				 * instruction sequence. This structure can be
				 * freed when refCount becomes zero. */
    size_t cmdEpoch;		/* Incremented to invalidate any references
				 * that point to this command when it is
				 * renamed, deleted, hidden, or exposed. */
    CompileProc *compileProc;	/* Procedure called to compile command. NULL
				 * if no compile proc exists for command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
    ClientData objClientData;	/* Arbitrary value passed to object proc. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */

				 * calling Tcl_Eval. See below for valid
				 * values. */
    LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects holding literals of scripts
				 * compiled by the interpreter. Indexed by the
				 * string representations of literals. Used to
				 * avoid creating duplicate objects. */
    size_t compileEpoch;	/* Holds the current "compilation epoch" for
				 * this interpreter. This is incremented to
				 * invalidate existing ByteCodes when, e.g., a
				 * command with a compile procedure is
				 * redefined. */
    Proc *compiledProcPtr;	/* If a procedure is being compiled, a pointer
				 * to its Proc structure; otherwise, this is
				 * NULL. Set by ObjInterpProc in tclProc.c and

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct {
    size_t numNsCreated;	/* Count of the number of namespaces created
				 * within the thread. This value is used as a
				 * unique id for each namespace. Cannot be
				 * per-interp because the nsId is used to
				 * distinguish objects which can be passed
				 * around between interps in the same thread,
				 * but does not need to be global because
				 * object internal reps are always per-thread

typedef struct {
    Namespace *nsPtr;		/* A cached pointer to the Namespace that the
				 * name resolved to. */
    Namespace *refNsPtr;	/* Points to the namespace context in which
				 * the name was resolved. NULL if the name is
				 * fully qualified and thus the resolution
				 * does not depend on the context. */
    size_t refCount;		/* Reference count: 1 for each nsName object
				 * that has a pointer to this ResolvedNsName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedNsName;

/*

 *----------------------------------------------------------------------
 */

void
TclNsDecrRefCount(
    Namespace *nsPtr)
{

    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
	NamespaceFree(nsPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *

    ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * Decrement the reference count of the namespace. If there are no more
     * references, free it up.
     */


    if (resNamePtr->refCount-- <= 1) {
	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);

typedef struct ResolvedCmdName {
    Command *cmdPtr;		/* A cached Command pointer. */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced command). NULL if the name
				 * is fully qualified.*/
    size_t refNsId;		/* refNsPtr's unique namespace id. Used to
				 * verify that refNsPtr is still valid (e.g.,
				 * it's possible that the cmd's containing
				 * namespace was deleted and a new one created
				 * at the same address). */
    size_t refNsCmdEpoch;		/* Value of the referencing namespace's
				 * cmdRefEpoch when the pointer was cached.
				 * Before using the cached pointer, we check
				 * if the namespace's epoch was incremented;
				 * if so, this cached pointer is invalid. */
    size_t cmdEpoch;		/* Value of the command's cmdEpoch when this
				 * pointer was cached. Before using the cached
				 * pointer, we check if the cmd's epoch was
				 * incremented; if so, the cmd was renamed,
				 * deleted, hidden, or exposed, and so the
				 * pointer is invalid. */
    size_t refCount;		/* Reference count: 1 for each cmdName object
				 * that has a pointer to this ResolvedCmdName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedCmdName;

/*

    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
	 */

	if (resPtr->refCount-- <= 1) {
	    /*
	     * Now free the cached command, unless it is still in its hash
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	/*
	 * Re-use existing ResolvedCmdName struct when possible.
	 * Cleanup the old fields that need it.
	 */

	Command *oldCmdPtr = resPtr->cmdPtr;

	if (oldCmdPtr->refCount-- <= 1) {
	    TclCleanupCommandMacro(oldCmdPtr);
	}
    } else {
	resPtr = NULL;
    }

    SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);

 * The following data structure is used to keep track of all the Tcl_Preserve
 * calls that are still in effect. It grows as needed to accommodate any
 * number of calls in effect.
 */

typedef struct {
    ClientData clientData;	/* Address of preserved block. */
    size_t refCount;		/* Number of Tcl_Preserve calls in effect for
				 * block. */
    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
				 * called while a Tcl_Preserve call was in
				 * effect, so the structure must be freed when
				 * refCount becomes zero. */
    Tcl_FreeProc *freeProc;	/* Function to call to free. */
} Reference;

				 * block is deleted. This field must be the
				 * first in the structure. */
#ifdef TCL_MEM_DEBUG
    void *ptr2;			/* Backup copy of the above pointer used to
				 * ensure that the contents of the handle are
				 * not changed by anyone else. */
#endif
    size_t refCount;		/* Number of TclHandlePreserve() calls in
				 * effect on this handle. */
} HandleStruct;

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizePreserve --

	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {
	    continue;
	}

	if (refPtr->refCount-- > 1) {
	    Tcl_MutexUnlock(&preserveMutex);
	    return;
	}

	/*
	 * Must remove information from the slot before calling freeProc to
	 * avoid reentrancy problems if the freeProc calls Tcl_Preserve on the

	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	ckfree(handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

				 * traces, store the level at which the step
				 * trace was invoked */
    char *startCmd;		/* Used for bookkeeping with step execution
				 * traces, store the command name which
				 * invoked step trace */
    int curFlags;		/* Trace flags for the current command */
    int curCode;		/* Return code for the current command */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
    char command[1];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1