summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog15
-rwxr-xr-xgeneric/tclStrToD.c58
-rw-r--r--generic/tclStubInit.c1
-rw-r--r--generic/tclTomMath.decls3
-rw-r--r--generic/tclTomMathDecls.h11
-rw-r--r--macosx/Tcl.xcode/project.pbxproj2
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj2
-rw-r--r--tests/util.test33
-rw-r--r--unix/Makefile.in7
-rw-r--r--win/Makefile.in1
-rw-r--r--win/makefile.vc1
11 files changed, 123 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index 70860fe..0df1778 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2011-07-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c:
+ * generic/tclTomMath.decls:
+ * generic/tclTomMathDecls.h:
+ * macosx/Tcl.xcode/project.pbxproj:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+ * tests/util.test:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ Fix a bug where bignum->double conversion is "round up" and
+ not "round to nearest" (causing expr double(1[string repeat 0 23])
+ not to be 1e+23). [Bug 3349507]
+
2011-06-30 Reinhard Max <max@suse.de>
* unix/configure.in: Add a volatile declaration to the test for
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 421657c..7e76727 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -4542,12 +4542,13 @@ TclBignumToDouble(
mp_int *a) /* Integer to convert. */
{
mp_int b;
- int bits, shift, i;
+ int bits, shift, i, lsb;
double r;
+
/*
- * Determine how many bits we need, and extract that many from the input.
- * Round to nearest unit in the last place.
+ * We need a 'mantBits'-bit significand. Determine what shift will
+ * give us that.
*/
bits = mp_count_bits(a);
@@ -4559,17 +4560,54 @@ TclBignumToDouble(
return -HUGE_VAL;
}
}
- shift = mantBits + 1 - bits;
+ shift = mantBits - bits;
+
+ /*
+ * If shift > 0, shift the significand left by the requisite number of
+ * bits. If shift == 0, the significand is already exactly 'mantBits'
+ * in length. If shift < 0, we will need to shift the significand right
+ * by the requisite number of bits, and round it. If the '1-shift'
+ * least significant bits are 0, but the 'shift'th bit is nonzero,
+ * then the significand lies exactly between two values and must be
+ * 'rounded to even'.
+ */
+
mp_init(&b);
- if (shift > 0) {
+ if (shift == 0) {
+ mp_copy(a, &b);
+ } else if (shift > 0) {
mp_mul_2d(a, shift, &b);
} else if (shift < 0) {
- mp_div_2d(a, -shift, &b, NULL);
- } else {
- mp_copy(a, &b);
+ lsb = mp_cnt_lsb(a);
+ if (lsb == -1-shift) {
+
+ /*
+ * Round to even
+ */
+
+ mp_div_2d(a, -shift, &b, NULL);
+ if (mp_isodd(&b)) {
+ if (b.sign == MP_ZPOS) {
+ mp_add_d(&b, 1, &b);
+ } else {
+ mp_sub_d(&b, 1, &b);
+ }
+ }
+ } else {
+
+ /*
+ * Ordinary rounding
+ */
+
+ mp_div_2d(a, -1-shift, &b, NULL);
+ if (b.sign == MP_ZPOS) {
+ mp_add_d(&b, 1, &b);
+ } else {
+ mp_sub_d(&b, 1, &b);
+ }
+ mp_div_2d(&b, 1, &b, NULL);
+ }
}
- mp_add_d(&b, 1, &b);
- mp_div_2d(&b, 1, &b, NULL);
/*
* Accumulate the result, one mp_digit at a time.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index bc29ee6..d8a300c 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -481,6 +481,7 @@ TclTomMathStubs tclTomMathStubs = {
TclBN_s_mp_sub, /* 60 */
TclBN_mp_init_set_int, /* 61 */
TclBN_mp_set_int, /* 62 */
+ TclBN_mp_cnt_lsb, /* 63 */
};
static TclStubHooks tclStubHooks = {
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index ca883f6..191312f 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -217,3 +217,6 @@ declare 61 {
declare 62 {
int TclBN_mp_set_int(mp_int* a, unsigned long i)
}
+declare 63 {
+ int TclBN_mp_cnt_lsb(mp_int* a)
+}
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index f072311..4d5515b 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -63,6 +63,7 @@
#define mp_cmp TclBN_mp_cmp
#define mp_cmp_d TclBN_mp_cmp_d
#define mp_cmp_mag TclBN_mp_cmp_mag
+#define mp_cnt_lsb TclBN_mp_cnt_lsb
#define mp_copy TclBN_mp_copy
#define mp_count_bits TclBN_mp_count_bits
#define mp_div TclBN_mp_div
@@ -461,6 +462,11 @@ EXTERN int TclBN_mp_init_set_int(mp_int*a, unsigned long i);
/* 62 */
EXTERN int TclBN_mp_set_int(mp_int*a, unsigned long i);
#endif
+#ifndef TclBN_mp_cnt_lsb_TCL_DECLARED
+#define TclBN_mp_cnt_lsb_TCL_DECLARED
+/* 63 */
+EXTERN int TclBN_mp_cnt_lsb(mp_int*a);
+#endif
typedef struct TclTomMathStubs {
int magic;
@@ -529,6 +535,7 @@ typedef struct TclTomMathStubs {
int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
int (*tclBN_mp_init_set_int) (mp_int*a, unsigned long i); /* 61 */
int (*tclBN_mp_set_int) (mp_int*a, unsigned long i); /* 62 */
+ int (*tclBN_mp_cnt_lsb) (mp_int*a); /* 63 */
} TclTomMathStubs;
#ifdef __cplusplus
@@ -797,6 +804,10 @@ extern TclTomMathStubs *tclTomMathStubsPtr;
#define TclBN_mp_set_int \
(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
#endif
+#ifndef TclBN_mp_cnt_lsb
+#define TclBN_mp_cnt_lsb \
+ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
index 035cf26..0153b26 100644
--- a/macosx/Tcl.xcode/project.pbxproj
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -93,6 +93,7 @@
F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; };
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; };
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; };
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; };
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; };
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; };
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; };
@@ -2073,6 +2074,7 @@
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index 2215f71..97158b0 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -93,6 +93,7 @@
F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; };
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; };
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; };
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; };
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; };
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; };
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; };
@@ -2084,6 +2085,7 @@
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
diff --git a/tests/util.test b/tests/util.test
index 7e3f962..6a0785e 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -3853,7 +3853,40 @@ test util-16.1.17.307 {8.4 compatible formatting of doubles} \
{expr 1e307} \
9.9999999999999999e+306
+test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
+ set r {}
+ foreach {input} {
+ 0x1ffffffffffffc000
+ 0x1ffffffffffffc800
+ 0x1ffffffffffffd000
+ 0x1ffffffffffffd800
+ 0x1ffffffffffffe000
+ 0x1ffffffffffffe800
+ 0x1fffffffffffff000
+ 0x1fffffffffffff800
+ } {
+ binary scan [binary format q [expr double($input)]] wu x
+ lappend r [format %#llx $x]
+ binary scan [binary format q [expr double(-$input)]] wu x
+ lappend r [format %#llx $x]
+ }
+ set r
+} [list {*}{
+ 0x43fffffffffffffc 0xc3fffffffffffffc
+ 0x43fffffffffffffc 0xc3fffffffffffffc
+ 0x43fffffffffffffd 0xc3fffffffffffffd
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43ffffffffffffff 0xc3ffffffffffffff
+ 0x4400000000000000 0xc400000000000000
+}]
+
set ::tcl_precision $saved_precision
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: \ No newline at end of file
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1ed5484..ded4c6b 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -294,7 +294,8 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
- bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o bn_mp_copy.o \
+ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
+ bn_mp_cnt_lsb.o bn_mp_copy.o \
bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_exch.o bn_mp_expt_d.o bn_mp_grow.o bn_mp_init.o \
@@ -439,6 +440,7 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_cmp_d.c \
$(TOMMATH_DIR)/bn_mp_cmp_mag.c \
$(TOMMATH_DIR)/bn_mp_copy.c \
+ $(TOMMATH_DIR)/bn_mp_cnt_lsb.c \
$(TOMMATH_DIR)/bn_mp_count_bits.c \
$(TOMMATH_DIR)/bn_mp_div.c \
$(TOMMATH_DIR)/bn_mp_div_d.c \
@@ -1238,6 +1240,9 @@ bn_mp_cmp_d.o: $(TOMMATH_DIR)/bn_mp_cmp_d.c $(MATHHDRS)
bn_mp_cmp_mag.o: $(TOMMATH_DIR)/bn_mp_cmp_mag.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_mag.c
+bn_mp_cnt_lsb.o: $(TOMMATH_DIR)/bn_mp_cnt_lsb.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cnt_lsb.c
+
bn_mp_copy.o: $(TOMMATH_DIR)/bn_mp_copy.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_copy.c
diff --git a/win/Makefile.in b/win/Makefile.in
index b48f1f4..8883128 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -291,6 +291,7 @@ TOMMATH_OBJS = \
bn_mp_cmp.${OBJEXT} \
bn_mp_cmp_d.${OBJEXT} \
bn_mp_cmp_mag.${OBJEXT} \
+ bn_mp_cnt_lsb.${OBJEXT} \
bn_mp_copy.${OBJEXT} \
bn_mp_count_bits.${OBJEXT} \
bn_mp_div.${OBJEXT} \
diff --git a/win/makefile.vc b/win/makefile.vc
index 7dc96b7..d982284 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -343,6 +343,7 @@ TCLOBJS = \
$(TMP_DIR)\bn_mp_cmp.obj \
$(TMP_DIR)\bn_mp_cmp_d.obj \
$(TMP_DIR)\bn_mp_cmp_mag.obj \
+ $(TMP_DIR)\bn_mp_cnt_lsb.obj \
$(TMP_DIR)\bn_mp_copy.obj \
$(TMP_DIR)\bn_mp_count_bits.obj \
$(TMP_DIR)\bn_mp_div.obj \