From 2bfc68501866a3efdbc3da722c3968f8ce0004ec Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Tue, 10 May 2005 20:17:28 +0000 Subject: Fixes for C++-style comment and bad NaN on PA-RISC --- ChangeLog | 4 ++++ generic/tclStrToD.c | 19 +++++++++++++++--- libtommath/tommath_superclass.h | 2 +- tests/binary.test | 44 ++++++++++++++++++++--------------------- 4 files changed, 43 insertions(+), 26 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8da1173..c3bcd37 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ * generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's resulted in reads of uninitialized memory when using 'd', 'q', or 'Q' format. + * generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to + handle the peculiarities of HP's PA_RISC, which uses a different + 'quiet' bit in NaN from everyone else. + * libtommath/tommath_superclass.h: Corrected C++-style comment. 2005-05-10 Kevin Kenny diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2d622a7..feb0278 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.2 2005/05/10 18:34:49 kennykb Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.3 2005/05/10 20:17:42 kennykb Exp $ * *---------------------------------------------------------------------- */ @@ -60,6 +60,19 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); #define _FPU_SETCW(cw) __asm__ ("fldcw %0" : : "m" (*&cw)) #endif +/* + * HP's PA_RISC architecture uses 7ff4000000000000 to represent a + * quiet NaN. Everyone else uses 7ff8000000000000. (Why, HP, why?) + */ + +#ifdef __hppa +# define NAN_START 0x7ff4 +# define NAN_MASK (((Tcl_WideUInt) 1) << 50) +#else +# define NAN_START 0x7ff8 +# define NAN_MASK (((Tcl_WideUInt) 1) << 51) +#endif + /* The powers of ten that can be represented exactly as IEEE754 doubles. */ #define MAXPOW 22 @@ -762,7 +775,7 @@ ParseNaN( int signum, /* Flag == 1 if minus sign has been } else if ( c >= 'a' && c <= 'f' ) { c = c - 'a' + 10; } else { - theNaN.iv = ( ((Tcl_WideUInt) 0x7ff8) << 48 ) + theNaN.iv = ( ((Tcl_WideUInt) NAN_START) << 48 ) | ( ((Tcl_WideUInt) signum) << 63 ); return theNaN.dv; } @@ -778,7 +791,7 @@ ParseNaN( int signum, /* Flag == 1 if minus sign has been if ( signum ) { theNaN.iv |= ((Tcl_WideUInt) 0xfff8) << 48; } else { - theNaN.iv |= ((Tcl_WideUInt) 0x7ff8) << 48; + theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48; } *endPtr = p; diff --git a/libtommath/tommath_superclass.h b/libtommath/tommath_superclass.h index b50ecb0..e3926df 100644 --- a/libtommath/tommath_superclass.h +++ b/libtommath/tommath_superclass.h @@ -4,7 +4,7 @@ #define LTM_ALL /* RSA only (does not support DH/DSA/ECC) */ -// #define SC_RSA_1 +/* #define SC_RSA_1 */ /* For reference.... On an Athlon64 optimizing for speed... diff --git a/tests/binary.test b/tests/binary.test index 047f80f..fb934d8 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.19 2005/05/10 18:34:56 kennykb Exp $ +# RCS: @(#) $Id: binary.test,v 1.20 2005/05/10 20:17:43 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1932,25 +1932,6 @@ test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian { list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 } {2 {1386435412 16909060} 5} -# scan m -test binary-60.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian { - binary scan HelloTcl m x - set x -} 5216694956358656876 -test binary-60.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian { - binary scan lcTolleH m x - set x -} 5216694956358656876 -test binary-60.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { - binary scan [binary format w [expr {wide(3) << 31}]] m x - set x -} 6442450944 -test binary-60.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { - binary scan [binary format W [expr {wide(3) << 31}]] m x - set x -} 6442450944 - - # scan Q/q test binary-58.1 {Tcl_BinaryObjCmd: scan} { list [catch {binary scan abc q} msg] $msg @@ -2085,11 +2066,30 @@ test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian { list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} -test binary-60.1 {[binary format] with NaN} { +test binary-60.1 {[binary format] with NaN} -body { binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \ v1 v2 v3 v4 v5 v6 list $v1 $v2 $v3 $v4 $v5 $v6 -} {NaN NaN NaN NaN NaN NaN} +} -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?} + +# scan m +test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian { + binary scan HelloTcl m x + set x +} 5216694956358656876 +test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian { + binary scan lcTolleH m x + set x +} 5216694956358656876 +test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { + binary scan [binary format w [expr {wide(3) << 31}]] m x + set x +} 6442450944 +test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { + binary scan [binary format W [expr {wide(3) << 31}]] m x + set x +} 6442450944 + # cleanup ::tcltest::cleanupTests -- cgit v0.12