summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2010-10-02 16:04:29 (GMT)
committerKevin B Kenny <kennykb@acm.org>2010-10-02 16:04:29 (GMT)
commit845f29c25c98e563d2887cbfcf16f1963ecc20bb (patch)
tree5f620de3f16a930ef11d1d791e3100d4b9983e9a /generic
parent7761e7d99c2161de375c85db2076faef03f286e8 (diff)
downloadtcl-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.c58
-rw-r--r--generic/tclAssembly.h10
-rw-r--r--generic/tclExecute.c25
-rw-r--r--generic/tclObj.c51
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