Tcl Source Code

Check-in [7480ac5646]
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_RSHIFT.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 7480ac5646f347cedb4fd58e9e0ce534ac6d6590
User & Date: dgp 2005-10-06 16:14:45
Context
2005-10-06
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
03:41
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_MULT...
check-in: ac4d98012f 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-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.
>
>
>
>
>
>







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

	[kennykb-numerics-branch]

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

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.

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
 * 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>
................................................................................
	    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 *valuePtr, *value2Ptr;
	mp_int big1, big2, bigResult;
	int shift;

	value2Ptr = *tosPtr;
	valuePtr  = *(tosPtr - 1);
	result = Tcl_GetBignumFromObj(NULL, valuePtr, &big1);






|







 







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







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
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
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
 * 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?
		    valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}

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

	/* reject negative shift argument */
	switch (type2) {
	case TCL_NUMBER_LONG:
	    invalid = (*((CONST long *)ptr2) < (long)0);
	    break;
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    invalid = (*((CONST Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    /* TODO: const correctness ? */
	    invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT);
	}
	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);