Synchronized with HEAD

9 files changed, 188 insertions, 37 deletions

diff --git a/ChangeLog b/ChangeLog
index e98b93c..5937cb9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,11 +1,42 @@
+2005-05-11  Kevin Kenny <kennykb@acm.org>
+
+	[kennykb-numerics-branch] Resynchronized with the HEAD; at this
+	checkpoint [-rkennykb-numerics-branch-20050511], the HEAD and
+	kennykb-numerics-branch contain identical code.
+	
+2005-05-10  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly
+	compliant compilers that don't like trailing ,s.
+
+	* tests/string.test: string-10.[21-30]
+	* generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to
+	prevent possible UMR in unichar cmp function for string map.
+
+2005-05-10  Kevin Kenny  <kennykb@acm.org>
+
+	* 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  <kennykb@acm.org>
+
+	Merged all changes on kennykb-numerics-branch back into the
+	HEAD.  TIP's 132 and 232 are now Final.
+	
 2005-05-10  Kevin Kenny  <kennykb@acm.org>
 
 	[kennykb-numerics-branch] Merged changes from HEAD.
 	
 2005-05-10  Miguel Sofer <msofer@users.sf.net>
 
-	* generic/tclExecute.c (ExponLong, ExponWide): fixed special case
-	'i**0' for i>0 [Bug 1198892]
+	* generic/tclExecute.c (ExponLong, ExponWide): 
+	* tests/expr.test (expr-23.34/35): fixed special case 'i**0' for
+	i>0 [Bug 1198892] 
 
 2005-05-09  Kevin B. Kenny  <kennykb@acm.org>
 
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 7e2be41..be4265b 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -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: tclBinary.c,v 1.21.2.2 2005/04/26 17:09:46 kennykb Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.21.2.3 2005/05/11 15:01:06 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -1632,6 +1632,7 @@ FormatNumber(interp, type, src, cursorPtr)
 	    if ( src->typePtr != &tclDoubleType ) {
 		return TCL_ERROR;
 	    }
+	    dvalue = src->internalRep.doubleValue;
 	}
 
 	/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 958a03d..3eced23 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.115.2.4 2005/05/05 17:55:32 kennykb Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.5 2005/05/11 15:01:06 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -1907,7 +1907,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 
 		ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
 		p = ustring1;
