? 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 <kennykb@acm.org>. All rights reserved.
+Copyright (c) 2005, 2006 by Kevin B. Kenny <kennykb@acm.org>.
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]} {
