tclbasic.c

linux系统下的音频通信

    Tcl_FreeResult(interp);
    interp->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    if (iPtr->errorInfo != NULL) {
	ckfree(iPtr->errorInfo);
        iPtr->errorInfo = NULL;
    }
    if (iPtr->errorCode != NULL) {
	ckfree(iPtr->errorCode);
        iPtr->errorCode = NULL;
    }
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
        iPtr->appendResult = NULL;
    }
    for (i = 0; i < NUM_REGEXPS; i++) {
	if (iPtr->patterns[i] == NULL) {
	    break;
	}
	ckfree(iPtr->patterns[i]);
	ckfree((char *) iPtr->regexps[i]);
        iPtr->regexps[i] = NULL;
    }
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Trace *nextPtr = iPtr->tracePtr->nextPtr;

	ckfree((char *) iPtr->tracePtr);
	iPtr->tracePtr = nextPtr;
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
	nextResPtr = resPtr->nextPtr;
	ckfree(resPtr->name);
	ckfree((char *) resPtr);
        resPtr = nextResPtr;
    }
    
    ckfree((char *) iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpDeleted --
 *
 *	Returns nonzero if the interpreter has been deleted with a call
 *	to Tcl_DeleteInterp.
 *
 * Results:
 *	Nonzero if the interpreter is deleted, zero otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_InterpDeleted(interp)
    Tcl_Interp *interp;
{
    return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteInterp --
 *
 *	Ensures that the interpreter will be deleted eventually. If there
 *	are no Tcl_Preserve calls in effect for this interpreter, it is
 *	deleted immediately, otherwise the interpreter is deleted when
 *	the last Tcl_Preserve is matched by a call to Tcl_Release. In either
 *	case, the procedure runs the currently registered deletion callbacks. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The interpreter is marked as deleted. The caller may still use it
 *	safely if there are calls to Tcl_Preserve in effect for the
 *	interpreter, but further calls to Tcl_Eval etc in this interpreter
 *	will fail.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteInterp(interp)
    Tcl_Interp *interp;		/* Token for command interpreter (returned
				 * by a previous call to Tcl_CreateInterp). */
{
    Interp *iPtr = (Interp *) interp;

    /*
     * If the interpreter has already been marked deleted, just punt.
     */

    if (iPtr->flags & DELETED) {
        return;
    }
    
    /*
     * Mark the interpreter as deleted. No further evals will be allowed.
     */

    iPtr->flags |= DELETED;

    /*
     * Ensure that the interpreter is eventually deleted.
     */

    Tcl_EventuallyFree((ClientData) interp,
            (Tcl_FreeProc *) DeleteInterpProc);
}

/*
 *----------------------------------------------------------------------
 *
 * HiddenCmdsDeleteProc --
 *
 *	Called on interpreter deletion to delete all the hidden
 *	commands in an interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees up memory.
 *
 *----------------------------------------------------------------------
 */

static void
HiddenCmdsDeleteProc(clientData, interp)
    ClientData clientData;		/* The hidden commands hash table. */
    Tcl_Interp *interp;			/* The interpreter being deleted. */
{
    Tcl_HashTable *hiddenCmdTblPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    Command *cmdPtr;

    hiddenCmdTblPtr = (Tcl_HashTable *) clientData;
    for (hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch);
	     hPtr != NULL;
             hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch)) {

        /*
         * Cannot use Tcl_DeleteCommand because (a) the command is not
         * in the command hash table, and (b) that table has already been
         * deleted above. Hence we emulate what it does, below.
         */
        
        cmdPtr = (Command *) Tcl_GetHashValue(hPtr);

	/*
         * The code here is tricky.  We can't delete the hash table entry
         * before invoking the deletion callback because there are cases
         * where the deletion callback needs to invoke the command (e.g.
         * object systems such as OTcl).  However, this means that the
         * callback could try to delete or rename the command.  The deleted
         * flag allows us to detect these cases and skip nested deletes.
         */

        if (cmdPtr->deleted) {

	    /*
             * Another deletion is already in progress.  Remove the hash
             * table entry now, but don't invoke a callback or free the
             * command structure.
             */

            Tcl_DeleteHashEntry(cmdPtr->hPtr);
            cmdPtr->hPtr = NULL;
            continue;
        }
        cmdPtr->deleted = 1;
        if (cmdPtr->deleteProc != NULL) {
            (*cmdPtr->deleteProc)(cmdPtr->deleteData);
        }

	/*
	 * Bump the command epoch counter. This will invalidate all cached
         * references that refer to this command.
	 */
	
        cmdPtr->cmdEpoch++;

	/*
         * Don't use hPtr to delete the hash entry here, because it's
         * possible that the deletion callback renamed the command.
         * Instead, use cmdPtr->hptr, and make sure that no-one else
         * has already deleted the hash entry.
         */

        if (cmdPtr->hPtr != NULL) {
            Tcl_DeleteHashEntry(cmdPtr->hPtr);
        }
	
        /*
	 * Now free the Command structure, unless there is another reference
	 * to it from a CmdName Tcl object in some ByteCode code
	 * sequence. In that case, delay the cleanup until all references
	 * are either discarded (when a ByteCode is freed) or replaced by a
	 * new reference (when a cached CmdName Command reference is found
	 * to be invalid and TclExecuteByteCode looks up the command in the
	 * command hashtable).
	 */
	
	TclCleanupCommand(cmdPtr);
    }
    Tcl_DeleteHashTable(hiddenCmdTblPtr);
    ckfree((char *) hiddenCmdTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *
 *	Makes a command hidden so that it cannot be invoked from within
 *	an interpreter, only from within an ancestor.
 *
 * Results:
 *	A standard Tcl result; also leaves a message in interp->result
 *	if an error occurs.
 *
 * Side effects:
 *	Removes a command from the command table and create an entry
 *      into the hidden command table under the specified token name.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
    Tcl_Interp *interp;		/* Interpreter in which to hide command. */
    char *cmdName;		/* Name of command to hide. */
    char *hiddenCmdToken;	/* Token name of the to-be-hidden command. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Command cmd;
    Command *cmdPtr;
    Tcl_HashTable *hTblPtr;
    Tcl_HashEntry *hPtr;
    int new;

    if (iPtr->flags & DELETED) {

        /*
         * The interpreter is being deleted. Do not create any new
         * structures, because it is not safe to modify the interpreter.
         */
        
        return TCL_ERROR;
    }

    /*
     * Disallow hiding of commands that are currently in a namespace or
     * renaming (as part of hiding) into a namespace.
     *
     * (because the current implementation with a single global table
     *  and the needed uniqueness of names cause problems with namespaces)
     *
     * we don't need to check for "::" in cmdName because the real check is
     * on the nsPtr below.
     *
     * hiddenCmdToken is just a string which is not interpreted in any way.
     * It may contain :: but the string is not interpreted as a namespace
     * qualifier command name. Thus, hiding foo::bar to foo::bar and then
     * trying to expose or invoke ::foo::bar will NOT work; but if the
     * application always uses the same strings it will get consistent
     * behaviour.
     *
     * But as we currently limit ourselves to the global namespace only
     * for the source, in order to avoid potential confusion,
     * lets prevent "::" in the token too.  --dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "cannot use namespace qualifiers as hidden command",
		"token (rename)", (char *) NULL);
        return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't
     * be found. Look up the command only from the global namespace.
     * Full path of the command must be given if using namespaces.
     */

    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
	    /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
    if (cmd == (Tcl_Command) NULL) {
	return TCL_ERROR;
    }
    cmdPtr = (Command *) cmd;

    /*
     * Check that the command is really in global namespace
     */

    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "can only hide global namespace commands",
		" (use rename then hide)", (char *) NULL);
        return TCL_ERROR;
    }
    
    /*
     * Initialize the hidden command table if necessary.
     */

    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
            NULL);
    if (hTblPtr == (Tcl_HashTable *) NULL) {
        hTblPtr = (Tcl_HashTable *)
	        ckalloc((unsigned) sizeof(Tcl_HashTable));
        Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
        Tcl_SetAssocData(interp, "tclHiddenCmds", HiddenCmdsDeleteProc,
                (ClientData) hTblPtr);
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */
    
    hPtr = Tcl_CreateHashEntry(hTblPtr, hiddenCmdToken, &new);
    if (!new) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "hidden command named \"", hiddenCmdToken, "\" already exists",
                (char *) NULL);
        return TCL_ERROR;
    }

    /*
     * Nb : This code is currently 'like' a rename to a specialy set apart
     * name table. Changes here and in TclRenameCommand must
     * be kept in synch untill the common parts are actually
     * factorized out.
     */

    /*
     * Remove the hash entry for the command from the interpreter command
     * table. This is like deleting the command, so bump its command epoch;
     * this invalidates any cached references that point to the command.
     */

    if (cmdPtr->hPtr != NULL) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
	cmdPtr->cmdEpoch++;
    }

    /*
     * Now link the hash table entry with the command structure.
     * We ensured above that the nsPtr was right.
     */
    
    cmdPtr->hPtr = hPtr;
    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);

    /*
     * If the command being hidden has a compile procedure, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This
     * makes sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-hidden
     * command. This field is checked in Tcl_EvalObj and ObjInterpProc,
     * and code whose compilation epoch doesn't match is recompiled.
     */

    if (cmdPtr->compileProc != NULL) {
	iPtr->compileEpoch++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExposeCommand --
 *
 *	Makes a previously hidden command callable from inside the
 *	interpreter instead of only by its ancestors.
 *
 * Results:
 *	A standard Tcl result. If an error occurs, a message is left
 *	in interp->result.
 *
 * Side effects:
 *	Moves commands from one hash table to another.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
    Tcl_Interp *interp;		/* Interpreter in which to make command
                                 * callable. */
    char *hiddenCmdToken;	/* Name of hidden command. */
    char *cmdName;		/* Name of to-be-exposed command. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr;