From 5888f0657adfcd3ac7d1f4e88e8e30546cd172d8 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Sep 2005 19:29:02 +0000 Subject: [kennykb-numerics-branch] * generic/tclInt.h: Added TclBNInitBigNumFromWideInt() * generic/tclTomMathInterface.c: so that every caller isn't required to duplicate the sign logic to use the unsigned interface. * generic/tclBasic.c: Reduce the number of places where Tcl * generic/tclExecute.c: intrudes into the internal format details * generic/tclObj.c: of the mp_int struct. * generic/tclStrToD.c: * generic/tcLStringObj.c: * generic/tclTomMath.h: Added mp_cmp_d to routines from * unix/Makefile.in: libtommath used by Tcl. * win/Makefile.in: * win/makefile.vc: --- ChangeLog | 10 ++++++++++ generic/tclBasic.c | 4 ++-- generic/tclExecute.c | 17 ++++++++--------- generic/tclInt.h | 4 +++- generic/tclObj.c | 18 ++++-------------- generic/tclStrToD.c | 27 ++++++--------------------- generic/tclStringObj.c | 4 ++-- generic/tclTomMathInterface.c | 32 +++++++++++++++++++++++++++++++- 8 files changed, 66 insertions(+), 50 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8df0368..7daa6d8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,16 @@ [kennykb-numerics-branch] + * generic/tclInt.h: Added TclBNInitBigNumFromWideInt() + * generic/tclTomMathInterface.c: so that every caller isn't + required to duplicate the sign logic to use the unsigned interface. + + * generic/tclBasic.c: Reduce the number of places where Tcl + * generic/tclExecute.c: intrudes into the internal format details + * generic/tclObj.c: of the mp_int struct. + * generic/tclStrToD.c: + * generic/tcLStringObj.c: + * generic/tclTomMath.h: Added mp_cmp_d to routines from * unix/Makefile.in: libtommath used by Tcl. * win/Makefile.in: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c50ea94..fcd7910 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.34 2005/09/15 20:58:39 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.35 2005/09/16 19:29:02 dgp Exp $ */ #include "tclInt.h" @@ -5242,7 +5242,7 @@ ExprAbsFunc(clientData, interp, objc, objv) */ if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) { - big.sign = MP_ZPOS; + mp_neg(&big, &big); Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 93e68f0..63a88e4 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.167.2.40 2005/09/16 15:35:54 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.41 2005/09/16 19:29:02 dgp Exp $ */ #include "tclInt.h" @@ -3831,7 +3831,7 @@ TclExecuteByteCode(interp, codePtr) IllegalExprOperandType(interp, pc, value2Ptr); goto checkForCatch; } - if (big2.sign == MP_NEG) { + if (mp_cmp_d(&big2, 0) == MP_LT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("negative shift argument", -1)); result = TCL_ERROR; @@ -3857,7 +3857,7 @@ TclExecuteByteCode(interp, codePtr) mp_int bigRemainder; mp_init(&bigRemainder); mp_div_2d(&big1, shift, &bigResult, &bigRemainder); - if (!mp_iszero(&bigRemainder) && (bigRemainder.sign == MP_NEG)) { + if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { /* Convert to Tcl's integer division rules */ mp_sub_d(&bigResult, 1, &bigResult); } @@ -3902,10 +3902,10 @@ TclExecuteByteCode(interp, codePtr) IllegalExprOperandType(interp, pc, value2Ptr); goto checkForCatch; } - if (big1.sign == MP_ZPOS) { + if (mp_cmp_d(&big1, 0) != MP_LT) { numPos++; Pos = &big1; - if (big2.sign == MP_ZPOS) { + if (mp_cmp_d(&big2, 0) != MP_LT) { numPos++; Other = &big2; } else { @@ -3913,7 +3913,7 @@ TclExecuteByteCode(interp, codePtr) } } else { Neg = &big1; - if (big2.sign == MP_ZPOS) { + if (mp_cmp_d(&big2, 0) != MP_LT) { numPos++; Pos = &big2; } else { @@ -4845,8 +4845,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F(1, 2, 1); } if (mp_iszero(&big1)) { - /* TODO: Use mp_cmp_d() call instead */ - if (big2.sign == MP_NEG) { + if (mp_cmp_d(&big2, 0) == MP_LT) { TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr), O2S(value2Ptr))); mp_clear(&big1); @@ -4858,7 +4857,7 @@ TclExecuteByteCode(interp, codePtr) objResultPtr = eePtr->constants[0]; NEXT_INST_F(1, 2, 1); } - if (big2.sign == MP_NEG) { + if (mp_cmp_d(&big2, 0) == MP_LT) { switch (mp_cmp_d(&big1, 1)) { case MP_GT: objResultPtr = eePtr->constants[0]; diff --git a/generic/tclInt.h b/generic/tclInt.h index 015ecc2..d71dadb 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.39 2005/09/15 20:58:39 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.40 2005/09/16 19:29:02 dgp Exp $ */ #ifndef _TCLINT @@ -2869,6 +2869,8 @@ MODULE_SCOPE void * TclBNAlloc(size_t nBytes); MODULE_SCOPE void * TclBNRealloc(void *oldBlock, size_t newNBytes); MODULE_SCOPE void TclBNFree(void *block); MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal); +MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int* bignum, + Tcl_WideInt initVal); MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, Tcl_WideUInt initVal); diff --git a/generic/tclObj.c b/generic/tclObj.c index e238b34..ab645fd 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -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: tclObj.c,v 1.72.2.34 2005/09/09 18:48:40 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.72.2.35 2005/09/16 19:29:02 dgp Exp $ */ #include "tclInt.h" @@ -2415,12 +2415,7 @@ Tcl_SetWideIntObj(objPtr, wideValue) TclSetLongObj(objPtr, (long) wideValue); } else { mp_int big; - if (wideValue < 0) { - TclBNInitBignumFromWideUInt(&big, (Tcl_WideUInt)(-wideValue)); - big.sign = MP_NEG; - } else { - TclBNInitBignumFromWideUInt(&big, (Tcl_WideUInt)(wideValue)); - } + TclBNInitBignumFromWideInt(&big, wideValue); Tcl_SetBignumObj(objPtr, &big); } #endif @@ -2738,13 +2733,8 @@ Tcl_GetBignumFromObj( } #ifndef NO_WIDE_TYPE if (objPtr->typePtr == &tclWideIntType) { - Tcl_WideInt w = objPtr->internalRep.wideValue; - if (w < 0) { - TclBNInitBignumFromWideUInt(bignumValue, (Tcl_WideUInt)(-w)); - bignumValue->sign = MP_NEG; - } else { - TclBNInitBignumFromWideUInt(bignumValue, (Tcl_WideUInt)w); - } + TclBNInitBignumFromWideInt(bignumValue, + objPtr->internalRep.wideValue) return TCL_OK; } #endif diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 7eef0b3..c3b37ef 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -14,7 +14,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.36 2005/09/02 17:42:24 dgp Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.37 2005/09/16 19:29:02 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -1018,9 +1018,7 @@ TclParseNumber( Tcl_Interp* interp, } if (octalSignificandOverflow) { if (signum) { - octalSignificandBig.sign = MP_NEG; - } else { - octalSignificandBig.sign = MP_ZPOS; + mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumIntRep(objPtr, &octalSignificandBig); octalSignificandOverflow = 0; @@ -1074,9 +1072,7 @@ TclParseNumber( Tcl_Interp* interp, } if (significandOverflow) { if (signum) { - significandBig.sign = MP_NEG; - } else { - significandBig.sign = MP_ZPOS; + mp_neg(&significandBig, &significandBig); } TclSetBignumIntRep(objPtr, &significandBig); significandOverflow = 0; @@ -2188,24 +2184,13 @@ TclInitBignumFromDouble(Tcl_Interp *interp, /* For error message */ 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); + TclBNInitBignumFromWideInt(b, w); 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; - } } return TCL_OK; } @@ -2294,7 +2279,7 @@ TclCeil(mp_int *a) /* Integer to convert. */ mp_int b; mp_init(&b); - if (a->sign == MP_NEG) { + if (mp_cmp_d(a, 0) == MP_LT) { mp_neg(a, &b); r = -TclFloor(&b); } else { @@ -2336,7 +2321,7 @@ TclFloor(mp_int *a) /* Integer to convert. */ mp_int b; mp_init(&b); - if (a->sign == MP_NEG) { + if (mp_cmp_d(a, 0) == MP_LT) { mp_neg(a, &b); r = -TclCeil(&b); } else { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 0cb89e8..d0d972c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.35.2.9 2005/09/15 20:58:40 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.35.2.10 2005/09/16 19:29:02 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -1940,7 +1940,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { goto error; } - isNegative = (big.sign == MP_NEG); + isNegative = (mp_cmp_d(&big, 0) == MP_LT); } else if (useWide) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c index a23b721..568b5fb3 100644 --- a/generic/tclTomMathInterface.c +++ b/generic/tclTomMathInterface.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTomMathInterface.c,v 1.1.2.3 2005/08/10 18:21:53 dgp Exp $ + * RCS: @(#) $Id: tclTomMathInterface.c,v 1.1.2.4 2005/09/16 19:29:02 dgp Exp $ */ #include "tclInt.h" @@ -145,6 +145,36 @@ TclBNInitBignumFromLong( mp_int* a, long initVal ) /* *---------------------------------------------------------------------- * + * TclBNInitBignumFromWideInt -- + * + * Allocate and initialize a 'bignum' from a Tcl_WideInt + * + * Results: + * None. + * + * Side effects: + * The 'bignum' is constructed. + * + *---------------------------------------------------------------------- + */ + +extern void +TclBNInitBignumFromWideInt(mp_int* a, + /* Bignum to initialize */ + Tcl_WideInt v) + /* Initial value */ +{ + if (v < (Tcl_WideInt)0) { + TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v)); + mp_neg(a, a); + } else { + TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v); + } +} + +/* + *---------------------------------------------------------------------- + * * TclBNInitBignumFromWideUInt -- * * Allocate and initialize a 'bignum' from a Tcl_WideUInt -- cgit v0.12