[kennykb-numerics-branch]

        * generic/tclTomMath.h: Added mp_sqrt to routines from
        * unix/Makefile.in:     libtommath used by Tcl.
        * win/Makefile.in:
        * win/makefile.vc:

        * generic/tclBasic.c:   Extended sqrt(.) so that range covers
        the entire double range, accepting as many bignums in the domain
        as that will allow.

6 files changed, 71 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index a669f02..f3e71f3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2005-08-30  Don Porter  <dgp@users.sourceforge.net>
+
+	[kennykb-numerics-branch]
+
+	* generic/tclTomMath.h:	Added mp_sqrt to routines from
+	* unix/Makefile.in:	libtommath used by Tcl.
+	* win/Makefile.in:
+	* win/makefile.vc:
+
+	* generic/tclBasic.c:	Extended sqrt(.) so that range covers
+	the entire double range, accepting as many bignums in the domain
+	as that will allow.
+
 2005-08-29  Don Porter  <dgp@users.sourceforge.net>
 
 	[kennykb-numerics-branch]	Merge updates from HEAD.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8c3bebf..1f1d34d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.136.2.31 2005/08/29 18:38:45 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.136.2.32 2005/08/30 15:54:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -71,6 +71,8 @@ static int	ExprRandFunc _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
 static int	ExprRoundFunc _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
+static int	ExprSqrtFunc _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
 static int	ExprSrandFunc _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
 static int	ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
@@ -267,7 +269,7 @@ static BuiltinFuncDef BuiltinFuncTable[] = {
     { "::tcl::mathfunc::round",	ExprRoundFunc,	NULL			},
     { "::tcl::mathfunc::sin",	ExprUnaryFunc,	(ClientData) sin 	},
     { "::tcl::mathfunc::sinh",	ExprUnaryFunc,	(ClientData) sinh 	},
-    { "::tcl::mathfunc::sqrt",	ExprUnaryFunc,	(ClientData) sqrt 	},
+    { "::tcl::mathfunc::sqrt",	ExprSqrtFunc,	NULL		 	},
     { "::tcl::mathfunc::srand",	ExprSrandFunc,	NULL			},
     { "::tcl::mathfunc::tan",	ExprUnaryFunc,	(ClientData) tan 	},
     { "::tcl::mathfunc::tanh",	ExprUnaryFunc,	(ClientData) tanh 	},
@@ -4983,9 +4985,7 @@ Tcl_GetVersion(majorV, minorV, patchLevelV, type)
 
 static int
 ExprCeilFunc(clientData, interp, objc, objv)
-    ClientData clientData;	/* Contains the address of a procedure that
-				 * takes one double argument and returns a
-				 * double result. */
+    ClientData clientData;	/* Ignored */
     Tcl_Interp *interp;		/* The interpreter in which to execute the
 				 * function. */
     int objc;			/* Actual parameter count */
@@ -5020,9 +5020,7 @@ ExprCeilFunc(clientData, interp, objc, objv)
 
 static int
 ExprFloorFunc(clientData, interp, objc, objv)
-    ClientData clientData;	/* Contains the address of a procedure that
-				 * takes one double argument and returns a
-				 * double result. */
+    ClientData clientData;	/* Ignored */
     Tcl_Interp *interp;		/* The interpreter in which to execute the
 				 * function. */
     int objc;			/* Actual parameter count */
@@ -5056,6 +5054,46 @@ ExprFloorFunc(clientData, interp, objc, objv)
 }
 
 static int
