summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c1611
1 files changed, 425 insertions, 1186 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fafd511..717ebf6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -34,14 +34,14 @@
#endif
/*
- * A mask (should be 2**n-1) that is used to work out when the bytecode engine
- * should call Tcl_AsyncReady() to see whether there is a signal that needs
- * handling.
+ * A counter that is used to work out when the bytecode engine should call
+ * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
+ * other expensive periodic operations.
*/
-#ifndef ASYNC_CHECK_COUNT_MASK
-# define ASYNC_CHECK_COUNT_MASK 63
-#endif /* !ASYNC_CHECK_COUNT_MASK */
+#ifndef ASYNC_CHECK_COUNT
+# define ASYNC_CHECK_COUNT 64
+#endif /* !ASYNC_CHECK_COUNT */
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -498,29 +498,9 @@ VarHashCreateVar(
* ClientData *ptrPtr, int *tPtr);
*/
-#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
- ? (*(tPtr) = TCL_NUMBER_LONG, \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.longValue)), TCL_OK) : \
- ((objPtr)->typePtr == &tclDoubleType) \
- ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
- ? (*(tPtr) = TCL_NUMBER_NAN) \
- : (*(tPtr) = TCL_NUMBER_DOUBLE)), \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
- (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
- TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#else /* !TCL_WIDE_INT_IS_LONG */
-#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? (*(tPtr) = TCL_NUMBER_LONG, \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.longValue)), TCL_OK) : \
- ((objPtr)->typePtr == &tclWideIntType) \
- ? (*(tPtr) = TCL_NUMBER_WIDE, \
+ ? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclDoubleType) \
@@ -530,23 +510,8 @@ VarHashCreateVar(
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ ? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#endif /* TCL_WIDE_INT_IS_LONG */
-
-/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- * int *boolPtr);
- */
-
-#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
- ((((objPtr)->typePtr == &tclIntType) \
- || ((objPtr)->typePtr == &tclBooleanType)) \
- ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
- : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
/*
* Macro used to make the check for type overflow more mnemonic. This works by
@@ -576,40 +541,6 @@ VarHashCreateVar(
* Auxiliary tables used to compute powers of small integers.
*/
-#if (LONG_MAX == 0x7fffffff)
-
-/*
- * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit
- * signed integer.
- */
-
-static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
-static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);
-
-/*
- * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they
- * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of
- * powers of i+3; Exp32Value[i] gives the corresponding powers.
- */
-
-static const unsigned short Exp32Index[] = {
- 0, 11, 18, 23, 26, 29, 31, 32, 33
-};
-static const size_t Exp32IndexSize =
- sizeof(Exp32Index) / sizeof(unsigned short);
-static const long Exp32Value[] = {
- 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721,
- 129140163, 387420489, 1162261467, 262144, 1048576, 4194304,
- 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625,
- 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056,
- 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489,
- 1000000000
-};
-static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long);
-#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */
-
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
-
/*
* Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
* Tcl_WideInt.
@@ -713,7 +644,6 @@ static const Tcl_WideInt Exp64Value[] = {
(Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
-#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */
/*
* Markers for ExecuteExtendedBinaryMathOp.
@@ -744,8 +674,6 @@ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void DeleteExecStack(ExecStack *esPtr);
static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
-MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
- Tcl_Obj *value2Ptr);
static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
int opcode, Tcl_Obj **constants,
Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
@@ -820,20 +748,22 @@ ReleaseDictIterator(
{
Tcl_DictSearch *searchPtr;
Tcl_Obj *dictPtr;
+ const Tcl_ObjIntRep *irPtr;
+
+ irPtr = TclFetchIntRep(objPtr, &dictIteratorType);
+ assert(irPtr != NULL);
/*
* First kill the search, and then release the reference to the dictionary
* that we were holding.
*/
- searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ searchPtr = irPtr->twoPtrValue.ptr1;
Tcl_DictObjDone(searchPtr);
ckfree(searchPtr);
- dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ dictPtr = irPtr->twoPtrValue.ptr2;
TclDecrRefCount(dictPtr);
-
- objPtr->typePtr = NULL;
}
/*
@@ -908,9 +838,9 @@ TclCreateExecEnv(
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
- TclNewBooleanObj(eePtr->constants[0], 0);
+ TclNewIntObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
- TclNewBooleanObj(eePtr->constants[1], 1);
+ TclNewIntObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
@@ -1272,7 +1202,7 @@ TclStackFree(
Tcl_Obj **markerPtr, *marker;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- ckfree((char *) freePtr);
+ ckfree(freePtr);
return;
}
@@ -1496,11 +1426,9 @@ ExprObjCallback(
*
* Results:
* A (ByteCode *) is returned pointing to the resulting ByteCode.
- * The caller must manage its refCount and arrange for a call to
- * TclCleanupByteCode() when the last reference disappears.
*
* Side effects:
- * The Tcl_ObjType of objPtr is changed to the "bytecode" type,
+ * The Tcl_ObjType of objPtr is changed to the "exprcode" type,
* and the ByteCode is kept in the internal rep (along with context
* data for checking validity) for faster operations the next time
* CompileExprObj is called on the same value.
@@ -1524,28 +1452,31 @@ CompileExprObj(
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &exprCodeType) {
+
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+
+ if (codePtr != NULL) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
- FreeExprCodeInternalRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &exprCodeType, NULL);
+ codePtr = NULL;
}
}
- if (objPtr->typePtr != &exprCodeType) {
+
+ if (codePtr == NULL) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
*/
- int length;
- const char *string = TclGetStringFromObj(objPtr, &length);
+ const char *string = TclGetString(objPtr);
- TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
- TclCompileExpr(interp, string, length, &compEnv, 0);
+ TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
+ TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);
/*
* Successful compilation. If the expression yielded no instructions,
@@ -1553,7 +1484,7 @@ CompileExprObj(
*/
if (compEnv.codeNext == compEnv.codeStart) {
- TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
+ TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, 0),
&compEnv);
}
@@ -1564,10 +1495,8 @@ CompileExprObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &exprCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1639,12 +1568,11 @@ static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+ assert(codePtr != NULL);
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
}
/*
@@ -1680,7 +1608,8 @@ TclCompileObj(
* compilation). Otherwise, check that it is "fresh" enough.
*/
- if (objPtr->typePtr == &tclByteCodeType) {
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+ if (codePtr != NULL) {
/*
* Make sure the Bytecode hasn't been invalidated by, e.g., someone
* redefining a command with a compile procedure (this might make the
@@ -1698,7 +1627,6 @@ TclCompileObj(
* here.
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1826,7 +1754,7 @@ TclCompileObj(
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1885,37 +1813,6 @@ TclIncrObj(
return TCL_ERROR;
}
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- long augend = *((const long *) ptr1);
- long addend = *((const long *) ptr2);
- long sum = augend + addend;
-
- /*
- * Overflow when (augend and sum have different sign) and (augend and
- * addend have the same sign). This is encapsulated in the Overflowing
- * macro.
- */
-
- if (!Overflowing(augend, addend, sum)) {
- TclSetLongObj(valuePtr, sum);
- return TCL_OK;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- {
- Tcl_WideInt w1 = (Tcl_WideInt) augend;
- Tcl_WideInt w2 = (Tcl_WideInt) addend;
-
- /*
- * We know the sum value is outside the long range, so we use the
- * macro form that doesn't range test again.
- */
-
- TclSetWideIntObj(valuePtr, w1 + w2);
- return TCL_OK;
- }
-#endif
- }
-
if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
/*
* Produce error message (reparse?!)
@@ -1933,12 +1830,11 @@ TclIncrObj(
return TCL_ERROR;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
Tcl_WideInt w1, w2, sum;
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, incrPtr, &w2);
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
sum = w1 + w2;
/*
@@ -1946,11 +1842,10 @@ TclIncrObj(
*/
if (!Overflowing(w1, w2, sum)) {
- Tcl_SetWideIntObj(valuePtr, sum);
+ TclSetIntObj(valuePtr, sum);
return TCL_OK;
}
}
-#endif
Tcl_TakeBignumFromObj(interp, valuePtr, &value);
Tcl_GetBignumFromObj(interp, incrPtr, &incr);
@@ -2030,7 +1925,7 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- codePtr->refCount++;
+ TclPreserveByteCode(codePtr);
/*
* Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
@@ -2119,8 +2014,14 @@ TEBCresume(
* sporadically: no special need for speed.
*/
- int instructionCount = 0; /* Counter that is used to work out when to
- * call Tcl_AsyncReady() */
+ unsigned interruptCounter = 1;
+ /* Counter that is used to work out when to
+ * call Tcl_AsyncReady(). This must be 1
+ * initially so that we call the async-check
+ * stanza early, otherwise there are command
+ * sequences that can make the interpreter
+ * busy-loop without an opportunity to
+ * recognise an interrupt. */
const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
int traceInstructions; /* Whether we are doing instruction-level
@@ -2318,10 +2219,11 @@ TEBCresume(
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
- * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+ * ASYNC_CHECK_COUNT instructions.
*/
- if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ if ((--interruptCounter) == 0) {
+ interruptCounter = ASYNC_CHECK_COUNT;
DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
@@ -2535,7 +2437,7 @@ TEBCresume(
/* FIXME: What is the right thing to trace? */
fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
- Tcl_GetString(valuePtr));
+ TclGetString(valuePtr));
}
fflush(stdout);
}
@@ -2682,154 +2584,18 @@ TEBCresume(
NEXT_INST_F(5, 0, 0);
}
- case INST_STR_CONCAT1: {
- int appendLen = 0;
- char *bytes, *p;
- Tcl_Obj **currPtr;
- int onlyb = 1;
+ case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
-
- /*
- * Detect only-bytearray-or-null case.
- */
-
- for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
- if (((*currPtr)->typePtr != &tclByteArrayType)
- && ((*currPtr)->bytes != tclEmptyStringRep)) {
- onlyb = 0;
- break;
- } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
- ((*currPtr)->bytes != NULL)) {
- onlyb = 0;
- break;
- }
- }
-
- /*
- * Compute the length to be appended.
- */
-
- if (onlyb) {
- for (currPtr = &OBJ_AT_DEPTH(opnd-2);
- appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
- if ((*currPtr)->bytes != tclEmptyStringRep) {
- Tcl_GetByteArrayFromObj(*currPtr, &length);
- appendLen += length;
- }
- }
- } else {
- for (currPtr = &OBJ_AT_DEPTH(opnd-2);
- appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
- bytes = TclGetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- appendLen += length;
- }
- }
- }
-
- if (appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
- }
-
- /*
- * If nothing is to be appended, just return the first object by
- * dropping all the others from the stack; this saves both the
- * computation and copy of the string rep of the first object,
- * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
- */
-
- if (appendLen == 0) {
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(2, (opnd-1), 0);
- }
-
- /*
- * If the first object is shared, we need a new obj for the result;
- * otherwise, we can reuse the first object. In any case, make sure it
- * has enough room to accomodate all the concatenated bytes. Note that
- * if it is unshared its bytes are copied by ckrealloc, so that we set
- * the loop parameters to avoid copying them again: p points to the
- * end of the already copied bytes, currPtr to the second object.
- */
-
- objResultPtr = OBJ_AT_DEPTH(opnd-1);
- if (!onlyb) {
- bytes = TclGetStringFromObj(objResultPtr, &length);
- if (length + appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
- INT_MAX);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
- TclFreeIntRep(objResultPtr);
- objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
- objResultPtr->length = length + appendLen;
- p = TclGetString(objResultPtr) + length;
- currPtr = &OBJ_AT_DEPTH(opnd - 2);
- } else
-#endif
- {
- p = ckalloc(length + appendLen + 1);
- TclNewObj(objResultPtr);
- objResultPtr->bytes = p;
- objResultPtr->length = length + appendLen;
- currPtr = &OBJ_AT_DEPTH(opnd - 1);
- }
-
- /*
- * Append the remaining characters.
- */
-
- for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
- bytes = TclGetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- memcpy(p, bytes, (size_t) length);
- p += length;
- }
- }
- *p = '\0';
- } else {
- bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
- if (length + appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
- INT_MAX);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (!Tcl_IsShared(objResultPtr)) {
- bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
- length + appendLen);
- p = bytes + length;
- currPtr = &OBJ_AT_DEPTH(opnd - 2);
- } else
-#endif
- {
- TclNewObj(objResultPtr);
- bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
- length + appendLen);
- p = bytes;
- currPtr = &OBJ_AT_DEPTH(opnd - 1);
- }
-
- /*
- * Append the remaining characters.
- */
-
- for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
- if ((*currPtr)->bytes != tclEmptyStringRep) {
- bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
- memcpy(p, bytes, (size_t) length);
- p += length;
- }
- }
+ objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
+ TCL_STRING_IN_PLACE);
+ if (objResultPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
- }
case INST_CONCAT_STK:
/*
@@ -3763,9 +3529,7 @@ TEBCresume(
{
Tcl_Obj *incrPtr;
-#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
-#endif
long increment;
case INST_INCR_SCALAR1:
@@ -3864,9 +3628,9 @@ TEBCresume(
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
- if (type == TCL_NUMBER_LONG) {
- long augend = *((const long *)ptr);
- long sum = augend + increment;
+ if (type == TCL_NUMBER_INT) {
+ Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
+ Tcl_WideInt sum = augend + increment;
/*
* Overflow when (augend and sum have different sign) and
@@ -3878,16 +3642,15 @@ TEBCresume(
TRACE(("%u %ld => ", opnd, increment));
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared. */
- TclNewLongObj(objResultPtr, sum);
+ TclNewIntObj(objResultPtr, sum);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
- TclSetLongObj(objPtr, sum);
+ TclSetIntObj(objPtr, sum);
}
goto doneIncr;
}
-#ifndef TCL_WIDE_INT_IS_LONG
w = (Tcl_WideInt)augend;
TRACE(("%u %ld => ", opnd, increment));
@@ -3904,44 +3667,10 @@ TEBCresume(
* use macro form that doesn't range test again.
*/
- TclSetWideIntObj(objPtr, w+increment);
+ TclSetIntObj(objPtr, w+increment);
}
goto doneIncr;
-#endif
- } /* end if (type == TCL_NUMBER_LONG) */
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type == TCL_NUMBER_WIDE) {
- Tcl_WideInt sum;
-
- w = *((const Tcl_WideInt *) ptr);
- sum = w + increment;
-
- /*
- * Check for overflow.
- */
-
- if (!Overflowing(w, increment, sum)) {
- TRACE(("%u %ld => ", opnd, increment));
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* We know it's shared. */
- objResultPtr = Tcl_NewWideIntObj(sum);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- objResultPtr = objPtr;
-
- /*
- * We *do not* know the sum value is outside the
- * long range (wide + long can yield long); use
- * the function call that checks range.
- */
-
- Tcl_SetWideIntObj(objPtr, sum);
- }
- goto doneIncr;
- }
- }
-#endif
+ } /* end if (type == TCL_NUMBER_INT) */
}
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared */
@@ -3951,7 +3680,7 @@ TEBCresume(
} else {
objResultPtr = objPtr;
}
- TclNewLongObj(incrPtr, increment);
+ TclNewIntObj(incrPtr, increment);
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
TRACE_ERROR(interp);
@@ -3965,7 +3694,7 @@ TEBCresume(
* All other cases, flow through to generic handling.
*/
- TclNewLongObj(incrPtr, increment);
+ TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
doIncrScalar:
@@ -4349,10 +4078,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclSetVarArray(varPtr);
- varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
- TclInitVarHashTable(varPtr->value.tablePtr,
- TclGetVarNsPtr(varPtr));
+ TclInitArrayVar(varPtr);
#ifdef TCL_COMPILE_DEBUG
TRACE_APPEND(("done\n"));
} else {
@@ -5042,8 +4768,8 @@ TEBCresume(
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
- && (value2Ptr->typePtr != &tclListType)
- && (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
+ && !TclHasIntRep(value2Ptr, &tclListType)
+ && (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
&index) == TCL_OK)) {
TclDecrRefCount(value2Ptr);
tosPtr--;
@@ -5215,11 +4941,11 @@ TEBCresume(
TclGetInt4AtPtr(pc+5)));
/*
- * Get the contents of the list, making sure that it really is a list
+ * Get the length of the list, making sure that it really is a list
* in the process.
*/
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -5247,17 +4973,11 @@ TEBCresume(
/* Decode index value operands. */
- /*
- assert ( toIdx != TCL_INDEX_AFTER);
- *
- * Extra safety for legacy bytecodes:
- */
- if (toIdx == TCL_INDEX_AFTER) {
- toIdx = TCL_INDEX_END;
- }
-
- if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
- goto emptyList;
+ if (toIdx == TCL_INDEX_NONE) {
+ emptyList:
+ objResultPtr = Tcl_NewObj();
+ TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
+ NEXT_INST_F(9, 1, 1);
}
toIdx = TclIndexDecode(toIdx, objc - 1);
if (toIdx < 0) {
@@ -5268,37 +4988,17 @@ TEBCresume(
assert ( toIdx >= 0 && toIdx < objc);
/*
- assert ( fromIdx != TCL_INDEX_BEFORE );
+ assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (fromIdx == TCL_INDEX_BEFORE) {
+ if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- if (fromIdx < 0) {
- fromIdx = 0;
- }
- if (fromIdx <= toIdx) {
- /* Construct the subsquence list */
- /* unshared optimization */
- if (Tcl_IsShared(valuePtr)) {
- objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
- } else {
- if (toIdx != objc - 1) {
- Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX,
- 0, NULL);
- }
- Tcl_ListObjReplace(NULL, valuePtr, 0, fromIdx, 0, NULL);
- TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
- NEXT_INST_F(9, 0, 0);
- }
- } else {
- emptyList:
- TclNewObj(objResultPtr);
- }
+ objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5515,17 +5215,23 @@ TEBCresume(
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
} else {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
+ char buf[4];
+ int ch = Tcl_GetUniChar(valuePtr, index);
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
* but creating the object as a string seems to be faster in
* practical use.
*/
-
- length = Tcl_UniCharToUtf(ch, buf);
- objResultPtr = Tcl_NewStringObj(buf, length);
+ if (ch == -1) {
+ objResultPtr = Tcl_NewObj();
+ } else {
+ length = Tcl_UniCharToUtf(ch, buf);
+ if (!length) {
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
+ objResultPtr = Tcl_NewStringObj(buf, length);
+ }
}
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
@@ -5573,17 +5279,13 @@ TEBCresume(
/* Decode index operands. */
/*
- assert ( toIdx != TCL_INDEX_BEFORE );
- assert ( toIdx != TCL_INDEX_AFTER);
+ assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (toIdx == TCL_INDEX_BEFORE) {
+ if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
}
- if (toIdx == TCL_INDEX_AFTER) {
- toIdx = TCL_INDEX_END;
- }
toIdx = TclIndexDecode(toIdx, length - 1);
if (toIdx < 0) {
@@ -5595,17 +5297,13 @@ TEBCresume(
assert ( toIdx >= 0 && toIdx < length );
/*
- assert ( fromIdx != TCL_INDEX_BEFORE );
- assert ( fromIdx != TCL_INDEX_AFTER);
+ assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (fromIdx == TCL_INDEX_BEFORE) {
+ if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
- if (fromIdx == TCL_INDEX_AFTER) {
- goto emptyRange;
- }
fromIdx = TclIndexDecode(fromIdx, length - 1);
if (fromIdx < 0) {
@@ -5668,82 +5366,9 @@ TEBCresume(
NEXT_INST_F(1, 0, 0);
}
- length3 = Tcl_GetCharLength(value3Ptr);
-
- /*
- * See if we can splice in place. This happens when the number of
- * characters being replaced is the same as the number of characters
- * in the string to be inserted.
- */
-
- if (length3 - 1 == toIdx - fromIdx) {
- unsigned char *bytes1, *bytes2;
+ objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
+ toIdx - fromIdx + 1, value3Ptr, TCL_STRING_IN_PLACE);
- if (Tcl_IsShared(valuePtr)) {
- objResultPtr = Tcl_DuplicateObj(valuePtr);
- } else {
- objResultPtr = valuePtr;
- }
- if (TclIsPureByteArray(objResultPtr)
- && TclIsPureByteArray(value3Ptr)) {
- bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
- bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
- memcpy(bytes1 + fromIdx, bytes2, length3);
- } else {
- ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
- ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
- memcpy(ustring1 + fromIdx, ustring2,
- length3 * sizeof(Tcl_UniChar));
- }
- Tcl_InvalidateStringRep(objResultPtr);
- TclDecrRefCount(value3Ptr);
- TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
- if (objResultPtr == valuePtr) {
- NEXT_INST_F(1, 0, 0);
- } else {
- NEXT_INST_F(1, 1, 1);
- }
- }
-
- /*
- * Get the unicode representation; this is where we guarantee to lose
- * bytearrays.
- */
-
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
- length--;
-
- /*
- * Remove substring using copying.
- */
-
- objResultPtr = NULL;
- if (fromIdx > 0) {
- objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
- }
- if (length3 > 0) {
- if (objResultPtr) {
- Tcl_AppendObjToObj(objResultPtr, value3Ptr);
- } else if (Tcl_IsShared(value3Ptr)) {
- objResultPtr = Tcl_DuplicateObj(value3Ptr);
- } else {
- objResultPtr = value3Ptr;
- }
- }
- if (toIdx < length) {
- if (objResultPtr) {
- Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
- length - toIdx);
- } else {
- objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
- length - toIdx);
- }
- }
- if (objResultPtr == NULL) {
- /* This has to be the case [string replace $s 0 end {}] */
- /* which has result {} which is same as value3Ptr. */
- objResultPtr = value3Ptr;
- }
if (objResultPtr == value3Ptr) {
/* See [Bug 82e7f67325] */
TclDecrRefCount(OBJ_AT_TOS);
@@ -5816,20 +5441,7 @@ TEBCresume(
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
- ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
- ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
-
- match = -1;
- if (length2 > 0 && length2 <= length) {
- end = ustring1 + length - length2 + 1;
- for (p=ustring1 ; p<end ; p++) {
- if ((*p == *ustring2) &&
- memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
- match = p - ustring1;
- break;
- }
- }
- }
+ match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
@@ -5837,23 +5449,10 @@ TEBCresume(
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
- ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
- ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
-
- match = -1;
- if (length2 > 0 && length2 <= length) {
- for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
- if ((*p == *ustring2) &&
- memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
- match = p - ustring1;
- break;
- }
- }
- }
+ match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -6022,35 +5621,18 @@ TEBCresume(
{
ClientData ptr1, ptr2;
int type1, type2;
- long l1, l2, lResult;
+ Tcl_WideInt w1, w2, wResult;
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
- } else if (type1 == TCL_NUMBER_LONG) {
- /* value is between LONG_MIN and LONG_MAX */
- /* [string is integer] is -UINT_MAX to UINT_MAX range */
- int i;
-
- if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
- type1 = TCL_NUMBER_WIDE;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- } else if (type1 == TCL_NUMBER_WIDE) {
- /* value is between WIDE_MIN and WIDE_MAX */
- /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
- int i;
- if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
- type1 = TCL_NUMBER_LONG;
- }
-#endif
} else if (type1 == TCL_NUMBER_BIG) {
/* value is an integer outside the WIDE_MIN to WIDE_MAX range */
- /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
Tcl_WideInt w;
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
- type1 = TCL_NUMBER_WIDE;
+ type1 = TCL_NUMBER_INT;
}
}
TclNewIntObj(objResultPtr, type1);
@@ -6096,10 +5678,10 @@ TEBCresume(
compare = MP_EQ;
goto convertComparison;
}
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
- compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
+ compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
} else {
compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
}
@@ -6175,17 +5757,17 @@ TEBCresume(
* Check for common, simple case.
*/
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_MOD:
- if (l2 == 0) {
+ if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
O2S(value2Ptr)));
goto divideByZero;
- } else if ((l2 == 1) || (l2 == -1)) {
+ } else if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
@@ -6194,7 +5776,7 @@ TEBCresume(
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
/*
* 0 % (non-zero) always yields remainder of 0.
*/
@@ -6204,24 +5786,24 @@ TEBCresume(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else {
- lResult = l1 / l2;
+ wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
- if ((lResult < 0 || (lResult == 0 &&
- ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
- (lResult * l2 != l1)) {
- lResult -= 1;
+ if ((wResult < 0 || (wResult == 0 &&
+ ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+ (wResult * w2 != w1)) {
+ wResult -= 1;
}
- lResult = l1 - l2*lResult;
- goto longResultOfArithmetic;
+ wResult = w1 - w2*wResult;
+ goto wideResultOfArithmetic;
}
case INST_RSHIFT:
- if (l2 < 0) {
+ if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
@@ -6232,7 +5814,7 @@ TEBCresume(
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
@@ -6242,7 +5824,7 @@ TEBCresume(
* Quickly force large right shifts to 0 or -1.
*/
- if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
+ if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
/*
* We assume that INT_MAX is much larger than the
* number of bits in a long. This is a pretty safe
@@ -6251,7 +5833,7 @@ TEBCresume(
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- if (l1 > 0L) {
+ if (w1 > 0L) {
objResultPtr = TCONST(0);
} else {
TclNewIntObj(objResultPtr, -1);
@@ -6264,12 +5846,12 @@ TEBCresume(
* Handle shifts within the native long range.
*/
- lResult = l1 >> ((int) l2);
- goto longResultOfArithmetic;
+ wResult = w1 >> ((int) w2);
+ goto wideResultOfArithmetic;
}
case INST_LSHIFT:
- if (l2 < 0) {
+ if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
@@ -6280,12 +5862,12 @@ TEBCresume(
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- } else if (l2 > (long) INT_MAX) {
+ } else if (w2 > INT_MAX) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1))
* in an mp_int, but since we're using mp_mul_2d() to do
@@ -6303,17 +5885,17 @@ TEBCresume(
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
- int shift = (int) l2;
+ int shift = (int) w2;
/*
* Handle shifts within the native long range.
*/
- if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)
- && !((l1>0 ? l1 : ~l1) &
+ if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
+ && !((w1>0 ? w1 : ~w1) &
-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
- lResult = l1 << shift;
- goto longResultOfArithmetic;
+ wResult = w1 << shift;
+ goto wideResultOfArithmetic;
}
}
@@ -6325,23 +5907,14 @@ TEBCresume(
break;
case INST_BITAND:
- lResult = l1 & l2;
- goto longResultOfArithmetic;
+ wResult = w1 & w2;
+ goto wideResultOfArithmetic;
case INST_BITOR:
- lResult = l1 | l2;
- goto longResultOfArithmetic;
+ wResult = w1 | w2;
+ goto wideResultOfArithmetic;
case INST_BITXOR:
- lResult = l1 ^ l2;
- longResultOfArithmetic:
- TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, lResult);
- TRACE(("%s\n", O2S(objResultPtr)));
- NEXT_INST_F(1, 2, 1);
- }
- TclSetLongObj(valuePtr, lResult);
- TRACE(("%s\n", O2S(valuePtr)));
- NEXT_INST_F(1, 1, 0);
+ wResult = w1 ^ w2;
+ goto wideResultOfArithmetic;
}
}
@@ -6424,18 +5997,13 @@ TEBCresume(
* an external function.
*/
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- Tcl_WideInt w1, w2, wResult;
-
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_ADD:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
wResult = w1 + w2;
-#ifdef TCL_WIDE_INT_IS_LONG
/*
* Check for overflow.
*/
@@ -6443,14 +6011,10 @@ TEBCresume(
if (Overflowing(w1, w2, wResult)) {
goto overflow;
}
-#endif
goto wideResultOfArithmetic;
case INST_SUB:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
wResult = w1 - w2;
-#ifdef TCL_WIDE_INT_IS_LONG
/*
* Must check for overflow. The macro tests for overflows in
* sums by looking at the sign bits. As we have a subtraction
@@ -6464,7 +6028,6 @@ TEBCresume(
if (Overflowing(w1, ~w2, wResult)) {
goto overflow;
}
-#endif
wideResultOfArithmetic:
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (Tcl_IsShared(valuePtr)) {
@@ -6472,45 +6035,45 @@ TEBCresume(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- Tcl_SetWideIntObj(valuePtr, wResult);
+ TclSetIntObj(valuePtr, wResult);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
case INST_DIV:
- if (l2 == 0) {
+ if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n",
O2S(valuePtr), O2S(value2Ptr)));
goto divideByZero;
- } else if ((l1 == LONG_MIN) && (l2 == -1)) {
+ } else if ((w1 == WIDE_MIN) && (w2 == -1)) {
/*
- * Can't represent (-LONG_MIN) as a long.
+ * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
*/
goto overflow;
}
- lResult = l1 / l2;
+ wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
- if (((lResult < 0) || ((lResult == 0) &&
- ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
- ((lResult * l2) != l1)) {
- lResult -= 1;
+ if (((wResult < 0) || ((wResult == 0) &&
+ ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+ ((wResult * w2) != w1)) {
+ wResult -= 1;
}
- goto longResultOfArithmetic;
+ goto wideResultOfArithmetic;
case INST_MULT:
- if (((sizeof(long) >= 2*sizeof(int))
- && (l1 <= INT_MAX) && (l1 >= INT_MIN)
- && (l2 <= INT_MAX) && (l2 >= INT_MIN))
- || ((sizeof(long) >= 2*sizeof(short))
- && (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
- && (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
- lResult = l1 * l2;
- goto longResultOfArithmetic;
+ if (((sizeof(Tcl_WideInt) >= 2*sizeof(int))
+ && (w1 <= INT_MAX) && (w1 >= INT_MIN)
+ && (w2 <= INT_MAX) && (w2 >= INT_MIN))
+ || ((sizeof(Tcl_WideInt) >= 2*sizeof(short))
+ && (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN)
+ && (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) {
+ wResult = w1 * w2;
+ goto wideResultOfArithmetic;
}
}
@@ -6577,14 +6140,14 @@ TEBCresume(
CACHE_STACK_INFO();
goto gotError;
}
- if (type1 == TCL_NUMBER_LONG) {
- l1 = *((const long *) ptr1);
+ if (type1 == TCL_NUMBER_INT) {
+ w1 = *((const Tcl_WideInt *) ptr1);
if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, ~l1);
+ TclNewIntObj(objResultPtr, ~w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
- TclSetLongObj(valuePtr, ~l1);
+ TclSetIntObj(valuePtr, ~w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -6614,15 +6177,15 @@ TEBCresume(
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
- case TCL_NUMBER_LONG:
- l1 = *((const long *) ptr1);
- if (l1 != LONG_MIN) {
+ case TCL_NUMBER_INT:
+ w1 = *((const Tcl_WideInt *) ptr1);
+ if (w1 != WIDE_MIN) {
if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, -l1);
+ TclNewIntObj(objResultPtr, -w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
- TclSetLongObj(valuePtr, -l1);
+ TclSetIntObj(valuePtr, -w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -6766,7 +6329,8 @@ TEBCresume(
Var *iterVarPtr, *listVarPtr;
Tcl_Obj *oldValuePtr, *listPtr, **elements;
ForeachVarList *varListPtr;
- int numLists, iterNum, listTmpIndex, listLen, numVars;
+ int numLists, listTmpIndex, listLen, numVars;
+ size_t iterNum;
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
long i;
@@ -6783,10 +6347,10 @@ TEBCresume(
oldValuePtr = iterVarPtr->value.objPtr;
if (oldValuePtr == NULL) {
- TclNewLongObj(iterVarPtr->value.objPtr, -1);
+ TclNewIntObj(iterVarPtr->value.objPtr, -1);
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
} else {
- TclSetLongObj(oldValuePtr, -1);
+ TclSetIntObj(oldValuePtr, -1);
}
TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
@@ -6820,8 +6384,8 @@ TEBCresume(
iterVarPtr = LOCAL(infoPtr->loopCtTemp);
valuePtr = iterVarPtr->value.objPtr;
- iterNum = valuePtr->internalRep.longValue + 1;
- TclSetLongObj(valuePtr, iterNum);
+ iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
+ TclSetIntObj(valuePtr, iterNum);
/*
* Check whether all value lists are exhausted and we should stop the
@@ -6841,7 +6405,7 @@ TEBCresume(
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
- if (listLen > iterNum * numVars) {
+ if ((size_t)listLen > iterNum * numVars) {
continueLoop = 1;
}
listTmpIndex++;
@@ -6907,7 +6471,7 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
@@ -6928,8 +6492,9 @@ TEBCresume(
ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements, *tmpPtr;
ForeachVarList *varListPtr;
- int numLists, iterMax, listLen, numVars;
- int iterTmp, iterNum, listTmpDepth;
+ int numLists, listLen, numVars;
+ int listTmpDepth;
+ size_t iterNum, iterMax, iterTmp;
int varIndex, valIndex, j;
long i;
@@ -6980,8 +6545,8 @@ TEBCresume(
*/
TclNewObj(tmpPtr);
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
- tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
PUSH_OBJECT(tmpPtr); /* iterCounts object */
/*
@@ -7013,8 +6578,8 @@ TEBCresume(
TRACE(("=> "));
tmpPtr = OBJ_AT_DEPTH(1);
- iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
- iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+ iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
+ iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;
/*
* If some list still has a remaining list element iterate one more
@@ -7026,7 +6591,7 @@ TEBCresume(
* Set the variables and jump back to run the body
*/
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+ tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
listTmpDepth = numLists + 1;
@@ -7534,13 +7099,16 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclNewObj(statePtr);
- statePtr->typePtr = &dictIteratorType;
- statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
- statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+ {
+ Tcl_ObjIntRep ir;
+ TclNewObj(statePtr);
+ ir.twoPtrValue.ptr1 = searchPtr;
+ ir.twoPtrValue.ptr2 = dictPtr;
+ Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
+ }
varPtr = LOCAL(opnd);
if (varPtr->value.objPtr) {
- if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+ if (TclHasIntRep(varPtr->value.objPtr, &dictIteratorType)) {
Tcl_Panic("mis-issued dictFirst!");
}
TclDecrRefCount(varPtr->value.objPtr);
@@ -7553,11 +7121,17 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
statePtr = (*LOCAL(opnd)).value.objPtr;
- if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
- Tcl_Panic("mis-issued dictNext!");
+ {
+ const Tcl_ObjIntRep *irPtr;
+
+ if (statePtr &&
+ (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) {
+ searchPtr = irPtr->twoPtrValue.ptr1;
+ Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+ } else {
+ Tcl_Panic("mis-issued dictNext!");
+ }
}
- searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
- Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
pushDictIteratorResult:
if (done) {
TclNewObj(emptyPtr);
@@ -7820,7 +7394,6 @@ TEBCresume(
default:
Tcl_Panic("clockRead instruction with unknown clock#");
}
- /* TclNewWideObj(objResultPtr, wval); doesn't exist */
objResultPtr = Tcl_NewWideIntObj(wval);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(2, 0, 1);
@@ -8114,9 +7687,7 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
TclStackFree(interp, TD); /* free my stack */
return result;
@@ -8222,6 +7793,91 @@ FinalizeOONextFilter(
}
/*
+ * WidePwrSmallExpon --
+ *
+ * Helper to calculate small powers of integers whose result is wide.
+ */
+static inline Tcl_WideInt
+WidePwrSmallExpon(Tcl_WideInt w1, long exponent) {
+
+ Tcl_WideInt wResult;
+
+ wResult = w1 * w1; /* b**2 */
+ switch (exponent) {
+ case 2:
+ break;
+ case 3:
+ wResult *= w1; /* b**3 */
+ break;
+ case 4:
+ wResult *= wResult; /* b**4 */
+ break;
+ case 5:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ break;
+ case 6:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ break;
+ case 7:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ break;
+ case 8:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ break;
+ case 9:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= w1; /* b**9 */
+ break;
+ case 10:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ break;
+ case 11:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ wResult *= w1; /* b**11 */
+ break;
+ case 12:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ break;
+ case 13:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ wResult *= w1; /* b**13 */
+ break;
+ case 14:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ break;
+ case 15:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ wResult *= w1; /* b**15 */
+ break;
+ case 16:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= wResult; /* b**16 */
+ break;
+ }
+ return wResult;
+}
+/*
*----------------------------------------------------------------------
*
* ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
@@ -8254,19 +7910,11 @@ ExecuteExtendedBinaryMathOp(
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
-#define LONG_RESULT(l) \
- if (Tcl_IsShared(valuePtr)) { \
- TclNewLongObj(objResultPtr, l); \
- return objResultPtr; \
- } else { \
- Tcl_SetLongObj(valuePtr, l); \
- return NULL; \
- }
#define WIDE_RESULT(w) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
- Tcl_SetWideIntObj(valuePtr, w); \
+ TclSetIntObj(valuePtr, w); \
return NULL; \
}
#define BIG_RESULT(b) \
@@ -8288,11 +7936,10 @@ ExecuteExtendedBinaryMathOp(
int type1, type2;
ClientData ptr1, ptr2;
double d1, d2, dResult;
- long l1, l2, lResult;
Tcl_WideInt w1, w2, wResult;
mp_int big1, big2, bigResult, bigRemainder;
Tcl_Obj *objResultPtr;
- int invalid, numPos, zero;
+ int invalid, zero;
long shift;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
@@ -8302,13 +7949,13 @@ ExecuteExtendedBinaryMathOp(
case INST_MOD:
/* TODO: Attempts to re-use unshared operands on stack */
- l2 = 0; /* silence gcc warning */
- if (type2 == TCL_NUMBER_LONG) {
- l2 = *((const long *)ptr2);
- if (l2 == 0) {
+ w2 = 0; /* silence gcc warning */
+ if (type2 == TCL_NUMBER_INT) {
+ w2 = *((const Tcl_WideInt *)ptr2);
+ if (w2 == 0) {
return DIVIDED_BY_ZERO;
}
- if ((l2 == 1) || (l2 == -1)) {
+ if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
@@ -8316,12 +7963,19 @@ ExecuteExtendedBinaryMathOp(
return constants[0];
}
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type1 == TCL_NUMBER_WIDE) {
+ if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *)ptr1);
- if (type2 != TCL_NUMBER_BIG) {
+
+ if (w1 == 0) {
+ /*
+ * 0 % (non-zero) always yields remainder of 0.
+ */
+
+ return constants[0];
+ }
+ if (type2 == TCL_NUMBER_INT) {
Tcl_WideInt wQuotient, wRemainder;
- Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+ w2 = *((const Tcl_WideInt *)ptr2);
wQuotient = w1 / w2;
/*
@@ -8348,7 +8002,7 @@ ExecuteExtendedBinaryMathOp(
* Arguments are opposite sign; remainder is sum.
*/
- TclBNInitBignumFromWideInt(&big1, w1);
+ TclInitBignumFromWideInt(&big1, w1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
BIG_RESULT(&big2);
@@ -8361,7 +8015,6 @@ ExecuteExtendedBinaryMathOp(
mp_clear(&big2);
return NULL;
}
-#endif
Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
mp_init(&bigResult);
@@ -8388,17 +8041,12 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type2) {
- case TCL_NUMBER_LONG:
- invalid = (*((const long *)ptr2) < 0L);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
break;
-#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- invalid = (mp_cmp_d(&big2, 0) == MP_LT);
+ invalid = mp_isneg(&big2);
mp_clear(&big2);
break;
default:
@@ -8415,7 +8063,7 @@ ExecuteExtendedBinaryMathOp(
* Zero shifted any number of bits is still zero.
*/
- if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+ if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
return constants[0];
}
@@ -8428,8 +8076,8 @@ ExecuteExtendedBinaryMathOp(
* counterparts, leading to incorrect results.
*/
- if ((type2 != TCL_NUMBER_LONG)
- || (*((const long *)ptr2) > (long) INT_MAX)) {
+ if ((type2 != TCL_NUMBER_INT)
+ || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1)) in
* an mp_int, but since we're using mp_mul_2d() to do the
@@ -8441,15 +8089,15 @@ ExecuteExtendedBinaryMathOp(
"integer value too large to represent", -1));
return GENERAL_ARITHMETIC_ERROR;
}
- shift = (int)(*((const long *)ptr2));
+ shift = (int)(*((const Tcl_WideInt *)ptr2));
/*
* Handle shifts within the native wide range.
*/
- if ((type1 != TCL_NUMBER_BIG)
+ if ((type1 == TCL_NUMBER_INT)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ w1 = *((const Tcl_WideInt *)ptr1);
if (!((w1>0 ? w1 : ~w1)
& -(((Tcl_WideInt)1)
<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
@@ -8461,8 +8109,8 @@ ExecuteExtendedBinaryMathOp(
* Quickly force large right shifts to 0 or -1.
*/
- if ((type2 != TCL_NUMBER_LONG)
- || (*(const long *)ptr2 > INT_MAX)) {
+ if ((type2 != TCL_NUMBER_INT)
+ || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
/*
* Again, technically, the value to be shifted could be an
* mp_int so huge that a right shift by (INT_MAX+1) bits could
@@ -8472,17 +8120,12 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type1) {
- case TCL_NUMBER_LONG:
- zero = (*(const long *)ptr1 > 0L);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
-#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
- zero = (mp_cmp_d(&big1, 0) == MP_GT);
+ zero = (!mp_isneg(&big1));
mp_clear(&big1);
break;
default:
@@ -8492,26 +8135,24 @@ ExecuteExtendedBinaryMathOp(
if (zero) {
return constants[0];
}
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
- shift = (int)(*(const long *)ptr2);
+ shift = (int)(*(const Tcl_WideInt *)ptr2);
-#ifndef TCL_WIDE_INT_IS_LONG
/*
* Handle shifts within the native wide range.
*/
- if (type1 == TCL_NUMBER_WIDE) {
+ if (type1 == TCL_NUMBER_INT) {
w1 = *(const Tcl_WideInt *)ptr1;
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w1 >= (Tcl_WideInt)0) {
return constants[0];
}
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
WIDE_RESULT(w1 >> shift);
}
-#endif
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -8520,16 +8161,7 @@ ExecuteExtendedBinaryMathOp(
if (opcode == INST_LSHIFT) {
mp_mul_2d(&big1, shift, &bigResult);
} else {
- mp_init(&bigRemainder);
- mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
- if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
- /*
- * Convert to Tcl's integer division rules.
- */
-
- mp_sub_d(&bigResult, 1, &bigResult);
- }
- mp_clear(&bigRemainder);
+ mp_tc_div_2d(&big1, shift, &bigResult);
}
mp_clear(&big1);
BIG_RESULT(&bigResult);
@@ -8538,139 +8170,23 @@ ExecuteExtendedBinaryMathOp(
case INST_BITOR:
case INST_BITXOR:
case INST_BITAND:
- if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
- mp_int *First, *Second;
-
+ if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) {
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- /*
- * Count how many positive arguments we have. If only one of the
- * arguments is negative, store it in 'Second'.
- */
-
- if (mp_cmp_d(&big1, 0) != MP_LT) {
- numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
- First = &big1;
- Second = &big2;
- } else {
- First = &big2;
- Second = &big1;
- numPos = (mp_cmp_d(First, 0) != MP_LT);
- }
mp_init(&bigResult);
switch (opcode) {
case INST_BITAND:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_and(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_and(First, &bigResult, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_or(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- }
+ mp_tc_and(&big1, &big2, &bigResult);
break;
case INST_BITOR:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_or(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_and(Second, &bigResult, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_and(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- }
+ mp_tc_or(&big1, &big2, &bigResult);
break;
case INST_BITXOR:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_xor(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * P^N = ~(P^~N) = -(P^(-N-1))-1
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- break;
- }
+ mp_tc_xor(&big1, &big2, &bigResult);
break;
}
@@ -8679,46 +8195,24 @@ ExecuteExtendedBinaryMathOp(
BIG_RESULT(&bigResult);
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
- switch (opcode) {
- case INST_BITAND:
- wResult = w1 & w2;
- break;
- case INST_BITOR:
- wResult = w1 | w2;
- break;
- case INST_BITXOR:
- wResult = w1 ^ w2;
- break;
- default:
- /* Unused, here to silence compiler warning. */
- wResult = 0;
- }
- WIDE_RESULT(wResult);
- }
-#endif
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_BITAND:
- lResult = l1 & l2;
+ wResult = w1 & w2;
break;
case INST_BITOR:
- lResult = l1 | l2;
+ wResult = w1 | w2;
break;
case INST_BITXOR:
- lResult = l1 ^ l2;
+ wResult = w1 ^ w2;
break;
default:
/* Unused, here to silence compiler warning. */
- lResult = 0;
+ wResult = 0;
}
- LONG_RESULT(lResult);
+ WIDE_RESULT(wResult);
case INST_EXPON: {
int oddExponent = 0, negativeExponent = 0;
@@ -8734,51 +8228,38 @@ ExecuteExtendedBinaryMathOp(
dResult = pow(d1, d2);
goto doubleResult;
}
- l1 = l2 = 0;
- if (type2 == TCL_NUMBER_LONG) {
- l2 = *((const long *) ptr2);
- if (l2 == 0) {
+ w1 = w2 = 0; /* to silence compiler warning (maybe-uninitialized) */
+ if (type2 == TCL_NUMBER_INT) {
+ w2 = *((const Tcl_WideInt *) ptr2);
+ if (w2 == 0) {
/*
* Anything to the zero power is 1.
*/
return constants[1];
- } else if (l2 == 1) {
+ } else if (w2 == 1) {
/*
* Anything to the first power is itself
*/
return NULL;
}
- }
- switch (type2) {
- case TCL_NUMBER_LONG:
- negativeExponent = (l2 < 0);
- oddExponent = (int) (l2 & 1);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
- w2 = *((const Tcl_WideInt *)ptr2);
negativeExponent = (w2 < 0);
oddExponent = (int) (w2 & (Tcl_WideInt)1);
- break;
-#endif
- case TCL_NUMBER_BIG:
+ } else {
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+ negativeExponent = mp_isneg(&big2);
mp_mod_2d(&big2, 1, &big2);
oddExponent = !mp_iszero(&big2);
mp_clear(&big2);
- break;
}
- if (type1 == TCL_NUMBER_LONG) {
- l1 = *((const long *)ptr1);
- }
- if (negativeExponent) {
- if (type1 == TCL_NUMBER_LONG) {
- switch (l1) {
+ if (type1 == TCL_NUMBER_INT) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+
+ if (negativeExponent) {
+ switch (w1) {
case 0:
/*
* Zero to a negative power is div by zero error.
@@ -8787,7 +8268,7 @@ ExecuteExtendedBinaryMathOp(
return EXPONENT_OF_ZERO;
case -1:
if (oddExponent) {
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
/* fallthrough */
case 1:
@@ -8798,17 +8279,21 @@ ExecuteExtendedBinaryMathOp(
return constants[1];
}
}
+ }
+ if (negativeExponent) {
/*
* Integers with magnitude greater than 1 raise to a negative
* power yield the answer zero (see TIP 123).
*/
-
return constants[0];
}
- if (type1 == TCL_NUMBER_LONG) {
- switch (l1) {
+ if (type1 != TCL_NUMBER_INT) {
+ goto overflowExpon;
+ }
+
+ switch (w1) {
case 0:
/*
* Zero to a positive power is zero.
@@ -8825,8 +8310,7 @@ ExecuteExtendedBinaryMathOp(
if (!oddExponent) {
return constants[1];
}
- LONG_RESULT(-1);
- }
+ WIDE_RESULT(-1);
}
/*
@@ -8834,208 +8318,49 @@ ExecuteExtendedBinaryMathOp(
* which means the max exponent value is 2**28-1 = 0x0fffffff =
* 268435455, which fits into a signed 32 bit int which is within the
* range of the long int type. This means any numeric Tcl_Obj value
- * not using TCL_NUMBER_LONG type must hold a value larger than we
+ * not using TCL_NUMBER_INT type must hold a value larger than we
* accept.
*/
- if (type2 != TCL_NUMBER_LONG) {
+ if (type2 != TCL_NUMBER_INT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
- if (type1 == TCL_NUMBER_LONG) {
- if (l1 == 2) {
- /*
- * Reduce small powers of 2 to shifts.
- */
-
- if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
- LONG_RESULT(1L << l2);
- }
-#if !defined(TCL_WIDE_INT_IS_LONG)
- if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
- WIDE_RESULT(((Tcl_WideInt) 1) << l2);
- }
-#endif
- goto overflowExpon;
- }
- if (l1 == -2) {
- int signum = oddExponent ? -1 : 1;
+ /* From here (up to overflowExpon) w1 and exponent w2 are wide-int's. */
+ assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);
- /*
- * Reduce small powers of 2 to shifts.
- */
+ if (w1 == 2) {
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
- if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
- LONG_RESULT(signum * (1L << l2));
- }
-#if !defined(TCL_WIDE_INT_IS_LONG)
- if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
- WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
- }
-#endif
- goto overflowExpon;
+ if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
+ WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
}
-#if (LONG_MAX == 0x7fffffff)
- if (l2 - 2 < (long)MaxBase32Size
- && l1 <= MaxBase32[l2 - 2]
- && l1 >= -MaxBase32[l2 - 2]) {
- /*
- * Small powers of 32-bit integers.
- */
-
- lResult = l1 * l1; /* b**2 */
- switch (l2) {
- case 2:
- break;
- case 3:
- lResult *= l1; /* b**3 */
- break;
- case 4:
- lResult *= lResult; /* b**4 */
- break;
- case 5:
- lResult *= lResult; /* b**4 */
- lResult *= l1; /* b**5 */
- break;
- case 6:
- lResult *= l1; /* b**3 */
- lResult *= lResult; /* b**6 */
- break;
- case 7:
- lResult *= l1; /* b**3 */
- lResult *= lResult; /* b**6 */
- lResult *= l1; /* b**7 */
- break;
- case 8:
- lResult *= lResult; /* b**4 */
- lResult *= lResult; /* b**8 */
- break;
- }
- LONG_RESULT(lResult);
- }
-
- if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
- && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
- base = Exp32Index[l1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase32Size);
- if (base < Exp32Index[l1 - 2]) {
- /*
- * 32-bit number raised to intermediate power, done by
- * table lookup.
- */
+ goto overflowExpon;
+ }
+ if (w1 == -2) {
+ int signum = oddExponent ? -1 : 1;
- LONG_RESULT(Exp32Value[base]);
- }
- }
- if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
- && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
- base = Exp32Index[-l1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase32Size);
- if (base < Exp32Index[-l1 - 2]) {
- /*
- * 32-bit number raised to intermediate power, done by
- * table lookup.
- */
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
- lResult = (oddExponent) ?
- -Exp32Value[base] : Exp32Value[base];
- LONG_RESULT(lResult);
- }
+ if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
+ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
}
-#endif
- }
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
- if (type1 == TCL_NUMBER_LONG) {
- w1 = l1;
-#ifndef TCL_WIDE_INT_IS_LONG
- } else if (type1 == TCL_NUMBER_WIDE) {
- w1 = *((const Tcl_WideInt *) ptr1);
-#endif
- } else {
goto overflowExpon;
}
- if (l2 - 2 < (long)MaxBase64Size
- && w1 <= MaxBase64[l2 - 2]
- && w1 >= -MaxBase64[l2 - 2]) {
+ if (w2 - 2 < (long)MaxBase64Size
+ && w1 <= MaxBase64[w2 - 2]
+ && w1 >= -MaxBase64[w2 - 2]) {
/*
* Small powers of integers whose result is wide.
*/
+ wResult = WidePwrSmallExpon(w1, (long)w2);
- wResult = w1 * w1; /* b**2 */
- switch (l2) {
- case 2:
- break;
- case 3:
- wResult *= l1; /* b**3 */
- break;
- case 4:
- wResult *= wResult; /* b**4 */
- break;
- case 5:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- break;
- case 6:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- break;
- case 7:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- break;
- case 8:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- break;
- case 9:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- wResult *= w1; /* b**9 */
- break;
- case 10:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- wResult *= wResult; /* b**10 */
- break;
- case 11:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- wResult *= wResult; /* b**10 */
- wResult *= w1; /* b**11 */
- break;
- case 12:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= wResult; /* b**12 */
- break;
- case 13:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= wResult; /* b**12 */
- wResult *= w1; /* b**13 */
- break;
- case 14:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- wResult *= wResult; /* b**14 */
- break;
- case 15:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- wResult *= wResult; /* b**14 */
- wResult *= w1; /* b**15 */
- break;
- case 16:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- wResult *= wResult; /* b**16 */
- break;
- }
WIDE_RESULT(wResult);
}
@@ -9045,9 +8370,9 @@ ExecuteExtendedBinaryMathOp(
*/
if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
- && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[w1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase64Size);
+ + (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
@@ -9059,9 +8384,9 @@ ExecuteExtendedBinaryMathOp(
}
if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
- && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[-w1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase64Size);
+ + (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[-w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
@@ -9072,7 +8397,6 @@ ExecuteExtendedBinaryMathOp(
WIDE_RESULT(wResult);
}
}
-#endif
overflowExpon:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
@@ -9084,7 +8408,7 @@ ExecuteExtendedBinaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
- mp_expt_d(&big1, big2.dp[0], &bigResult);
+ mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
mp_clear(&big1);
mp_clear(&big2);
BIG_RESULT(&bigResult);
@@ -9145,16 +8469,14 @@ ExecuteExtendedBinaryMathOp(
#endif
DOUBLE_RESULT(dResult);
}
- if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
+ if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Check for overflow.
@@ -9168,9 +8490,7 @@ ExecuteExtendedBinaryMathOp(
case INST_SUB:
wResult = w1 - w2;
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
+ if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Must check for overflow. The macro tests for overflows
@@ -9190,8 +8510,7 @@ ExecuteExtendedBinaryMathOp(
break;
case INST_MULT:
- if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
- || (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
+ if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) {
goto overflowBasic;
}
wResult = w1 * w2;
@@ -9203,10 +8522,10 @@ ExecuteExtendedBinaryMathOp(
}
/*
- * Need a bignum to represent (LLONG_MIN / -1)
+ * Need a bignum to represent (WIDE_MIN / -1)
*/
- if ((w1 == LLONG_MIN) && (w2 == -1)) {
+ if ((w1 == WIDE_MIN) && (w2 == -1)) {
goto overflowBasic;
}
wResult = w1 / w2;
@@ -9294,12 +8613,10 @@ ExecuteExtendedUnaryMathOp(
switch (opcode) {
case INST_BITNOT:
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type == TCL_NUMBER_WIDE) {
+ if (type == TCL_NUMBER_INT) {
w = *((const Tcl_WideInt *) ptr);
WIDE_RESULT(~w);
}
-#endif
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
/* ~a = - a - 1 */
mp_neg(&big, &big);
@@ -9309,22 +8626,13 @@ ExecuteExtendedUnaryMathOp(
switch (type) {
case TCL_NUMBER_DOUBLE:
DOUBLE_RESULT(-(*((const double *) ptr)));
- case TCL_NUMBER_LONG:
- w = (Tcl_WideInt) (*((const long *) ptr));
- if (w != LLONG_MIN) {
- WIDE_RESULT(-w);
- }
- TclBNInitBignumFromLong(&big, *(const long *) ptr);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w = *((const Tcl_WideInt *) ptr);
- if (w != LLONG_MIN) {
+ if (w != WIDE_MIN) {
WIDE_RESULT(-w);
}
- TclBNInitBignumFromWideInt(&big, w);
+ TclInitBignumFromWideInt(&big, w);
break;
-#endif
default:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
}
@@ -9335,7 +8643,6 @@ ExecuteExtendedUnaryMathOp(
Tcl_Panic("unexpected opcode");
return NULL;
}
-#undef LONG_RESULT
#undef WIDE_RESULT
#undef BIG_RESULT
#undef DOUBLE_RESULT
@@ -9367,31 +8674,22 @@ TclCompareTwoNumbers(
ClientData ptr1, ptr2;
mp_int big1, big2;
double d1, d2, tmp;
- long l1, l2;
-#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w1, w2;
-#endif
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
switch (type1) {
- case TCL_NUMBER_LONG:
- l1 = *((const long *)ptr1);
+ case TCL_NUMBER_INT:
+ w1 = *((const Tcl_WideInt *)ptr1);
switch (type2) {
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- longCompare:
- return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
- w1 = (Tcl_WideInt)l1;
- goto wideCompare;
-#endif
+ wideCompare:
+ return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
- d1 = (double) l1;
+ d1 = (double) w1;
/*
* If the double has a fractional part, or if the long can be
@@ -9399,7 +8697,7 @@ TclCompareTwoNumbers(
* doubles.
*/
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1
|| modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
@@ -9416,55 +8714,17 @@ TclCompareTwoNumbers(
* integer comparison can tell the difference.
*/
- if (d2 < (double)LONG_MIN) {
- return MP_GT;
- }
- if (d2 > (double)LONG_MAX) {
- return MP_LT;
- }
- l2 = (long) d2;
- goto longCompare;
- case TCL_NUMBER_BIG:
- Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if (mp_cmp_d(&big2, 0) == MP_LT) {
- compare = MP_GT;
- } else {
- compare = MP_LT;
- }
- mp_clear(&big2);
- return compare;
- }
-
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
- w1 = *((const Tcl_WideInt *)ptr1);
- switch (type2) {
- case TCL_NUMBER_WIDE:
- w2 = *((const Tcl_WideInt *)ptr2);
- wideCompare:
- return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- w2 = (Tcl_WideInt)l2;
- goto wideCompare;
- case TCL_NUMBER_DOUBLE:
- d2 = *((const double *)ptr2);
- d1 = (double) w1;
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
- || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
- goto doubleCompare;
- }
- if (d2 < (double)LLONG_MIN) {
+ if (d2 < (double)WIDE_MIN) {
return MP_GT;
}
- if (d2 > (double)LLONG_MAX) {
+ if (d2 > (double)WIDE_MAX) {
return MP_LT;
}
w2 = (Tcl_WideInt) d2;
goto wideCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if (mp_cmp_d(&big2, 0) == MP_LT) {
+ if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
@@ -9472,7 +8732,6 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
-#endif
case TCL_NUMBER_DOUBLE:
d1 = *((const double *)ptr1);
@@ -9481,45 +8740,28 @@ TclCompareTwoNumbers(
d2 = *((const double *)ptr2);
doubleCompare:
return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- d2 = (double) l2;
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2
- || modf(d1, &tmp) != 0.0) {
- goto doubleCompare;
- }
- if (d1 < (double)LONG_MIN) {
- return MP_LT;
- }
- if (d1 > (double)LONG_MAX) {
- return MP_GT;
- }
- l1 = (long) d1;
- goto longCompare;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
|| w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
- if (d1 < (double)LLONG_MIN) {
+ if (d1 < (double)WIDE_MIN) {
return MP_LT;
}
- if (d1 > (double)LLONG_MAX) {
+ if (d1 > (double)WIDE_MAX) {
return MP_GT;
}
w1 = (Tcl_WideInt) d1;
goto wideCompare;
-#endif
case TCL_NUMBER_BIG:
if (TclIsInfinite(d1)) {
return (d1 > 0.0) ? MP_GT : MP_LT;
}
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
- if (mp_cmp_d(&big2, 0) == MP_LT) {
+ if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
+ if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
@@ -9540,10 +8782,7 @@ TclCompareTwoNumbers(
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
-#endif
- case TCL_NUMBER_LONG:
+ case TCL_NUMBER_INT:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
@@ -9554,7 +8793,7 @@ TclCompareTwoNumbers(
mp_clear(&big1);
return compare;
}
- if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
+ if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
@@ -9608,8 +8847,8 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
- codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
+ fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
+ codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
fprintf(stdout, " Source: ");
@@ -9707,7 +8946,7 @@ ValidatePcAndStackTop(
TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
- fprintf(stderr,"%s\n", Tcl_GetString(message));
+ fprintf(stderr,"%s\n", TclGetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
@@ -9757,7 +8996,7 @@ IllegalExprOperandType(
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
int numBytes;
- const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
+ const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
if (numBytes == 0) {
description = "empty string";
@@ -10170,7 +9409,7 @@ TclExprFloatError(
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
- Tcl_GetString(objPtr), NULL);
+ TclGetString(objPtr), NULL);
Tcl_SetObjResult(interp, objPtr);
}
}
@@ -10383,10 +9622,10 @@ EvalStatsCmd(
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
- if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
+ if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) {
numByteCodeLits++;
}
- (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ (void) TclGetStringFromObj(entryPtr->objPtr, &length);
refCountSum += entryPtr->refCount;
objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
strBytesIfUnshared += (entryPtr->refCount * (length+1));
@@ -10608,7 +9847,7 @@ EvalStatsCmd(
Tcl_SetObjResult(interp, objPtr);
} else {
Tcl_Channel outChan;
- char *str = Tcl_GetStringFromObj(objv[1], &length);
+ char *str = TclGetStringFromObj(objv[1], &length);
if (length) {
if (strcmp(str, "stdout") == 0) {
generated by cgit v0.12 at 2024-11-16 08:10:00 (GMT)