Tcl Source Code

Check-in [4ab5ab7388]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
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 INST_MULT and replaces a "goto... label" with a "break from loop" in TclIncrObj().
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 4ab5ab7388041e879e6000b1aa4efc8ad42f1985
User & Date: dgp 2005-10-05 16:28:39
Context
2005-10-06
02:51
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_MULT...
 check-in: 318d5967ce user: dgp tags: kennykb-numerics-branch
2005-10-05
16:28
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance INST_MULT an...
 check-in: 4ab5ab7388 user: dgp tags: kennykb-numerics-branch
2005-10-04
21:02
[kennykb-numerics-branch]
* generic/tclExecute.c: Updated TclIncrObj() to more effi...
 check-in: 8d4c5bb62b user: dgp tags: kennykb-numerics-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 








1
2
3
4
5
6
7







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
	and the INST_UMINUS, INST_UPLUS, INST_BITNOT, and

>
>
>
>
>
>
>








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 INST_MULT and
	replaces a "goto... label" with a "break from loop" in TclIncrObj().

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
	and the INST_UMINUS, INST_UPLUS, INST_BITNOT, and

Changes to generic/tclExecute.c. 

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
....
4414
4415
4416
4417
4418
4419
4420
4421
4422






























































































































4423
4424
4425
4426
4427
4428
4429
4430
4431
....
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
....
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843

 * 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.45 2005/10/04 21:02:30 dgp Exp $
 */

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

#include <math.h>
................................................................................
    int type1, type2;
    mp_int value, incr;

    if (Tcl_IsShared(valuePtr)) {
	Tcl_Panic("shared object passed to TclIncrObj");
    }

    if ((TclGetNumberFromObj(interp, valuePtr, &ptr1, &type1) == TCL_OK)
	    && (TclGetNumberFromObj(interp, incrPtr, &ptr2, &type2) == TCL_OK)
	    && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	Tcl_WideInt w1 = (Tcl_WideInt)(*(CONST long *)ptr1);
	Tcl_WideInt w2 = (Tcl_WideInt)(*(CONST long *)ptr2);
	Tcl_WideInt sum = w1 + w2;
#ifdef TCL_WIDE_INT_IS_LONG
	/* Must check for overflow */
	if (((w1 < 0) && (w2 < 0) && (sum > 0))
		|| ((w1 > 0) && (w2 > 0) && (sum < 0))) {
	    goto overflow;
	}
#endif
	Tcl_SetWideIntObj(valuePtr, sum);
	return TCL_OK;
    }

    overflow:
    if (Tcl_GetBignumAndClearObj(interp, valuePtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(interp, incrPtr, &incr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }
................................................................................
		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
		TclSetLongObj(valuePtr, iResult);
	    }
	    NEXT_INST_F(1, 1, 0);
	}
    }
#endif

    case INST_ADD:






























































































































    case INST_SUB:
    case INST_MULT:
    case INST_DIV:
    case INST_MOD:
    case INST_EXPON: {
	/*
	 * Operands must be numeric and ints get converted to floats if
	 * necessary. We compute value op value2.
	 */
................................................................................
	    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));
		    goto divideByZero;
		}
#endif
................................................................................
	    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:
	    case INST_MOD:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    mp_clear(&big1);
		    mp_clear(&big2);







|







 







|









|




|

<







 








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







 







<
<
<







 







<
<
<








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
....
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
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
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
....
4880
4881
4882
4883
4884
4885
4886



4887
4888
4889
4890
4891
4892
4893
....
4949
4950
4951
4952
4953
4954
4955



4956
4957
4958
4959
4960
4961
4962

 * 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.46 2005/10/05 16:28:40 dgp Exp $
 */

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

