diff options
author | dgp <dgp@users.sourceforge.net> | 2005-08-11 16:29:23 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-08-11 16:29:23 (GMT) |
commit | b8f109ec4d7d31f6f7847c46c43d2549fd6a430b (patch) | |
tree | 1598b6dbeb32f0d0c3082f326b27f272bd8548a6 | |
parent | b3602e927e9d6c19dd279f624576ae3a3eff1989 (diff) | |
download | tcl-b8f109ec4d7d31f6f7847c46c43d2549fd6a430b.zip tcl-b8f109ec4d7d31f6f7847c46c43d2549fd6a430b.tar.gz tcl-b8f109ec4d7d31f6f7847c46c43d2549fd6a430b.tar.bz2 |
[kennykb_numerics_branch]
* generic/tclStrToD.c: Restored conditional generation of
tclWideIntType values by TclParseNumber so that Tcl's not
completely broken while bignum calculation support is incomplete.
The NO_WIDE_TYPE macro can be used to disable this.
* generic/tclBasic.c (ExprAbsFunc): First pass making [expr abs(.)]
bignum-aware.
* generic/tclExecute.c: Made INST_TRY_CVT_TO_NUMERIC bignum aware.
-rw-r--r-- | ChangeLog | 14 | ||||
-rw-r--r-- | generic/tclBasic.c | 101 | ||||
-rw-r--r-- | generic/tclExecute.c | 9 | ||||
-rwxr-xr-x | generic/tclStrToD.c | 34 |
4 files changed, 101 insertions, 57 deletions
@@ -1,3 +1,17 @@ +2005-08-11 Don Porter <dgp@users.sourceforge.net> + + [kennykb_numerics_branch] + + * generic/tclStrToD.c: Restored conditional generation of + tclWideIntType values by TclParseNumber so that Tcl's not + completely broken while bignum calculation support is incomplete. + The NO_WIDE_TYPE macro can be used to disable this. + + * generic/tclBasic.c (ExprAbsFunc): First pass making [expr abs(.)] + bignum-aware. + + * generic/tclExecute.c: Made INST_TRY_CVT_TO_NUMERIC bignum aware. + 2005-08-10 Don Porter <dgp@users.sourceforge.net> [kennykb_numerics_branch] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 51dd06a..b22f351 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,13 +13,14 @@ * 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.13 2005/08/02 18:15:10 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.14 2005/08/11 16:29:23 dgp Exp $ */ #include "tclInt.h" #include "tclCompile.h" #include <float.h> #include <math.h> +#include "tommath.h" /* * The following structure defines the client data for a math function @@ -5068,74 +5069,66 @@ ExprAbsFunc(clientData, interp, objc, objv) int objc; /* Actual parameter count */ Tcl_Obj *CONST *objv; /* Parameter vector */ { - register Tcl_Obj *valuePtr; - long i, iResult; - double d, dResult; - Tcl_Obj* oResult; + double d; + mp_int big; + Tcl_Obj *valuePtr = objv[1]; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } - valuePtr = objv[1]; - if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + /* TODO - an Tcl_GetNumberFromObj call might be more useful ? */ + if (Tcl_GetDoubleFromObj(NULL, valuePtr, &d) == TCL_ERROR) { + /* TODO - decide what the right error message, etc. */ + Tcl_SetObjResult(interp, Tcl_NewStringObj("non-numeric argument", -1)); return TCL_ERROR; } + if (d >= 0.0) { + /* Non-negative values are their own absolute value */ + Tcl_SetObjResult(interp, valuePtr); + return TCL_OK; + } /* - * Derive the absolute value according to the arg type. + * To take the absolute value of a negative value, take care to + * keep the same data type, fixed vs. floating point, and to + * promote to wider type if needed. */ + + if (valuePtr->typePtr == &tclDoubleType) { + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); + return TCL_OK; + } if (valuePtr->typePtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - if (i < 0) { - iResult = -i; - if (iResult < 0) { - /* FIXME: This should promote to wide! */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", - "integer value too large to represent", (char *) NULL); - return TCL_ERROR; - } - } else { - iResult = i; - } - TclNewLongObj(oResult, iResult); - Tcl_SetObjResult(interp, oResult); - } else if (valuePtr->typePtr == &tclWideIntType) { - Tcl_WideInt wResult, w; - TclGetWide(w,valuePtr); - if (w < (Tcl_WideInt)0) { - wResult = -w; - if (wResult < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", - "integer value too large to represent", (char *) NULL); - return TCL_ERROR; - } - } else { - wResult = w; - } - TclNewWideIntObj(oResult, wResult); - Tcl_SetObjResult(interp, oResult); - } else { - d = valuePtr->internalRep.doubleValue; - if (d < 0.0) { - dResult = -d; - } else { - dResult = d; + long l = - valuePtr->internalRep.longValue; + if (l < 0) { + TclBNInitBignumFromLong(&big, l); + goto promotion; } - if (IS_NAN(dResult)) { - TclExprFloatError(interp, dResult); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewLongObj(l)); + return TCL_OK; + } +#ifndef NO_WIDE_TYPE + if (valuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt w; + TclGetWide(w, valuePtr); + w = -w; + if (w < 0) { + TclBNInitBignumFromWideUInt(&big, (Tcl_WideUInt)w); + goto promotion; } - TclNewDoubleObj(oResult, dResult); - Tcl_SetObjResult(interp, oResult); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w)); + return TCL_OK; + } +#endif + if (valuePtr->typePtr == &tclBignumType) { + Tcl_GetBignumFromObj(NULL, valuePtr, &big); + promotion: + big.sign = MP_ZPOS; + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); + return TCL_OK; } - - return TCL_OK; } static int diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8e2f8be..424f6a7 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,11 +12,12 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.167.2.15 2005/08/02 18:15:24 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.16 2005/08/11 16:29:24 dgp Exp $ */ #include "tclInt.h" #include "tclCompile.h" +#include "tommath.h" #include <math.h> #include <float.h> @@ -321,7 +322,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; (longVar) = Tcl_WideAsLong(wideVar); \ } #define IS_INTEGER_TYPE(typePtr) \ - ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType) + ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType || (typePtr) == &tclBignumType) #define IS_NUMERIC_TYPE(typePtr) \ (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType) @@ -4512,6 +4513,10 @@ TclExecuteByteCode(interp, codePtr) } else if (tPtr == &tclWideIntType) { TclGetWide(w,valuePtr); TclNewWideIntObj(objResultPtr, w); + } else if (tPtr == &tclBignumType) { + mp_int big; + Tcl_GetBignumFromObj(NULL, valuePtr, &big); + objResultPtr = Tcl_NewBignumObj(&big); } else { d = valuePtr->internalRep.doubleValue; TclNewDoubleObj(objResultPtr, d); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 701b5c4..95a116a 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.18 2005/08/10 18:21:53 dgp Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.19 2005/08/11 16:29:24 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -873,6 +873,22 @@ TclParseNumber( Tcl_Interp* interp, if (!octalSignificandOverflow) { if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { +#ifndef TCL_WIDE_INT_IS_LONG +#ifndef NO_WIDE_TYPE + if (octalSignificandWide + <= (((~(Tcl_WideUInt)0) >> 1) + signum)) { + objPtr->typePtr = &tclWideIntType; + if (signum) { + objPtr->internalRep.wideValue = + - (Tcl_WideInt) octalSignificandWide; + } else { + objPtr->internalRep.wideValue = + (Tcl_WideInt) octalSignificandWide; + } + break; + } +#endif +#endif TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; @@ -922,6 +938,22 @@ TclParseNumber( Tcl_Interp* interp, if (!significandOverflow) { if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { +#ifndef TCL_WIDE_INT_IS_LONG +#ifndef NO_WIDE_TYPE + if (significandWide + <= (((~(Tcl_WideUInt)0) >> 1) + signum)) { + objPtr->typePtr = &tclWideIntType; + if (signum) { + objPtr->internalRep.wideValue = + - (Tcl_WideInt) significandWide; + } else { + objPtr->internalRep.wideValue = + (Tcl_WideInt) significandWide; + } + break; + } +#endif +#endif TclBNInitBignumFromWideUInt(&significandBig, significandWide); significandOverflow = 1; |