Tcl Source Code

Check-in [936ff6a20a]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:more WIDE support
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:936ff6a20a5ed26f203141ad0a606efd2e5aadc2
User & Date: dgp 2005-10-08 06:43:18
Context
2005-10-08
13:44
merge updates from HEAD Closed-Leaf check-in: 1b902ae45a user: dgp tags: kennykb-numerics-branch
06:43
more WIDE support check-in: 936ff6a20a user: dgp tags: kennykb-numerics-branch
06:07
[kennykb-numerics-branch]
* generic/tclExecute.c: More performance macros and speci...
check-in: cd534dbb23 user: dgp tags: kennykb-numerics-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462



4463
4464
4465
4466
4467
4468

4469
4470
4471
4472
4473



4474
4475
4476
4477
4478
4479

4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
....
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
 * 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.56 2005/10/08 06:07:58 dgp Exp $
 */

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

#include <math.h>
................................................................................
	    }
	    Tcl_SetWideIntObj(valuePtr, wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	} 

	if ((*pc != INST_MULT) 
		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    Tcl_WideInt w1, w2, wResult;
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (*pc) {
	    case INST_ADD:
		wResult = w1 + w2;
#ifdef TCL_WIDE_INT_IS_LONG



		/* Must check for overflow */
		if (((w1 < 0) && (w2 < 0) && (wResult > 0))
			|| ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
		    goto overflow;
		}
#endif

		break;

	    case INST_SUB:
		wResult = w1 - w2;
#ifdef TCL_WIDE_INT_IS_LONG



		/* Must check for overflow */
		if (((w1 < 0) && (w2 > 0) && (wResult > 0))
			|| ((w1 > 0) && (w2 < 0) && (wResult < 0))) {
		    goto overflow;
		}
#endif

		break;

	    case INST_DIV:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		}

#ifdef TCL_WIDE_INT_IS_LONG
		/* Need a bignum to represent (LONG_MIN / -1) */
		if ((w1 == LONG_MIN) && (w2 == -1)) {
		    goto overflow;
		}
#endif
		wResult = w1 / w2;

		/* Force Tcl's integer division rules */
		/* TODO: examine for logic simplification */
		if (((wResult < 0) || ((wResult == 0) &&
			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
			((wResult * w2) != w1)) {
................................................................................
		NEXT_INST_F(1, 2, 1);
	    }
	    Tcl_SetWideIntObj(valuePtr, wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

#ifdef TCL_WIDE_INT_IS_LONG
    overflow:
#endif
	{
	    mp_int big1, big2, bigResult, bigRemainder;
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);







|







 







|







|
>
>
>
|
|
|
|
|
<
>




|
>
>
>
|
|
|
|
|
<
>









<
|
|


<







 







<

<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484

4485
4486
4487
4488
4489
4490
4491
4492
4493
4494

4495
4496
4497
4498

4499
4500
4501
4502
4503
4504
4505
....
4515
4516
4517
4518
4519
4520
4521

4522

4523
4524
4525
4526
4527
4528
4529
 * 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.57 2005/10/08 06:43:18 dgp Exp $
 */

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

#include <math.h>
................................................................................
	    }
	    Tcl_SetWideIntObj(valuePtr, wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	} 

	if ((*pc != INST_MULT) 
		&& (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	    Tcl_WideInt w1, w2, wResult;
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (*pc) {
	    case INST_ADD:
		wResult = w1 + w2;
#ifndef NO_WIDE_TYPE
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
		{
		    /* Check for overflow */
		    if (((w1 < 0) && (w2 < 0) && (wResult > 0))
			    || ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
			goto overflow;
		    }

		}
		break;

	    case INST_SUB:
		wResult = w1 - w2;
#ifndef NO_WIDE_TYPE
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
		{
		    /* Must check for overflow */
		    if (((w1 < 0) && (w2 > 0) && (wResult > 0))
			    || ((w1 > 0) && (w2 < 0) && (wResult < 0))) {
			goto overflow;
		    }

		}
		break;

	    case INST_DIV:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		}


		/* Need a bignum to represent (LLONG_MIN / -1) */
		if ((w1 == LLONG_MIN) && (w2 == -1)) {
		    goto overflow;
		}

		wResult = w1 / w2;

		/* Force Tcl's integer division rules */
		/* TODO: examine for logic simplification */
		if (((wResult < 0) || ((wResult == 0) &&
			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
			((wResult * w2) != w1)) {
................................................................................
		NEXT_INST_F(1, 2, 1);
	    }
	    Tcl_SetWideIntObj(valuePtr, wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}


    overflow:

	{
	    mp_int big1, big2, bigResult, bigRemainder;
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);