diff options
Diffstat (limited to 'generic/tclExecute.c')
| -rw-r--r-- | generic/tclExecute.c | 974 |
1 files changed, 302 insertions, 672 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7d4f47a..d3bae38 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -107,63 +107,6 @@ long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -190,7 +133,7 @@ typedef struct TEBCdata { esPtr->tosPtr = tosPtr; \ TD->pc = pc; \ TD->cleanup = cleanup; \ - TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ + TclNRAddCallback(interp, ExecuteByteCode, TD, INT2PTR(1),NULL,NULL); \ } while (0) #define TEBC_DATA_DIG() \ @@ -316,11 +259,11 @@ VarHashCreateVar( } while (0) /* - * Macros used to cache often-referenced Tcl evaluation stack information - * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() - * pair must surround any call inside TclNRExecuteByteCode (and a few other - * procedures that use this scheme) that could result in a recursive call - * to TclNRExecuteByteCode. + * Macros used to cache often-referenced Tcl evaluation stack information in + * local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() pair + * must surround any call inside ExecuteByteCode (and a few other procedures + * that use this scheme) that could result in a recursive call to + * ExecuteByteCode. */ #define CACHE_STACK_INFO() \ @@ -342,12 +285,19 @@ VarHashCreateVar( * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT * macro. The actual parameter might be an expression with side effects, and * this ensures that it will be executed only once. + * + * For actually discarding an object from the stack, use POP_DROP_OBJECT(). */ #define PUSH_OBJECT(objPtr) \ Tcl_IncrRefCount(*(++tosPtr) = (objPtr)) #define POP_OBJECT() *(tosPtr--) +#define POP_DROP_OBJECT() \ + do { \ + register Tcl_Obj *discardPtr = POP_OBJECT(); \ + TclDecrRefCount(discardPtr); \ + } while (0) #define OBJ_AT_TOS *tosPtr @@ -690,9 +640,7 @@ static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt); */ #ifdef TCL_COMPILE_STATS -static int EvalStatsCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc EvalStatsCmd; #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName(const unsigned char *pc); @@ -731,8 +679,7 @@ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; - -static Tcl_NRPostProc TEBCresume; +static Tcl_NRPostProc ExecuteByteCode; /* * The structure below defines a bytecode Tcl object type to hold the @@ -2019,13 +1966,13 @@ TclNRExecuteByteCode( * Push the callback for bytecode execution */ - TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0), + TclNRAddCallback(interp, ExecuteByteCode, TD, /*resume*/ INT2PTR(0), NULL, NULL); return TCL_OK; } static int -TEBCresume( +ExecuteByteCode( ClientData data[], Tcl_Interp *interp, int result) @@ -2066,6 +2013,14 @@ TEBCresume( #define LOCAL(i) (&compiledLocals[(i)]) #define TCONST(i) (constants[(i)]) +#define LOCALVAR(varPtr,i) \ + do { \ + register Var *vPtr = LOCAL(i); \ + while (TclIsVarLink(vPtr)) { \ + vPtr = vPtr->value.linkPtr; \ + } \ + (varPtr) = vPtr; \ + } while (0) /* * These macros are just meant to save some global variables that are not @@ -2214,13 +2169,11 @@ TEBCresume( default: cleanup -= 2; while (cleanup--) { - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); } case 2: cleanup2_pushObjResultPtr: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; @@ -2234,17 +2187,14 @@ TEBCresume( default: cleanup -= 2; while (cleanup--) { - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); } case 2: cleanup2: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 1: cleanup1: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 0: /* * We really want to do nothing now, but this is needed for some @@ -2317,12 +2267,12 @@ TEBCresume( TCL_DTRACE_INST_NEXT(); - if (inst == INST_LOAD_SCALAR1) { - goto instLoadScalar1; - } else if (inst == INST_PUSH1) { - PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); - TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS); - inst = *(pc += 2); + if (inst == INST_LOAD_SCALAR) { + goto instLoadScalar; + } else if (inst == INST_PUSH) { + PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]); + TRACE_WITH_OBJ(("%u => ", TclGetInt4AtPtr(pc+1)), OBJ_AT_TOS); + inst = *(pc += 5); goto peepholeStart; } else if (inst == INST_START_CMD) { /* @@ -2492,15 +2442,9 @@ TEBCresume( (void) POP_OBJECT(); goto abnormalReturn; - case INST_PUSH4: - objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; - TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); - NEXT_INST_F(5, 0, 1); - case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); NEXT_INST_F(1, 0, 0); case INST_NOP: @@ -2510,17 +2454,32 @@ TEBCresume( objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); - + case INST_UNDER: + objResultPtr = OBJ_UNDER_TOS; + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(5, 0, 1); - case INST_REVERSE: { + { Tcl_Obj **a, **b; + case INST_EXCH: + TRACE(("\"%.20s\" \"%.20s\" => ", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); + tmpPtr = OBJ_AT_TOS; + OBJ_AT_TOS = OBJ_UNDER_TOS; + OBJ_UNDER_TOS = tmpPtr; + TRACE_APPEND(("\"%.20s\" \"%.20s\"", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); + NEXT_INST_F(1, 0, 0); + + case INST_REVERSE: opnd = TclGetUInt4AtPtr(pc+1); + TRACE(("%u\n", opnd)); a = tosPtr-(opnd-1); b = tosPtr; while (a<b) { @@ -2532,7 +2491,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); } - case INST_CONCAT1: { + case INST_CONCAT: { int appendLen = 0; char *bytes, *p; Tcl_Obj **currPtr; @@ -2800,15 +2759,9 @@ TEBCresume( TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); - case INST_INVOKE_STK4: + case INST_INVOKE_STK: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doInvocation; - - case INST_INVOKE_STK1: - objc = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - doInvocation: objv = &OBJ_AT_DEPTH(objc-1); cleanup = objc; @@ -2855,91 +2808,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else - /* - * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. - */ - - case INST_CALL_BUILTIN_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); - case INST_CALL_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif - case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); @@ -3013,35 +2881,10 @@ TEBCresume( * common execution code. */ - case INST_LOAD_SCALAR1: - instLoadScalar1: - opnd = TclGetUInt1AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - TRACE(("%u => ", opnd)); - if (TclIsVarDirectReadable(varPtr)) { - /* - * 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; - part1Ptr = part2Ptr = NULL; - goto doCallPtrGetVar; - - case INST_LOAD_SCALAR4: + case INST_LOAD_SCALAR: + instLoadScalar: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { /* @@ -3058,22 +2901,11 @@ TEBCresume( part1Ptr = part2Ptr = NULL; goto doCallPtrGetVar; - case INST_LOAD_ARRAY4: + case INST_LOAD_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); - pcAdjustment = 5; - goto doLoadArray; - - case INST_LOAD_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doLoadArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); @@ -3084,7 +2916,7 @@ TEBCresume( objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(pcAdjustment, 1, 1); + NEXT_INST_F(5, 1, 1); } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, @@ -3094,6 +2926,7 @@ TEBCresume( goto gotError; } cleanup = 1; + pcAdjustment = 5; goto doCallPtrGetVar; case INST_LOAD_ARRAY_STK: @@ -3162,24 +2995,15 @@ TEBCresume( { int storeFlags; - case INST_STORE_ARRAY4: + case INST_STORE_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doStoreArrayDirect; - case INST_STORE_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doStoreArrayDirect: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectWritable(varPtr)) { @@ -3194,22 +3018,13 @@ TEBCresume( part1Ptr = NULL; goto doStoreArrayDirectFailed; - case INST_STORE_SCALAR4: + case INST_STORE_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doStoreScalarDirect; - case INST_STORE_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doStoreScalarDirect: valuePtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } if (!TclIsVarDirectWritable(varPtr)) { storeFlags = TCL_LEAVE_ERR_MSG; part1Ptr = NULL; @@ -3300,41 +3115,24 @@ TEBCresume( opnd = -1; goto doCallPtrSetVar; - case INST_LAPPEND_ARRAY4: + case INST_LAPPEND_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreArray; - case INST_LAPPEND_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE - | TCL_LIST_ELEMENT); - goto doStoreArray; - - case INST_APPEND_ARRAY4: + case INST_APPEND_ARRAY: 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; doStoreArray: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } cleanup = 2; part1Ptr = NULL; @@ -3347,39 +3145,22 @@ TEBCresume( } goto doCallPtrSetVar; - case INST_LAPPEND_SCALAR4: + case INST_LAPPEND_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreScalar; - case INST_LAPPEND_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE - | TCL_LIST_ELEMENT); - goto doStoreScalar; - - case INST_APPEND_SCALAR4: + case INST_APPEND_SCALAR: 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; doStoreScalar: valuePtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } cleanup = 1; arrayPtr = NULL; part1Ptr = part2Ptr = NULL; @@ -3421,30 +3202,17 @@ TEBCresume( #endif long increment; - 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); + opnd = TclGetUInt4AtPtr(pc+1); incrPtr = POP_OBJECT(); - switch (*pc) { - case INST_INCR_SCALAR1: - pcAdjustment = 2; - goto doIncrScalar; - case INST_INCR_ARRAY1: - pcAdjustment = 2; - goto doIncrArray; - default: - pcAdjustment = 1; - goto doIncrStk; - } + pcAdjustment = 1; + goto doIncrStk; case INST_INCR_ARRAY_STK_IMM: - case INST_INCR_SCALAR_STK_IMM: case INST_INCR_STK_IMM: increment = TclGetInt1AtPtr(pc+1); - incrPtr = Tcl_NewIntObj(increment); + TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); pcAdjustment = 2; @@ -3474,21 +3242,23 @@ TEBCresume( cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; - case INST_INCR_ARRAY1_IMM: - opnd = TclGetUInt1AtPtr(pc+1); - increment = TclGetInt1AtPtr(pc+2); - incrPtr = Tcl_NewIntObj(increment); + case INST_INCR_ARRAY_IMM: + opnd = TclGetUInt4AtPtr(pc+1); + increment = TclGetInt1AtPtr(pc+5); + TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); - pcAdjustment = 3; + pcAdjustment = 6; + goto doIncrArray; + case INST_INCR_ARRAY: + opnd = TclGetUInt4AtPtr(pc+1); + incrPtr = POP_OBJECT(); + pcAdjustment = 5; doIncrArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); cleanup = 1; - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment)); varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd); @@ -3499,132 +3269,108 @@ TEBCresume( } goto doIncrVar; - case INST_INCR_SCALAR1_IMM: - opnd = TclGetUInt1AtPtr(pc+1); - increment = TclGetInt1AtPtr(pc+2); - pcAdjustment = 3; - cleanup = 0; - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + /* + * This is the most common type of INST_INCR_* as it is the one that + * [incr foo] (of a local variable) is compiled into, where 'foo' + * holds a small integer. Thus we take special effort to make sure + * that it goes faster than many other instructions. + */ + + case INST_INCR_SCALAR_IMM: + opnd = TclGetUInt4AtPtr(pc+1); + increment = TclGetInt1AtPtr(pc+5); + LOCALVAR(varPtr, opnd); if (TclIsVarDirectModifyable(varPtr)) { ClientData ptr; int type; objPtr = varPtr->value.objPtr; - if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { - if (type == TCL_NUMBER_LONG) { - long augend = *((const long *)ptr); - long sum = augend + increment; - - /* - * Overflow when (augend and sum have different sign) and - * (augend and increment have the same sign). This is - * encapsulated in the Overflowing macro. - */ + if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK + && type == TCL_NUMBER_LONG) { + long augend = *((const long *)ptr); + long sum = augend + increment; - if (!Overflowing(augend, increment, sum)) { - TRACE(("%u %ld => ", opnd, increment)); - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared. */ - TclNewLongObj(objResultPtr, sum); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - TclSetLongObj(objPtr, sum); - } - goto doneIncr; - } -#ifndef NO_WIDE_TYPE - w = (Tcl_WideInt)augend; + /* + * Overflow when (augend and sum have different sign) and + * (augend and increment have the same sign). This is + * encapsulated in the Overflowing macro. + */ + if (!Overflowing(augend, increment, sum)) { TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ - objResultPtr = Tcl_NewWideIntObj(w+increment); + TclNewLongObj(objResultPtr, sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; + TclSetLongObj(objPtr, sum); + } + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); +#ifndef TCL_COMPILE_DEBUG + if (*(pc+6) == INST_POP) { + NEXT_INST_F(7, 0, 0); + } +#endif /*!TCL_COMPILE_DEBUG*/ + NEXT_INST_F(6, 0, 1); + } - /* - * We know the sum value is outside the long range; - * use macro form that doesn't range test again. - */ + /* + * If adding a byte to a long won't fit but we've got a + * functional wide integer type defined, we *know* that we'll + * be able to fit in that. (That is, long is 32 bits and wide + * is 64 bits, and our increment is only 8 bits.) + */ - TclSetWideIntObj(objPtr, w+increment); - } - goto doneIncr; -#endif - } /* end if (type == TCL_NUMBER_LONG) */ #ifndef NO_WIDE_TYPE - if (type == TCL_NUMBER_WIDE) { - Tcl_WideInt sum; - - w = *((const Tcl_WideInt *) ptr); - sum = w + increment; + w = (Tcl_WideInt)augend; + + TRACE(("%u %ld => ", opnd, increment)); + if (Tcl_IsShared(objPtr)) { + objPtr->refCount--; /* We know it's shared. */ + TclNewWideIntObj(objResultPtr, w+increment); + Tcl_IncrRefCount(objResultPtr); + varPtr->value.objPtr = objResultPtr; + } else { + objResultPtr = objPtr; /* - * Check for overflow. + * We know the sum value is outside the long range; use + * macro form that doesn't range test again. */ - if (!Overflowing(w, increment, sum)) { - TRACE(("%u %ld => ", opnd, increment)); - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared. */ - objResultPtr = Tcl_NewWideIntObj(sum); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - - /* - * We *do not* know the sum value is outside the - * long range (wide + long can yield long); use - * the function call that checks range. - */ - - Tcl_SetWideIntObj(objPtr, sum); - } - goto doneIncr; - } + TclSetWideIntObj(objPtr, w+increment); } -#endif - } - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared */ - objResultPtr = Tcl_DuplicateObj(objPtr); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - } - TclNewLongObj(incrPtr, increment); - if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { - Tcl_DecrRefCount(incrPtr); - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); - goto gotError; + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); +#ifndef TCL_COMPILE_DEBUG + if (*(pc+6) == INST_POP) { + NEXT_INST_F(7, 0, 0); + } +#endif /*!TCL_COMPILE_DEBUG*/ + NEXT_INST_F(6, 0, 1); +#endif /*!NO_WIDE_TYPE*/ } - Tcl_DecrRefCount(incrPtr); - goto doneIncr; } /* - * All other cases, flow through to generic handling. + * All other cases, flow through to generic handling. Note that we've + * already followed the linked-var chain so we can skip that. */ TclNewLongObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); + pcAdjustment = 6; + cleanup = 0; + goto doIncrScalar; + case INST_INCR_SCALAR: + opnd = TclGetUInt4AtPtr(pc+1); + incrPtr = POP_OBJECT(); + pcAdjustment = 5; + LOCALVAR(varPtr, opnd); doIncrScalar: - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; @@ -3660,7 +3406,6 @@ TEBCresume( goto gotError; } } - doneIncr: TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { @@ -3678,10 +3423,7 @@ TEBCresume( case INST_EXIST_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (ReadTraced(varPtr)) { DECACHE_STACK_INFO(); @@ -3705,10 +3447,7 @@ TEBCresume( case INST_EXIST_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); @@ -3779,10 +3518,7 @@ TEBCresume( case INST_UNSET_SCALAR: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd)); if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { /* @@ -3812,10 +3548,7 @@ TEBCresume( flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%s %u \"%.30s\"\n", (flags ? "normal" : "noerr"), opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) { @@ -3885,29 +3618,6 @@ TEBCresume( CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; - - /* - * This is really an unset operation these days. Do not issue. - */ - - case INST_DICT_DONE: - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u\n", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { - if (!TclIsVarUndefined(varPtr)) { - TclDecrRefCount(varPtr->value.objPtr); - } - varPtr->value.objPtr = NULL; - } else { - DECACHE_STACK_INFO(); - TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); - } - NEXT_INST_F(5, 0, 0); } /* @@ -3923,10 +3633,7 @@ TEBCresume( part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); goto doArrayExists; case INST_ARRAY_EXISTS_STK: opnd = -1; @@ -3950,11 +3657,8 @@ TEBCresume( goto gotError; } } - if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { - objResultPtr = TCONST(1); - } else { - objResultPtr = TCONST(0); - } + objResultPtr = TCONST((varPtr && TclIsVarArray(varPtr) + && !TclIsVarUndefined(varPtr)) ? 1 : 0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); @@ -3965,10 +3669,7 @@ TEBCresume( part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); goto doArrayMake; case INST_ARRAY_MAKE_STK: opnd = -1; @@ -4087,7 +3788,7 @@ TEBCresume( */ opnd = TclGetInt4AtPtr(pc+1);; - varPtr = LOCAL(opnd); + varPtr = LOCAL(opnd); /* Not LOCALVAR()! */ if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { @@ -4130,13 +3831,7 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_JUMP1: - opnd = TclGetInt1AtPtr(pc+1); - TRACE(("%d => new pc %u\n", opnd, - (unsigned)(pc + opnd - codePtr->codeStart))); - NEXT_INST_F(opnd, 0, 0); - - case INST_JUMP4: + case INST_JUMP: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); @@ -4147,24 +3842,14 @@ TEBCresume( /* TODO: consider rewrite so we don't compute the offset we're not * going to take. */ - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */ jmpOffset[1] = 5; /* TRUE offset */ goto doCondJump; - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: jmpOffset[0] = 5; jmpOffset[1] = TclGetInt4AtPtr(pc+1); - goto doCondJump; - - case INST_JUMP_FALSE1: - jmpOffset[0] = TclGetInt1AtPtr(pc+1); - jmpOffset[1] = 2; - goto doCondJump; - - case INST_JUMP_TRUE1: - jmpOffset[0] = 2; - jmpOffset[1] = TclGetInt1AtPtr(pc+1); doCondJump: valuePtr = OBJ_AT_TOS; @@ -4172,15 +3857,15 @@ TEBCresume( /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) { - TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[ - ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) - ? 0 : 1]), Tcl_GetObjResult(interp)); + TRACE_WITH_OBJ(("%d => ERROR: ", + jmpOffset[(*pc == INST_JUMP_FALSE) ? 0 : 1]), + Tcl_GetObjResult(interp)); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (b) { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { + if (*pc == INST_JUMP_TRUE) { TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr), (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); @@ -4188,7 +3873,7 @@ TEBCresume( TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr))); } } else { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { + if (*pc == INST_JUMP_TRUE) { TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr))); } else { TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], @@ -4405,8 +4090,7 @@ TEBCresume( */ { - int index, numIndices, fromIdx, toIdx; - int nocase, match, length2, cflags, s1len, s2len; + int index, fromIdx, toIdx, numIndices, match, s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -4678,7 +4362,7 @@ TEBCresume( * list type. */ - List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1; + List *listPtr = ListRepPtr(valuePtr); if (listPtr->refCount == 1) { TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), @@ -4752,18 +4436,15 @@ TEBCresume( pc++; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif objResultPtr = TCONST(match); NEXT_INST_F(0, 2, 1); + } /* * End of INST_LIST and related instructions. @@ -4771,6 +4452,11 @@ TEBCresume( * Start of string-related instructions. */ + { + int index, fromIdx, toIdx, nocase, match; + int length2, cflags, s1len, s2len; + const char *s1, *s2; + case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ case INST_STR_CMP: /* String compare. */ @@ -4861,43 +4547,39 @@ TEBCresume( } /* - * Make sure only -1,0,1 is returned - * TODO: consider peephole opt. + * Make sure only -1,0,1 is returned. */ - if (*pc != INST_STR_CMP) { - /* - * Take care of the opcodes that goto'ed into here. - */ - - switch (*pc) { - case INST_STR_EQ: - case INST_EQ: - match = (match == 0); - break; - case INST_STR_NEQ: - case INST_NEQ: - match = (match != 0); - break; - case INST_LT: - match = (match < 0); - break; - case INST_GT: - match = (match > 0); - break; - case INST_LE: - match = (match <= 0); - break; - case INST_GE: - match = (match >= 0); - break; + switch (*pc) { + case INST_STR_CMP: + if (match < 0) { + TclNewIntObj(objResultPtr, -1); + } else { + objResultPtr = TCONST(match > 0); } - } - if (match < 0) { - TclNewIntObj(objResultPtr, -1); - } else { + break; + case INST_STR_EQ: + case INST_EQ: + objResultPtr = TCONST(match == 0); + break; + case INST_STR_NEQ: + case INST_NEQ: + objResultPtr = TCONST(match != 0); + break; + case INST_LT: + objResultPtr = TCONST(match < 0); + break; + case INST_GT: objResultPtr = TCONST(match > 0); + break; + case INST_LE: + objResultPtr = TCONST(match <= 0); + break; + case INST_GE: + objResultPtr = TCONST(match >= 0); + break; } + TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -4971,7 +4653,8 @@ TEBCresume( TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); - NEXT_INST_V(1, 3, 1); + POP_DROP_OBJECT(); + NEXT_INST_F(1, 2, 1); case INST_STR_RANGE_IMM: valuePtr = OBJ_AT_TOS; @@ -5016,35 +4699,34 @@ TEBCresume( Tcl_Obj *value3Ptr; case INST_STR_MAP: - valuePtr = OBJ_AT_TOS; /* "Main" string. */ - value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ - value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */ + valuePtr = POP_OBJECT(); /* "Main" string. */ + value3Ptr = OBJ_AT_TOS; /* "Target" string. */ + value2Ptr = OBJ_UNDER_TOS; /* "Source" string. */ if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); - objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + length; @@ -5070,14 +4752,15 @@ TEBCresume( Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } + doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); - NEXT_INST_V(1, 3, 1); + TclDecrRefCount(valuePtr); + NEXT_INST_F(1, 2, 1); case INST_STR_FIND: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ - match = -1; if (length2 > 0 && length2 <= length) { end = ustring1 + length - length2 + 1; @@ -5089,17 +4772,14 @@ TEBCresume( } } } - TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ - match = -1; if (length2 > 0 && length2 <= length) { for (p=ustring1+length-length2 ; p>=ustring1 ; p--) { @@ -5110,10 +4790,8 @@ TEBCresume( } } } - TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); } @@ -5161,13 +4839,9 @@ TEBCresume( pc += 2; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5190,9 +4864,7 @@ TEBCresume( if (regExpr == NULL) { goto regexpFailure; } - match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0); - if (match < 0) { regexpFailure: #ifdef TCL_COMPILE_DEBUG @@ -5214,13 +4886,9 @@ TEBCresume( pc += 2; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5326,13 +4994,9 @@ TEBCresume( pc++; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5947,7 +5611,7 @@ TEBCresume( int varIndex, valIndex, continueLoop, j, iterTmpIndex; long i; - case INST_FOREACH_START4: + case INST_FOREACH_START: /* * Initialize the temporary local var that holds the count of the * number of iterations of the loop body to -1. @@ -5956,7 +5620,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; iterTmpIndex = infoPtr->loopCtTemp; - iterVarPtr = LOCAL(iterTmpIndex); + LOCALVAR(iterVarPtr, iterTmpIndex); oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { @@ -5980,7 +5644,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); #endif - case INST_FOREACH_STEP4: + case INST_FOREACH_STEP: /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. @@ -5994,7 +5658,7 @@ TEBCresume( * Increment the temp holding the loop iteration number. */ - iterVarPtr = LOCAL(infoPtr->loopCtTemp); + LOCALVAR(iterVarPtr, infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; iterNum = valuePtr->internalRep.longValue + 1; TclSetLongObj(valuePtr, iterNum); @@ -6010,7 +5674,7 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; - listVarPtr = LOCAL(listTmpIndex); + LOCALVAR(listVarPtr, listTmpIndex); listPtr = listVarPtr->value.objPtr; if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ", @@ -6038,7 +5702,7 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; - listVarPtr = LOCAL(listTmpIndex); + LOCALVAR(listVarPtr, listTmpIndex); listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); TclListObjGetElements(interp, listPtr, &listLen, &elements); @@ -6051,10 +5715,7 @@ TEBCresume( } varIndex = varListPtr->varIndexes[j]; - varPtr = LOCAL(varIndex); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, varIndex); if (TclIsVarDirectWritable(varPtr)) { value2Ptr = varPtr->value.objPtr; if (valuePtr != value2Ptr) { @@ -6093,14 +5754,10 @@ TEBCresume( */ pc += 5; - if (*pc == INST_JUMP_FALSE1) { - NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - } else { - NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - } + NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); } - case INST_BEGIN_CATCH4: + case INST_BEGIN_CATCH: /* * Record start of the catch command with exception range index equal * to the operand. Push the current stack depth onto the special catch @@ -6157,9 +5814,9 @@ TEBCresume( Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!"); } if (code < TCL_ERROR || code > TCL_CONTINUE) { - code = TCL_CONTINUE + 1; + NEXT_INST_F(21, 1, 0); } - NEXT_INST_F(2*code -1, 1, 0); + NEXT_INST_F(5*code -4, 1, 0); } /* @@ -6213,11 +5870,12 @@ TEBCresume( &objResultPtr) == TCL_OK) { if (*pc == INST_DICT_EXISTS) { objResultPtr = TCONST(objResultPtr ? 1 : 0); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(5, opnd+1, 1); } if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (opnd == 1) { + NEXT_INST_F(5, 2, 1); + } NEXT_INST_V(5, opnd+1, 1); } DECACHE_STACK_INFO(); @@ -6233,6 +5891,9 @@ TEBCresume( dictNotExists: objResultPtr = TCONST(0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (opnd == 1) { + NEXT_INST_F(5, 2, 1); + } NEXT_INST_V(5, opnd+1, 1); } TRACE_WITH_OBJ(( @@ -6248,10 +5909,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd2); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd2); TRACE(("%u %u => ", opnd, opnd2)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6283,10 +5941,10 @@ TEBCresume( if (result != TCL_OK) { break; } + TclNewIntObj(value2Ptr, opnd); if (valuePtr == NULL) { - Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd)); + Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, value2Ptr); } else { - value2Ptr = Tcl_NewIntObj(opnd); Tcl_IncrRefCount(value2Ptr); if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); @@ -6341,21 +5999,24 @@ TEBCresume( goto gotError; } } + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG if (*(pc+9) == INST_POP) { + if (cleanup == 2) { + NEXT_INST_F(10, 2, 0); + } NEXT_INST_V(10, cleanup, 0); } #endif - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (cleanup == 2) { + NEXT_INST_F(9, 2, 1); + } NEXT_INST_V(9, cleanup, 1); case INST_DICT_APPEND: case INST_DICT_LAPPEND: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6499,7 +6160,7 @@ TEBCresume( statePtr->typePtr = &dictIteratorType; statePtr->internalRep.twoPtrValue.ptr1 = searchPtr; statePtr->internalRep.twoPtrValue.ptr2 = dictPtr; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr == &dictIteratorType) { Tcl_Panic("mis-issued dictFirst!"); @@ -6513,7 +6174,8 @@ TEBCresume( case INST_DICT_NEXT: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); - statePtr = (*LOCAL(opnd)).value.objPtr; + LOCALVAR(varPtr, opnd); + statePtr = varPtr->value.objPtr; if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) { Tcl_Panic("mis-issued dictNext!"); } @@ -6539,13 +6201,9 @@ TEBCresume( pc += 5; switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0); default: pc -= 5; @@ -6556,17 +6214,13 @@ TEBCresume( TRACE_APPEND(("\"%.30s\" \"%.30s\" %d", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); objResultPtr = TCONST(done); - /* TODO: consider opt like INST_FOREACH_STEP4 */ NEXT_INST_F(5, 0, 1); case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6591,10 +6245,7 @@ TEBCresume( &valuePtr) != TCL_OK) { goto gotError; } - varPtr = LOCAL(duiPtr->varIndices[i]); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, duiPtr->varIndices[i]); DECACHE_STACK_INFO(); if (valuePtr == NULL) { TclObjUnsetVar2(interp, @@ -6613,11 +6264,8 @@ TEBCresume( case INST_DICT_UPDATE_END: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6642,11 +6290,9 @@ TEBCresume( TclInvalidateStringRep(dictPtr); } for (i=0 ; i<length ; i++) { - Var *var2Ptr = LOCAL(duiPtr->varIndices[i]); + Var *var2Ptr; - while (TclIsVarLink(var2Ptr)) { - var2Ptr = var2Ptr->value.linkPtr; - } + LOCALVAR(var2Ptr, duiPtr->varIndices[i]); if (TclIsVarDirectReadable(var2Ptr)) { valuePtr = var2Ptr->value.objPtr; } else { @@ -6733,16 +6379,13 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); listPtr = OBJ_UNDER_TOS; keysPtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; } - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd, objc, objv, keysPtr); @@ -6785,11 +6428,7 @@ TEBCresume( processExceptionReturn: #if TCL_COMPILE_DEBUG switch (*pc) { - case INST_INVOKE_STK1: - opnd = TclGetUInt1AtPtr(pc+1); - TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); - break; - case INST_INVOKE_STK4: + case INST_INVOKE_STK: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); break; @@ -6817,8 +6456,7 @@ TEBCresume( goto processCatch; } while (cleanup--) { - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); + POP_DROP_OBJECT(); } if (result == TCL_BREAK) { result = TCL_OK; @@ -6994,8 +6632,7 @@ TEBCresume( processCatch: while (CURR_DEPTH > *catchTop) { - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); + POP_DROP_OBJECT(); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { @@ -7032,8 +6669,7 @@ TEBCresume( POP_TAUX_OBJ(); } while (tosPtr > initTosPtr) { - objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); + POP_DROP_OBJECT(); } if (tosPtr < initTosPtr) { @@ -7066,30 +6702,30 @@ TEBCresume( * case INST_START_CMD: */ - instStartCmdFailed: - { - const char *bytes; - - checkInterp = 1; - length = 0; + instStartCmdFailed: + { + const char *bytes; - /* - * We used to switch to direct eval; for NRE-awareness we now - * compile and eval the command so that this evaluation does not - * add a new TEBC instance. [Bug 2910748] - */ + checkInterp = 1; + length = 0; - if (TclInterpReady(interp) == TCL_ERROR) { - goto gotError; - } + /* + * We used to switch to direct eval; for NRE-awareness we now compile + * and eval the command so that this evaluation does not add a new + * TEBC instance. [Bug 2910748] + */ - codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); - opnd = TclGetUInt4AtPtr(pc+1); - pc += (opnd-1); - PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); - goto instEvalStk; + if (TclInterpReady(interp) == TCL_ERROR) { + goto gotError; } + + codePtr->flags |= TCL_BYTECODE_RECOMPILE; + bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); + opnd = TclGetUInt4AtPtr(pc+1); + pc += (opnd-1); + PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + goto instEvalStk; + } } #undef codePtr @@ -8461,7 +8097,6 @@ TclCompareTwoNumbers( } } -#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -8480,6 +8115,7 @@ TclCompareTwoNumbers( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_DEBUG static void PrintByteCodeInfo( register ByteCode *codePtr) /* The bytecode whose summary is printed to @@ -8634,16 +8270,7 @@ IllegalExprOperandType( } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -8654,7 +8281,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, operator)); + "can't use %s \"%s\" as operand of \"%s\"", description, + Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } @@ -9021,7 +8649,6 @@ TclExprFloatError( } } -#ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * @@ -9040,6 +8667,7 @@ TclExprFloatError( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_STATS int TclLog2( register int value) /* The integer for which to compute the log @@ -9054,6 +8682,7 @@ TclLog2( } return result; } +#endif /* TCL_COMPILE_STATS */ /* *---------------------------------------------------------------------- @@ -9072,6 +8701,7 @@ TclLog2( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_STATS static int EvalStatsCmd( ClientData unused, /* Unused. */ @@ -9476,7 +9106,6 @@ EvalStatsCmd( } #endif /* TCL_COMPILE_STATS */ -#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -9498,6 +9127,7 @@ EvalStatsCmd( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_DEBUG static const char * StringForResultCode( int result) /* The Tcl result code for which to generate a |