Tcl Source Code

Check-in [6e1addf33e]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:
[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:
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 6e1addf33ec523f44d06a1322464f93b908081f5
User & Date: dgp 2005-09-16 19:29:02
Context
2005-09-20
14:11
[kennykb-numerics-branch]
* generic/tclExecute.c: Revise TclIncrObj() to call ...
check-in: dd93281cd4 user: dgp tags: kennykb-numerics-branch
2005-09-16
19:29
[kennykb-numerics-branch]
* generic/tclInt.h: Added TclBNInitBigNumFrom...
check-in: 6e1addf33e user: dgp tags: kennykb-numerics-branch
16:13
* libtommath/bn_mp_add_d.c: Bug fix. For mp_add_d(&a, d, &c), when &a has the v...
check-in: dc9f2eaf23 user: dgp tags: kennykb-numerics-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3










4
5
6
7
8
9
10
2005-09-16  Don Porter  <[email protected]>

	[kennykb-numerics-branch]











	* generic/tclTomMath.h:	Added mp_cmp_d to routines from
	* unix/Makefile.in:	libtommath used by Tcl.
	* win/Makefile.in:
	* win/makefile.vc:

	* libtommath/bn_mp_add_d.c:	Bug fix.  For mp_add_d(&a, d, &c),


>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
2005-09-16  Don Porter  <[email protected]>

	[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:

	* libtommath/bn_mp_add_d.c:	Bug fix.  For mp_add_d(&a, d, &c),

Changes to generic/tclBasic.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
....
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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 $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
     * keep the same data type, fixed vs. floating point, and to
     * promote to wider type if needed.
     *
     * TODO: efficient use of narrower ints.
     */

    if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) {
	big.sign = MP_ZPOS;
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
    }
    return TCL_OK;
}







|







 







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
....
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.35 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
     * keep the same data type, fixed vs. floating point, and to
     * promote to wider type if needed.
     *
     * TODO: efficient use of narrower ints.
     */

    if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) {
	mp_neg(&big, &big);
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
    }
    return TCL_OK;
}

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
....
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
....
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
....
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005 by Donal K. Fellows.
 *
 * 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 $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
................................................................................
	    mp_clear(&big1);
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}
	if (big2.sign == MP_NEG) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("negative shift argument", -1));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	mp_clear(&big2);
	if (mp_iszero(&big1)) {
................................................................................
	mp_init(&bigResult);
	if (*pc == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_int bigRemainder;
	    mp_init(&bigRemainder);
	    mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
	    if (!mp_iszero(&bigRemainder) && (bigRemainder.sign == MP_NEG)) {
		/* Convert to Tcl's integer division rules */
		mp_sub_d(&bigResult, 1, &bigResult);
	    }
	    mp_clear(&bigRemainder);
	}
	mp_clear(&big1);
	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
................................................................................
	    mp_clear(&big1);
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}
	if (big1.sign == MP_ZPOS) {
	    numPos++;
	    Pos = &big1;
	    if (big2.sign == MP_ZPOS) {
		numPos++;
		Other = &big2;
	    } else {
		Neg = &big2;
	    }
	} else {
	    Neg = &big1;
	    if (big2.sign == MP_ZPOS) {
		numPos++;
		Pos = &big2;
	    } else {
		Other = &big2;
	    }
	}
	mp_init(&bigResult);
................................................................................
		    /* Anything to the zero power is 1 */
		    mp_clear(&big1);
		    mp_clear(&big2);
		    objResultPtr = eePtr->constants[1];
		    NEXT_INST_F(1, 2, 1);
		}
		if (mp_iszero(&big1)) {
		    /* TODO: Use mp_cmp_d() call instead */
		    if (big2.sign == MP_NEG) {
			TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
			mp_clear(&big1);
			mp_clear(&big2);
			goto exponOfZero;
		    }
		    mp_clear(&big1);
		    mp_clear(&big2);
		    objResultPtr = eePtr->constants[0];
		    NEXT_INST_F(1, 2, 1);
		}
		if (big2.sign == MP_NEG) {
		    switch (mp_cmp_d(&big1, 1)) {
		    case MP_GT:
			objResultPtr = eePtr->constants[0];
			break;
		    case MP_EQ:
			objResultPtr = eePtr->constants[1];
			break;






|







 







|







 







|







 







|


|







|







 







|
<











|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
....
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
....
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
....
4841
4842
4843
4844
4845
4846
4847
4848

4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005 by Donal K. Fellows.
 *
 * 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.41 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
................................................................................
	    mp_clear(&big1);
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}
	if (mp_cmp_d(&big2, 0) == MP_LT) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("negative shift argument", -1));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}
	mp_clear(&big2);
	if (mp_iszero(&big1)) {
................................................................................
	mp_init(&bigResult);
	if (*pc == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_int bigRemainder;
	    mp_init(&bigRemainder);
	    mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
	    if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
		/* Convert to Tcl's integer division rules */
		mp_sub_d(&bigResult, 1, &bigResult);
	    }
	    mp_clear(&bigRemainder);
	}
	mp_clear(&big1);
	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