+ExprSqrtFunc(clientData, interp, objc, objv)
+    ClientData clientData;	/* Ignored */
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    int objc;			/* Actual parameter count */
+    Tcl_Obj *CONST *objv;	/* Actual parameter list */
+{
+    int code;
+    double d;
+    mp_int big;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (d >= 0.0 && TclIsInfinite(d) 
+	    && Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
+	mp_int root;
+	mp_init(&root);
+	mp_sqrt(&big, &root);
+	mp_clear(&big);
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root)));
+	mp_clear(&root);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
+    }
+    return TCL_OK;
+}
+
+static int
 ExprUnaryFunc(clientData, interp, objc, objv)
     ClientData clientData;	/* Contains the address of a procedure that
 				 * takes one double argument and returns a
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index 3d3bebb..fcaa240 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -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: tclTomMath.h,v 1.1.2.4 2005/08/16 16:55:18 dgp Exp $
+ * RCS: @(#) $Id: tclTomMath.h,v 1.1.2.5 2005/08/30 15:54:29 dgp Exp $
  */
 
 #ifndef TCLTOMMATH_H
@@ -103,6 +103,7 @@ void* TclBNCalloc( size_t, size_t );
 #define mp_read_radix TclBN_mp_read_radix
 #define mp_rshd TclBN_mp_rshd
 #define mp_shrink TclBN_mp_shrink
+#define mp_sqrt TclBN_mp_sqrt
 #define mp_sub TclBN_mp_sub
 #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
 #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
diff --git a/unix/Makefile.in b/unix/Makefile.in
index b2ff79f..3d5f987 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.157.2.16 2005/08/25 15:47:07 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.157.2.17 2005/08/30 15:54:29 dgp Exp $
 
 VERSION 		= @TCL_VERSION@
 MAJOR_VERSION		= @TCL_MAJOR_VERSION@
@@ -326,7 +326,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
         bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
 	bn_mp_radix_size.o bn_mp_radix_smap.o \
         bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_shrink.o \
-	bn_mp_sqr.o bn_mp_sub.o bn_mp_sub_d.o \
+	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
         bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
 	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
 	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
@@ -477,6 +477,7 @@ TOMMATH_SRCS = \
 	$(TOMMATH_DIR)/bn_mp_set.c \
 	$(TOMMATH_DIR)/bn_mp_shrink.c \
 	$(TOMMATH_DIR)/bn_mp_sqr.c \
+	$(TOMMATH_DIR)/bn_mp_sqrt.c \
 	$(TOMMATH_DIR)/bn_mp_sub.c \
 	$(TOMMATH_DIR)/bn_mp_sub_d.c \
 	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \
@@ -1322,6 +1323,9 @@ bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c
 bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c
 	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqr.c
 
+bn_mp_sqrt.o: $(TOMMATH_DIR)/bn_mp_sqrt.c
+	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqrt.c
+
 bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c
 	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index 4d14ad6..4cef73e 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.84.2.12 2005/08/25 15:47:07 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.84.2.13 2005/08/30 15:54:29 dgp Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -328,6 +328,7 @@ TOMMATH_OBJS = \
 	bn_mp_set.${OBJEXT} \
 	bn_mp_shrink.${OBJEXT} \
 	bn_mp_sqr.${OBJEXT} \
+	bn_mp_sqrt.${OBJEXT} \
 	bn_mp_sub.${OBJEXT} \
 	bn_mp_sub_d.${OBJEXT} \
 	bn_mp_to_unsigned_bin.${OBJEXT} \
diff --git a/win/makefile.vc b/win/makefile.vc
index 3c5062a..358c313 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
 # Copyright (c) 2001-2004 David Gravereaux.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.135.2.8 2005/08/25 15:47:07 dgp Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.135.2.9 2005/08/30 15:54:29 dgp Exp $
 #------------------------------------------------------------------------------
 
 # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -380,6 +380,7 @@ TCLOBJS = \
 	$(TMP_DIR)\bn_mp_set.obj \
 	$(TMP_DIR)\bn_mp_shrink.obj \
 	$(TMP_DIR)\bn_mp_sqr.obj \
+	$(TMP_DIR)\bn_mp_sqrt.obj \
 	$(TMP_DIR)\bn_mp_sub.obj \
 	$(TMP_DIR)\bn_mp_sub_d.obj \
 	$(TMP_DIR)\bn_mp_to_unsigned_bin.obj \