diff options
| -rw-r--r-- | ChangeLog | 17 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 214 | ||||
| -rw-r--r-- | generic/tclCompile.c | 44 | ||||
| -rw-r--r-- | generic/tclCompile.h | 35 | ||||
| -rw-r--r-- | generic/tclExecute.c | 49 | ||||
| -rw-r--r-- | tests/dict.test | 18 |
6 files changed, 304 insertions, 73 deletions
@@ -1,3 +1,18 @@ +2007-03-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tclCompile.c (TclPrintInstruction): Added a scheme to allow + * generic/tclCompile.h (AuxDataPrintProc): aux-data to be printed + * generic/tclCompCmds.c (Print*Info): out for debugging. For + this to work, immediate operands referring to aux-data must be + identified as such in the instruction descriptor table using + OPERAND_AUX4 (all are always 4 bytes). + + * generic/tclExecute.c (TclExecuteByteCode): Rewrote the compiled + * generic/tclCompCmds.c (TclCompileDictCmd): [dict update] so that it + * generic/tclCompile.h (DictUpdateInfo): stores critical + * tests/dict.test (dict-21.{14,15}): non-varying data in an + aux-data value instead of a (shimmerable) literal. + 2007-03-01 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdIL.c (Tcl_LinsertObjCmd): Code simplifications @@ -15,7 +30,7 @@ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Rewrite to make an efficient private copy of the list argument, so we can operate on the - list elements directly with no fear of shimmering effects. Replaces + list elements directly with no fear of shimmering effects. Replaces defensive coding schemes that are otherwise required. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Rewrite to make diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c0721fa..8ceb0b9 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.101 2007/03/01 10:07:12 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.102 2007/03/02 10:32:11 dkf Exp $ */ #include "tclInt.h" @@ -128,10 +128,18 @@ * Prototypes for procedures defined later in this file: */ +static ClientData DupDictUpdateInfo(ClientData clientData); +static void FreeDictUpdateInfo(ClientData clientData); +static void PrintDictUpdateInfo(ClientData clientData, + ByteCode *codePtr, unsigned int pcOffset); static ClientData DupForeachInfo(ClientData clientData); static void FreeForeachInfo(ClientData clientData); +static void PrintForeachInfo(ClientData clientData, + ByteCode *codePtr, unsigned int pcOffset); static ClientData DupJumptableInfo(ClientData clientData); static void FreeJumptableInfo(ClientData clientData); +static void PrintJumptableInfo(ClientData clientData, + ByteCode *codePtr, unsigned int pcOffset); static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -163,13 +171,22 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp, AuxDataType tclForeachInfoType = { "ForeachInfo", /* name */ DupForeachInfo, /* dupProc */ - FreeForeachInfo /* freeProc */ + FreeForeachInfo, /* freeProc */ + PrintForeachInfo /* printProc */ }; AuxDataType tclJumptableInfoType = { "JumptableInfo", /* name */ DupJumptableInfo, /* dupProc */ - FreeJumptableInfo /* freeProc */ + FreeJumptableInfo, /* freeProc */ + PrintJumptableInfo /* printProc */ +}; + +AuxDataType tclDictUpdateInfoType = { + "DictUpdateInfo", /* name */ + DupDictUpdateInfo, /* dupProc */ + FreeDictUpdateInfo, /* freeProc */ + PrintDictUpdateInfo /* printProc */ }; /* @@ -890,9 +907,9 @@ TclCompileDictCmd( return TCL_OK; } else if (size==6 && strncmp(cmd, "update", 6)==0) { const char *name; - int nameChars, dictIndex, keyTmpIndex, numVars, range; + int nameChars, dictIndex, keyTmpIndex, numVars, range, infoIndex; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr; - Tcl_DString localVarsLiteral; + DictUpdateInfo *duiPtr; /* * Parse the command. Expect the following: @@ -915,35 +932,32 @@ TclCompileDictCmd( dictIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR, procPtr); - Tcl_DStringInit(&localVarsLiteral); + duiPtr = (DictUpdateInfo *) + ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); + duiPtr->length = numVars; keyTokenPtrs = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; i<numVars ; i++) { keyTokenPtrs[i] = tokenPtr; tokenPtr = TokenAfter(tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) duiPtr); ckfree((char *) keyTokenPtrs); return TCL_ERROR; } name = tokenPtr[1].start; nameChars = tokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) duiPtr); ckfree((char *) keyTokenPtrs); return TCL_ERROR; - } else { - int localVar = TclFindCompiledLocal(name, nameChars, 1, - VAR_SCALAR, procPtr); - char buf[12]; - - sprintf(buf, "%d", localVar); - Tcl_DStringAppendElement(&localVarsLiteral, buf); } + duiPtr->varIndices[i] = TclFindCompiledLocal(name, nameChars, 1, + VAR_SCALAR, procPtr); tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) duiPtr); ckfree((char *) keyTokenPtrs); return TCL_ERROR; } @@ -951,14 +965,21 @@ TclCompileDictCmd( keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr); + /* + * The list of variables to bind is stored in auxiliary data so that + * it can't be snagged by literal sharing and forced to shimmer + * dangerously. + */ + + infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); + for (i=0 ; i<numVars ; i++) { CompileWord(envPtr, keyTokenPtrs[i], interp, i); } TclEmitInstInt4( INST_LIST, numVars, envPtr); TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr); - PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral), - Tcl_DStringLength(&localVarsLiteral)); TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); @@ -974,19 +995,21 @@ TclCompileDictCmd( envPtr->exceptDepth--; TclEmitInstInt4( INST_LOAD_SCALAR4, keyTmpIndex, envPtr); - PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral), - Tcl_DStringLength(&localVarsLiteral)); /* - * Any literal would do, but this one is handy... + * Now remove the contents of the temporary key variable so that the + * reference counts of the keys end up correct. Unsetting the variable + * would be better, but there's no opcode for that. */ + PushLiteral(envPtr, "", 0); TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_RETURN_STK, envPtr); - Tcl_DStringFree(&localVarsLiteral); ckfree((char *) keyTokenPtrs); return TCL_OK; } else if (size==6 && strncmp(cmd, "append", 6) == 0) { @@ -1060,6 +1083,65 @@ TclCompileDictCmd( /* *---------------------------------------------------------------------- * + * DupDictUpdateInfo, FreeDictUpdateInfo -- + * + * Functions to duplicate, release and print the aux data created for use + * with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions. + * + * Results: + * DupDictUpdateInfo: a copy of the auxiliary data + * FreeDictUpdateInfo: none + * PrintDictUpdateInfo: none + * + * Side effects: + * DupDictUpdateInfo: allocates memory + * FreeDictUpdateInfo: releases memory + * PrintDictUpdateInfo: none + * + *---------------------------------------------------------------------- + */ + +static ClientData +DupDictUpdateInfo( + ClientData clientData) +{ + DictUpdateInfo *dui1Ptr, *dui2Ptr; + unsigned len; + + dui1Ptr = clientData; + len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1); + dui2Ptr = (DictUpdateInfo *) ckalloc(len); + memcpy(dui2Ptr, dui1Ptr, len); + return dui2Ptr; +} + +static void +FreeDictUpdateInfo( + ClientData clientData) +{ + ckfree(clientData); +} + +static void +PrintDictUpdateInfo( + ClientData clientData, + ByteCode *codePtr, + unsigned int pcOffset) +{ + DictUpdateInfo *duiPtr = clientData; + int i; + + for (i=0 ; i<duiPtr->length ; i++) { + if (i) { + fprintf(stdout, ", "); + } + fprintf(stdout, "%%v%u", duiPtr->varIndices[i]); + } +} + +/* + *---------------------------------------------------------------------- + * * TclCompileExprCmd -- * * Procedure called to compile the "expr" command. @@ -1683,6 +1765,59 @@ FreeForeachInfo( /* *---------------------------------------------------------------------- * + * PrintForeachInfo -- + * + * Function to write a human-readable representation of a ForeachInfo + * structure to stdout for debugging. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +PrintForeachInfo( + ClientData clientData, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register ForeachInfo *infoPtr = clientData; + register ForeachVarList *varsPtr; + int i, j; + + fprintf(stdout, "data=["); + + for (i=0 ; i<infoPtr->numLists ; i++) { + if (i) { + fprintf(stdout, ", "); + } + fprintf(stdout, "%%v%u", (unsigned) (infoPtr->firstValueTemp + i)); + } + fprintf(stdout, "], loop=%%v%u", (unsigned) infoPtr->loopCtTemp); + for (i=0 ; i<infoPtr->numLists ; i++) { + if (i) { + fprintf(stdout, ","); + } + fprintf(stdout, "\n\t\t it%%v%u\t[", + (unsigned) (infoPtr->firstValueTemp + i)); + varsPtr = infoPtr->varLists[i]; + for (j=0 ; j<varsPtr->numVars ; j++) { + if (j) { + fprintf(stdout, ", "); + } + fprintf(stdout, "%%v%u", (unsigned) varsPtr->varIndexes[j]); + } + fprintf(stdout, "]"); + } +} + +/* + *---------------------------------------------------------------------- + * * TclCompileIfCmd -- * * Procedure called to compile the "if" command. @@ -4097,16 +4232,18 @@ TclCompileSwitchCmd( * * DupJumptableInfo, FreeJumptableInfo -- * - * Functions to duplicate and release a jump-table created for use with - * the INST_JUMP_TABLE instruction. + * Functions to duplicate, release and print a jump-table created for use + * with the INST_JUMP_TABLE instruction. * * Results: * DupJumptableInfo: a copy of the jump-table * FreeJumptableInfo: none + * PrintJumptableInfo: none * * Side effects: * DupJumptableInfo: allocates memory * FreeJumptableInfo: releases memory + * PrintJumptableInfo: none * *---------------------------------------------------------------------- */ @@ -4141,6 +4278,33 @@ FreeJumptableInfo( Tcl_DeleteHashTable(&jtPtr->hashTable); ckfree((char *) jtPtr); } + +static void +PrintJumptableInfo( + ClientData clientData, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register JumptableInfo *jtPtr = clientData; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + const char *keyPtr; + int offset, i = 0; + + hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); + for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { + keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); + offset = (int) Tcl_GetHashValue(hPtr); + + if (i++) { + fprintf(stdout, ", "); + if (i%4==0) { + fprintf(stdout, "\n\t\t"); + } + } + fprintf(stdout, "\"%s\"->pc %d", keyPtr, pcOffset + offset); + } +} /* *---------------------------------------------------------------------- diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 8509b60..02e23c7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.107 2007/02/20 23:24:02 nijtmans Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.108 2007/03/02 10:32:12 dkf Exp $ */ #include "tclInt.h" @@ -196,10 +196,10 @@ InstructionDesc tclInstructionTable[] = { /* Skip to next iteration of closest enclosing loop; if none, return * TCL_CONTINUE code. */ - {"foreach_start4", 5, 0, 1, {OPERAND_UINT4}}, + {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, /* Initialize execution of a foreach loop. Operand is aux data index * of the ForeachInfo structure for the foreach command. */ - {"foreach_step4", 5, +1, 1, {OPERAND_UINT4}}, + {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}}, /* "Step" or begin next iteration of foreach loop. Push 0 if to * terminate loop, else push 1. */ @@ -350,19 +350,21 @@ InstructionDesc tclInstructionTable[] = { * Stack: ... => ... value key doneBool */ {"dictDone", 5, 0, 1, {OPERAND_LVT4}}, /* Terminate the iterator in op4's local scalar. */ - {"dictUpdateStart", 5, -2, 1, {OPERAND_LVT4}}, - /* Create the variables to mirror the state of the dictionary in the - * variable referred to by the immediate argument. - * Stack: ... keyList LVTindexList => ... - * Note that the list of LVT indices is assumed to be the same length - * as the keyList, and the indices should be only ever generated by the - * compiler. */ - {"dictUpdateEnd", 5, -2, 1, {OPERAND_LVT4}}, - /* Reflect the state of local variables back to the state of the - * dictionary in the variable referred to by the immediate argument. - * Stack: ... keyList LVTindexList => ... - * Same notes as in "dictUpdateStart" apply here. */ - {"jumpTable", 5, -1, 1, {OPERAND_UINT4}}, + {"dictUpdateStart", 5, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}}, + /* Create the variables (described in the aux data referred to by the + * second immediate argument) to mirror the state of the dictionary in + * the variable referred to by the first immediate argument. The list + * of keys (popped from the stack) must be the same length as the list + * of variables. + * Stack: ... keyList => ... */ + {"dictUpdateEnd", 5, -1, 1, {OPERAND_LVT4, OPERAND_AUX4}}, + /* Reflect the state of local variables (described in the aux data + * referred to by the second immediate argument) back to the state of + * the dictionary in the variable referred to by the first immediate + * argument. The list of keys (popped from the stack) must be the same + * length as the list of variables. + * Stack: ... keyList => ... */ + {"jumpTable", 5, -1, 1, {OPERAND_AUX4}}, /* Jump according to the jump-table (in AuxData as indicated by the * operand) and the argument popped from the list. Always executes the * next instruction if no match against the table's entries was found. @@ -3641,6 +3643,7 @@ TclPrintInstruction( * and immediates. */ char *suffixSrc = NULL; Tcl_Obj *suffixObj = NULL; + AuxData *auxPtr = NULL; suffixBuffer[0] = '\0'; fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name); @@ -3669,6 +3672,7 @@ TclPrintInstruction( } fprintf(stdout, "%u ", (unsigned int) opnd); break; + case OPERAND_AUX4: case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_PUSH4) { @@ -3677,6 +3681,9 @@ TclPrintInstruction( sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd); } fprintf(stdout, "%u ", (unsigned int) opnd); + if (instDesc->opTypes[i] == OPERAND_AUX4) { + auxPtr = &codePtr->auxDataArrayPtr[opnd]; + } break; case OPERAND_IDX4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; @@ -3728,6 +3735,11 @@ TclPrintInstruction( } } fprintf(stdout, "\n"); + if (auxPtr && auxPtr->type->printProc) { + fprintf(stdout, "\t\t["); + auxPtr->type->printProc(auxPtr->clientData, codePtr, pcOffset); + fprintf(stdout, "]\n"); + } return numBytes; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index cba0888..b5ad0ba 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.68 2007/01/19 14:06:10 dkf Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.69 2007/03/02 10:32:12 dkf Exp $ */ #ifndef _TCLCOMPILATION @@ -16,6 +16,8 @@ #include "tclInt.h" +struct ByteCode; /* Forward declaration. */ + /* *------------------------------------------------------------------------ * Variables related to compilation. These are used in tclCompile.c, @@ -157,6 +159,8 @@ typedef struct ExtCmdLoc { typedef ClientData (AuxDataDupProc) (ClientData clientData); typedef void (AuxDataFreeProc) (ClientData clientData); +typedef void (AuxDataPrintProc)(ClientData clientData, + struct ByteCode *codePtr, unsigned int pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -177,6 +181,9 @@ typedef struct AuxDataType { AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux * data is freed. NULL means no proc need be * called. */ + AuxDataPrintProc *printProc;/* Callback function to invoke when printing + * the aux data as part of debugging. NULL + * means that the data can't be printed. */ } AuxDataType; /* @@ -281,8 +288,8 @@ typedef struct CompileEnv { AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; /* Initial storage for aux data array. */ /* TIP #280 */ - ExtCmdLoc *extCmdMapPtr; /* Extended command location information - * for 'info frame'. */ + ExtCmdLoc *extCmdMapPtr; /* Extended command location information for + * 'info frame'. */ int line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ @@ -631,8 +638,10 @@ typedef enum InstOperandType { * integer, but displayed differently.) */ OPERAND_LVT1, /* One byte unsigned index into the local * variable table. */ - OPERAND_LVT4 /* Four byte unsigned index into the local + OPERAND_LVT4, /* Four byte unsigned index into the local * variable table. */ + OPERAND_AUX4, /* Four byte unsigned index into the aux data + * table. */ } InstOperandType; typedef struct InstructionDesc { @@ -754,6 +763,24 @@ typedef struct JumptableInfo { MODULE_SCOPE AuxDataType tclJumptableInfoType; /* + * Structure used to hold information about a [dict update] command that is + * needed during program execution. These structures are stored in CompileEnv + * and ByteCode structures as auxiliary data. + */ + +typedef struct { + int length; /* Size of array */ + int varIndices[1]; /* Array of variable indices to manage when + * processing the start and end of a [dict + * update]. There is really more than one + * entry, and the structure is allocated to + * take account of this. MUST BE LAST FIELD IN + * STRUCTURE. */ +} DictUpdateInfo; + +MODULE_SCOPE AuxDataType tclDictUpdateInfoType; + +/* * ClientData type used by the math operator commands. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 94207b3..c64f171 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,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.259 2007/02/20 23:24:03 nijtmans Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.260 2007/03/02 10:32:12 dkf Exp $ */ #include "tclInt.h" @@ -5786,14 +5786,17 @@ TclExecuteByteCode( } { - int opnd, i, length, length2, allocdict; - Tcl_Obj **keyPtrPtr, **varIdxPtrPtr, *dictPtr; + int opnd, opnd2, i, length, allocdict; + Tcl_Obj **keyPtrPtr, *dictPtr; + DictUpdateInfo *duiPtr; Var *varPtr; char *part1; case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); + opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = &(compiledLocals[opnd]); + duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -5810,25 +5813,21 @@ TclExecuteByteCode( goto dictUpdateStartFailed; } } - if (Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length, - &keyPtrPtr) != TCL_OK || - Tcl_ListObjGetElements(interp, *tosPtr, &length2, - &varIdxPtrPtr) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, *tosPtr, &length, + &keyPtrPtr) != TCL_OK) { goto dictUpdateStartFailed; } - if (length != length2) { + if (length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; i<length ; i++) { Tcl_Obj *valPtr; - int varIdx; if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i], &valPtr) != TCL_OK) { goto dictUpdateStartFailed; } - Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx); - varPtr = &(compiledLocals[varIdx]); + varPtr = &(compiledLocals[duiPtr->varIndices[i]]); part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -5840,17 +5839,19 @@ TclExecuteByteCode( valPtr, TCL_LEAVE_ERR_MSG) == NULL) { CACHE_STACK_INFO(); dictUpdateStartFailed: - cleanup = 2; + cleanup = 1; result = TCL_ERROR; goto checkForCatch; } CACHE_STACK_INFO(); } - NEXT_INST_F(5, 2, 0); + NEXT_INST_F(9, 1, 0); case INST_DICT_UPDATE_END: opnd = TclGetUInt4AtPtr(pc+1); + opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = &(compiledLocals[opnd]); + duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -5864,14 +5865,12 @@ TclExecuteByteCode( CACHE_STACK_INFO(); } if (dictPtr == NULL) { - NEXT_INST_F(5, 2, 0); - } - if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK || - Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length, - &keyPtrPtr) != TCL_OK || - Tcl_ListObjGetElements(interp, *tosPtr, &length2, - &varIdxPtrPtr) != TCL_OK) { - cleanup = 2; + NEXT_INST_F(9, 1, 0); + } + if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK + || Tcl_ListObjGetElements(interp, *tosPtr, &length, + &keyPtrPtr) != TCL_OK) { + cleanup = 1; result = TCL_ERROR; goto checkForCatch; } @@ -5881,12 +5880,10 @@ TclExecuteByteCode( } for (i=0 ; i<length ; i++) { Tcl_Obj *valPtr; - int varIdx; Var *var2Ptr; char *part1a; - Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx); - var2Ptr = &(compiledLocals[varIdx]); + var2Ptr = &(compiledLocals[duiPtr->varIndices[i]]); part1a = var2Ptr->name; while (TclIsVarLink(var2Ptr)) { var2Ptr = var2Ptr->value.linkPtr; @@ -5922,7 +5919,7 @@ TclExecuteByteCode( goto checkForCatch; } } - NEXT_INST_F(5, 2, 0); + NEXT_INST_F(9, 1, 0); } default: @@ -6302,7 +6299,7 @@ ValidatePcAndStackTop( if (checkStack && ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) { int numChars; - char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars); + const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars); fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)", stackTop, relativePc, stackLowerBound, stackUpperBound); diff --git a/tests/dict.test b/tests/dict.test index cf9fc1f..c6e8987 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.19 2006/08/09 13:51:02 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.20 2007/03/02 10:32:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1042,6 +1042,22 @@ test dict-21.13 {dict update command: compilation} { } getOrder [dicttest {a 1 c 2}] b c } {b 1 c 2 2} +test dict-21.14 {dict update command: compilation} { + proc dicttest x { + set indices {2 3} + trace add variable aa write "string length \$indices ;#" + dict update x k aa l bb {} + } + dicttest {k 1 l 2} +} {} +test dict-21.15 {dict update command: compilation} { + proc dicttest x { + set indices {2 3} + trace add variable aa read "string length \$indices ;#" + dict update x k aa l bb {} + } + dicttest {k 1 l 2} +} {} test dict-22.1 {dict with command} -body { dict with |