Tcl Source Code

Check-in [ac4d98012f]
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/tclExecute.c: Improved performance of INST_MULT, INST_DIV, INST_ADD, and INST_SUB and replaced a "goto... label" with a "break from loop" in TclIncrObj() and removed some dead code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: ac4d98012f50ce470a67a2c50152f71552d8bf52
User & Date: dgp 2005-10-06 03:41:27
Context
2005-10-06
16:14
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_RSHI...
check-in: 7480ac5646 user: dgp tags: kennykb-numerics-branch
03:41
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_MULT...
check-in: ac4d98012f user: dgp tags: kennykb-numerics-branch
02:51
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_MULT...
check-in: 318d5967ce 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
11
12
13
14
2005-10-05  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_MULT and INST_DIV
	and replaced a "goto... label" with a "break from loop" in TclIncrObj()
	and removed some dead code.

2005-10-04  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Updated TclIncrObj() to more efficiently
	add native long integers.  Also updated IllegalExprOperandType



|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
2005-10-05  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_MULT, INST_DIV,
	INST_ADD, and INST_SUB and replaced a "goto... label" with a
	"break from loop" in TclIncrObj() and removed some dead code.

2005-10-04  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Updated TclIncrObj() to more efficiently
	add native long integers.  Also updated IllegalExprOperandType

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
4414
4415
4416
4417
4418
4419
4420


4421
4422
4423
4424
4425
4426
4427
....
4472
4473
4474
4475
4476
4477
4478






4479
4480
4481
4482
4483
4484
4485
....
4540
4541
4542
4543
4544
4545
4546
























4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566


4567
4568
4569
4570
4571
4572
4573
....
4589
4590
4591
4592
4593
4594
4595






4596
4597
4598
4599
4600
4601
4602
....
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
....
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
....
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
 * 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.47 2005/10/06 02:51:00 dgp Exp $
 */

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

#include <math.h>
................................................................................
		TclSetLongObj(valuePtr, iResult);
	    }
	    NEXT_INST_F(1, 1, 0);
	}
    }
#endif



    case INST_DIV:
    case INST_MULT: {
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr = *(tosPtr - 1);

................................................................................
	    /* At least one of the values is floating-point, so perform
	     * floating point calculations */
	    double d1, d2, dResult;
	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);

	    switch (*pc) {






	    case INST_MULT:
		dResult = d1 * d2;
		break;
	    case INST_DIV:
#ifndef IEEE_FLOATING_POINT
		if (d2 == 0.0) {
		    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
................................................................................

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

























	    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)) {
		wResult -= 1;


	    }

	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_NewWideIntObj(wResult);
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
................................................................................
	    if (Tcl_IsShared(value2Ptr)) {
		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
	    }
	    mp_init(&bigResult);
	    switch (*pc) {






	    case INST_MULT:
		mp_mul(&big1, &big2, &bigResult);
		break;
	    case INST_DIV:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
................................................................................
	    }
	    Tcl_SetBignumObj(valuePtr, &bigResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MOD:
    case INST_EXPON: {
	/*
	 * Operands must be numeric and ints get converted to floats if
	 * necessary. We compute value op value2.
	 */

................................................................................
	    goto checkForCatch;
	}
	if (valuePtr->typePtr == &tclDoubleType
		|| value2Ptr->typePtr == &tclDoubleType) {
	    /* At least one of the values is floating-point, so perform
	     * floating point calculations */
	    switch (*pc) {
	    case INST_ADD:
		dResult = d1 + d2;
		break;
	    case INST_SUB:
		dResult = d1 - d2;
		break;
	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    /* Both values are some kind of integer */
	    /* TODO: optimize use of narrower native integers */
	    mp_int big1, big2, bigResult, bigRemainder;
	    Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	    mp_init(&bigResult);
	    switch (*pc) {
	    case INST_ADD:
		mp_add(&big1, &big2, &bigResult);
		break;
	    case INST_SUB:
		mp_sub(&big1, &big2, &bigResult);
		break;
	    case INST_MOD:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    mp_clear(&big1);
		    mp_clear(&big2);
		    goto divideByZero;






|







 







>
>







 







>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|


|
|
|
|

|

|
|
|
|
|
|
>
>







 







>
>
>
>
>
>







 







<
<







 







<
<
<
<
<
<







 







<
<
<
<
<
<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
....
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
....
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
....
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
....
4668
4669
4670
4671
4672
4673
4674


4675
4676
4677
4678
4679
4680
4681
....
4984
4985
4986
4987
4988
4989
4990






4991
4992
4993
4994
4995
4996
4997
....
5033
5034
5035
5036
5037
5038
5039






5040
5041
5042
5043
5044
5045
5046
 * 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.48 2005/10/06 03:41:27 dgp Exp $
 */

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

#include <math.h>
................................................................................
		TclSetLongObj(valuePtr, iResult);
	    }
	    NEXT_INST_F(1, 1, 0);
	}
    }
#endif

    case INST_ADD:
    case INST_SUB:
    case INST_DIV:
    case INST_MULT: {
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr = *(tosPtr - 1);

................................................................................
	    /* At least one of the values is floating-point, so perform
	     * floating point calculations */
	    double d1, d2, dResult;
	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);

	    switch (*pc) {
	    case INST_ADD:
		dResult = d1 + d2;
		break;
	    case INST_SUB:
		dResult = d1 - d2;
		break;
	    case INST_MULT:
		dResult = d1 * d2;
		break;
	    case INST_DIV:
#ifndef IEEE_FLOATING_POINT
		if (d2 == 0.0) {
		    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
................................................................................

	if ((*pc != INST_MULT) 
		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    Tcl_WideInt w1, w2, wResult;
	    Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
	    Tcl_GetWideIntFromObj(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)) {
		    wResult -= 1;
		}
		break;
	    }

	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_NewWideIntObj(wResult);
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
................................................................................
	    if (Tcl_IsShared(value2Ptr)) {
		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
	    }
	    mp_init(&bigResult);
	    switch (*pc) {
	    case INST_ADD:
		mp_add(&big1, &big2, &bigResult);
		break;
	    case INST_SUB:
		mp_sub(&big1, &big2, &bigResult);
		break;
	    case INST_MULT:
		mp_mul(&big1, &big2, &bigResult);
		break;
	    case INST_DIV:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
................................................................................
	    }
	    Tcl_SetBignumObj(valuePtr, &bigResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
    }



    case INST_MOD:
    case INST_EXPON: {
	/*
	 * Operands must be numeric and ints get converted to floats if
	 * necessary. We compute value op value2.
	 */

................................................................................
	    goto checkForCatch;
	}
	if (valuePtr->typePtr == &tclDoubleType
		|| value2Ptr->typePtr == &tclDoubleType) {
	    /* At least one of the values is floating-point, so perform
	     * floating point calculations */
	    switch (*pc) {






	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    /* Both values are some kind of integer */
	    /* TODO: optimize use of narrower native integers */
	    mp_int big1, big2, bigResult, bigRemainder;
	    Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	    mp_init(&bigResult);
	    switch (*pc) {






	    case INST_MOD:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    mp_clear(&big1);
		    mp_clear(&big2);
		    goto divideByZero;