diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2002-07-17 10:36:21 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2002-07-17 10:36:21 (GMT) |
commit | 239854b80c97ffda9f1300635a18bfb1350c1e53 (patch) | |
tree | 4d1cb86aa902e81bdefccdaf0a4fd9875459360e /generic/tclExecute.c | |
parent | c5f54ca90775a8e1f51e53d2a87a5898b613a90f (diff) | |
download | tcl-239854b80c97ffda9f1300635a18bfb1350c1e53.zip tcl-239854b80c97ffda9f1300635a18bfb1350c1e53.tar.gz tcl-239854b80c97ffda9f1300635a18bfb1350c1e53.tar.bz2 |
variable access optimisations
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 650 |
1 files changed, 410 insertions, 240 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 024509e..c7538b5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.77 2002/07/16 01:12:50 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.78 2002/07/17 10:36:22 msofer Exp $ */ #include "tclInt.h" @@ -174,14 +174,14 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #define NEXT_INST_V(pcAdjustment, nCleanup, result) \ pc += (pcAdjustment);\ + cleanup = (nCleanup);\ if (result) {\ if ((result) > 0) {\ Tcl_IncrRefCount(objResultPtr);\ }\ - cleanup = (nCleanup);\ goto cleanupV_pushObjResultPtr;\ } else {\ - panic("ERROR: bad usage of macro NEXT_INST_V");\ + goto cleanupV;\ } @@ -1054,15 +1054,19 @@ TclExecuteByteCode(interp, codePtr) int traceInstructions = (tclTraceExec == 3); char cmdNameBuf[21]; #endif - Tcl_Obj *valuePtr, *value2Ptr, *objPtr, *elemPtr; + Tcl_Obj *valuePtr, *value2Ptr, *objPtr; char *bytes; int length; long i = 0; /* Init. avoids compiler warning. */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; #endif - int cleanup; + register int cleanup; Tcl_Obj *objResultPtr; +// + char *part1, *part2; + Var *varPtr, *arrayPtr; + CallFrame *varFramePtr = iPtr->varFramePtr; /* * This procedure uses a stack to hold information about catch commands. @@ -1127,6 +1131,9 @@ TclExecuteByteCode(interp, codePtr) cleanupV_pushObjResultPtr: switch (cleanup) { + case 0: + PUSH_OBJECT(objResultPtr); + goto cleanup0; default: cleanup -= 2; while (cleanup--) { @@ -1145,13 +1152,24 @@ TclExecuteByteCode(interp, codePtr) stackPtr[stackTop] = objResultPtr; goto cleanup0; - cleanup2: - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); - - cleanup1: - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); + cleanupV: + switch (cleanup) { + default: + cleanup -= 2; + while (cleanup--) { + valuePtr = POP_OBJECT(); + TclDecrRefCount(valuePtr); + } + case 2: + cleanup2: + valuePtr = POP_OBJECT(); + TclDecrRefCount(valuePtr); + case 1: + cleanup1: + valuePtr = POP_OBJECT(); + TclDecrRefCount(valuePtr); + case 0: + } cleanup0: @@ -1420,66 +1438,93 @@ TclExecuteByteCode(interp, codePtr) 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); - DECACHE_STACK_INFO(); - objResultPtr = TclGetIndexedScalar(interp, opnd, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u => ERROR: ", opnd), - Tcl_GetObjResult(interp)); - result = TCL_ERROR; - goto checkForCatch; + varPtr = &(varFramePtr->compiledLocals[opnd]); + part1 = varPtr->name; + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; } - TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); - NEXT_INST_F(2, 0, 1); + if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) + && (varPtr->tracePtr == NULL)) { + /* + * No errors, no traces: just get the value. + */ + objResultPtr = varPtr->value.objPtr; + TRACE_WITH_OBJ(("%u => ", opnd), 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); - DECACHE_STACK_INFO(); - objResultPtr = TclGetIndexedScalar(interp, opnd, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u => ERROR: ", opnd), Tcl_GetObjResult(interp)); - result = TCL_ERROR; - goto checkForCatch; + varPtr = &(varFramePtr->compiledLocals[opnd]); + part1 = varPtr->name; + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; } - TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); - NEXT_INST_F(5, 0, 1); + if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) + && (varPtr->tracePtr == NULL)) { + /* + * No errors, no traces: just get the value. + */ + objResultPtr = varPtr->value.objPtr; + TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); + NEXT_INST_F(5, 0, 1); + } + pcAdjustment = 5; + cleanup = 0; + arrayPtr = NULL; + part2 = NULL; + goto doCallPtrGetVar; case INST_LOAD_ARRAY_STK: - elemPtr = stackPtr[stackTop]; /* element name */ + cleanup = 2; + part2 = Tcl_GetString(stackPtr[stackTop]); /* element name */ objPtr = stackPtr[stackTop-1]; /* array name */ goto doLoadStk; case INST_LOAD_STK: case INST_LOAD_SCALAR_STK: - elemPtr = NULL; + cleanup = 1; + part2 = NULL; objPtr = stackPtr[stackTop]; /* variable name */ doLoadStk: - DECACHE_STACK_INFO(); - objResultPtr = Tcl_ObjGetVar2(interp, objPtr, elemPtr, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ERROR: ", - O2S(objPtr), O2S(elemPtr)), Tcl_GetObjResult(interp)); - } else { - TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), - Tcl_GetObjResult(interp)); - } + part1 = TclGetString(objPtr); + varPtr = TclObjLookupVar(interp, objPtr, part2, + TCL_LEAVE_ERR_MSG, "read", + /*createPart1*/ 0, + /*createPart2*/ 1, &arrayPtr); + if (varPtr == NULL) { result = TCL_ERROR; goto checkForCatch; } - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ", - O2S(objPtr), O2S(elemPtr)), objResultPtr); - NEXT_INST_F(1, 2, 1); - } else { - TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), objResultPtr); - NEXT_INST_F(1, 1, 1); + 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; + NEXT_INST_V(1, cleanup, 1); } + pcAdjustment = 1; + goto doCallPtrGetVar; case INST_LOAD_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); @@ -1489,147 +1534,115 @@ TclExecuteByteCode(interp, codePtr) case INST_LOAD_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); pcAdjustment = 2; - + doLoadArray: - elemPtr = stackPtr[stackTop]; - - DECACHE_STACK_INFO(); - objResultPtr = TclGetElementOfIndexedArray(interp, opnd, - elemPtr, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ", - opnd, O2S(elemPtr)), Tcl_GetObjResult(interp)); + part2 = TclGetString(stackPtr[stackTop]); + arrayPtr = &(varFramePtr->compiledLocals[opnd]); + part1 = arrayPtr->name; + while (TclIsVarLink(arrayPtr)) { + arrayPtr = arrayPtr->value.linkPtr; + } + varPtr = TclLookupArrayElement(interp, part1, part2, + TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr); + if (varPtr == NULL) { result = TCL_ERROR; goto checkForCatch; } - TRACE_WITH_OBJ(("%u \"%.30s\" => ", - opnd, O2S(elemPtr)), objResultPtr); - NEXT_INST_F(pcAdjustment, 1, 1); - - 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; + 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; + NEXT_INST_F(pcAdjustment, 1, 1); + } + cleanup = 1; + goto doCallPtrGetVar; - case INST_STORE_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = TCL_LEAVE_ERR_MSG; + doCallPtrGetVar: + /* + * There are either errors or the variable is traced: + * call TclPtrGetVar to process fully. + */ - doStoreScalar: - valuePtr = stackPtr[stackTop]; DECACHE_STACK_INFO(); - objResultPtr = TclSetIndexedScalar(interp, opnd, valuePtr, storeFlags); + objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, + part2, TCL_LEAVE_ERR_MSG); CACHE_STACK_INFO(); if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ", - opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); result = TCL_ERROR; goto checkForCatch; } - TRACE_WITH_OBJ(("%u <- \"%.30s\" => ", - opnd, O2S(valuePtr)), objResultPtr); + NEXT_INST_V(pcAdjustment, cleanup, 1); - if (*(pc+pcAdjustment) == INST_POP) { - NEXT_INST_F((pcAdjustment+1), 1, 0); - } - NEXT_INST_F(pcAdjustment, 1, 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 */ - elemPtr = NULL; + 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 */ - elemPtr = stackPtr[stackTop - 1]; + 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 */ - elemPtr = NULL; + part2 = NULL; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_APPEND_ARRAY_STK: valuePtr = stackPtr[stackTop]; /* value to append */ - elemPtr = stackPtr[stackTop - 1]; + part2 = TclGetString(stackPtr[stackTop - 1]); storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_STORE_ARRAY_STK: valuePtr = stackPtr[stackTop]; - elemPtr = stackPtr[stackTop - 1]; + part2 = TclGetString(stackPtr[stackTop - 1]); storeFlags = TCL_LEAVE_ERR_MSG; goto doStoreStk; case INST_STORE_STK: case INST_STORE_SCALAR_STK: valuePtr = stackPtr[stackTop]; - elemPtr = NULL; + part2 = NULL; storeFlags = TCL_LEAVE_ERR_MSG; doStoreStk: - objPtr = stackPtr[stackTop - 1 - (elemPtr != NULL)]; /* variable name */ - DECACHE_STACK_INFO(); - objResultPtr = Tcl_ObjSetVar2(interp, objPtr, elemPtr, valuePtr, storeFlags); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ", - O2S(objPtr), O2S(elemPtr), O2S(valuePtr)), - Tcl_GetObjResult(interp)); - } else { - TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ", - O2S(objPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - } + objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */ + part1 = TclGetString(objPtr); + varPtr = TclObjLookupVar(interp, objPtr, part2, + TCL_LEAVE_ERR_MSG, "set", + /*createPart1*/ 1, + /*createPart2*/ 1, &arrayPtr); + if (varPtr == NULL) { result = TCL_ERROR; goto checkForCatch; } - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ", - O2S(objPtr), O2S(elemPtr), O2S(objResultPtr)), objResultPtr); - NEXT_INST_V(1, 3, 1); - } else { - TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ", - O2S(objPtr), O2S(valuePtr)), objResultPtr); - if (*(pc+1) == INST_POP) { - NEXT_INST_F(2, 2, 0); - } - NEXT_INST_F(1, 2, 1); - } + cleanup = ((part2 == NULL)? 2 : 3); + pcAdjustment = 1; + goto doCallPtrSetVar; case INST_LAPPEND_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); @@ -1670,35 +1683,128 @@ TclExecuteByteCode(interp, codePtr) doStoreArray: valuePtr = stackPtr[stackTop]; - elemPtr = stackPtr[stackTop - 1]; - DECACHE_STACK_INFO(); - objResultPtr = TclSetElementOfIndexedArray(interp, opnd, - elemPtr, valuePtr, storeFlags); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ERROR: ", - opnd, O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); + part2 = TclGetString(stackPtr[stackTop - 1]); + arrayPtr = &(varFramePtr->compiledLocals[opnd]); + part1 = arrayPtr->name; + while (TclIsVarLink(arrayPtr)) { + arrayPtr = arrayPtr->value.linkPtr; + } + varPtr = TclLookupArrayElement(interp, part1, part2, + TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr); + if (varPtr == NULL) { result = TCL_ERROR; goto checkForCatch; } - TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ", - opnd, O2S(elemPtr), O2S(valuePtr)), objResultPtr); + 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; + 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); + } + if (*(pc+pcAdjustment) == INST_POP) { + NEXT_INST_V((pcAdjustment+1), cleanup, 0); + } + 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) { + result = TCL_ERROR; + goto checkForCatch; + } + } if (*(pc+pcAdjustment) == INST_POP) { - NEXT_INST_F((pcAdjustment+1), 2, 0); + NEXT_INST_V((pcAdjustment+1), cleanup, 0); } - NEXT_INST_F(pcAdjustment, 2, 1); + NEXT_INST_V(pcAdjustment, cleanup, 1); - case INST_LIST: - /* - * Pop the opnd (objc) top stack elements into a new list obj - * and then decrement their ref counts. - */ - opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)])); - TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); - NEXT_INST_V(5, opnd, 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: @@ -1736,26 +1842,32 @@ TclExecuteByteCode(interp, codePtr) goto doIncrStk; } - case INST_INCR_SCALAR1_IMM: - opnd = TclGetUInt1AtPtr(pc+1); - i = TclGetInt1AtPtr(pc+2); - pcAdjustment = 3; - - doIncrScalar: - DECACHE_STACK_INFO(); - objResultPtr = TclIncrIndexedScalar(interp, opnd, i); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u %ld => ERROR: ", opnd, i), Tcl_GetObjResult(interp)); + 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]; + } else { + part2 = NULL; + objPtr = stackPtr[stackTop]; + } + 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); result = TCL_ERROR; goto checkForCatch; } - TRACE_WITH_OBJ(("%u %ld => ", opnd, i), objResultPtr); - - if (*(pc+pcAdjustment) == INST_POP) { - NEXT_INST_F((pcAdjustment+1), 0, 0); - } - NEXT_INST_F(pcAdjustment, 0, 1); + cleanup = ((part2 == NULL)? 1 : 2); + goto doIncrVar; case INST_INCR_ARRAY1_IMM: opnd = TclGetUInt1AtPtr(pc+1); @@ -1763,66 +1875,82 @@ TclExecuteByteCode(interp, codePtr) pcAdjustment = 3; doIncrArray: - elemPtr = stackPtr[stackTop]; - DECACHE_STACK_INFO(); - objResultPtr = TclIncrElementOfIndexedArray(interp, opnd, elemPtr, i); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ", - opnd, O2S(elemPtr), i), Tcl_GetObjResult(interp)); + part2 = TclGetString(stackPtr[stackTop]); + arrayPtr = &(varFramePtr->compiledLocals[opnd]); + part1 = arrayPtr->name; + while (TclIsVarLink(arrayPtr)) { + arrayPtr = arrayPtr->value.linkPtr; + } + varPtr = TclLookupArrayElement(interp, part1, part2, + TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr); + if (varPtr == NULL) { + Tcl_AddObjErrorInfo(interp, + "\n (reading value of variable to increment)", -1); result = TCL_ERROR; goto checkForCatch; } - TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ", - opnd, O2S(elemPtr), i), objResultPtr); + cleanup = 1; + goto doIncrVar; - if (*(pc+pcAdjustment) == INST_POP) { - NEXT_INST_F((pcAdjustment+1), 1, 0); - } - NEXT_INST_F(pcAdjustment, 1, 1); - - 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)) { - elemPtr = stackPtr[stackTop]; - objPtr = stackPtr[stackTop - 1]; - } else { - elemPtr = NULL; - objPtr = stackPtr[stackTop]; + 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; } - DECACHE_STACK_INFO(); - objResultPtr = TclIncrVar2(interp, objPtr, elemPtr, i, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (objResultPtr == NULL) { - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ", - O2S(objPtr), O2S(elemPtr), i), Tcl_GetObjResult(interp)); + arrayPtr = NULL; + part2 = NULL; + cleanup = 0; + + 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 { - TRACE_WITH_OBJ(("\"%.30s\" %ld => ERROR: ", - O2S(objPtr), i), Tcl_GetObjResult(interp)); + Tcl_SetLongObj(objPtr, i); + objResultPtr = objPtr; } - result = TCL_ERROR; - goto checkForCatch; - } - if (elemPtr != NULL) { - TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ", - O2S(objPtr), O2S(elemPtr), i), objResultPtr); - NEXT_INST_F(pcAdjustment, 2, 1); } else { - TRACE_WITH_OBJ(("\"%.30s\" %ld => ", O2S(objPtr), i), objResultPtr); - NEXT_INST_F(pcAdjustment, 1, 1); + DECACHE_STACK_INFO(); + objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1, + part2, i, TCL_LEAVE_ERR_MSG); + CACHE_STACK_INFO(); + if (objResultPtr == NULL) { + result = TCL_ERROR; + goto checkForCatch; + } } - + if (*(pc+pcAdjustment) == INST_POP) { + NEXT_INST_V((pcAdjustment+1), cleanup, 0); + } + NEXT_INST_V(pcAdjustment, cleanup, 1); + /* - * END INCR INSTRUCTIONS + * End of INST_INCR instructions. + * --------------------------------------------------------- */ + case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, @@ -2006,6 +2134,22 @@ TclExecuteByteCode(interp, codePtr) } } + /* + * --------------------------------------------------------- + * Start of INST_LIST and related instructions. + */ + + case INST_LIST: + /* + * Pop the opnd (objc) top stack elements into a new list obj + * and then decrement their ref counts. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)])); + TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); + NEXT_INST_V(5, opnd, 1); + case INST_LIST_LENGTH: valuePtr = stackPtr[stackTop]; @@ -2166,6 +2310,11 @@ TclExecuteByteCode(interp, codePtr) TRACE(("=> %s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, -1); + /* + * End of INST_LIST and related instructions. + * --------------------------------------------------------- + */ + case INST_STR_EQ: case INST_STR_NEQ: { @@ -3679,19 +3828,40 @@ TclExecuteByteCode(interp, codePtr) } varIndex = varListPtr->varIndexes[j]; - DECACHE_STACK_INFO(); - value2Ptr = TclSetIndexedScalar(interp, - varIndex, valuePtr, TCL_LEAVE_ERR_MSG); - CACHE_STACK_INFO(); - if (value2Ptr == NULL) { - TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ", - opnd, varIndex), - Tcl_GetObjResult(interp)); - if (setEmptyStr) { - TclDecrRefCount(valuePtr); + varPtr = &(varFramePtr->compiledLocals[varIndex]); + part1 = varPtr->name; + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) + && (varPtr->tracePtr == NULL) + && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) { + value2Ptr = varPtr->value.objPtr; + if (valuePtr != value2Ptr) { + if (value2Ptr != NULL) { + TclDecrRefCount(value2Ptr); + } else { + TclSetVarScalar(varPtr); + TclClearVarUndefined(varPtr); + } + varPtr->value.objPtr = valuePtr; + Tcl_IncrRefCount(valuePtr); + } + } else { + DECACHE_STACK_INFO(); + value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, + NULL, valuePtr, TCL_LEAVE_ERR_MSG); + CACHE_STACK_INFO(); + if (value2Ptr == NULL) { + TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ", + opnd, varIndex), + Tcl_GetObjResult(interp)); + if (setEmptyStr) { + TclDecrRefCount(valuePtr); + } + result = TCL_ERROR; + goto checkForCatch; } - result = TCL_ERROR; - goto checkForCatch; } valIndex++; } |