tclexecute.c

tcl是工具命令语言

		}
	    }

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

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

    case INST_INVOKE_STK1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
	    
    doInvocation:
	{
	    int objc = opnd; /* The number of arguments. */
	    Tcl_Obj **objv;	 /* The array of argument objects. */

	    /*
	     * We keep the stack reference count as a (char *), as that
	     * works nicely as a portable pointer-sized counter.
	     */

	    char **preservedStackRefCountPtr;
	    
	    /* 
	     * Reference to memory block containing
	     * objv array (must be kept live throughout
	     * trace and command invokations.) 
	     */

	    objv = &(stackPtr[stackTop - (objc-1)]);

#ifdef TCL_COMPILE_DEBUG
	    if (tclTraceExec >= 2) {
		if (traceInstructions) {
		    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		    TRACE(("%u => call ", objc));
		} else {
		    fprintf(stdout, "%d: (%u) invoking ",
			    iPtr->numLevels,
			    (unsigned int)(pc - codePtr->codeStart));
		}
		for (i = 0;  i < objc;  i++) {
		    TclPrintObject(stdout, objv[i], 15);
		    fprintf(stdout, " ");
		}
		fprintf(stdout, "\n");
		fflush(stdout);
	    }
#endif /*TCL_COMPILE_DEBUG*/

	    /* 
	     * If trace procedures will be called, we need a
	     * command string to pass to TclEvalObjvInternal; note 
	     * that a copy of the string will be made there to 
	     * include the ending \0.
	     */

	    bytes = NULL;
	    length = 0;
	    if (iPtr->tracePtr != NULL) {
		Trace *tracePtr, *nextTracePtr;
		    
		for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
		     tracePtr = nextTracePtr) {
		    nextTracePtr = tracePtr->nextPtr;
		    if (tracePtr->level == 0 ||
			iPtr->numLevels <= tracePtr->level) {
			/*
			 * Traces will be called: get command string
			 */

			bytes = GetSrcInfoForPc(pc, codePtr, &length);
			break;
		    }
		}
	    } else {		
		Command *cmdPtr;
		cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
		if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
		    bytes = GetSrcInfoForPc(pc, codePtr, &length);
		}
	    }		

	    /*
	     * A reference to part of the stack vector itself
	     * escapes our control: increase its refCount
	     * to stop it from being deallocated by a recursive
	     * call to ourselves.  The extra variable is needed
	     * because all others are liable to change due to the
	     * trace procedures.
	     */

	    preservedStackRefCountPtr = (char **) (stackPtr-1);
	    ++*preservedStackRefCountPtr;

	    /*
	     * Finally, let TclEvalObjvInternal handle the command. 
	     */

	    Tcl_ResetResult(interp);
	    DECACHE_STACK_INFO();
	    result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
	    CACHE_STACK_INFO();

	    /*
	     * If the old stack is going to be released, it is
	     * safe to do so now, since no references to objv are
	     * going to be used from now on.
	     */

	    --*preservedStackRefCountPtr;
	    if (*preservedStackRefCountPtr == (char *) 0) {
		ckfree((VOID *) preservedStackRefCountPtr);
	    }	    

	    if (result == TCL_OK) {
		/*
		 * Push the call's object result and continue execution
		 * with the next instruction.
		 */

		TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
		        objc, cmdNameBuf), Tcl_GetObjResult(interp));

		objResultPtr = Tcl_GetObjResult(interp);
		NEXT_INST_V(pcAdjustment, opnd, 1);
	    } else {
		cleanup = opnd;
		goto processExceptionReturn;
	    }
	}

    case INST_EVAL_STK:
	/*
	 * Note to maintainers: it is important that INST_EVAL_STK
	 * pop its argument from the stack before jumping to
	 * checkForCatch! DO NOT OPTIMISE!
	 */

	objPtr = stackPtr[stackTop];
	DECACHE_STACK_INFO();
	result = TclCompEvalObj(interp, objPtr);
	CACHE_STACK_INFO();
	if (result == TCL_OK) {
	    /*
	     * Normal return; push the eval's object result.
	     */

	    objResultPtr = Tcl_GetObjResult(interp);
	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
			   Tcl_GetObjResult(interp));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    cleanup = 1;
	    goto processExceptionReturn;
	}

    case INST_EXPR_STK:
	objPtr = stackPtr[stackTop];
	Tcl_ResetResult(interp);
	DECACHE_STACK_INFO();
	result = Tcl_ExprObj(interp, objPtr, &valuePtr);
	CACHE_STACK_INFO();
	if (result != TCL_OK) {
	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", 
	        O2S(objPtr)), Tcl_GetObjResult(interp));
	    goto checkForCatch;
	}
	objResultPtr = valuePtr;
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
	NEXT_INST_F(1, 1, -1); /* already has right refct */

    /*
     * ---------------------------------------------------------
     *     Start of INST_LOAD instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended!
     * The different instructions set the value of some variables
     * and then jump to somme common execution code.
     */

    case INST_LOAD_SCALAR1:
	opnd = TclGetUInt1AtPtr(pc+1);
	varPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = varPtr->name;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
	        && (varPtr->tracePtr == NULL)) {
	    /*
	     * No errors, no traces: just get the value.
	     */
	    objResultPtr = varPtr->value.objPtr;
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_F(2, 0, 1);
	}
	pcAdjustment = 2;
	cleanup = 0;
	arrayPtr = NULL;
	part2 = NULL;
	goto doCallPtrGetVar;

    case INST_LOAD_SCALAR4:
	opnd = TclGetUInt4AtPtr(pc+1);
	varPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = varPtr->name;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
	        && (varPtr->tracePtr == NULL)) {
	    /*
	     * No errors, no traces: just get the value.
	     */
	    objResultPtr = varPtr->value.objPtr;
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_F(5, 0, 1);
	}
	pcAdjustment = 5;
	cleanup = 0;
	arrayPtr = NULL;
	part2 = NULL;
	goto doCallPtrGetVar;

    case INST_LOAD_ARRAY_STK:
	cleanup = 2;
	part2 = Tcl_GetString(stackPtr[stackTop]);  /* element name */
	objPtr = stackPtr[stackTop-1]; /* array name */
	TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
	goto doLoadStk;

    case INST_LOAD_STK:
    case INST_LOAD_SCALAR_STK:
	cleanup = 1;
	part2 = NULL;
	objPtr = stackPtr[stackTop]; /* variable name */
	TRACE(("\"%.30s\" => ", O2S(objPtr)));

    doLoadStk:
	part1 = TclGetString(objPtr);
	varPtr = TclObjLookupVar(interp, objPtr, part2, 
	         TCL_LEAVE_ERR_MSG, "read",
                 /*createPart1*/ 0,
	         /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
	        && (varPtr->tracePtr == NULL)
	        && ((arrayPtr == NULL) 
		        || (arrayPtr->tracePtr == NULL))) {
	    /*
	     * No errors, no traces: just get the value.
	     */
	    objResultPtr = varPtr->value.objPtr;
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_V(1, cleanup, 1);
	}
	pcAdjustment = 1;
	goto doCallPtrGetVar;

    case INST_LOAD_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	goto doLoadArray;

    case INST_LOAD_ARRAY1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
    
    doLoadArray:
	part2 = TclGetString(stackPtr[stackTop]);
	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = arrayPtr->name;
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%u \"%.30s\" => ", opnd, part2));
	varPtr = TclLookupArrayElement(interp, part1, part2, 
	        TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
	        && (varPtr->tracePtr == NULL)
	        && ((arrayPtr == NULL) 
		        || (arrayPtr->tracePtr == NULL))) {
	    /*
	     * No errors, no traces: just get the value.
	     */
	    objResultPtr = varPtr->value.objPtr;
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_F(pcAdjustment, 1, 1);
	}
	cleanup = 1;
	goto doCallPtrGetVar;

    doCallPtrGetVar:
	/*
	 * There are either errors or the variable is traced:
	 * call TclPtrGetVar to process fully.
	 */

	DECACHE_STACK_INFO();
	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, 
	        part2, TCL_LEAVE_ERR_MSG);
	CACHE_STACK_INFO();
	if (objResultPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);

    /*
     *     End of INST_LOAD instructions.
     * ---------------------------------------------------------
     */

    /*
     * ---------------------------------------------------------
     *     Start of INST_STORE and related instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended!
     * The different instructions set the value of some variables
     * and then jump to somme common execution code.
     */

    case INST_LAPPEND_STK:
	valuePtr = stackPtr[stackTop]; /* value to append */
	part2 = NULL;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
		      | TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreStk;

    case INST_LAPPEND_ARRAY_STK:
	valuePtr = stackPtr[stackTop]; /* value to append */
	part2 = TclGetString(stackPtr[stackTop - 1]);
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
		      | TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreStk;

    case INST_APPEND_STK:
	valuePtr = stackPtr[stackTop]; /* value to append */
	part2 = NULL;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
	goto doStoreStk;

    case INST_APPEND_ARRAY_STK:
	valuePtr = stackPtr[stackTop]; /* value to append */
	part2 = TclGetString(stackPtr[stackTop - 1]);
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
	goto doStoreStk;

    case INST_STORE_ARRAY_STK:
	valuePtr = stackPtr[stackTop];
	part2 = TclGetString(stackPtr[stackTop - 1]);
	storeFlags = TCL_LEAVE_ERR_MSG;
	goto doStoreStk;

    case INST_STORE_STK:
    case INST_STORE_SCALAR_STK:
	valuePtr = stackPtr[stackTop];
	part2 = NULL;
	storeFlags = TCL_LEAVE_ERR_MSG;

    doStoreStk:
	objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */
	part1 = TclGetString(objPtr);
#ifdef TCL_COMPILE_DEBUG
	if (part2 == NULL) {
	    TRACE(("\"%.30s\" <- \"%.30s\" =>", 
	            part1, O2S(valuePtr)));
	} else {
	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
		    part1, part2, O2S(valuePtr)));
	}
#endif
	varPtr = TclObjLookupVar(interp, objPtr, part2, 
	         TCL_LEAVE_ERR_MSG, "set",
                 /*createPart1*/ 1,
	         /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	cleanup = ((part2 == NULL)? 2 : 3);
	pcAdjustment = 1;
	goto doCallPtrSetVar;

    case INST_LAPPEND_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
		      | TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreArray;

    case INST_LAPPEND_ARRAY1: