Tcl Source Code

Check-in [c420c12ecc]
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/tclInt.h: Made #undef NO_WIDE_TYPE the default on 32-bit systems. Being able to use 64-bit values without leaping to mp_int should help with performance. * generic/tclObj.c: Bug fixes in the #undef NO_WIDE_TYPE * generic/tclExecute.c: configuration.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: c420c12ecc78cfdfd64267360e4e1787667076e0
User & Date: dgp 2005-10-07 20:15:08
Context
2005-10-08
01:07
* generic/tclExecute.c: Macro GetNumberFromObj() is version of TclGetNumberFromObj()...
check-in: 6da6e869af user: dgp tags: kennykb-numerics-branch
2005-10-07
20:15
[kennykb-numerics-branch]
* generic/tclInt.h: Made #undef NO_WIDE_TYPE the defa...
check-in: c420c12ecc user: dgp tags: kennykb-numerics-branch
18:01
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of compariso...
check-in: 852981a34b 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
2005-10-07  Don Porter  <[email protected]>

	[kennykb-numerics-branch]







	* generic/tclExecute.c:	Improved performance of comparison opcodes
	and bitwise operations and removed yet more dead code.

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

	[kennykb-numerics-branch]


>
>
>
>
>
>







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

	[kennykb-numerics-branch]

	* generic/tclInt.h:	Made #undef NO_WIDE_TYPE the default on
	32-bit systems.  Being able to use 64-bit values without leaping
	to mp_int should help with performance.
	* generic/tclObj.c:	Bug fixes in the #undef NO_WIDE_TYPE
	* generic/tclExecute.c:	configuration.

	* generic/tclExecute.c:	Improved performance of comparison opcodes
	and bitwise operations and removed yet more dead code.

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

	[kennykb-numerics-branch]

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
 * 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.53 2005/10/07 18:01:40 dgp Exp $
 */

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

#include <math.h>
................................................................................
		break;
	    case INST_BITXOR:
		wResult = w1 ^ w2;
	    }
	
	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (Tcl_IsShared(valuePtr)) {
		TclNewWideIntObj(objResultPtr, wResult);
		TRACE(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 2, 1);
	    }
	    TclSetWideIntObj(valuePtr, &wResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
#endif
	{
	    long lResult, l1 = *((CONST long *)ptr1);
	    long l2 = *((CONST long *)ptr2);






|







 







|



|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
 * 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.54 2005/10/07 20:15:09 dgp Exp $
 */

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

#include <math.h>
................................................................................
		break;
	    case INST_BITXOR:
		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);
	}
#endif
	{
	    long lResult, l1 = *((CONST long *)ptr1);
	    long l2 = *((CONST long *)ptr2);

Changes to generic/tclInt.h.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
....
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
....
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.202.2.41 2005/10/03 15:50:19 dgp Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options
 */

#define NO_WIDE_TYPE
#undef	ACCEPT_NAN

/*
 * Common include files needed by most of the Tcl source files are included
 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
 * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_
................................................................................
/*
 * NOTE: There is to be no such thing as a "pure" boolean.
 * See comment above TclSetBooleanObj macro above.
 */
#define TclNewBooleanObj(objPtr, b) \
    TclNewIntObj((objPtr), ((b)? 1 : 0))

#ifndef NO_WIDE_TYPE
#define TclNewWideIntObj(objPtr, w) \
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes = NULL; \
    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
    (objPtr)->typePtr = &tclWideIntType
#endif

#define TclNewDoubleObj(objPtr, d) \
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes = NULL; \
    (objPtr)->internalRep.doubleValue = (double)(d); \
    (objPtr)->typePtr = &tclDoubleType
................................................................................

#define TclNewLongObj(objPtr, l) \
    (objPtr) = Tcl_NewLongObj(l)

#define TclNewBooleanObj(objPtr, b) \
    (objPtr) = Tcl_NewBooleanObj(b)

#define TclNewWideIntObj(objPtr, w)\
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */







|









|
|







 







<
<
<
<
<
<
<
<
<
<







 







<
<
<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
....
2990
2991
2992
2993
2994
2995
2996










2997
2998
2999
3000
3001
3002
3003
....
3012
3013
3014
3015
3016
3017
3018



3019
3020
3021
3022
3023
3024
3025
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.202.2.42 2005/10/07 20:15:09 dgp Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options
 */

#undef NO_WIDE_TYPE
#undef ACCEPT_NAN

/*
 * Common include files needed by most of the Tcl source files are included
 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
 * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_
................................................................................
/*
 * NOTE: There is to be no such thing as a "pure" boolean.
 * See comment above TclSetBooleanObj macro above.
 */
#define TclNewBooleanObj(objPtr, b) \
    TclNewIntObj((objPtr), ((b)? 1 : 0))











#define TclNewDoubleObj(objPtr, d) \
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes = NULL; \
    (objPtr)->internalRep.doubleValue = (double)(d); \
    (objPtr)->typePtr = &tclDoubleType
................................................................................

#define TclNewLongObj(objPtr, l) \
    (objPtr) = Tcl_NewLongObj(l)

#define TclNewBooleanObj(objPtr, b) \
    (objPtr) = Tcl_NewBooleanObj(b)




#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */

Changes to generic/tclObj.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
....
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416



2417
2418
2419
2420
2421

2422
2423
2424
2425
2426
2427
2428
....
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.72.2.40 2005/10/03 15:50:19 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
Tcl_Obj *
Tcl_NewWideIntObj(wideValue)
    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
					 * the new object. */
{
    register Tcl_Obj *objPtr;

#ifndef NO_WIDE_TYPE
    TclNewWideIntObj(objPtr, wideValue);
#else
    TclNewObj(objPtr);
    Tcl_SetWideIntObj(objPtr, wideValue);
#endif
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
					 * the object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("Tcl_SetWideIntObj called with shared object");
    }

#ifndef NO_WIDE_TYPE
    TclSetWideIntObj(objPtr, wideValue);
#else
    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	TclSetLongObj(objPtr, (long) wideValue);
    } else {



	mp_int big;
	TclBNInitBignumFromWideInt(&big, wideValue);
	Tcl_SetBignumObj(objPtr, &big);
    }
#endif

}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideIntFromObj --
 *
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    TclBNInitBignumFromWideInt(bignumValue, 
		    objPtr->internalRep.wideValue)
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
		Tcl_Obj* msg =
			Tcl_NewStringObj("expected integer but got \"", -1);






|







 







<
<
<


<







 







<
<
<




>
>
>



<

>







 







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2298
2299
2300
2301
2302
2303
2304



2305
2306

2307
2308
2309
2310
2311
2312
2313
....
2399
2400
2401
2402
2403
2404
2405



2406
2407
2408
2409
2410
2411
2412
2413
2414
2415

2416
2417
2418
2419
2420
2421
2422
2423
2424
....
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.72.2.41 2005/10/07 20:15:09 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
Tcl_Obj *
Tcl_NewWideIntObj(wideValue)
    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
					 * the new object. */
{
    register Tcl_Obj *objPtr;




    TclNewObj(objPtr);
    Tcl_SetWideIntObj(objPtr, wideValue);

    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
					 * the object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("Tcl_SetWideIntObj called with shared object");
    }




    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	TclSetLongObj(objPtr, (long) wideValue);
    } else {
#ifndef NO_WIDE_TYPE
	TclSetWideIntObj(objPtr, wideValue);
#else
	mp_int big;
	TclBNInitBignumFromWideInt(&big, wideValue);
	Tcl_SetBignumObj(objPtr, &big);

#endif
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideIntFromObj --
 *
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    TclBNInitBignumFromWideInt(bignumValue, 
		    objPtr->internalRep.wideValue);
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
		Tcl_Obj* msg =
			Tcl_NewStringObj("expected integer but got \"", -1);