tclexecute.c

tcl是工具命令语言

	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
		      | TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreArray;

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

    case INST_APPEND_ARRAY1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
	goto doStoreArray;

    case INST_STORE_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = TCL_LEAVE_ERR_MSG;
	goto doStoreArray;

    case INST_STORE_ARRAY1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
	storeFlags = TCL_LEAVE_ERR_MSG;
	    
    doStoreArray:
	valuePtr = stackPtr[stackTop];
	part2 = TclGetString(stackPtr[stackTop - 1]);
	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = arrayPtr->name;
	TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
		    opnd, part2, O2S(valuePtr)));
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	varPtr = TclLookupArrayElement(interp, part1, part2, 
	        TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	cleanup = 2;
	goto doCallPtrSetVar;

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

    case INST_LAPPEND_SCALAR1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;	    
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
		      | TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreScalar;

    case INST_APPEND_SCALAR4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
	goto doStoreScalar;

    case INST_APPEND_SCALAR1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;	    
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
	goto doStoreScalar;

    case INST_STORE_SCALAR4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = TCL_LEAVE_ERR_MSG;
	goto doStoreScalar;

    case INST_STORE_SCALAR1:
	opnd = TclGetUInt1AtPtr(pc+1);
	pcAdjustment = 2;
	storeFlags = TCL_LEAVE_ERR_MSG;

    doStoreScalar:
	valuePtr = stackPtr[stackTop];
	varPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = varPtr->name;
	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	cleanup = 1;
	arrayPtr = NULL;
	part2 = NULL;

    doCallPtrSetVar:
	if ((storeFlags == TCL_LEAVE_ERR_MSG)
	        && !((varPtr->flags & VAR_IN_HASHTABLE) 
		        && (varPtr->hPtr == NULL))
	        && (varPtr->tracePtr == NULL)
	        && (TclIsVarScalar(varPtr) 
		        || TclIsVarUndefined(varPtr))
	        && ((arrayPtr == NULL) 
		        || (arrayPtr->tracePtr == NULL))) {
	    /*
	     * No traces, no errors, plain 'set': we can safely inline.
	     * The value *will* be set to what's requested, so that 
	     * the stack top remains pointing to the same Tcl_Obj.
	     */
	    valuePtr = varPtr->value.objPtr;
	    objResultPtr = stackPtr[stackTop];
	    if (valuePtr != objResultPtr) {
		if (valuePtr != NULL) {
		    TclDecrRefCount(valuePtr);
		} else {
		    TclSetVarScalar(varPtr);
		    TclClearVarUndefined(varPtr);
		}
		varPtr->value.objPtr = objResultPtr;
		Tcl_IncrRefCount(objResultPtr);
	    }
#ifndef TCL_COMPILE_DEBUG
	    if (*(pc+pcAdjustment) == INST_POP) {
		NEXT_INST_V((pcAdjustment+1), cleanup, 0);
	    }
#else
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#endif
	    NEXT_INST_V(pcAdjustment, cleanup, 1);
	} else {
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, 
	            part1, part2, valuePtr, storeFlags);
	    CACHE_STACK_INFO();
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	}
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
	}
#endif
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);


    /*
     *     End of INST_STORE and related instructions.
     * ---------------------------------------------------------
     */

    /*
     * ---------------------------------------------------------
     *     Start of INST_INCR 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_INCR_SCALAR1:
    case INST_INCR_ARRAY1:
    case INST_INCR_ARRAY_STK:
    case INST_INCR_SCALAR_STK:
    case INST_INCR_STK:
	opnd = TclGetUInt1AtPtr(pc+1);
	valuePtr = stackPtr[stackTop];
	if (valuePtr->typePtr == &tclIntType) {
	    i = valuePtr->internalRep.longValue;
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (valuePtr->typePtr == &tclWideIntType) {
	    i = Tcl_WideAsLong(valuePtr->internalRep.wideValue);
#endif /* TCL_WIDE_INT_IS_LONG */
	} else {
	    REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
	    if (result != TCL_OK) {
		TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
		        opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
		Tcl_AddErrorInfo(interp, "\n    (reading increment)");
		goto checkForCatch;
	    }
	    FORCE_LONG(valuePtr, i, w);
	}
	stackTop--;
	TclDecrRefCount(valuePtr);
	switch (*pc) {
	    case INST_INCR_SCALAR1:
		pcAdjustment = 2;
		goto doIncrScalar;
	    case INST_INCR_ARRAY1:
		pcAdjustment = 2;
		goto doIncrArray;
	    default:
		pcAdjustment = 1;
		goto doIncrStk;
	}

    case INST_INCR_ARRAY_STK_IMM:
    case INST_INCR_SCALAR_STK_IMM:
    case INST_INCR_STK_IMM:
	i = TclGetInt1AtPtr(pc+1);
	pcAdjustment = 2;
	    
    doIncrStk:
	if ((*pc == INST_INCR_ARRAY_STK_IMM) 
	        || (*pc == INST_INCR_ARRAY_STK)) {
	    part2 = TclGetString(stackPtr[stackTop]);
	    objPtr = stackPtr[stackTop - 1];
	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
		    O2S(objPtr), part2, i));
	} else {
	    part2 = NULL;
	    objPtr = stackPtr[stackTop];
	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
	}
	part1 = TclGetString(objPtr);

	varPtr = TclObjLookupVar(interp, objPtr, part2, 
	        TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
	if (varPtr == NULL) {
	    Tcl_AddObjErrorInfo(interp,
	            "\n    (reading value of variable to increment)", -1);
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	cleanup = ((part2 == NULL)? 1 : 2);
	goto doIncrVar;

    case INST_INCR_ARRAY1_IMM:
	opnd = TclGetUInt1AtPtr(pc+1);
	i = TclGetInt1AtPtr(pc+2);
	pcAdjustment = 3;

    doIncrArray:
	part2 = TclGetString(stackPtr[stackTop]);
	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = arrayPtr->name;
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%u \"%.30s\" (by %ld) => ",
		    opnd, part2, i));
	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;
	}
	cleanup = 1;
	goto doIncrVar;

    case INST_INCR_SCALAR1_IMM:
	opnd = TclGetUInt1AtPtr(pc+1);
	i = TclGetInt1AtPtr(pc+2);
	pcAdjustment = 3;

    doIncrScalar:
	varPtr = &(varFramePtr->compiledLocals[opnd]);
	part1 = varPtr->name;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	arrayPtr = NULL;
	part2 = NULL;
	cleanup = 0;
	TRACE(("%u %ld => ", opnd, i));


    doIncrVar:
	objPtr = varPtr->value.objPtr;
	if (TclIsVarScalar(varPtr)
	        && !TclIsVarUndefined(varPtr) 
	        && (varPtr->tracePtr == NULL)
	        && ((arrayPtr == NULL) 
		        || (arrayPtr->tracePtr == NULL))
	        && (objPtr->typePtr == &tclIntType)) {
	    /*
	     * No errors, no traces, the variable already has an
	     * integer value: inline processing.
	     */

	    i += objPtr->internalRep.longValue;
	    if (Tcl_IsShared(objPtr)) {
		objResultPtr = Tcl_NewLongObj(i);
		TclDecrRefCount(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {
		Tcl_SetLongObj(objPtr, i);
		objResultPtr = objPtr;
	    }
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	} else {
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1, 
                    part2, i, 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)));
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
	}
#endif
	NEXT_INST_V(pcAdjustment, cleanup, 1);
	    	    
    /*
     *     End of INST_INCR instructions.
     * ---------------------------------------------------------
     */


    case INST_JUMP1:
	opnd = TclGetInt1AtPtr(pc+1);
	TRACE(("%d => new pc %u\n", opnd,
	        (unsigned int)(pc + opnd - codePtr->codeStart)));
	NEXT_INST_F(opnd, 0, 0);

    case INST_JUMP4:
	opnd = TclGetInt4AtPtr(pc+1);
	TRACE(("%d => new pc %u\n", opnd,
	        (unsigned int)(pc + opnd - codePtr->codeStart)));
	NEXT_INST_F(opnd, 0, 0);

    case INST_JUMP_FALSE4:
	opnd = 5;                             /* TRUE */
	pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
	goto doJumpTrue;

    case INST_JUMP_TRUE4:
	opnd = TclGetInt4AtPtr(pc+1);         /* TRUE */
	pcAdjustment = 5;                     /* FALSE */
	goto doJumpTrue;

    case INST_JUMP_FALSE1:
	opnd = 2;                             /* TRUE */
	pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
	goto doJumpTrue;

    case INST_JUMP_TRUE1:
	opnd = TclGetInt1AtPtr(pc+1);          /* TRUE */
	pcAdjustment = 2;                      /* FALSE */
	    
    doJumpTrue:
	{
	    int b;
		
	    valuePtr = stackPtr[stackTop];
	    if (valuePtr->typePtr == &tclIntType) {
		b = (valuePtr->internalRep.longValue != 0);
	    } else if (valuePtr->typePtr == &tclDoubleType) {
		b = (valuePtr->internalRep.doubleValue != 0.0);
#ifndef TCL_WIDE_INT_IS_LONG
	    } else if (valuePtr->typePtr == &tclWideIntType) {
		b = (valuePtr->internalRep.wideValue != W0);
#endif /* TCL_WIDE_INT_IS_LONG */
	    } else {
		result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
		if (result != TCL_OK) {
		    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
		    goto checkForCatch;
		}
	    }
#ifndef TCL_COMPILE_DEBUG
	    NEXT_INST_F((b? opnd : pcAdjustment), 1, 0);
#else
	    if (b) {
		if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
		    TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr),
		            (unsigned int)(pc+opnd - codePtr->codeStart)));
		} else {
		    TRACE(("%d => %.20s true\n", pcAdjustment, O2S(valuePtr)));
		}
		NEXT_INST_F(opnd, 1, 0);
	    } else {
		if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
		    TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
		} else {
		    opnd = pcAdjustment;
		    TRACE(("%d => %.20s false, new pc %u\n", opnd, O2S(valuePtr),
		            (unsigned int)(pc + opnd - codePtr->codeStart)));
		}
		NEXT_INST_F(pcAdjustment, 1, 0);
	    }
#endif
	}
	    	    
    case INST_LOR:
    case INST_LAND:
    {
	/*
	 * Operands must be boolean or numeric. No int->double
	 * conversions are performed.
	 */
		
	int i1, i2;
	int iResult;
	char *s;
	Tcl_ObjType *t1Ptr, *t2Ptr;

	value2Ptr = stackPtr[stackTop];
	valuePtr  = stackPtr[stackTop - 1];;
	t1Ptr = valuePtr->typePtr;
	t2Ptr = value2Ptr->typePtr;

	if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
	    i1 = (valuePtr->internalRep.longValue != 0);
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (t1Ptr == &tclWideIntType) {
	    i1 = (valuePtr->internalRep.wideValue != W0);
#endif /* TCL_WIDE_INT_IS_LONG */
	} else if (t1Ptr == &tclDoubleType) {
	    i1 = (valuePtr->internalRep.doubleValue != 0.0);
	} else {
	    s = Tcl_GetStringFromObj(valuePtr, &length);
	    if (TclLooksLikeInt(s, length)) {
#ifdef TCL_WIDE_INT_IS_LONG
		result