-		if (length2 == 0) {
+		if ((length2 > length1) || (length2 == 0)) {
+		    /* match string is either longer than input or empty */
 		    ustring1 = end;
 		} else {
 		    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
@@ -1965,6 +1966,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			if ((length2 > 0) && ((*ustring1 == *ustring2) ||
 				(nocase && (Tcl_UniCharToLower(*ustring1) ==
 					u2lc[index/2]))) &&
+				/* restrict max compare length */
+				((end - ustring1) >= length2) &&
 				((length2 == 1) || strCmpFn(ustring2, ustring1,
 					(unsigned long) length2) == 0)) {
 			    if (p != ustring1) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 95fc1da..aede4ba 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.1.2.12 2005/05/08 20:42:00 kennykb Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.13 2005/05/11 15:01:22 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
new file mode 100644
index 0000000..e3926df
--- /dev/null
+++ b/libtommath/tommath_superclass.h
@@ -0,0 +1,72 @@
+/* super class file for PK algos */
+
+/* default ... include all MPI */
+#define LTM_ALL
+
+/* RSA only (does not support DH/DSA/ECC) */
+/* #define SC_RSA_1 */
+
+/* For reference.... On an Athlon64 optimizing for speed...
+
+   LTM's mpi.o with all functions [striped] is 142KiB in size.
+
+*/
+
+/* Works for RSA only, mpi.o is 68KiB */
+#ifdef SC_RSA_1
+   #define BN_MP_SHRINK_C
+   #define BN_MP_LCM_C
+   #define BN_MP_PRIME_RANDOM_EX_C
+   #define BN_MP_INVMOD_C
+   #define BN_MP_GCD_C
+   #define BN_MP_MOD_C
+   #define BN_MP_MULMOD_C
+   #define BN_MP_ADDMOD_C
+   #define BN_MP_EXPTMOD_C
+   #define BN_MP_SET_INT_C
+   #define BN_MP_INIT_MULTI_C
+   #define BN_MP_CLEAR_MULTI_C
+   #define BN_MP_UNSIGNED_BIN_SIZE_C
+   #define BN_MP_TO_UNSIGNED_BIN_C
+   #define BN_MP_MOD_D_C
+   #define BN_MP_PRIME_RABIN_MILLER_TRIALS_C
+   #define BN_REVERSE_C
+   #define BN_PRIME_TAB_C
+
+   /* other modifiers */
+   #define BN_MP_DIV_SMALL                    /* Slower division, not critical */
+
+   /* here we are on the last pass so we turn things off.  The functions classes are still there
+    * but we remove them specifically from the build.  This also invokes tweaks in functions
+    * like removing support for even moduli, etc...
+    */
+#ifdef LTM_LAST
+   #undef  BN_MP_TOOM_MUL_C
+   #undef  BN_MP_TOOM_SQR_C
+   #undef  BN_MP_KARATSUBA_MUL_C
+   #undef  BN_MP_KARATSUBA_SQR_C
+   #undef  BN_MP_REDUCE_C
+   #undef  BN_MP_REDUCE_SETUP_C
+   #undef  BN_MP_DR_IS_MODULUS_C
+   #undef  BN_MP_DR_SETUP_C
+   #undef  BN_MP_DR_REDUCE_C
+   #undef  BN_MP_REDUCE_IS_2K_C
+   #undef  BN_MP_REDUCE_2K_SETUP_C
+   #undef  BN_MP_REDUCE_2K_C
+   #undef  BN_S_MP_EXPTMOD_C
+   #undef  BN_MP_DIV_3_C
+   #undef  BN_S_MP_MUL_HIGH_DIGS_C
+   #undef  BN_FAST_S_MP_MUL_HIGH_DIGS_C
+   #undef  BN_FAST_MP_INVMOD_C
+
+   /* To safely undefine these you have to make sure your RSA key won't exceed the Comba threshold
+    * which is roughly 255 digits [7140 bits for 32-bit machines, 15300 bits for 64-bit machines] 
+    * which means roughly speaking you can handle upto 2536-bit RSA keys with these defined without
+    * trouble.  
+    */
+   #undef  BN_S_MP_MUL_DIGS_C
+   #undef  BN_S_MP_SQR_C
+   #undef  BN_MP_MONTGOMERY_REDUCE_C
+#endif
+
+#endif
diff --git a/tests/binary.test b/tests/binary.test
index ca0298b..ad8bba1 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.18.2.4 2005/03/15 19:08:08 kennykb Exp $
+# RCS: @(#) $Id: binary.test,v 1.18.2.5 2005/05/11 15:01:22 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
diff --git a/tests/string.test b/tests/string.test
index 25d7800..2e38d63 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: string.test,v 1.43.2.3 2005/05/05 17:56:35 kennykb Exp $
+# RCS: @(#) $Id: string.test,v 1.43.2.4 2005/05/11 15:01:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -810,6 +810,36 @@ test string-10.21 {string map, nasty sharing crash from [Bug 1018562]} {
     set a {a b}
     string map $a $a
 } {b b}
+test string-10.21 {string map, ABR checks} {
+    string map {longstring foob} long
+} long
+test string-10.22 {string map, ABR checks} {
+    string map {long foob} long
+} foob
+test string-10.23 {string map, ABR checks} {
+    string map {lon foob} long
+} foobg
+test string-10.24 {string map, ABR checks} {
+    string map {lon foob} longlo
+} foobglo
+test string-10.25 {string map, ABR checks} {
+    string map {lon foob} longlon
+} foobgfoob
+test string-10.26 {string map, ABR checks} {
+    string map {longstring foob longstring bar} long
+} long
+test string-10.27 {string map, ABR checks} {
+    string map {long foob longstring bar} long
+} foob
+test string-10.28 {string map, ABR checks} {
+    string map {lon foob longstring bar} long
+} foobg
+test string-10.29 {string map, ABR checks} {
+    string map {lon foob longstring bar} longlo
+} foobglo
+test string-10.30 {string map, ABR checks} {
+    string map {lon foob longstring bar} longlon
+} foobgfoob
 
 test string-11.1 {string match, too few args} {
     list [catch {string match a} msg] $msg
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index c5eef27..3fa2abb 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -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: tclUnixFCmd.c,v 1.40.2.1 2005/01/20 14:53:41 kennykb Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.40.2.2 2005/05/11 15:01:22 kennykb Exp $
  *
  * Portions of this code were derived from NetBSD source code which has
  * the following copyright notice:
@@ -135,6 +135,7 @@ enum {
     MACOSX_HIDDEN_ATTRIBUTE,
     MACOSX_RSRCLENGTH_ATTRIBUTE,
 #endif
+    UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
 };
 
 CONST char *tclpFileAttrStrings[] = {
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index b7accc9..e1bb1ce 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.40.2.2 2005/05/09 22:13:22 kennykb Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.40.2.3 2005/05/11 15:01:23 kennykb Exp $
  */
 
 #include "tclWinInt.h"
@@ -554,7 +554,7 @@ TclpCheckStackSpace()
         "leal   %[stat],        %%edx"          "\n\t"
         "pushl  %%edx"                          "\n\t"
         "pushl  %%ebp"                          "\n\t"
-        "leal   %%cs:1f,        %%edx"          "\n\t"
+        "leal   1f,	        %%edx"          "\n\t"
         "pushl  %%edx"                          "\n\t"
         "pushl  %%fs:0"                         "\n\t"
         "movl   %%esp,          %%fs:0"         "\n\t"
@@ -1066,7 +1066,7 @@ Tcl_WinTCharToUtf(string, len, dsPtr)
 
 int
 TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */
-             register unsigned int * regsPtr ) /* Registers after the CPUID */
+             unsigned int * regsPtr ) /* Registers after the CPUID */
 {
 
     int status = TCL_ERROR;
@@ -1093,7 +1093,7 @@ TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */
         "movl   %[rptr],        %%edi"          "\n\t"
         "pushl  %%edx"                          "\n\t"
         "pushl  %%ebp"                          "\n\t"
-        "leal   %%cs:1f,        %%edx"          "\n\t"
+        "leal   1f,	        %%edx"          "\n\t"
         "pushl  %%edx"                          "\n\t"
         "pushl  %%fs:0"                         "\n\t"
         "movl   %%esp,          %%fs:0"         "\n\t"
@@ -1135,7 +1135,7 @@ TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */
 
         : [stat]"=m"(status)
         : [index]"m"(index),
-          [rptr]"r"(regsPtr),
+          [rptr]"m"(regsPtr),
           [ok]"i"(TCL_OK),
           [error]"i"(TCL_ERROR)
         : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" );