tclinterp.c

linux系统下的音频通信

        ckfree((char *) localArgv);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter named \"", path, "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    ckfree((char *) localArgv);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteInterpObject --
 *
 *	Helper function to do the work of deleting zero or more
 *	interpreters and their interpreter object commands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes interpreters and their interpreter object command.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteInterpObject(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Interpreter start search from. */
    Master *masterPtr;			/* Interim storage for master record.*/
    int objc;				/* Number of arguments in vector. */
    Tcl_Obj *CONST objv[];		/* with alias. */
{
    int i;
    int len;
    
    for (i = 2; i < objc; i++) {
        if (DeleteOneInterpObject(interp, masterPtr,
                Tcl_GetStringFromObj(objv[i], &len))
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasCreationHelper --
 *
 *	Helper function to do the work to actually create an alias or
 *	delete an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	An alias command is created and entered into the alias table
 *	for the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
     aliasName, targetName, objc, objv)
    Tcl_Interp *curInterp;		/* Interp that invoked this proc. */
    Tcl_Interp *slaveInterp;		/* Interp where alias cmd will live
                                         * or from which alias will be
                                         * deleted. */
    Tcl_Interp *masterInterp;		/* Interp where target cmd will be. */
    Master *masterPtr;			/* Master record for target interp. */
    char *aliasName;			/* Name of alias cmd. */
    char *targetName;			/* Name of target cmd. */
    int objc;				/* Additional arguments to store */
    Tcl_Obj *CONST objv[];		/* with alias. */
{
    Alias *aliasPtr;			/* Storage for alias data. */
    Alias *tmpAliasPtr;			/* Temp storage for alias to delete. */
    Tcl_HashEntry *hPtr;		/* Entry into interp hashtable. */
    int i;				/* Loop index. */
    int new;				/* Is it a new hash entry? */
    Target *targetPtr;			/* Maps from target command in master
                                         * to source command in slave. */
    Slave *slavePtr;			/* Maps from source command in slave
                                         * to target command in master. */

    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);

    /*
     * Slave record should be always present because it is created when
     * the interpreter is created.
     */
    
    if (slavePtr == (Slave *) NULL) {
        panic("AliasCreationHelper: could not find slave record");
    }

    if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
        if (objc != 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
                    "malformed command: should be",
                    " \"alias ",  aliasName, " {}\"", (char *) NULL);
            return TCL_ERROR;
        }

        return DeleteAlias(curInterp, slaveInterp, aliasName);
    }
    
    aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
    aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
    aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
    strcpy(aliasPtr->aliasName, aliasName);
    strcpy(aliasPtr->targetName, targetName);
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->objv = NULL;
    aliasPtr->objc = objc;

    if (aliasPtr->objc > 0) {
        aliasPtr->objv =
            (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) *
                    aliasPtr->objc);
        for (i = 0; i < objc; i++) {
            aliasPtr->objv[i] = objv[i];
            Tcl_IncrRefCount(objv[i]);
        }
    }

    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, aliasName,
            AliasCmd, (ClientData) aliasPtr, AliasCmdDeleteProc);

    if (TclPreventAliasLoop(curInterp, slaveInterp, 
            aliasPtr->slaveCmd) != TCL_OK) {

	/*
         *  Found an alias loop!  The last call to Tcl_CreateObjCommand
         *  made the alias point to itself.  Delete the command and
         *  its alias record.  Be careful to wipe out its client data
         *  first, so the command doesn't try to delete itself.
         */
	
        Command *cmdPtr = (Command*) aliasPtr->slaveCmd;
        cmdPtr->clientData = NULL;
        cmdPtr->deleteProc = NULL;
        cmdPtr->deleteData = NULL;
        Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

        for (i = 0; i < objc; i++) {
            Tcl_DecrRefCount(aliasPtr->objv[i]);
        }
        if (aliasPtr->objv != (Tcl_Obj *CONST *) NULL) {
            ckfree((char *) aliasPtr->objv);
        }
        ckfree(aliasPtr->aliasName);
        ckfree(aliasPtr->targetName);
        ckfree((char *) aliasPtr);

        /*
         * The result was already set by TclPreventAliasLoop.
         */

        return TCL_ERROR;
    }
    
    /*
     * Make an entry in the alias table. If it already exists delete
     * the alias command. Then retry.
     */

    do {
        hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
        if (!new) {
            tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
            (void) Tcl_DeleteCommandFromToken(slaveInterp,
	            tmpAliasPtr->slaveCmd);

            /*
             * The hash entry should be deleted by the Tcl_DeleteCommand
             * above, in its command deletion callback (most likely this
             * will be AliasCmdDeleteProc, which does the deletion).
             */
        }
    } while (new == 0);
    aliasPtr->aliasEntry = hPtr;
    Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
    
    /*
     * Create the new command. We must do it after deleting any old command,
     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    do {
        hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
                (char *) aliasCounter, &new);
	aliasCounter++;
    } while (new == 0);

    Tcl_SetHashValue(hPtr, (ClientData) targetPtr);

    aliasPtr->targetEntry = hPtr;

    /*
     * Make sure we clear out the object result when setting the string
     * result.
     */

    Tcl_SetObjResult(curInterp, Tcl_NewStringObj(aliasPtr->aliasName, -1));
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpAliasesHelper --
 *
 *	Computes a list of aliases defined in an interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpAliasesHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Invoking interpreter. */
    Master *masterPtr;			/* Master record for current interp. */
    int objc;				/* How many arguments? */
    Tcl_Obj *CONST objv[];		/* Actual arguments. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    Slave *slavePtr;			/* Record for slave interp. */
    Tcl_HashEntry *hPtr;		/* Search variable. */
    Tcl_HashSearch hSearch;		/* Iteration variable. */
    int len;				/* Dummy length variable. */
    Tcl_Obj *listObjPtr, *elemObjPtr;	/* Local object pointers. */
    
    if ((objc != 2) && (objc != 3)) {
        Tcl_WrongNumArgs(interp, 2, objv, "?path?");
        return TCL_ERROR;
    }
    if (objc == 3) {
        slaveInterp = GetInterp(interp, masterPtr,
                Tcl_GetStringFromObj(objv[2], &len), NULL);
        if (slaveInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
                    "\" not found", (char *) NULL);
            return TCL_ERROR;
        }
    } else {
        slaveInterp = interp;
    }
    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
            "tclSlaveRecord", NULL);
    if (slavePtr == (Slave *) NULL) {
        return TCL_OK;
    }

    /*
     * Build a list to return the aliases:
     */
            
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSearch)) {

        elemObjPtr = Tcl_NewStringObj(
            Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr), -1);
        Tcl_ListObjAppendElement(interp, listObjPtr, elemObjPtr);
    }
    Tcl_SetObjResult(interp, listObjPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpAliasHelper -
 *
 *	Handles the different forms of the "interp alias" command:
 *	- interp alias slavePath aliasName
 *		Describes an alias.
 *	- interp alias slavePath aliasName {}
 *		Deletes an alias.
 *	- interp alias slavePath srcCmd masterPath targetCmd args...
 *		Creates an alias.
 *
 * Results:
 *	A Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
InterpAliasHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for current interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Interp *slaveInterp,		/* Interpreters used when */
        *masterInterp;			/* creating an alias btn siblings. */
    Master *masterMasterPtr;		/* Master record for master interp. */
    int len;

    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "slavePath slaveCmd masterPath masterCmd ?args ..?");
        return TCL_ERROR;
    }
    slaveInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[2], &len), NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not find interpreter \"",
                Tcl_GetStringFromObj(objv[2], &len), "\"",
                (char *) NULL);
        return TCL_ERROR;
    }
    if (objc == 4) {
        return DescribeAlias(interp, slaveInterp,
                Tcl_GetStringFromObj(objv[3], &len));
    }
    if (objc == 5 && strcmp(Tcl_GetStringFromObj(objv[4], &len), "") == 0) {
        return DeleteAlias(interp, slaveInterp,
                Tcl_GetStringFromObj(objv[3], &len));
    }
    if (objc < 6) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "slavePath slaveCmd masterPath masterCmd ?args ..?");
        return TCL_ERROR;
    }
    masterInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[4], &len), &masterMasterPtr);
    if (masterInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not find interpreter \"",
                Tcl_GetStringFromObj(objv[4], &len), "\"", (char *) NULL);
        return TCL_ERROR;
    }
    return AliasCreationHelper(interp, slaveInterp, masterInterp,
            masterMasterPtr, Tcl_GetStringFromObj(objv[3], &len),
            Tcl_GetStringFromObj(objv[5], &len),
            objc-6, objv+6);
}

/*
 *----------------------------------------------------------------------
 *
 * InterpExistsHelper --
 *
 *	Computes whether a named interpreter exists or not.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpExistsHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for current interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{