From fa017c619ce3a26b2765bca23aa499ca4fd0053c Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 30 Aug 2005 15:54:28 +0000 Subject: [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. --- ChangeLog | 13 +++++++++++++ generic/tclBasic.c | 54 ++++++++++++++++++++++++++++++++++++++++++++-------- generic/tclTomMath.h | 3 ++- unix/Makefile.in | 8 ++++++-- win/Makefile.in | 3 ++- win/makefile.vc | 3 ++- 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 + + [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 [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 \ -- cgit v0.12