Attachment "isqrt.patch" to
ticket [1602534fff]
added by
kennykb
2006-11-25 07:30:40.
? NSK1KENNYKB03
Index: doc/mathfunc.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/mathfunc.n,v
retrieving revision 1.11
diff -b -u -r1.11 mathfunc.n
--- doc/mathfunc.n 28 Jul 2006 10:38:00 -0000 1.11
+++ doc/mathfunc.n 25 Nov 2006 00:28:47 -0000
@@ -51,6 +51,8 @@
.br
\fB::tcl::mathfunc::int\fR \fIarg\fR
.br
+\fB::tcl::mathfunc::isqrt\fR \fIarg \F
+.br
\fB::tcl::mathfunc::log\fR \fIarg\fR
.br
\fB::tcl::mathfunc::log10\fR \fIarg\fR
@@ -99,10 +101,10 @@
\fBatan2\fR \fBbool\fR \fBceil\fR \fBcos\fR
\fBcosh\fR \fBdouble\fR \fBentier\fR \fBexp\fR
\fBfloor\fR \fBfmod\fR \fBhypot\fR \fBint\fR
-\fBlog\fR \fBlog10\fR \fBmax\fR \fBmin\fR
-\fBpow\fR \fBrand\fR \fBround\fR \fBsin\fR
-\fBsinh\fR \fBsqrt\fR \fBsrand\fR \fBtan\fR
-\fBtanh\fR \fBwide\fR
+\fBisqrt\fR \fBlog\fR \fBlog10\fR \fBmax\fR
+\fBmin\fR \fBpow\fR \fBrand\fR \fBround\fR
+\fBsin\fR \fBsinh\fR \fBsqrt\fR \fBsrand\fR
+\fBtan\fR \fBtanh\fR \fBwide\fR
.DE
.PP
.TP
@@ -185,6 +187,12 @@
the number of bytes in the machine word are stored in
\fBtcl_platform(wordSize)\fR.
.TP
+\fBisqrt(\fIarg\fB)\fR
+Computes the integer part of the square root of \fIarg\fR. \fIArg\fR must be
+a positive value, either an integer or a floating point number.
+Unlike \fBsqrt\fR, which is limited to the precision of a floating point
+number, \fIisqrt\fR will return a result of arbitrary precision.
+.TP
\fBlog(\fIarg\fB)\fR
Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a
positive value.
@@ -261,4 +269,4 @@
.br
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
.br
-Copyright (c) 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
+Copyright (c) 2005, 2006 by Kevin B. Kenny <[email protected]>.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.220
diff -b -u -r1.220 tclBasic.c
--- generic/tclBasic.c 23 Nov 2006 15:24:28 -0000 1.220
+++ generic/tclBasic.c 25 Nov 2006 00:28:48 -0000
@@ -19,10 +19,21 @@
#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
+#include <limits.h>
#include <math.h>
#include "tommath.h"
/*
+ * Determine whether we're using IEEE floating point
+ */
+
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+# define IEEE_FLOATING_POINT
+/* Largest odd integer that can be represented exactly in a double */
+# define MAX_EXACT 9007199254740991.0
+#endif
+
+/*
* The following structure defines the client data for a math function
* registered with Tcl_CreateMathFunc
*/
@@ -65,6 +76,8 @@
int argc, Tcl_Obj *CONST *objv);
static int ExprIntFunc (ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *CONST *objv);
+static int ExprIsqrtFunc (ClientData clientData, Tcl_Interp *interp,
+ int argc, Tcl_Obj *CONST *objv);
static int ExprRandFunc (ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *CONST *objv);
static int ExprRoundFunc (ClientData clientData, Tcl_Interp *interp,
@@ -237,6 +250,7 @@
{ "fmod", ExprBinaryFunc, (ClientData) fmod },
{ "hypot", ExprBinaryFunc, (ClientData) hypot },
{ "int", ExprIntFunc, NULL },
+ { "isqrt", ExprIsqrtFunc, NULL },
{ "log", ExprUnaryFunc, (ClientData) log },
{ "log10", ExprUnaryFunc, (ClientData) log10 },
{ "pow", ExprBinaryFunc, (ClientData) pow },
@@ -5154,6 +5168,110 @@
}
static int
+ExprIsqrtFunc(
+ ClientData clientData, /* Ignored */
+ Tcl_Interp* interp, /* The interpreter in which to execute */
+ int objc, /* Actual parameter count */
+ Tcl_Obj *CONST *objv) /* Actual parameter list */
+{
+ ClientData ptr;
+ int type;
+ double d;
+ Tcl_WideInt w;
+ mp_int big;
+ int exact = 0; /* Flag == 1 if the argument can be
+ * represented in a double as an exact
+ * integer */
+
+ /* Check syntax */
+ if (objc != 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+
+ /* Make sure that the arg is a number */
+ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (type) {
+
+ case TCL_NUMBER_NAN:
+ {
+ Tcl_GetDoubleFromObj(interp, objv[1], &d);
+ return TCL_ERROR;
+ }
+
+ case TCL_NUMBER_DOUBLE:
+ {
+ d = *((CONST double *)ptr);
+ if (d < 0) {
+ goto negarg;
+ }
+#ifdef IEEE_FLOATING_POINT
+ if (d <= MAX_EXACT) {
+ exact = 1;
+ }
+#endif
+ if (!exact) {
+ if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ case TCL_NUMBER_BIG:
+ {
+ if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (SIGN(&big) == MP_NEG) {
+ mp_clear(&big);
+ goto negarg;
+ }
+ break;
+ }
+
+ default:
+ {
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (w < 0) {
+ goto negarg;
+ }
+ d = (double) w;
+#ifdef IEEE_FLOATING_POINT
+ if (d < MAX_EXACT) {
+ exact = 1;
+ }
+#endif
+ if (!exact) {
+ Tcl_GetBignumFromObj(interp, objv[1], &big);
+ }
+ break;
+ }
+ }
+
+ if (exact) {
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
+ } else {
+ mp_int root;
+ mp_init(&root);
+ mp_sqrt(&big, &root);
+ mp_clear(&big);
+ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
+ }
+
+ return TCL_OK;
+
+ negarg:
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("square root of negative argument", -1));
+ return TCL_ERROR;
+}
+
+static int
ExprSqrtFunc(
ClientData clientData, /* Ignored */
Tcl_Interp *interp, /* The interpreter in which to execute the
Index: libtommath/bn_mp_sqrt.c
===================================================================
RCS file: /cvsroot/tcl/libtommath/bn_mp_sqrt.c,v
retrieving revision 1.2
diff -b -u -r1.2 bn_mp_sqrt.c
--- libtommath/bn_mp_sqrt.c 27 Dec 2005 17:39:02 -0000 1.2
+++ libtommath/bn_mp_sqrt.c 25 Nov 2006 00:28:48 -0000
@@ -68,12 +68,18 @@
dig = (mp_digit) ldexp(d, -DIGIT_BIT);
if (dig) {
t1.used = i+2;
- t1.dp[i+1] = dig;
d -= ldexp((double) dig, DIGIT_BIT);
+ if (d != 0,0) {
+ t1.dp[i+1] = dig;
+ t1.dp[i] = ((mp_digit) d) - 1;
+ } else {
+ t1.dp[i+1] = dig-1;
+ t1.dp[i] = MP_DIGIT_MAX;
+ }
} else {
t1.used = i+1;
+ t1.dp[i] = ((mp_digit) d) - 1;
}
- t1.dp[i] = (mp_digit) d;
#else
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.65
diff -b -u -r1.65 expr.test
--- tests/expr.test 5 Nov 2006 03:33:57 -0000 1.65
+++ tests/expr.test 25 Nov 2006 00:28:49 -0000
@@ -6556,6 +6556,97 @@
expr {round(double(0x7fffffffffffffff))}
} 9223372036854775808
+test expr-47.1 {isqrt() - arg count} {
+ list [catch {expr {isqrt(1,2)}} result] $result
+} {1 {too many arguments for math function "isqrt"}}
+
+test expr-47.2 {isqrt() - non-number} {
+ list [catch {expr {isqrt({rubbish})}} result] $result
+} {1 {expected number but got "rubbish"}}
+
+test expr-47.3 {isqrt() - NaN} ieeeFloatingPoint {
+ list [catch {expr {isqrt(NaN)}} result] $result
+} {1 {floating point value is Not a Number}}
+
+test expr-47.4 {isqrt() of negative floating point number} {
+ list [catch {expr {isqrt(-1.0)}} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.5 {isqrt() of floating point zero} {
+ expr isqrt(0.0)
+} 0
+
+test expr-47.6 {isqrt() of exact floating point numbers} {
+ set trouble {}
+ for {set i 0} {$i < 16} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {pow(2., (2 * $i))}]
+ if {isqrt($arg-1) != $rm1} {
+ append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+ }
+ if {isqrt($arg) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+ }
+ if {isqrt($arg+1) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+ }
+ }
+ set trouble
+} {}
+
+test expr-47.7 {isqrt() of exact floating point numbers} ieeeFloatingPoint {
+ set trouble {}
+ for {set i 17} {$i < 27} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {pow(2., (2 * $i))}]
+ if {isqrt($arg-1.0) != $rm1} {
+ append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+ }
+ if {isqrt($arg) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+ }
+ if {isqrt($arg+1.0) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+ }
+ }
+ set trouble
+} {}
+
+test expr-47.8 {isqrt of inexact floating point number} ieeeFloatingPoint {
+ expr isqrt(2[string repeat 0 34])
+} 141421356237309504
+
+test expr-47.9 {isqrt of negative int} {
+ list [catch {expr isqrt(-1)} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.10 {isqrt of negative bignum} {
+ list [catch {expr isqrt(-1[string repeat 0 1000])} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.11 {isqrt of zero} {
+ expr {isqrt(0)}
+} 0
+
+test expr-47.12 {isqrt of various sizes of integer} {
+ for {set i 0} {$i < 3000} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {1 << (2 * $i)}]
+ if {isqrt($arg-1) != $rm1} {
+ append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+ }
+ if {isqrt($arg) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+ }
+ if {isqrt($arg+1) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+ }
+ }
+ set trouble
+} {}
# cleanup
if {[info exists a]} {
