tclinterp.c

linux系统下的音频通信

    Tcl_Obj *objPtr;
    int len;

    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 2, objv, "?path?");
        return TCL_ERROR;
    }
    if (objc == 3) {
        if (GetInterp(interp, masterPtr,
                Tcl_GetStringFromObj(objv[2], &len), NULL) ==
                (Tcl_Interp *) NULL) {
            objPtr = Tcl_NewIntObj(0);
        } else {
            objPtr = Tcl_NewIntObj(1);
        }
    } else {
        objPtr = Tcl_NewIntObj(1);
    }
    Tcl_SetObjResult(interp, objPtr);
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpEvalHelper --
 *
 *	Helper function to handle all the details of evaluating a
 *	command in another interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the command itself does.
 *
 *----------------------------------------------------------------------
 */

static int
InterpEvalHelper(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;		/* A slave. */
    Interp *iPtr;			/* Internal data type for slave. */
    int len;				/* Dummy length variable. */
    int result;
    Tcl_Obj *namePtr, *objPtr;		/* Local object pointer. */
    char *string;

    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
        return TCL_ERROR;
    }
    slaveInterp = GetInterp(interp, masterPtr,
            Tcl_GetStringFromObj(objv[2], &len), NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    objPtr = Tcl_ConcatObj(objc-3, objv+3);
    Tcl_IncrRefCount(objPtr);
    
    Tcl_Preserve((ClientData) slaveInterp);
    result = Tcl_EvalObj(slaveInterp, objPtr);

    Tcl_DecrRefCount(objPtr);

    /*
     * Now make the result and any error information accessible. We
     * have to be careful because the slave interpreter and the current
     * interpreter can be the same - do not destroy the result.. This
     * can happen if an interpreter contains an alias which is directed
     * at a target command in the same interpreter.
     */

    if (interp != slaveInterp) {
        if (result == TCL_ERROR) {

            /*
             * An error occurred, so transfer error information from
             * 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);
            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);
            Tcl_DecrRefCount(namePtr);
        }

	/*
         * Move the result object from one interpreter to the
         * other.
         */
                
        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
        Tcl_ResetResult(slaveInterp);

    }
    Tcl_Release((ClientData) slaveInterp);
    return result;        
}

/*
 *----------------------------------------------------------------------
 *
 * InterpExposeHelper --
 *
 *	Helper function to handle the details of exposing a command in
 *	another interpreter.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	Exposes a command. From now on the command can be called by scripts
 *	in the interpreter in which it was exposed.
 *
 *----------------------------------------------------------------------
 */

static int
InterpExposeHelper(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;		/* A slave. */
    int len;				/* Dummy length variable. */

    if ((objc != 4) && (objc != 5)) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "path hiddenCmdName ?cmdName?");
        return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "permission denied: safe interpreter cannot expose commands",
                (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;
    }
    if (Tcl_ExposeCommand(slaveInterp,
            Tcl_GetStringFromObj(objv[3], &len),
                (objc == 5 ?
                        Tcl_GetStringFromObj(objv[4], &len) :
                        Tcl_GetStringFromObj(objv[3], &len)))
            == TCL_ERROR) {
        if (interp != slaveInterp) {
            Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
            Tcl_ResetResult(slaveInterp);
        }
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpHideHelper --
 *
 *	Helper function that handles the details of hiding a command in
 *	another interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Hides a command. From now on the command cannot be called by
 *	scripts in that interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
InterpHideHelper(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 != 4) && (objc != 5)) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "path cmdName ?hiddenCmdName?");
        return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "permission denied: safe interpreter cannot hide commands",
                (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;
    }
    if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[3], &len),
            (objc == 5 ?
                    Tcl_GetStringFromObj(objv[4], &len) :
                    Tcl_GetStringFromObj(objv[3], &len)))
            == TCL_ERROR) {
        if (interp != slaveInterp) {
            Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
            Tcl_ResetResult(slaveInterp);
        }
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpHiddenHelper --
 *
 *	Computes the list of hidden commands in a named interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
InterpHiddenHelper(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;
    Tcl_HashTable *hTblPtr;		/* Hidden command table. */
    Tcl_HashEntry *hPtr;		/* Search variable. */
    Tcl_HashSearch hSearch;		/* Iteration variable. */
    Tcl_Obj *listObjPtr;		/* 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;
        }
    } else {
        slaveInterp = interp;
    }
            
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
            "tclHiddenCmds", NULL);
    if (hTblPtr != (Tcl_HashTable *) NULL) {
        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
             hPtr != (Tcl_HashEntry *) NULL;
             hPtr = Tcl_NextHashEntry(&hSearch)) {

            Tcl_ListObjAppendElement(interp, listObjPtr,
                    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
        }
    }
    Tcl_SetObjResult(interp, listObjPtr);
            
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpInvokeHiddenHelper --
 *
 *	Helper routine to handle the details of invoking a hidden
 *	command in another interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the hidden command does.
 *
 *----------------------------------------------------------------------
 */

static int
InterpInvokeHiddenHelper(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 doGlobal = 0;
    int len;
    int result;
    Tcl_Obj *namePtr, *objPtr;
    Tcl_Interp *slaveInterp;
    Interp *iPtr;
    char *string;
            
    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 2, objv,
                "path ?-global? cmd ?arg ..?");
        return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "not allowed to invoke hidden commands from safe interpreter",
                (char *) NULL);
        return TCL_ERROR;
    }
    if (strcmp(Tcl_GetStringFromObj(objv[3], &len), "-global") == 0) {
        doGlobal = 1;
        if (objc < 5) {
            Tcl_WrongNumArgs(interp, 2, objv,
                    "path ?-global? cmd ?arg ..?");
            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;
    }
    Tcl_Preserve((ClientData) slaveInterp);
    if (doGlobal) {
        result = TclObjInvokeGlobal(slaveInterp, objc-4, objv+4,
                TCL_INVOKE_HIDDEN);
    } else {
        result = TclObjInvoke(slaveInterp, objc-3, objv+3, TCL_INVOKE_HIDDEN);
    }

    /*
     * Now make the result and any error information accessible. We
     * have to be careful because the slave interpreter and the current
     * interpreter can be the same - do not destroy the result.. This
     * can happen if an interpreter contains an alias which is directed
     * at a target command in the same interpreter.
     */

    if (interp != slaveInterp) {
        if (result == TCL_ERROR) {

            /*
             * An error occurred, so transfer error information from