tclnamesp.c

linux系统下的音频通信

        framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
        TclDeleteCompiledLocalVars(iPtr, framePtr);
    }

    iPtr->flags |= saveErrFlag;

    /*
     * Decrement the namespace's count of active call frames. If the
     * namespace is "dying" and there are no more active call frames,
     * call Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount == 0)) {
        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateNamespace --
 *
 *	Creates a new namespace with the given name. If there is no
 *	active namespace (i.e., the interpreter is being initialized),
 *	the global :: namespace is created and returned.
 *
 * Results:
 *	Returns a pointer to the new namespace if successful. If the
 *	namespace already exists or if another error occurs, this routine
 *	returns NULL, along with an error message in the interpreter's
 *	result object.
 *
 * Side effects:
 *	If the name contains "::" qualifiers and a parent namespace does
 *	not already exist, it is automatically created. 
 *
 *----------------------------------------------------------------------
 */

Tcl_Namespace *
Tcl_CreateNamespace(interp, name, clientData, deleteProc)
    Tcl_Interp *interp;             /* Interpreter in which a new namespace
				     * is being created. Also used for
				     * error reporting. */
    char *name;                     /* Name for the new namespace. May be a
				     * qualified name with names of ancestor
				     * namespaces separated by "::"s. */
    ClientData clientData;	    /* One-word value to store with
				     * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
    				    /* Procedure called to delete client
				     * data when the namespace is deleted.
				     * NULL if no procedure should be
				     * called. */
{
    Interp *iPtr = (Interp *) interp;
    register Namespace *nsPtr, *ancestorPtr;
    Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
    Namespace *globalNsPtr = iPtr->globalNsPtr;
    char *simpleName;
    Tcl_HashEntry *entryPtr;
    Tcl_DString buffer1, buffer2;
    int newEntry, result;

    /*
     * If there is no active namespace, the interpreter is being
     * initialized. 
     */

    if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
	/*
	 * Treat this namespace as the global namespace, and avoid
	 * looking for a parent.
	 */
	
        parentPtr = NULL;
        simpleName = "";
    } else if (*name == '\0') {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
	return NULL;
    } else {
	/*
	 * Find the parent for the new namespace.
	 */

	result = TclGetNamespaceForQualName(interp, name,
		(Namespace *) NULL,
		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
        if (result != TCL_OK) {
            return NULL;
        }

	/*
	 * If the unqualified name at the end is empty, there were trailing
	 * "::"s after the namespace's name which we ignore. The new
	 * namespace was already (recursively) created and is pointed to
	 * by parentPtr.
	 */

	if (*simpleName == '\0') {
	    return (Tcl_Namespace *) parentPtr;
	}

        /*
         * Check for a bad namespace name and make sure that the name
	 * does not already exist in the parent namespace.
	 */

        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "can't create namespace \"", name,
    	    	    "\": already exists", (char *) NULL);
            return NULL;
        }
    }

    /*
     * Create the new namespace and root it in its parent. Increment the
     * count of namespaces created.
     */

    numNsCreated++;

    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
    strcpy(nsPtr->name, simpleName);
    nsPtr->fullName        = NULL;   /* set below */
    nsPtr->clientData      = clientData;
    nsPtr->deleteProc      = deleteProc;
    nsPtr->parentPtr       = parentPtr;
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
    nsPtr->nsId            = numNsCreated;
    nsPtr->interp          = interp;
    nsPtr->flags           = 0;
    nsPtr->activationCount = 0;
    nsPtr->refCount        = 0;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
    nsPtr->exportArrayPtr  = NULL;
    nsPtr->numExportPatterns = 0;
    nsPtr->maxExportPatterns = 0;
    nsPtr->cmdRefEpoch       = 0;
    nsPtr->resolverEpoch     = 0;
    nsPtr->cmdResProc        = NULL;
    nsPtr->varResProc        = NULL;
    nsPtr->compiledVarResProc = NULL;

    if (parentPtr != NULL) {
        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
	        &newEntry);
        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
    }

    /*
     * Build the fully qualified name for this namespace.
     */

    Tcl_DStringInit(&buffer1);
    Tcl_DStringInit(&buffer2);
    for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
	    ancestorPtr = ancestorPtr->parentPtr) {
        if (ancestorPtr != globalNsPtr) {
            Tcl_DStringAppend(&buffer1, "::", 2);
            Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
        }
        Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);

        Tcl_DStringSetLength(&buffer2, 0);
        Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
        Tcl_DStringSetLength(&buffer1, 0);
    }
    
    name = Tcl_DStringValue(&buffer2);
    nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
    strcpy(nsPtr->fullName, name);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);

    /*
     * Return a pointer to the new namespace.
     */

    return (Tcl_Namespace *) nsPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteNamespace --
 *
 *	Deletes a namespace and all of the commands, variables, and other
 *	namespaces within it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When a namespace is deleted, it is automatically removed as a
 *	child of its parent namespace. Also, all its commands, variables
 *	and child namespaces are deleted.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteNamespace(namespacePtr)
    Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */
{
    register Namespace *nsPtr = (Namespace *) namespacePtr;
    Interp *iPtr = (Interp *) nsPtr->interp;
    Namespace *globalNsPtr =
	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
    Tcl_HashEntry *entryPtr;

    /*
     * If the namespace is on the call frame stack, it is marked as "dying"
     * (NS_DYING is OR'd into its flags): the namespace can't be looked up
     * by name but its commands and variables are still usable by those
     * active call frames. When all active call frames referring to the
     * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will
     * call this procedure again to delete everything in the namespace.
     * If no nsName objects refer to the namespace (i.e., if its refCount 
     * is zero), its commands and variables are deleted and the storage for
     * its namespace structure is freed. Otherwise, if its refCount is
     * nonzero, the namespace's commands and variables are deleted but the
     * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
     * flags to allow the namespace resolution code to recognize that the
     * namespace is "deleted". The structure's storage is freed by
     * FreeNsNameInternalRep when its refCount reaches 0.
     */

    if (nsPtr->activationCount > 0) {
        nsPtr->flags |= NS_DYING;
        if (nsPtr->parentPtr != NULL) {
            entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
		    nsPtr->name);
            if (entryPtr != NULL) {
                Tcl_DeleteHashEntry(entryPtr);
            }
        }
        nsPtr->parentPtr = NULL;
    } else {
	/*
	 * Delete the namespace and everything in it. If this is the global
	 * namespace, then clear it but don't free its storage unless the
	 * interpreter is being torn down.
	 */

        TclTeardownNamespace(nsPtr);

        if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
            /*
	     * If this is the global namespace, then it may have residual
             * "errorInfo" and "errorCode" variables for errors that
             * occurred while it was being torn down.  Try to clear the
             * variable list one last time.
	     */

            TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
	    
            Tcl_DeleteHashTable(&nsPtr->childTable);
            Tcl_DeleteHashTable(&nsPtr->cmdTable);

            /*
             * If the reference count is 0, then discard the namespace.
             * Otherwise, mark it as "dead" so that it can't be used.
             */

            if (nsPtr->refCount == 0) {
                NamespaceFree(nsPtr);
            } else {
                nsPtr->flags |= NS_DEAD;
            }
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
 *	Used internally to dismantle and unlink a namespace when it is
 *	deleted. Divorces the namespace from its parent, and deletes all
 *	commands, variables, and child namespaces.
 *
 *	This is kept separate from Tcl_DeleteNamespace so that the global
 *	namespace can be handled specially. Global variables like
 *	"errorInfo" and "errorCode" need to remain intact while other
 *	namespaces and commands are torn down, in case any errors occur.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Removes this namespace from its parent's child namespace hashtable.
 *	Deletes all commands, variables and namespaces in this namespace.
 *	If this is the global namespace, the "errorInfo" and "errorCode"
 *	variables are left alone and deleted later.
 *
 *----------------------------------------------------------------------
 */

void
TclTeardownNamespace(nsPtr)
    register Namespace *nsPtr;	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Namespace *childNsPtr;
    Tcl_Command cmd;
    Namespace *globalNsPtr =
	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
    int i;

    /*
     * Start by destroying the namespace's variable table,
     * since variables might trigger traces.
     */

    if (nsPtr == globalNsPtr) {
	/*
	 * This is the global namespace, so be careful to preserve the
	 * "errorInfo" and "errorCode" variables. These might be needed
	 * later on if errors occur while deleting commands. We are careful
	 * to destroy and recreate the "errorInfo" and "errorCode"
	 * variables, in case they had any traces on them.
	 */
    
        char *str, *errorInfoStr, *errorCodeStr;

        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
        if (str != NULL) {
            errorInfoStr = ckalloc((unsigned) (strlen(str)+1));
            strcpy(errorInfoStr, str);
        } else {
            errorInfoStr = NULL;
        }

        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY);
        if (str != NULL) {
            errorCodeStr = ckalloc((unsigned) (strlen(str)+1));
            strcpy(errorCodeStr, str);
        } else {
            errorCodeStr = NULL;
        }

        TclDeleteVars(iPtr, &nsPtr->varTable);
        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);

        if (errorInfoStr != NULL) {
            Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr,
                TCL_GLOBAL_ONLY);
            ckfree(errorInfoStr);
        }
        if (errorCodeStr != NULL) {
            Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr,
                TCL_GLOBAL_ONLY);
            ckfree(errorCodeStr);
        }
    } else {
	/*
	 * Variable table should be cleared but not freed! TclDeleteVars
	 * frees it, so we reinitialize it afterwards.
	 */
    
        TclDeleteVars(iPtr, &nsPtr->varTable);
        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
    }

    /*
     * Remove the namespace from its parent's child hashtable.
     */

    if (nsPtr->parentPtr != NULL) {
        entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
	        nsPtr->name);
        if (entryPtr != NULL) {
            Tcl_DeleteHashEntry(entryPtr);
        }
    }