diff options
author | dgp <dgp@users.sourceforge.net> | 2005-08-22 15:48:25 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-08-22 15:48:25 (GMT) |
commit | 3cc494a6f47eb9b3a2bab61d68ad44ac3760da42 (patch) | |
tree | f4a066d2db636e67b040ebe88ae9e366a7d8144f | |
parent | b8c1f5cc403d85f72dcb06625778e8c52345e754 (diff) | |
download | tcl-3cc494a6f47eb9b3a2bab61d68ad44ac3760da42.zip tcl-3cc494a6f47eb9b3a2bab61d68ad44ac3760da42.tar.gz tcl-3cc494a6f47eb9b3a2bab61d68ad44ac3760da42.tar.bz2 |
[kennykb_numerics_branch]
* generic/tclBasic: Added [expr {entier(.)}].
* generic/tclInt.h: New routine TclInitBignumFromDouble.
* generic/tclStrToD.c:
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | generic/tclBasic.c | 33 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rwxr-xr-x | generic/tclStrToD.c | 53 |
4 files changed, 92 insertions, 3 deletions
@@ -2,6 +2,11 @@ [kennykb_numerics_branch] + * generic/tclBasic: Added [expr {entier(.)}]. + + * generic/tclInt.h: New routine TclInitBignumFromDouble. + * generic/tclStrToD.c: + * generic/tclInt.h: TCL_WIDE_INT_IS_LONG implies NO_WIDE_TYPE. * generic/tclObj.c: Removed now unnecessary tests of the * generic/tclStrToD.c: TCL_WIDE_INT_IS_LONG definition. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2619d0e..7feb1e5 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.21 2005/08/22 03:49:38 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.22 2005/08/22 15:48:26 dgp Exp $ */ #include "tclInt.h" @@ -57,6 +57,8 @@ static int ExprBoolFunc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv)); static int ExprDoubleFunc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv)); +static int ExprEntierFunc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv)); static int ExprIntFunc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv)); static int ExprRandFunc _ANSI_ARGS_((ClientData clientData, @@ -262,6 +264,7 @@ BuiltinFuncDef BuiltinFuncTable[] = { { "::tcl::mathfunc::cos", ExprUnaryFunc, (ClientData) cos }, { "::tcl::mathfunc::cosh", ExprUnaryFunc, (ClientData) cosh }, { "::tcl::mathfunc::double",ExprDoubleFunc, NULL }, + { "::tcl::mathfunc::entier",ExprEntierFunc, NULL }, { "::tcl::mathfunc::exp", ExprUnaryFunc, (ClientData) exp }, { "::tcl::mathfunc::floor", ExprUnaryFunc, (ClientData) floor }, { "::tcl::mathfunc::fmod", ExprBinaryFunc, (ClientData) fmod }, @@ -5164,6 +5167,34 @@ ExprDoubleFunc(clientData, interp, objc, objv) } static int +ExprEntierFunc(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 vector */ +{ + double d; + mp_int big; + if (objc != 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) { + mp_clear(&big); + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + /* Non-numeric argument */ + return TCL_ERROR; + } + TclInitBignumFromDouble(d, &big); + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); + return TCL_OK; +} + +static int ExprIntFunc(clientData, interp, objc, objv) ClientData clientData; /* Ignored. */ Tcl_Interp *interp; /* The interpreter in which to execute the diff --git a/generic/tclInt.h b/generic/tclInt.h index 7b9ee69..76e3060 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.202.2.27 2005/08/22 14:21:01 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.28 2005/08/22 15:48:26 dgp Exp $ */ #ifndef _TCLINT @@ -2012,6 +2012,8 @@ MODULE_SCOPE Tcl_Obj * TclIncrObjVar2 _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags)); MODULE_SCOPE void TclInitAlloc _ANSI_ARGS_((void)); +MODULE_SCOPE void TclInitBignumFromDouble _ANSI_ARGS_((double d, + mp_int *b)); MODULE_SCOPE void TclInitDbCkalloc _ANSI_ARGS_((void)); MODULE_SCOPE void TclInitDoubleConversion _ANSI_ARGS_((void)); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index de5c268..ba14cbd 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.24 2005/08/22 14:21:02 dgp Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.25 2005/08/22 15:48:26 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -2687,6 +2687,57 @@ TclFinalizeDoubleConversion() /* *---------------------------------------------------------------------- * + * TclInitBignumFromDouble -- + * + * Extracts the integer part of a double and converts it to + * an arbitrary precision integer. + * + * Results: + * None. + * + * Side effects: + * Initializes the bignum supplied, and stores the converted number + * in it. + * + *---------------------------------------------------------------------- + */ + +void +TclInitBignumFromDouble(double d, /* Number to convert */ + mp_int* b) /* Place to store the result */ +{ + double fract; + int expt; + fract = frexp(d,&expt); + if (expt <= 0) { + mp_init(b); + mp_zero(b); + } else { + Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits); + int signum = 0; + int shift = expt - mantBits; + Tcl_WideUInt uw; + if (w < 0) { + uw = (Tcl_WideUInt)-w; + signum = 1; + } else { + uw = w; + } + TclBNInitBignumFromWideUInt(b, uw); + if (shift < 0) { + mp_div_2d(b, -shift, b, NULL); + } else if (shift > 0) { + mp_mul_2d(b, shift, b); + } + if (signum) { + b->sign = MP_NEG; + } + } +} + +/* + *---------------------------------------------------------------------- + * * TclBignumToDouble -- * * Convert an arbitrary-precision integer to a native floating point |