#include <math.h>
................................................................................
    int type1, type2;
    mp_int value, incr;

    if (Tcl_IsShared(valuePtr)) {
	Tcl_Panic("shared object passed to TclIncrObj");
    }

    do {if ((TclGetNumberFromObj(interp, valuePtr, &ptr1, &type1) == TCL_OK)
	    && (TclGetNumberFromObj(interp, incrPtr, &ptr2, &type2) == TCL_OK)
	    && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	Tcl_WideInt w1 = (Tcl_WideInt)(*(CONST long *)ptr1);
	Tcl_WideInt w2 = (Tcl_WideInt)(*(CONST long *)ptr2);
	Tcl_WideInt sum = w1 + w2;
#ifdef TCL_WIDE_INT_IS_LONG
	/* Must check for overflow */
	if (((w1 < 0) && (w2 < 0) && (sum > 0))
		|| ((w1 > 0) && (w2 > 0) && (sum < 0))) {
	    break;
	}
#endif
	Tcl_SetWideIntObj(valuePtr, sum);
	return TCL_OK;
    }} while (0);


    if (Tcl_GetBignumAndClearObj(interp, valuePtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(interp, incrPtr, &incr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }
................................................................................
		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
		TclSetLongObj(valuePtr, iResult);
	    }
	    NEXT_INST_F(1, 1, 0);
	}
    }
#endif

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

	result = TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
	if ((result != TCL_OK) 
#ifndef ACCEPT_NAN
		|| (type1 == TCL_NUMBER_NAN)
#endif
		) {
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr), 
		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}

#ifdef ACCEPT_NAN
	if (type1 == TCL_NUMBER_NAN) {
	    /* NaN first argument -> result is also NaN */
	    NEXT_INST_F(1, 1, 0);
	}
#endif

	result = TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
	if ((result != TCL_OK) 
#ifndef ACCEPT_NAN
		|| (type2 == TCL_NUMBER_NAN)
#endif
		) {
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr), 
		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}

#ifdef ACCEPT_NAN
	if (value2Ptr->typePtr == &tclDoubleType) {
	    /* NaN second argument -> result is also NaN */
	    objResultPtr = value2Ptr;
	    NEXT_INST_F(1, 2, 1);
	}
#endif

	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
	    /* 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);

	    dResult = d1 * d2;

#ifndef ACCEPT_NAN
	    /*
	     * Check now for IEEE floating-point error.
	     */

	    if (TclIsNaN(dResult)) {
		TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
			O2S(valuePtr), O2S(value2Ptr)));
		TclExprFloatError(interp, dResult);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
#endif
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		TclNewDoubleObj(objResultPtr, dResult);
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
	    }
	    TclSetDoubleObj(valuePtr, dResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

	if ((sizeof(Tcl_WideInt) >= 2*sizeof(long))
		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    Tcl_WideInt w1, w2, wResult;
	    Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
	    Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);

	    wResult = w1 * w2;

	    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);
	    }
	    Tcl_SetWideIntObj(valuePtr, wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	} else {
	    mp_int big1, big2, bigResult;
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
	    }
	    if (Tcl_IsShared(value2Ptr)) {
		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
	    }
	    mp_init(&bigResult);

	    mp_mul(&big1, &big2, &bigResult);

	    mp_clear(&big1);
	    mp_clear(&big2);
	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_NewBignumObj(&bigResult);
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
	    }
	    Tcl_SetBignumObj(valuePtr, &bigResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
    }

    case INST_ADD:
    case INST_SUB:
    case INST_DIV:
    case INST_MOD:
    case INST_EXPON: {
	/*
	 * Operands must be numeric and ints get converted to floats if
	 * necessary. We compute value op value2.
	 */
................................................................................
	    switch (*pc) {
	    case INST_ADD:
		dResult = d1 + d2;
		break;
	    case INST_SUB:
		dResult = d1 - d2;
		break;



	    case INST_DIV:
#ifndef IEEE_FLOATING_POINT
		if (d2 == 0.0) {
		    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
		    goto divideByZero;
		}
#endif
................................................................................
	    switch (*pc) {
	    case INST_ADD:
		mp_add(&big1, &big2, &bigResult);
		break;
	    case INST_SUB:
		mp_sub(&big1, &big2, &bigResult);
		break;



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

This page was generated in about 0.067s by Fossil 2.10 [3b10e64468] 2019-08-23 11:07:53