summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2006-12-01 19:59:59 (GMT)
committerKevin B Kenny <kennykb@acm.org>2006-12-01 19:59:59 (GMT)
commit339ca1b05809a2057811f8afa91f753e7482dc0f (patch)
tree583e2aa907472a929b1df844211858394e6f224a /generic/tclBasic.c
parent987906704f34c52aac4787e16dcbbc9d41ddbd48 (diff)
downloadtcl-339ca1b05809a2057811f8afa91f753e7482dc0f.zip
tcl-339ca1b05809a2057811f8afa91f753e7482dc0f.tar.gz
tcl-339ca1b05809a2057811f8afa91f753e7482dc0f.tar.bz2
TIP#299 IMPLEMENTATION
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c120
1 files changed, 119 insertions, 1 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a3fb387..1226323 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,16 +13,27 @@
* 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.223 2006/12/01 15:55:44 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.224 2006/12/01 19:59:59 kennykb Exp $
*/
#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 @@ static int ExprFloorFunc (ClientData clientData, Tcl_Interp *interp,
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 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "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 },
@@ -5598,6 +5612,110 @@ ExprFloorFunc(
}
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