tclexecute.c

linux系统下的音频通信

 *
 *----------------------------------------------------------------------
 */

#define TCL_STACK_INITIAL_SIZE 2000

ExecEnv *
TclCreateExecEnv(interp)
    Tcl_Interp *interp;		/* Interpreter for which the execution
				 * environment is being created. */
{
    ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));

    eePtr->stackPtr = (StackItem *)
	ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
    eePtr->stackTop = -1;
    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);

    if (!execInitialized) {
        TclInitAuxDataTypeTable();
        InitByteCodeExecution(interp);
        execInitialized = 1;
    }

    return eePtr;
}
#undef TCL_STACK_INITIAL_SIZE

/*
 *----------------------------------------------------------------------
 *
 * TclDeleteExecEnv --
 *
 *	Frees the storage for an ExecEnv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Storage for an ExecEnv and its contained storage (e.g. the
 *	evaluation stack) is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclDeleteExecEnv(eePtr)
    ExecEnv *eePtr;		/* Execution environment to free. */
{
    ckfree((char *) eePtr->stackPtr);
    ckfree((char *) eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecEnv --
 *
 *	Finalizes the execution environment setup so that it can be
 *	later reinitialized.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	After this call, the next time TclCreateExecEnv will be called
 *	it will call InitByteCodeExecution.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeExecEnv()
{
    execInitialized = 0;
    TclFinalizeAuxDataTypeTable();
}

/*
 *----------------------------------------------------------------------
 *
 * GrowEvaluationStack --
 *
 *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The size of the evaluation stack is doubled.
 *
 *----------------------------------------------------------------------
 */

static void
GrowEvaluationStack(eePtr)
    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
			      * stack to enlarge. */
{
    /*
     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
     */

    int currElems = (eePtr->stackEnd + 1);
    int newElems  = 2*currElems;
    int currBytes = currElems * sizeof(StackItem);
    int newBytes  = 2*currBytes;
    StackItem *newStackPtr = (StackItem *) ckalloc((unsigned) newBytes);

    /*
     * Copy the existing stack items to the new stack space, free the old
     * storage if appropriate, and mark new space as malloc'ed.
     */
 
    memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
	   (size_t) currBytes);
    ckfree((char *) eePtr->stackPtr);
    eePtr->stackPtr = newStackPtr;
    eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
}

/*
 *----------------------------------------------------------------------
 *
 * TclExecuteByteCode --
 *
 *	This procedure executes the instructions of a ByteCode structure.
 *	It returns when a "done" instruction is executed or an error occurs.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.h
 *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
 *	that either contains the result of executing the code or an
 *	error message.
 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */

int
TclExecuteByteCode(interp, codePtr)
    Tcl_Interp *interp;		/* Token for command interpreter. */
    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    				/* Points to the execution environment. */
    register StackItem *stackPtr = eePtr->stackPtr;
    				/* Cached evaluation stack base pointer. */
    register int stackTop = eePtr->stackTop;
    				/* Cached top index of evaluation stack. */
    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
    				/* Points to the ByteCode's object array. */
    unsigned char *pc = codePtr->codeStart;
				/* The current program counter. */
    unsigned char opCode;	/* The current instruction code. */
    int opnd;			/* Current instruction's operand byte. */
    int pcAdjustment;		/* Hold pc adjustment after instruction. */
    int initStackTop = stackTop;/* Stack top at start of execution. */
    ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
				 * range enclosing the pc. Used by various
				 * instructions and processCatch to
				 * process break, continue, and errors. */
    int result = TCL_OK;	/* Return code returned after execution. */
    int traceInstructions = (tclTraceExec == 3);
    Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
    char *bytes;
    int length;
    long i;
    Tcl_DString command;	/* Used for debugging. If tclTraceExec >= 2
				 * holds a string representing the last
				 * command invoked. */

    /*
     * This procedure uses a stack to hold information about catch commands.
     * This information is the current operand stack top when starting to
     * execute the code for each catch command. It starts out with stack-
     * allocated space but uses dynamically-allocated storage if needed.
     */

#define STATIC_CATCH_STACK_SIZE 5
    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
    int *catchStackPtr = catchStackStorage;
    int catchTop = -1;

    /*
     * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
     */

    if (tclTraceExec >= 2) {
	PrintByteCodeInfo(codePtr);
#ifdef TCL_COMPILE_STATS
	fprintf(stdout, "  Starting stack top=%d, system objects=%ld\n",
		eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
#else
	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
#endif /* TCL_COMPILE_STATS */
	fflush(stdout);
    }

#ifdef TCL_COMPILE_STATS
    numExecutions++;
#endif /* TCL_COMPILE_STATS */

    /*
     * Make sure the catch stack is large enough to hold the maximum number
     * of catch commands that could ever be executing at the same time. This
     * will be no more than the exception range array's depth.
     */

    if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
	catchStackPtr = (int *)
	        ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
    }

    /*
     * Make sure the stack has enough room to execute this ByteCode.
     */

    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
        GrowEvaluationStack(eePtr); 
        stackPtr = eePtr->stackPtr;
    }

    /*
     * Initialize the buffer that holds a string containing the name and
     * arguments for the last invoked command.
     */

    Tcl_DStringInit(&command);

    /*
     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
     * or some error.
     */

    for (;;) {
#ifdef TCL_COMPILE_DEBUG
	ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
		eePtr->stackEnd);
#else /* not TCL_COMPILE_DEBUG */
	if (traceInstructions) {
#ifdef TCL_COMPILE_STATS
	    fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
		    (tclObjsAlloced - tclObjsFreed));
#else /* TCL_COMPILE_STATS */
	    fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
#endif /* TCL_COMPILE_STATS */
	    TclPrintInstruction(codePtr, pc);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */
	
	opCode = *pc;
#ifdef TCL_COMPILE_STATS    
	instructionCount[opCode]++;
#endif /* TCL_COMPILE_STATS */

        switch (opCode) {
	case INST_DONE:
	    /*
	     * Pop the topmost object from the stack, set the interpreter's
	     * object result to point to it, and return.
	     */
	    valuePtr = POP_OBJECT();
	    Tcl_SetObjResult(interp, valuePtr);
	    TclDecrRefCount(valuePtr);
	    if (stackTop != initStackTop) {
		fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
			(unsigned int)(pc - codePtr->codeStart),
			(unsigned int) stackTop,
			(unsigned int) initStackTop);
		fprintf(stderr, "  Source: ");
		TclPrintSource(stderr, codePtr->source, 150);
		panic("TclExecuteByteCode execution failure: end stack top != start stack top");
	    }
	    TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
		    iPtr->objResultPtr);
	    goto done;
	    
	case INST_PUSH1:
	    valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
	            valuePtr);
	    ADJUST_PC(2);
	    
	case INST_PUSH4:
	    valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(pc+1)),
		    valuePtr);
	    ADJUST_PC(5);
	    
	case INST_POP:
	    valuePtr = POP_OBJECT();
	    TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
	    TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
	    ADJUST_PC(1);

	case INST_DUP:
	    valuePtr = stackPtr[stackTop].o;
	    PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
	    TRACE_WITH_OBJ(("dup => "), valuePtr);
	    ADJUST_PC(1);

	case INST_CONCAT1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    {
		Tcl_Obj *concatObjPtr;
		int totalLen = 0;

		/*
		 * Concatenate strings (with no separators) from the top
		 * opnd items on the stack starting with the deepest item.
		 * First, determine how many characters are needed.
		 */

		for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
		    valuePtr = stackPtr[i].o;
		    bytes = TclGetStringFromObj(valuePtr, &length);
		    if (bytes != NULL) {
			totalLen += length;
		    }
                }

		/*
		 * Initialize the new append string object by appending the
		 * strings of the opnd stack objects. Also pop the objects. 
		 */

		TclNewObj(concatObjPtr);
		if (totalLen > 0) {
		    char *p = (char *) ckalloc((unsigned) (totalLen + 1));
		    concatObjPtr->bytes = p;
		    concatObjPtr->length = totalLen;
		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
			valuePtr = stackPtr[i].o;
			bytes = TclGetStringFromObj(valuePtr, &length);
			if (bytes != NULL) {
			    memcpy((VOID *) p, (VOID *) bytes,
			            (size_t) length);
			    p += length;
			}
			TclDecrRefCount(valuePtr);
		    }
		    *p = '\0';
		} else {
		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
			valuePtr = stackPtr[i].o;
			Tcl_DecrRefCount(valuePtr);
		    }
		}
		stackTop -= opnd;
		
		PUSH_OBJECT(concatObjPtr);
		TRACE_WITH_OBJ(("concat %u => ", opnd), concatObjPtr);
		ADJUST_PC(2);
            }
	    
	case INST_INVOKE_STK4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doInvocation;

	case INST_INVOKE_STK1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doInvocation:
	    {
		char *cmdName;
		Command *cmdPtr;   /* Points to command's Command struct. */
		int objc = opnd;   /* The number of arguments. */
		Tcl_Obj **objv;	   /* The array of argument objects. */
		Tcl_Obj *objv0Ptr; /* Holds objv[0], the command name. */
		int newPcOffset = 0;
				   /* Instruction offset computed during
				    * break, continue, error processing.
				    * Init. to avoid compiler warning. */
		Tcl_Command cmd;
#ifdef TCL_COMPILE_DEBUG
		int isUnknownCmd = 0;
		char cmdNameBuf[30];
#endif /* TCL_COMPILE_DEBUG */
		
		/*
		 * If the interpreter was deleted, return an error.
		 */
		
		if (iPtr->flags & DELETED) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		            "attempt to call eval in deleted interpreter", -1);
		    Tcl_SetErrorCode(interp, "CORE", "IDELETE",
			    "attempt to call eval in deleted interpreter",
			    (char *) NULL);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
    
		objv = &(stackPtr[stackTop - (objc-1)].o);
		objv0Ptr = objv[0];
		cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
		
		/*
		 * Find the procedure to execute this command. If there
		 * isn't one, then see if there is a command "unknown". If
		 * so, invoke it, passing it the original command words as
		 * arguments.
		 *
		 * We convert the objv[0] object to be a CmdName object.
		 * This caches a pointer to the Command structure for the
		 * command; this pointer is held in a ResolvedCmdName
		 * structure the object's internal rep. points to.
		 */

		cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
		cmdPtr = (Command *) cmd;
		
		/*
		 * If the command is still not found, handle it with the
		 * "unknown" proc.
		 */

		if (cmdPtr == NULL) {
		    cmd = Tcl_FindCommand(interp, "unknown",
                            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
                    if (cmd == (Tcl_Command) NULL) {