................................................................................
	    mp_clear(&big1);
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}
	if (mp_cmp_d(&big1, 0) != MP_LT) {
	    numPos++;
	    Pos = &big1;
	    if (mp_cmp_d(&big2, 0) != MP_LT) {
		numPos++;
		Other = &big2;
	    } else {
		Neg = &big2;
	    }
	} else {
	    Neg = &big1;
	    if (mp_cmp_d(&big2, 0) != MP_LT) {
		numPos++;
		Pos = &big2;
	    } else {
		Other = &big2;
	    }
	}
	mp_init(&bigResult);
................................................................................
		    /* Anything to the zero power is 1 */
		    mp_clear(&big1);
		    mp_clear(&big2);
		    objResultPtr = eePtr->constants[1];
		    NEXT_INST_F(1, 2, 1);
		}
		if (mp_iszero(&big1)) {
		    if (mp_cmp_d(&big2, 0) == MP_LT) {

			TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
			mp_clear(&big1);
			mp_clear(&big2);
			goto exponOfZero;
		    }
		    mp_clear(&big1);
		    mp_clear(&big2);
		    objResultPtr = eePtr->constants[0];
		    NEXT_INST_F(1, 2, 1);
		}
		if (mp_cmp_d(&big2, 0) == MP_LT) {
		    switch (mp_cmp_d(&big1, 1)) {
		    case MP_GT:
			objResultPtr = eePtr->constants[0];
			break;
		    case MP_EQ:
			objResultPtr = eePtr->constants[1];
			break;

Changes to generic/tclInt.h.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2865
2866
2867
2868
2869
2870
2871


2872
2873
2874
2875
2876
2877
2878
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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 $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options
................................................................................
 *----------------------------------------------------------------------
 */

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	TclBNInitBignumFromWideUInt(mp_int* bignum,
			    Tcl_WideUInt initVal);

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:






|







 







>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.40 2005/09/16 19:29:02 dgp Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options
................................................................................
 *----------------------------------------------------------------------
 */

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);

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:

Changes to generic/tclObj.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
....
2734
2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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 $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
    TclSetWideIntObj(objPtr, wideValue);
#else
    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	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));
	}
	Tcl_SetBignumObj(objPtr, &big);
    }
#endif
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	}
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#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);
	    }
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
		Tcl_Obj* msg =
			Tcl_NewStringObj("expected integer but got \"", -1);






|







 







<
<
<
<
|
<







 







>
|
<
<
<
<
<
<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2411
2412
2413
2414
2415
2416
2417




2418

2419
2420
2421
2422
2423
2424
2425
....
2729
2730
2731
2732
2733
2734
2735
2736
2737






2738
2739
2740
2741
2742
2743
2744
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.35 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
    TclSetWideIntObj(objPtr, wideValue);
#else
    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	TclSetLongObj(objPtr, (long) wideValue);
    } else {
	mp_int big;




	TclBNInitBignumFromWideInt(&big, wideValue);

	Tcl_SetBignumObj(objPtr, &big);
    }
#endif
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	}
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    TclBNInitBignumFromWideInt(bignumValue, 
		    objPtr->internalRep.wideValue)






	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
		Tcl_Obj* msg =
			Tcl_NewStringObj("expected integer but got \"", -1);

Changes to generic/tclStrToD.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
....
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
....
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
....
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
....
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
 *	interconversion among 'double' and 'mp_int' types.
 *
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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 $
 *
 *----------------------------------------------------------------------
 */

#include <tclInt.h>
#include <stdio.h>
#include <stdlib.h>
................................................................................
			objPtr->internalRep.longValue =
				(long) octalSignificandWide;
		    }
		}
	    }
	    if (octalSignificandOverflow) {
		if (signum) {
		    octalSignificandBig.sign = MP_NEG;
		} else {
		    octalSignificandBig.sign = MP_ZPOS;
		}
		TclSetBignumIntRep(objPtr, &octalSignificandBig);
		octalSignificandOverflow = 0;
	    }		
	    break;

	case ZERO:
................................................................................
			objPtr->internalRep.longValue =
				(long) significandWide;
		    }
		}
	    }
	    if (significandOverflow) {
		if (signum) {
		    significandBig.sign = MP_NEG;
		} else {
		    significandBig.sign = MP_ZPOS;
		}
		TclSetBignumIntRep(objPtr, &significandBig);
		significandOverflow = 0;
	    }
	    break;

	case FRACTION:
................................................................................
    }
    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;
	}
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
double
TclCeil(mp_int *a)	/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (a->sign == MP_NEG) {
	mp_neg(a, &b);
	r = -TclFloor(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = HUGE_VAL;
................................................................................
double
TclFloor(mp_int *a)	/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (a->sign == MP_NEG) {
	mp_neg(a, &b);
	r = -TclCeil(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = DBL_MAX;






|







 







|
<
<







 







|
<
<







 







<

<
<
<
<
<
<
<
|





<
<
<







 







|







 







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
1014
1015
1016
1017
1018
1019
1020
1021


1022
1023
1024
1025
1026
1027
1028
....
1068
1069
1070
1071
1072
1073
1074
1075


1076
1077
1078
1079
1080
1081
1082
....
2180
2181
2182
2183
2184
2185
2186

2187







2188
2189
2190
2191
2192
2193



2194
2195
2196
2197
2198
2199
2200
....
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
....
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
 *	interconversion among 'double' and 'mp_int' types.
 *
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.37 2005/09/16 19:29:02 dgp Exp $
 *
 *----------------------------------------------------------------------
 */

#include <tclInt.h>
#include <stdio.h>
#include <stdlib.h>
................................................................................
			objPtr->internalRep.longValue =
				(long) octalSignificandWide;
		    }
		}
	    }
	    if (octalSignificandOverflow) {
		if (signum) {
		    mp_neg(&octalSignificandBig, &octalSignificandBig);


		}
		TclSetBignumIntRep(objPtr, &octalSignificandBig);
		octalSignificandOverflow = 0;
	    }		
	    break;

	case ZERO:
................................................................................
			objPtr->internalRep.longValue =
				(long) significandWide;
		    }
		}
	    }
	    if (significandOverflow) {
		if (signum) {
		    mp_neg(&significandBig, &significandBig);


		}
		TclSetBignumIntRep(objPtr, &significandBig);
		significandOverflow = 0;
	    }
	    break;

	case FRACTION:
................................................................................
    }
    fract = frexp(d,&expt);
    if (expt <= 0) {
	mp_init(b);
	mp_zero(b);
    } else {
	Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);

	int shift = expt - mantBits;







	TclBNInitBignumFromWideInt(b, w);
	if (shift < 0) {
	    mp_div_2d(b, -shift, b, NULL);
	} else if (shift > 0) {
	    mp_mul_2d(b, shift, b);
	}



    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
double
TclCeil(mp_int *a)	/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
	mp_neg(a, &b);
	r = -TclFloor(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = HUGE_VAL;
................................................................................
double
TclFloor(mp_int *a)	/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
	mp_neg(a, &b);
	r = -TclCeil(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = DBL_MAX;

Changes to generic/tclStringObj.c.

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * 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 $ */

#include "tclInt.h"
#include "tommath.h"

/*
 * Prototypes for functions defined later in this file:
 */
................................................................................
	    mp_int big;
	    int isNegative = 0;

	    if (useBig) {
		if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
		    goto error;
		}
		isNegative = (big.sign == MP_NEG);
	    } else if (useWide) {
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;
		    if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
			goto error;
		    }
		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);






|







 







|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * 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.10 2005/09/16 19:29:02 dgp Exp $ */

#include "tclInt.h"
#include "tommath.h"

/*
 * Prototypes for functions defined later in this file:
 */
................................................................................
	    mp_int big;
	    int isNegative = 0;

	    if (useBig) {
		if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
		    goto error;
		}
		isNegative = (mp_cmp_d(&big, 0) == MP_LT);
	    } else if (useWide) {
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;
		    if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
			goto error;
		    }
		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);

Changes to generic/tclTomMathInterface.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
137
138
139
140
141
142
143






























144
145
146
147
148
149
150
 *	layer between Tcl and libtommath.
 *
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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 $
 */

#include "tclInt.h"
#include "tommath.h"
#include <limits.h>
 
/*
................................................................................
    while ( v ) {
	*p++ = (mp_digit) ( v & MP_MASK );
	v >>= MP_DIGIT_BIT;
    }
    a->used = p - a->dp;
    
}






























 
/*
 *----------------------------------------------------------------------
 *
 * TclBNInitBignumFromWideUInt --
 *
 *	Allocate and initialize a 'bignum' from a Tcl_WideUInt






|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
 *	layer between Tcl and libtommath.
 *
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.4 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <limits.h>
 
/*
................................................................................
    while ( v ) {
	*p++ = (mp_digit) ( v & MP_MASK );
	v >>= MP_DIGIT_BIT;
    }
    a->used = p - a->dp;
    
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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