diff options
author | hobbs <hobbs> | 1999-12-12 02:26:40 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-12-12 02:26:40 (GMT) |
commit | 9d5c1c3ab0220165e8761184bf18b03a0018c0e8 (patch) | |
tree | a0669e049fc8824bf3b37835e2244bac6c56a8d8 /generic/tclExecute.c | |
parent | 5f809539e37de57ab0461f54c17db348eac6e0dd (diff) | |
download | tcl-9d5c1c3ab0220165e8761184bf18b03a0018c0e8.zip tcl-9d5c1c3ab0220165e8761184bf18b03a0018c0e8.tar.gz tcl-9d5c1c3ab0220165e8761184bf18b03a0018c0e8.tar.bz2 |
* tests/var.test:
* generic/tclCompile.c: fixed problem where setting to {} array
would intermittently not work. (Fontaine) [Bug: 3339]
* generic/tclCmdMZ.c:
* generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to
recognize boolean objects. (Spjuth) [Bug: 2815]
* tests/info.test:
* tests/parseOld.test:
* generic/tclCmdAH.c:
* generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and
Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg
case as well, to take advantage of potential pure list input
optimization. This means that it won't get byte compiled though,
which should be acceptable.
* generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in
the TCL_EVAL_DIRECT case for efficiency.
* generic/tclUtil.c: made Tcl_ConcatObj pure list object aware,
and return a list object in that case [Bug: 2098 2257]
* generic/tclMain.c: changed Tcl_Main to not constantly reuse the
commandPtr object (interactive case) as it could be shared. (Fellows)
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 87 |
1 files changed, 52 insertions, 35 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 5262f6b..1affb53 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.8 1999/12/04 06:15:41 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.9 1999/12/12 02:26:42 hobbs Exp $ */ #include "tclInt.h" @@ -2311,20 +2311,25 @@ TclExecuteByteCode(interp, codePtr) tPtr = valuePtr->typePtr; if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + if ((tPtr == &tclBooleanType) + && (valuePtr->bytes == NULL)) { + valuePtr->typePtr = &tclIntType; } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d); - } - if (result != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", - s, (tPtr? tPtr->name : "null"))); - IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); - goto checkForCatch; + char *s = Tcl_GetStringFromObj(valuePtr, &length); + if (TclLooksLikeInt(s, length)) { + result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, + valuePtr, &i); + } else { + result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, + valuePtr, &d); + } + if (result != TCL_OK) { + TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", + s, (tPtr? tPtr->name : "null"))); + IllegalExprOperandType(interp, pc, valuePtr); + Tcl_DecrRefCount(valuePtr); + goto checkForCatch; + } } tPtr = valuePtr->typePtr; } @@ -2495,18 +2500,24 @@ TclExecuteByteCode(interp, codePtr) converted = 0; if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { - s = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d); - } - if (result == TCL_OK) { + if ((tPtr == &tclBooleanType) + && (valuePtr->bytes == NULL)) { + valuePtr->typePtr = &tclIntType; converted = 1; + } else { + s = Tcl_GetStringFromObj(valuePtr, &length); + if (TclLooksLikeInt(s, length)) { + result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, + valuePtr, &i); + } else { + result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, + valuePtr, &d); + } + if (result == TCL_OK) { + converted = 1; + } + result = TCL_OK; /* reset the result variable */ } - result = TCL_OK; /* reset the result variable */ tPtr = valuePtr->typePtr; } @@ -2525,18 +2536,24 @@ TclExecuteByteCode(interp, codePtr) shared = 0; if (Tcl_IsShared(valuePtr)) { shared = 1; - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - objPtr = Tcl_NewLongObj(i); - } else { - d = valuePtr->internalRep.doubleValue; - objPtr = Tcl_NewDoubleObj(d); + if (valuePtr->bytes != NULL) { + /* + * We only need to make a copy of the object + * when it already had a string rep + */ + if (tPtr == &tclIntType) { + i = valuePtr->internalRep.longValue; + objPtr = Tcl_NewLongObj(i); + } else { + d = valuePtr->internalRep.doubleValue; + objPtr = Tcl_NewDoubleObj(d); + } + Tcl_IncrRefCount(objPtr); + TclDecrRefCount(valuePtr); + valuePtr = objPtr; + stackPtr[stackTop] = valuePtr; + tPtr = valuePtr->typePtr; } - Tcl_IncrRefCount(objPtr); - TclDecrRefCount(valuePtr); - valuePtr = objPtr; - stackPtr[stackTop] = valuePtr; - tPtr = valuePtr->typePtr; } else { Tcl_InvalidateStringRep(valuePtr); } |