Tcl Source Code

Check-in [31b83841a8]
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:
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_RSHIFT and INST_LSHIFT.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:31b83841a878ed9b4ee3096b414c4a72a8093ba8
User & Date: dgp 2005-10-06 18:48:51
Context
2005-10-06
22:04
store shift result as long, not int check-in: df31ba52d1 user: dgp tags: kennykb-numerics-branch
18:48
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_RSHI...
check-in: 31b83841a8 user: dgp tags: kennykb-numerics-branch
16:14
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_RSHI...
check-in: 7480ac5646 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
2005-10-06  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_RSHIFT.


2005-10-05  Don Porter  <dgp@users.sourceforge.net>

	[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




|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2005-10-06  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_RSHIFT and
	INST_LSHIFT.

2005-10-05  Don Porter  <dgp@users.sourceforge.net>

	[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

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3821
3822
3823
3824
3825
3826
3827

3828
3829
3830
3831
3832

3833
3834
3835
3836
3837
3838
3839
....
3870
3871
3872
3873
3874
3875
3876


3877






























3878

3879
3880







3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
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
3924
3925
3926



3927
3928
3929
3930
3931
3932
3933

3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
 * 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.49 2005/10/06 16:14:48 dgp Exp $
 */

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

#include <math.h>
................................................................................
	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = eePtr->constants[iResult];
	NEXT_INST_F(0, 2, 1);
    }


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


	result = TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
	if ((result != TCL_OK)
		|| (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
	    result = TCL_ERROR;
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (valuePtr->typePtr?
................................................................................
	if (invalid) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("negative shift argument", -1));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}



	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));






























	/* Quickly force large right shifts to 0 or -1 */

	if ((type2 != TCL_NUMBER_LONG)
		|| ( *((CONST long *)ptr2) > INT_MAX)) {







	    int zero;
	    switch (type1) {
	    case TCL_NUMBER_LONG:
		zero = (*((CONST long *)ptr1) >= (long)0);
		break;
#ifndef NO_WIDE_TYPE
	    case TCL_NUMBER_WIDE: 
		zero = (*((CONST Tcl_WideInt *)ptr1) > (Tcl_WideInt)0);
		break;
#endif
	    case TCL_NUMBER_BIG:
		/* TODO: const correctness ? */
		zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT);
	    }
	    if (zero) {
		objResultPtr = eePtr->constants[0];
	    } else {
		TclNewIntObj(objResultPtr, -1);
	    }
	    TRACE(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	}
	shift = (int)(*((CONST long *)ptr2));

	if (type1 == TCL_NUMBER_LONG) {
	    long l = *((CONST long *)ptr1);
	    if (shift >= CHAR_BIT*sizeof(long)) {
		if (l >= (long)0) {
		    objResultPtr = eePtr->constants[0];
		} else {
		    TclNewIntObj(objResultPtr, -1);
		}
	    } else {
		TclNewIntObj(objResultPtr, (l >> shift));
	    }
	    TRACE(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	} else {




	    mp_int big, bigResult, bigRemainder;

	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
	    }

	    mp_init(&bigResult);



	    mp_init(&bigRemainder);
	    mp_div_2d(&big, 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(&big);

	    mp_clear(&bigRemainder);

	    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_LSHIFT: {
	Tcl_Obj *valuePtr, *value2Ptr;
	mp_int big1, big2, bigResult;
	int shift;

	value2Ptr = *tosPtr;
	valuePtr  = *(tosPtr - 1);
	result = Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	if (result != TCL_OK) {
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (valuePtr->typePtr?
		    valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}
	result = Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	if (result != TCL_OK) {
	    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)) {
	    /* Zero shifted any integral number of bits either way is zero */
	    mp_clear(&big1);
	    TRACE(("0 %s => 0\n", O2S(value2Ptr)));
	    NEXT_INST_F(1, 1, 0);
	}
	result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent", -1));
	    goto checkForCatch;
	}
	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)));
	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_BITOR:
    case INST_BITXOR:
    case INST_BITAND: {
	Tcl_Obj *valuePtr, *value2Ptr;
	mp_int big1, big2, bigResult;
	mp_int *Pos, *Neg, *Other;
	int numPos = 0;







|







 







>





>







 







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

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
<
>
>
>
>









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

|
<
<
<
<
|
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
|
|
|
<
<
<
|
<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
....
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
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
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959

3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986




3987
3988
3989
3990













































3991









3992






3993
3994
3995



3996

3997
3998
3999
4000
4001
4002
4003
 * 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.50 2005/10/06 18:48:52 dgp Exp $
 */

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

#include <math.h>
................................................................................
	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = eePtr->constants[iResult];
	NEXT_INST_F(0, 2, 1);
    }

    case INST_LSHIFT:
    case INST_RSHIFT: {
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr  = *(tosPtr - 1);
	ClientData ptr1, ptr2;
	int invalid, shift, type1, type2;
	long l;

	result = TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
	if ((result != TCL_OK)
		|| (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
	    result = TCL_ERROR;
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (valuePtr->typePtr?
................................................................................
	if (invalid) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("negative shift argument", -1));
	    result = TCL_ERROR;
	    goto checkForCatch;
	}

	/* Zero shifted any number of bits is still zero */
	if ((type1 == TCL_NUMBER_LONG) && (*((CONST long *)ptr1) == (long)0)) {
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    objResultPtr = eePtr->constants[0];
	    TRACE(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	}

	if (*pc == INST_LSHIFT) {
	    /* Large left shifts create integer overflow */
	    result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift);
	    if (result != TCL_OK) {
		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1))
		 * in an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"integer value too large to represent", -1));
		goto checkForCatch;
	    }
	    /* Handle shifts within the native long range */
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if ((type1 == TCL_NUMBER_LONG) && (shift < CHAR_BIT*sizeof(long))
		    && (l = *((CONST long *)ptr1)) 
		    && !(((l>0) ? l : ~l) 
			    & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) {
		TclNewLongObj(objResultPtr, (l<<shift));
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
	    }
	} else {
	    /* Quickly force large right shifts to 0 or -1 */
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if ((type2 != TCL_NUMBER_LONG)
		    || ( *((CONST long *)ptr2) > INT_MAX)) {
		/*
		 * Again, technically, the value to be shifted could
		 * be an mp_int so huge that a right shift by (INT_MAX+1)
		 * bits could not take us to the result of 0 or -1, but
		 * since we're using mp_div_2d to do the work, and it
		 * takes only an int argument, we draw the line there.
		 */
		int zero;
		switch (type1) {
		case TCL_NUMBER_LONG:
		    zero = (*((CONST long *)ptr1) > (long)0);
		    break;
#ifndef NO_WIDE_TYPE
		case TCL_NUMBER_WIDE: 
		    zero = (*((CONST Tcl_WideInt *)ptr1) > (Tcl_WideInt)0);
		    break;
#endif
		case TCL_NUMBER_BIG:
		    /* TODO: const correctness ? */
		    zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT);
		}
		if (zero) {
		    objResultPtr = eePtr->constants[0];
		} else {
		    TclNewIntObj(objResultPtr, -1);
		}
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
	    }
	    shift = (int)(*((CONST long *)ptr2));
	    /* Handle shifts within the native long range */
	    if (type1 == TCL_NUMBER_LONG) {
		l = *((CONST long *)ptr1);
		if (shift >= CHAR_BIT*sizeof(long)) {
		    if (l >= (long)0) {
			objResultPtr = eePtr->constants[0];
		    } else {
			TclNewIntObj(objResultPtr, -1);
		    }
		} else {
		    TclNewIntObj(objResultPtr, (l >> shift));
		}
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);

	    }
	}

	{
	    mp_int big, bigResult, bigRemainder;

	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
	    }

	    mp_init(&bigResult);
	    if (*pc == INST_LSHIFT) {
		mp_mul_2d(&big, shift, &bigResult);
	    } else {
		mp_init(&bigRemainder);
		mp_div_2d(&big, 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(&big);

	    if (!Tcl_IsShared(valuePtr)) {




		Tcl_SetBignumObj(valuePtr, &bigResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);
	    }













































	    objResultPtr = Tcl_NewBignumObj(&bigResult);









	}






	TRACE(("%s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);
    }



	

    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND: {
	Tcl_Obj *valuePtr, *value2Ptr;
	mp_int big1, big2, bigResult;
	mp_int *Pos, *Neg, *Other;
	int numPos = 0;