tclinterp.c

linux系统下的音频通信

             * the target interpreter back to our interpreter.
             */

            iPtr = (Interp *) slaveInterp;
            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
                Tcl_AddErrorInfo(slaveInterp, "");
            }
            iPtr->flags &= (~(ERR_ALREADY_LOGGED));

            Tcl_ResetResult(interp);
            namePtr = Tcl_NewStringObj("errorInfo", -1);
            objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
                    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
            Tcl_DecrRefCount(namePtr);
            string = Tcl_GetStringFromObj(objPtr, &len);
            Tcl_AddObjErrorInfo(interp, string, len);
            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
                    Tcl_GetVar2(slaveInterp, "errorCode", (char *)
                            NULL, TCL_GLOBAL_ONLY),
                    TCL_GLOBAL_ONLY);
        }

	/*
         * Move the result object from the slave to the master.
         */
                
        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
        Tcl_ResetResult(slaveInterp);
    }
    Tcl_Release((ClientData) slaveInterp);
    return result;        
}

/*
 *----------------------------------------------------------------------
 *
 * InterpMarkTrustedHelper --
 *
 *	Helper function to handle the details of marking another
 *	interpreter as trusted (unsafe).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Henceforth the hard-wired checks for safety will not prevent
 *	this interpreter from performing certain operations.
 *
 *----------------------------------------------------------------------
 */

static int
InterpMarkTrustedHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    int len;				/* Dummy length variable. */

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 2, objv, "path");
        return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", Tcl_GetStringFromObj(objv[0], &len),
                " marktrusted\" can only",
                " be invoked from a trusted interpreter",
                (char *) NULL);
        return TCL_ERROR;
    }

    slaveInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    return MarkTrusted(slaveInterp);
}

/*
 *----------------------------------------------------------------------
 *
 * InterpIsSafeHelper --
 *
 *	Computes whether a named interpreter is safe.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpIsSafeHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    int len;				/* Dummy length variable. */
    Tcl_Obj *objPtr;			/* Local object pointer. */

    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 2, objv, "?path?");
        return TCL_ERROR;
    }
    if (objc == 3) {
        slaveInterp = GetInterp(interp, masterPtr,
                Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
        if (slaveInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "interpreter \"",
                    Tcl_GetStringFromObj(objv[2], &len), "\" not found",
                    (char *) NULL);
            return TCL_ERROR;
        }
	objPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
    } else {
	objPtr = Tcl_NewIntObj(Tcl_IsSafe(interp));
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpSlavesHelper --
 *
 *	Computes a list of slave interpreters of a named interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpSlavesHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int len;
    Tcl_HashEntry *hPtr;		/* Search variable. */
    Tcl_HashSearch hSearch;		/* Iteration variable. */
    Tcl_Obj *listObjPtr;		/* Local object pointers. */

    if ((objc != 2) && (objc != 3)) {
        Tcl_WrongNumArgs(interp, 2, objv, "?path?");
        return TCL_ERROR;
    }
    if (objc == 3) {
        if (GetInterp(interp, masterPtr,
                Tcl_GetStringFromObj(objv[2], &len), &masterPtr) ==
                (Tcl_Interp *) NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
                    "\" not found", (char *) NULL);
            return TCL_ERROR;
        }
    }

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSearch)) {

        Tcl_ListObjAppendElement(interp, listObjPtr,
                Tcl_NewStringObj(
                    Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr), -1));
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpShareHelper --
 *
 *	Helper function to handle the details of sharing a channel between
 *	interpreters.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call the named channel will be shared between the
 *	interpreters named in the arguments.
 *
 *----------------------------------------------------------------------
 */

static int
InterpShareHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    Tcl_Interp *masterInterp;		/* Its master. */
    int len;
    Tcl_Channel chan;

    if (objc != 5) {
        Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
        return TCL_ERROR;
    }
    masterInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[2], &len), NULL);
    if (masterInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    slaveInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[4], &len), NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(masterInterp, Tcl_GetStringFromObj(objv[3], &len),
            NULL);
    if (chan == (Tcl_Channel) NULL) {
        if (interp != masterInterp) {
            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
            Tcl_ResetResult(masterInterp);
        }
        return TCL_ERROR;
    }
    Tcl_RegisterChannel(slaveInterp, chan);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpTargetHelper --
 *
 *	Helper function to compute the target of an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpTargetHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int len;
    
    if (objc != 4) {
        Tcl_WrongNumArgs(interp, 2, objv, "path alias");
        return TCL_ERROR;
    }
    return GetTarget(interp,
            Tcl_GetStringFromObj(objv[2], &len),
            Tcl_GetStringFromObj(objv[3], &len));
}

/*
 *----------------------------------------------------------------------
 *
 * InterpTransferHelper --
 *
 *	Helper function to handle the details of transferring ownership
 *	of a channel between interpreters.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After the call, the named channel will be registered in the target
 *	interpreter and no longer available for use in the source interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
InterpTransferHelper(interp, masterPtr, objc, objv)
    Tcl_Interp *interp;			/* Current interpreter. */
    Master *masterPtr;			/* Master record for interp. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    Tcl_Interp *masterInterp;		/* Its master. */
    int len;
    Tcl_Channel chan;
            
    if (objc != 5) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "srcPath channelId destPath");
        return TCL_ERROR;
    }
    masterInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[2], &len), NULL);
    if (masterInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    slaveInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[4], &len), NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(masterInterp,
            Tcl_GetStringFromObj(objv[3], &len), NULL);
    if (chan == (Tcl_Channel) NULL) {
        if (interp != masterInterp) {

            /*
             * After fixing objresult, this code will change to:
             * Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
             */
            
            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
            Tcl_ResetResult(masterInterp);
        }
        return TCL_ERROR;
    }
    Tcl_RegisterChannel(slaveInterp, chan);
    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
        if (interp != masterInterp) {
            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
            Tcl_ResetResult(masterInterp);
        }
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DescribeAlias --
 *
 *	Sets the interpreter's result object to a Tcl list describing
 *	the given alias in the given interpreter: its target command
 *	and the additional arguments to prepend to any invocation
 *	of the alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DescribeAlias(interp, slaveInterp, aliasName)
    Tcl_Interp *interp;			/* Interpreter for result & errors. */
    Tcl_Interp *slaveInterp;		/* Interpreter defining alias. */
    char *aliasName;			/* Name of alias to describe. */
{
    Slave