diff options
author | Kevin B Kenny <kennykb@acm.org> | 2010-10-02 16:04:29 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2010-10-02 16:04:29 (GMT) |
commit | 845f29c25c98e563d2887cbfcf16f1963ecc20bb (patch) | |
tree | 5f620de3f16a930ef11d1d791e3100d4b9983e9a /generic | |
parent | 7761e7d99c2161de375c85db2076faef03f286e8 (diff) | |
download | tcl-845f29c25c98e563d2887cbfcf16f1963ecc20bb.zip tcl-845f29c25c98e563d2887cbfcf16f1963ecc20bb.tar.gz tcl-845f29c25c98e563d2887cbfcf16f1963ecc20bb.tar.bz2 |
* generic/tclAssembly.c:
* generic/tclAssembly.h:
* tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
dictSet, dictUnset, nsupvar, upvar, and variable. (Still need tests
for the last three.)
Merged changes from HEAD.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclAssembly.c | 58 | ||||
-rw-r--r-- | generic/tclAssembly.h | 10 | ||||
-rw-r--r-- | generic/tclExecute.c | 25 | ||||
-rw-r--r-- | generic/tclObj.c | 51 |
4 files changed, 129 insertions, 15 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 94b1ff8..8232551 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -102,7 +102,21 @@ TalInstDesc TalInstructionTable[] = { {"bitor", ASSEM_1BYTE , INST_BITOR , 2 , 1}, {"bitxor", ASSEM_1BYTE , INST_BITXOR , 2 , 1}, {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, + {"dictAppend", + ASSEM_LVT4, INST_DICT_APPEND, + 2, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, + {"dictIncrImm", + ASSEM_SINT4_LVT4, + INST_DICT_INCR_IMM, + 1, 1}, + {"dictLappend", + ASSEM_LVT4, INST_DICT_LAPPEND, + 2, 1}, + {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1}, + {"dictUnset", + ASSEM_DICT_UNSET, + INST_DICT_UNSET,INT_MIN,1}, {"div", ASSEM_1BYTE, INST_DIV, 2, 1}, {"dup", ASSEM_1BYTE , INST_DUP , 1 , 2}, {"eq", ASSEM_1BYTE , INST_EQ , 2 , 1}, @@ -215,6 +229,7 @@ TalInstDesc TalInstructionTable[] = { {"mult", ASSEM_1BYTE , INST_MULT , 2 , 1}, {"neq", ASSEM_1BYTE , INST_NEQ , 2 , 1}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, + {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}. {"over", ASSEM_OVER, INST_OVER, INT_MIN, -1-1}, {"pop", ASSEM_1BYTE , INST_POP , 1 , 0}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN, -1-0}, @@ -258,6 +273,8 @@ TalInstDesc TalInstructionTable[] = { {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, + {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}. + {"variable",ASSEM_LVT4, INST_VARIABLE, 2, 1}. {NULL, 0, 0,0} }; @@ -1032,6 +1049,34 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1); break; + case ASSEM_DICT_SET: + if (parsePtr->numWords != 3) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || CheckStrictlyPositive(interp, opnd) != TCL_OK + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1); + TclEmitInt4(localVar, envPtr); + break; + + case ASSEM_DICT_UNSET: + if (parsePtr->numWords != 3) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || CheckStrictlyPositive(interp, opnd) != TCL_OK + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + TclEmitInt4(localVar, envPtr); + break; + case ASSEM_EVAL: /* TODO - Refactor this stuff into a subroutine * that takes the inst code, the message ("script" or "expression") @@ -1287,6 +1332,19 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0); break; + case ASSEM_SINT4_LVT4: + if (parsePtr->numWords != 3) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0); + TclEmitInt4(localVar, envPtr); + break; + default: Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n", Tcl_GetString(instNameObj)); diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h index 0c8cd61..7f1a36e 100644 --- a/generic/tclAssembly.h +++ b/generic/tclAssembly.h @@ -49,7 +49,12 @@ typedef enum TalInstType { ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must be * strictly positive, consumes N, produces 1 */ ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 operands, - * produces 1, N >= 0 */ + * produces 1, N > 0 */ + ASSEM_DICT_SET, /* specifies key count and LVT index, consumes N+1 operands, + * produces 1, N > 0 */ + ASSEM_DICT_UNSET, + /* specifies key count and LVT index, consumes N operands, + * produces 1, N > 0 */ ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it * in line with the assembly code! I love Tcl!) */ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */ @@ -74,6 +79,9 @@ typedef enum TalInstType { ASSEM_PUSH, /* one literal operand */ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, produces N */ ASSEM_SINT1, /* One 1-byte signed-integer operand (INCR_STK_IMM) */ + ASSEM_SINT4_LVT4, + /* Signed 4-byte integer operand followed by LVT entry. + * Fixed arity */ } TalInstType; /* Description of an instruction recognized by the assembler. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6f3701c..3f7c420 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,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.494.2.4 2010/10/02 01:38:27 kennykb Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.494.2.5 2010/10/02 16:04:29 kennykb Exp $ */ #include "tclInt.h" @@ -5768,6 +5768,16 @@ TEBCresume( Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr); } else { Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS); + + /* + * Must invalidate the string representation of dictionary + * here because we have directly updated the internal + * representation; if we don't, callers could see the wrong + * string rep despite the internal version of the dictionary + * having the correct value. [Bug 3079830] + */ + + TclInvalidateStringRep(dictPtr); } break; case INST_DICT_LAPPEND: @@ -5798,6 +5808,16 @@ TEBCresume( } goto gotError; } + + /* + * Must invalidate the string representation of dictionary + * here because we have directly updated the internal + * representation; if we don't, callers could see the wrong + * string rep despite the internal version of the dictionary + * having the correct value. [Bug 3079830] + */ + + TclInvalidateStringRep(dictPtr); } break; default: @@ -6021,6 +6041,9 @@ TEBCresume( if (allocdict) { dictPtr = Tcl_DuplicateObj(dictPtr); } + if (length > 0) { + TclInvalidateStringRep(dictPtr); + } for (i=0 ; i<length ; i++) { Var *var2Ptr = LOCAL(duiPtr->varIndices[i]); diff --git a/generic/tclObj.c b/generic/tclObj.c index 24a29a5..3161a46 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.174.2.2 2010/10/01 13:34:09 kennykb Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.174.2.3 2010/10/02 16:04:29 kennykb Exp $ */ #include "tclInt.h" @@ -55,9 +55,9 @@ char *tclEmptyStringRep = &tclEmptyString; #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) /* - * Structure for tracking the source file and line number where a given Tcl_Obj - * was allocated. We also track the pointer to the Tcl_Obj itself, for sanity - * checking purposes. + * Structure for tracking the source file and line number where a given + * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself, + * for sanity checking purposes. */ typedef struct ObjData { @@ -1486,7 +1486,7 @@ TclFreeObj( } } } -#endif +#endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- @@ -1512,7 +1512,6 @@ TclObjBeingDeleted( { return (objPtr->length == -1); } - /* *---------------------------------------------------------------------- @@ -1706,7 +1705,6 @@ Tcl_InvalidateStringRep( { TclInvalidateStringRep(objPtr); } - /* *---------------------------------------------------------------------- @@ -3259,7 +3257,7 @@ UpdateStringOfBignum( Tcl_Panic("conversion failure in UpdateStringOfBignum"); } objPtr->bytes = stringVal; - objPtr->length = size - 1; /* size includes a trailing null byte */ + objPtr->length = size - 1; /* size includes a trailing NUL byte. */ } /* @@ -3566,6 +3564,24 @@ Tcl_SetBignumObj( TclSetBignumIntRep(objPtr, bignumValue); } +/* + *---------------------------------------------------------------------- + * + * TclSetBignumIntRep -- + * + * Install a bignum into the internal representation of an object. + * + * Results: + * None. + * + * Side effects: + * Object internal representation is updated and object type is set. The + * bignum value is cleared, since ownership has transferred to the + * object. + * + *---------------------------------------------------------------------- + */ + void TclSetBignumIntRep( Tcl_Obj *objPtr, @@ -3576,8 +3592,9 @@ TclSetBignumIntRep( /* * Clear the mp_int value. - * Don't call mp_clear() because it would free the digit array - * we just packed into the Tcl_Obj. + * + * Don't call mp_clear() because it would free the digit array we just + * packed into the Tcl_Obj. */ bignumValue->dp = NULL; @@ -3590,9 +3607,17 @@ TclSetBignumIntRep( * * TclGetNumberFromObj -- * + * Extracts a number (of any possible numeric type) from an object. + * * Results: + * Whether the extraction worked. The type is stored in the variable + * referred to by the typePtr argument, and a pointer to the + * representation is stored in the variable referred to by the + * clientDataPtr. * * Side effects: + * Can allocate thread-specific data for handling the copy-out space for + * bignums; this space is shared within a thread. * *---------------------------------------------------------------------- */ @@ -3611,18 +3636,18 @@ TclGetNumberFromObj( } else { *typePtr = TCL_NUMBER_DOUBLE; } - *clientDataPtr = &(objPtr->internalRep.doubleValue); + *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { *typePtr = TCL_NUMBER_LONG; - *clientDataPtr = &(objPtr->internalRep.longValue); + *clientDataPtr = &objPtr->internalRep.longValue; return TCL_OK; } #ifndef NO_WIDE_TYPE if (objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; - *clientDataPtr = &(objPtr->internalRep.wideValue); + *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } #endif |