summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCompile.c2
-rw-r--r--generic/tclDecls.h4
-rw-r--r--generic/tclExecute.c19
-rw-r--r--generic/tclInterp.c2
-rw-r--r--generic/tclLink.c8
-rw-r--r--generic/tclMain.c2
-rw-r--r--generic/tclOOCall.c2
-rw-r--r--generic/tclResult.c32
-rw-r--r--generic/tclStrToD.c155
-rw-r--r--generic/tclTest.c28
-rw-r--r--generic/tclUtil.c23
14 files changed, 191 insertions, 94 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 8555ac2..528938d 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2221,7 +2221,7 @@ declare 606 {
# TIP#307 (move results between interpreters) dkf
declare 607 {
- void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result,
+ void Tcl_TransferResult(Tcl_Interp *sourceInterp, int code,
Tcl_Interp *targetInterp)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index 2825bb6..b1b1527 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2173,8 +2173,10 @@ typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData);
* Override definitions for libtommath.
*/
-typedef struct mp_int mp_int;
+#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
+typedef struct mp_int mp_int;
+#endif
/*
*----------------------------------------------------------------------------
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2169b9d..0eca69d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1868,8 +1868,10 @@ DeleteInterpProc(
* could have transferred ownership of the result string to Tcl.
*/
+#ifndef TCL_NO_DEPRECATED
Tcl_FreeResult(interp);
iPtr->result = NULL;
+#endif
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0d38e6b..7ed24ae 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -797,7 +797,7 @@ TclSetByteCodeFromAny(
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
if (Tcl_LinkVar(interp, "tcl_traceCompile",
- (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
+ &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
}
traceInitialized = 1;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 5c7aca6..38673cd 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1792,7 +1792,7 @@ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp);
EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
/* 607 */
EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp,
- int result, Tcl_Interp *targetInterp);
+ int code, Tcl_Interp *targetInterp);
/* 608 */
EXTERN int Tcl_InterpActive(Tcl_Interp *interp);
/* 609 */
@@ -2555,7 +2555,7 @@ typedef struct TclStubs {
int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
- void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */
+ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */
int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 68e85b2..f7f6c87 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -794,7 +794,7 @@ InitByteCodeExecution(
* instruction tracing. */
{
#ifdef TCL_COMPILE_DEBUG
- if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
+ if (Tcl_LinkVar(interp, "tcl_traceExec", &tclTraceExec,
TCL_LINK_INT) != TCL_OK) {
Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
@@ -1353,6 +1353,7 @@ CopyCallback(
Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0];
Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
(void)dummy;
+ (void)dummy;
if (result == TCL_OK) {
*resultPtrPtr = resultPtr;
@@ -2609,6 +2610,7 @@ TEBCresume(
TRACE(("%u => OK\n", opnd));
NEXT_INST_F(5, 0, 0);
}
+ break;
case INST_STR_CONCAT1:
@@ -2732,6 +2734,7 @@ TEBCresume(
Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
+ break;
case INST_EXPR_STK: {
ByteCode *newCodePtr;
@@ -4030,6 +4033,7 @@ TEBCresume(
}
NEXT_INST_F(5, 0, 0);
}
+ break;
/*
* End of INST_UNSET instructions.
@@ -4247,6 +4251,7 @@ TEBCresume(
TRACE_APPEND(("link made\n"));
NEXT_INST_F(5, 1, 0);
}
+ break;
/*
* End of variable linking instructions.
@@ -4320,6 +4325,7 @@ TEBCresume(
#endif
NEXT_INST_F(jmpOffset[b], 1, 0);
}
+ break;
case INST_JUMP_TABLE: {
Tcl_HashEntry *hPtr;
@@ -4345,6 +4351,7 @@ TEBCresume(
NEXT_INST_F(5, 1, 0);
}
}
+ break;
/*
* These two instructions are now redundant: the complete logic of the LOR
@@ -4389,6 +4396,7 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
NEXT_INST_F(1, 2, 1);
}
+ break;
/*
* -----------------------------------------------------------------
@@ -4407,6 +4415,7 @@ TEBCresume(
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
}
+ break;
case INST_COROUTINE_NAME: {
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
@@ -4418,6 +4427,7 @@ TEBCresume(
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
}
+ break;
case INST_INFO_LEVEL_NUM:
TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
TRACE_WITH_OBJ(("=> "), objResultPtr);
@@ -5653,6 +5663,7 @@ TEBCresume(
JUMP_PEEPHOLE_F(match, 2, 2);
}
+ break;
/*
* End of string-related instructions.
@@ -5843,6 +5854,7 @@ TEBCresume(
wResult = w1 - w2*wResult;
goto wideResultOfArithmetic;
}
+ break;
case INST_RSHIFT:
if (w2 < 0) {
@@ -5891,6 +5903,7 @@ TEBCresume(
wResult = w1 >> ((int) w2);
goto wideResultOfArithmetic;
}
+ break;
case INST_LSHIFT:
if (w2 < 0) {
@@ -6327,6 +6340,7 @@ TEBCresume(
TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
+ break;
/*
* End of numeric operator instructions.
@@ -6724,6 +6738,7 @@ TEBCresume(
Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
NEXT_INST_F(1, 1, 0);
}
+ break;
case INST_BEGIN_CATCH4:
/*
@@ -7433,6 +7448,7 @@ TEBCresume(
TRACE_APPEND(("OK\n"));
NEXT_INST_F(5, 2, 0);
}
+ break;
/*
* End of dictionary-related instructions.
@@ -7470,6 +7486,7 @@ TEBCresume(
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(2, 0, 1);
}
+ break;
default:
Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 2d03855..0d53476 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1001,6 +1001,7 @@ NRInterpCmd(
return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
}
}
+ break;
case OPT_MARKTRUSTED:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "path");
@@ -2709,6 +2710,7 @@ NRSlaveCmd(
return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv);
}
}
+ break;
case OPT_MARKTRUSTED:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 8bd29e1..cce838d 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -261,6 +261,14 @@ Tcl_LinkArray(
linkPtr = (Link *)ckalloc(sizeof(Link));
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
+ || defined(_WIN32) || defined(__CYGWIN__))
+ if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
+ linkPtr->type = TCL_LINK_LONG;
+ } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
+ linkPtr->type = TCL_LINK_ULONG;
+ }
+#endif
linkPtr->numElems = size;
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 4f4ad62..3a4949c 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -446,7 +446,7 @@ Tcl_MainEx(
* Get a new value for tty if anyone writes to ::tcl_interactive
*/
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN);
+ Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
is.input = Tcl_GetStdChannel(TCL_STDIN);
while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
mainLoopProc = TclGetMainLoop();
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index f6993ef..41f5334 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -1680,6 +1680,7 @@ AddPrivatesFromClassChainToCallContext(
return 1;
}
}
+ /* FALLTHRU */
case 0:
return 0;
}
@@ -1771,6 +1772,7 @@ AddSimpleClassChainToCallContext(
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
}
+ /* FALLTHRU */
case 0:
return privateDanger;
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index d5a7fb8..3d39bc5 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1690,22 +1690,14 @@ Tcl_SetReturnOptions(
*
* Tcl_TransferResult --
*
- * Copy the result (and error information) from one interp to another.
+ * Transfer the result (and error information) from one interp to another.
* Used when one interp has caused another interp to evaluate a script
* and then wants to transfer the results back to itself.
*
- * This routine copies the string reps of the result and error
- * information. It does not simply increment the refcounts of the result
- * and error information objects themselves. It is not legal to exchange
- * objects between interps, because an object may be kept alive by one
- * interp, but have an internal rep that is only valid while some other
- * interp is alive.
- *
* Results:
- * The target interp's result is set to a copy of the source interp's
- * result. The source's errorInfo field may be transferred to the
- * target's errorInfo field, and the source's errorCode field may be
- * transferred to the target's errorCode field.
+ * The result of targetInterp is set to the result read from sourceInterp.
+ * The return options dictionary of sourceInterp is transferred to
+ * targetInterp as appropriate for the return code value code.
*
* Side effects:
* None.
@@ -1715,14 +1707,16 @@ Tcl_SetReturnOptions(
void
Tcl_TransferResult(
- Tcl_Interp *sourceInterp, /* Interp whose result and error information
+ Tcl_Interp *sourceInterp, /* Interp whose result and return options
* should be moved to the target interp.
* After moving result, this interp's result
* is reset. */
- int result, /* TCL_OK if just the result should be copied,
- * TCL_ERROR if both the result and error
- * information should be copied. */
- Tcl_Interp *targetInterp) /* Interp where result and error information
+ int code, /* The return code value active in
+ * sourceInterp. Controls how the return options
+ * dictionary is retrieved from sourceInterp,
+ * same as in Tcl_GetReturnOptions, to then be
+ * transferred to targetInterp. */
+ Tcl_Interp *targetInterp) /* Interp where result and return options
* should be stored. If source and target are
* the same, nothing is done. */
{
@@ -1733,7 +1727,7 @@ Tcl_TransferResult(
return;
}
- if (result == TCL_OK && siPtr->returnOpts == NULL) {
+ if (code == TCL_OK && siPtr->returnOpts == NULL) {
/*
* Special optimization for the common case of normal command return
* code and no explicit return options.
@@ -1745,7 +1739,7 @@ Tcl_TransferResult(
}
} else {
Tcl_SetReturnOptions(targetInterp,
- Tcl_GetReturnOptions(sourceInterp, result));
+ Tcl_GetReturnOptions(sourceInterp, code));
tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
}
Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index afa4e61..64ebbfc 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -18,6 +18,18 @@
#include <math.h>
/*
+ * Older MSVC has no copysign function, but it's available at least since
+ * MSVC++ 12.0 (that is Visual Studio 2013).
+ */
+
+#if (defined(_MSC_VER) && (_MSC_VER < 1800))
+inline static double
+copysign(double a, double b) {
+ return _copysign(a, b);
+}
+#endif
+
+/*
* This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
* floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
* uniquely determined by radix and by the widths of significand and exponent.
@@ -289,10 +301,10 @@ static const Tcl_WideUInt wuipow5[27] = {
static int AccumulateDecimalDigit(unsigned, int,
Tcl_WideUInt *, mp_int *, int);
static double MakeHighPrecisionDouble(int signum,
- mp_int *significand, int nSigDigs, int exponent);
+ mp_int *significand, int nSigDigs, long exponent);
static double MakeLowPrecisionDouble(int signum,
Tcl_WideUInt significand, int nSigDigs,
- int exponent);
+ long exponent);
#ifdef IEEE_FLOATING_POINT
static double MakeNaN(int signum, Tcl_WideUInt tag);
#endif
@@ -847,6 +859,7 @@ TclParseNumber(
acceptState = state;
acceptPoint = p;
acceptLen = len;
+ /* FALLTHRU */
case ZERO_B:
zerob:
if (c == '0') {
@@ -1337,16 +1350,45 @@ TclParseNumber(
objPtr->typePtr = &tclDoubleType;
if (exponentSignum) {
+ /*
+ * At this point exponent>=0, so the following calculation
+ * cannot underflow.
+ */
exponent = -exponent;
}
+
+ /*
+ * Adjust the exponent for the number of trailing zeros that
+ * have not been accumulated, and the number of digits after
+ * the decimal point. Pin any overflow to LONG_MAX/LONG_MIN
+ * respectively.
+ */
+
+ if (exponent >= 0) {
+ if (exponent - numDigitsAfterDp > LONG_MAX - numTrailZeros) {
+ exponent = LONG_MAX;
+ } else {
+ exponent = exponent - numDigitsAfterDp + numTrailZeros;
+ }
+ } else {
+ if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) {
+ exponent = LONG_MIN;
+ } else {
+ exponent = exponent + numTrailZeros - numDigitsAfterDp;
+ }
+ }
+
+ /*
+ * The desired number is now significandWide * 10**exponent
+ * or significandBig * 10**exponent, depending on whether
+ * the significand has overflowed a wide int.
+ */
if (!significandOverflow) {
objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
- signum, significandWide, numSigDigs,
- numTrailZeros + exponent - numDigitsAfterDp);
+ signum, significandWide, numSigDigs, exponent);
} else {
objPtr->internalRep.doubleValue = MakeHighPrecisionDouble(
- signum, &significandBig, numSigDigs,
- numTrailZeros + exponent - numDigitsAfterDp);
+ signum, &significandBig, numSigDigs, exponent);
}
break;
@@ -1530,9 +1572,9 @@ AccumulateDecimalDigit(
static double
MakeLowPrecisionDouble(
int signum, /* 1 if the number is negative, 0 otherwise */
- Tcl_WideUInt significand, /* Significand of the number. */
- int numSigDigs, /* Number of digits in the significand. */
- int exponent) /* Power of ten. */
+ Tcl_WideUInt significand, /* Significand of the number */
+ int numSigDigs, /* Number of digits in the significand */
+ long exponent) /* Power of ten */
{
double retval; /* Value of the number. */
mp_int significandBig; /* Significand expressed as a bignum. */
@@ -1551,6 +1593,9 @@ MakeLowPrecisionDouble(
* Test for the easy cases.
*/
+ if (significand == 0) {
+ return copysign(0.0, -signum);
+ }
if (numSigDigs <= QUICK_MAX) {
if (exponent >= 0) {
if (exponent <= mmaxpow) {
@@ -1643,10 +1688,10 @@ MakeLowPrecisionDouble(
static double
MakeHighPrecisionDouble(
- int signum, /* 1=negative, 0=nonnegative. */
- mp_int *significand, /* Exact significand of the number. */
- int numSigDigs, /* Number of significant digits. */
- int exponent) /* Power of 10 by which to multiply. */
+ int signum, /* 1=negative, 0=nonnegative */
+ mp_int *significand, /* Exact significand of the number */
+ int numSigDigs, /* Number of significant digits */
+ long exponent) /* Power of 10 by which to multiply */
{
double retval;
int machexp; /* Machine exponent of a power of 10. */
@@ -1662,15 +1707,18 @@ MakeHighPrecisionDouble(
TCL_IEEE_DOUBLE_ROUNDING;
/*
- * Quick checks for over/underflow.
+ * Quick checks for zero, and over/underflow. Be careful to avoid
+ * integer overflow when calculating with 'exponent'.
*/
- if (numSigDigs+exponent-1 > maxDigits) {
+ if (mp_iszero(significand)) {
+ return copysign(0.0, -signum);
+ }
+ if (exponent >= 0 && exponent-1 > maxDigits-numSigDigs) {
retval = HUGE_VAL;
goto returnValue;
- }
- if (numSigDigs+exponent-1 < minDigits) {
- retval = 0;
+ } else if (exponent < 0 && numSigDigs+exponent < minDigits+1) {
+ retval = 0.0;
goto returnValue;
}
@@ -1805,6 +1853,9 @@ RefineApproximation(
* "round to even" functionality */
double rteSignificand; /* Significand of the round-to-even result */
int rteExponent; /* Exponent of the round-to-even result */
+ int shift; /* Shift count for converting numerator
+ * and denominator of corrector to floating
+ * point */
Tcl_WideInt rteSigWide; /* Wide integer version of the significand
* for testing evenness */
int i;
@@ -1817,13 +1868,22 @@ RefineApproximation(
if (approxResult == HUGE_VAL) {
return approxResult;
}
+ significand = frexp(approxResult, &binExponent);
/*
- * Find a common denominator for the decimal and binary fractions. The
- * common denominator will be 2**M2 + 5**M5.
+ * We are trying to compute a corrector term that, when added to the
+ * approximate result, will yield close to the exact result.
+ * The exact result is exactSignificand * 10**exponent.
+ * The approximate result is significand * 2**binExponent
+ * If exponent<0, we need to multiply the exact value by 10**-exponent
+ * to make it an integer, plus another factor of 2 to decide on rounding.
+ * Similarly if binExponent<FP_PRECISION, we need
+ * to multiply by 2**FP_PRECISION to make the approximate value an integer.
+ *
+ * Let M = 2**M2 * 5**M5 be the least common multiple of these two
+ * multipliers.
*/
- significand = frexp(approxResult, &binExponent);
i = mantBits - binExponent;
if (i < 0) {
M2 = 0;
@@ -1840,12 +1900,9 @@ RefineApproximation(
}
/*
- * The floating point number is significand*2**binExponent. Compute the
- * large integer significand*2**(binExponent+M2+1). The 2**-1 bit of the
- * significand (the most significant) corresponds to the
- * 2**(binExponent+M2 + 1) bit of 2*M2*v. Allocate enough digits to hold
- * that quantity, then convert the significand to a large integer, scaled
- * appropriately. Then multiply by the appropriate power of 5.
+ * Compute twoMv as 2*M*v, where v is the approximate value.
+ * This is done by bit-whacking to calculate 2**(M2+1)*significand,
+ * and then multiplying by 5**M5.
*/
msb = binExponent + M2; /* 1008 */
@@ -1866,10 +1923,9 @@ RefineApproximation(
}
/*
- * Collect the decimal significand as a high precision integer. The least
- * significant bit corresponds to bit M2+exponent+1 so it will need to be
- * shifted left by that many bits after being multiplied by
- * 5**(M5+exponent).
+ * Compute twoMd as 2*M*d, where d is the exact value.
+ * This is done by multiplying by 5**(M5+exponent) and then multiplying
+ * by 2**(M5+exponent+1), which is, of couse, a left shift.
*/
mp_init_copy(&twoMd, exactSignificand);
@@ -1879,16 +1935,22 @@ RefineApproximation(
}
}
mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);
+
+ /*
+ * Now let twoMd = twoMd - twoMv, the difference between the exact and
+ * approximate values.
+ */
+
mp_sub(&twoMd, &twoMv, &twoMd);
/*
* The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
* term. Because 2M may well overflow a double, we need to scale the
- * denominator by a factor of 2**binExponent-mantBits.
+ * denominator by a factor of 2**binExponent-mantBits. Place that factor
+ * times 1/2 ULP into twoMd.
*/
scale = binExponent - mantBits - 1;
-
mp_set_u64(&twoMv, 1);
for (i=0; i<=8; ++i) {
if (M5 & (1 << i)) {
@@ -1902,25 +1964,36 @@ RefineApproximation(
mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
}
+ /*
+ * Will the eventual correction term be less than, equal to, or
+ * greater than 1/2 ULP?
+ */
+
switch (mp_cmp_mag(&twoMd, &twoMv)) {
case MP_LT:
/*
- * If the result is less than unity, the error is less than 1/2 unit in
- * the last place, so there's no correction to make.
+ * If the error is less than 1/2 ULP, there's no correction to make.
*/
mp_clear(&twoMd);
mp_clear(&twoMv);
return approxResult;
case MP_EQ:
/*
- * If the result is exactly unity, we need to round to even.
+ * If the error is exactly 1/2 ULP, we need to round to even.
*/
roundToEven = 1;
break;
case MP_GT:
+ /*
+ * We need to correct the result if the error exceeds 1/2 ULP.
+ */
break;
}
+ /*
+ * If we're in the 'round to even' case, and the significand is already
+ * even, we're done. Return the approximate result.
+ */
if (roundToEven) {
rteSignificand = frexp(approxResult, &rteExponent);
rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
@@ -1932,6 +2005,16 @@ RefineApproximation(
}
/*
+ * Reduce the numerator and denominator of the corrector term so that
+ * they will fit in the floating point precision.
+ */
+ shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
+ if (shift > 0) {
+ mp_div_2d(&twoMv, shift, &twoMv, NULL);
+ mp_div_2d(&twoMd, shift, &twoMd, NULL);
+ }
+
+ /*
* Convert the numerator and denominator of the corrector term accurately
* to floating point numbers.
*/
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 23a25c3..634f22b 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2989,7 +2989,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "int", (char *) &intVar,
+ if (Tcl_LinkVar(interp, "int", &intVar,
TCL_LINK_INT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -2997,7 +2997,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "real", (char *) &realVar,
+ if (Tcl_LinkVar(interp, "real", &realVar,
TCL_LINK_DOUBLE | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3005,7 +3005,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "bool", (char *) &boolVar,
+ if (Tcl_LinkVar(interp, "bool", &boolVar,
TCL_LINK_BOOLEAN | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3013,7 +3013,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "string", (char *) &stringVar,
+ if (Tcl_LinkVar(interp, "string", &stringVar,
TCL_LINK_STRING | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3021,7 +3021,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "wide", (char *) &wideVar,
+ if (Tcl_LinkVar(interp, "wide", &wideVar,
TCL_LINK_WIDE_INT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3029,7 +3029,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "char", (char *) &charVar,
+ if (Tcl_LinkVar(interp, "char", &charVar,
TCL_LINK_CHAR | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3037,7 +3037,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "uchar", (char *) &ucharVar,
+ if (Tcl_LinkVar(interp, "uchar", &ucharVar,
TCL_LINK_UCHAR | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3045,7 +3045,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "short", (char *) &shortVar,
+ if (Tcl_LinkVar(interp, "short", &shortVar,
TCL_LINK_SHORT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3053,7 +3053,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "ushort", (char *) &ushortVar,
+ if (Tcl_LinkVar(interp, "ushort", &ushortVar,
TCL_LINK_USHORT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3061,7 +3061,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "uint", (char *) &uintVar,
+ if (Tcl_LinkVar(interp, "uint", &uintVar,
TCL_LINK_UINT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3069,7 +3069,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "long", (char *) &longVar,
+ if (Tcl_LinkVar(interp, "long", &longVar,
TCL_LINK_LONG | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3077,7 +3077,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "ulong", (char *) &ulongVar,
+ if (Tcl_LinkVar(interp, "ulong", &ulongVar,
TCL_LINK_ULONG | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3085,7 +3085,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "float", (char *) &floatVar,
+ if (Tcl_LinkVar(interp, "float", &floatVar,
TCL_LINK_FLOAT | flag) != TCL_OK) {
return TCL_ERROR;
}
@@ -3093,7 +3093,7 @@ TestlinkCmd(
return TCL_ERROR;
}
flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
- if (Tcl_LinkVar(interp, "uwide", (char *) &uwideVar,
+ if (Tcl_LinkVar(interp, "uwide", &uwideVar,
TCL_LINK_WIDE_UINT | flag) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5d43029..b736d5d 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3616,37 +3616,24 @@ TclFormatInt(
Tcl_WideInt n) /* The integer to format. */
{
Tcl_WideUInt intVal;
- int i;
+ int i = 0;
int numFormatted, j;
static const char digits[] = "0123456789";
/*
- * Check first whether "n" is zero.
- */
-
- if (n == 0) {
- buffer[0] = '0';
- buffer[1] = 0;
- return 1;
- }
-
- /*
* Generate the characters of the result backwards in the buffer.
*/
intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);
- i = 0;
- buffer[0] = '\0';
do {
- i++;
- buffer[i] = digits[intVal % 10];
+ buffer[i++] = digits[intVal % 10];
intVal = intVal / 10;
} while (intVal > 0);
if (n < 0) {
- i++;
- buffer[i] = '-';
+ buffer[i++] = '-';
}
- numFormatted = i;
+ buffer[i] = '\0';
+ numFormatted = i--;
/*
* Now reverse the characters.
generated by cgit v0.12 at 2024-11-16 12:37:44 (GMT)