Tcl Source Code

Check-in [7818e1ffac]
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 comparison opcodes and removed yet more dead code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:7818e1ffac385e20cdf566f9fdbaa39468392b08
User & Date: dgp 2005-10-07 15:51:26
Context
2005-10-07
18:01
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of compariso...
check-in: 852981a34b user: dgp tags: kennykb-numerics-branch
15:51
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of compariso...
check-in: 7818e1ffac user: dgp tags: kennykb-numerics-branch
2005-10-06
22:04
store shift result as long, not int check-in: df31ba52d1 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-06  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

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

>
>
>
>
>
>
>







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

	[kennykb-numerics-branch]

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

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

	[kennykb-numerics-branch]

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

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
....
3390
3391
3392
3393
3394
3395
3396
























































































































































































































































3397
3398
3399
3400
3401
3402
3403
....
3820
3821
3822
3823
3824
3825
3826

3827
3828
3829
3830
3831
3832
3833
....
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
....
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
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
 * 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.51 2005/10/06 22:04:22 dgp Exp $
 */

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

#include <math.h>
................................................................................
	 * Operands must be boolean or numeric. No int->double conversions are
	 * performed.
	 */

	int i1, i2, iResult;
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr  = *(tosPtr - 1);
#if 0
	Tcl_WideInt w;
	char *s;
	int length;
	Tcl_ObjType *t1Ptr = valuePtr->typePtr;
	Tcl_ObjType *t2Ptr = value2Ptr->typePtr;

	if (t1Ptr == &tclIntType) {
	    i1 = (valuePtr->internalRep.longValue != 0);
	} else if (t1Ptr == &tclWideIntType) {
	    TclGetWide(w,valuePtr);
	    i1 = (w != W0);
	} else if (t1Ptr == &tclDoubleType) {
	    i1 = (valuePtr->internalRep.doubleValue != 0.0);
	} else {
	    s = Tcl_GetStringFromObj(valuePtr, &length);
	    if (TclLooksLikeInt(s, length)) {
		long i = 0;

		GET_WIDE_OR_INT(result, valuePtr, i, w);
		if (valuePtr->typePtr == &tclIntType) {
		    i1 = (i != 0);
		} else {
		    i1 = (w != W0);
		}
	    } else {
		result = Tcl_GetBooleanFromObj(NULL, valuePtr, &i1);
	    }
	    if (result != TCL_OK) {
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(t1Ptr? t1Ptr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto checkForCatch;
	    }
	}
#else
	/* TODO - consider optimization search for eePtr->constants */
	result = Tcl_GetBooleanFromObj(NULL, valuePtr, &i1);
	if (result != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}
#endif

#if 0
	if (t2Ptr == &tclIntType) {
	    i2 = (value2Ptr->internalRep.longValue != 0);
	} else if (t2Ptr == &tclWideIntType) {
	    TclGetWide(w,value2Ptr);
	    i2 = (w != W0);
	} else if (t2Ptr == &tclDoubleType) {
	    i2 = (value2Ptr->internalRep.doubleValue != 0.0);
	} else {
	    s = Tcl_GetStringFromObj(value2Ptr, &length);
	    if (TclLooksLikeInt(s, length)) {
		long i = 0;

		GET_WIDE_OR_INT(result, value2Ptr, i, w);
		if (value2Ptr->typePtr == &tclIntType) {
		    i2 = (i != 0);
		} else {
		    i2 = (w != W0);
		}
	    } else {
		result = Tcl_GetBooleanFromObj(NULL, value2Ptr, &i2);
	    }
	    if (result != TCL_OK) {
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
			(t2Ptr? t2Ptr->name : "null")));
		IllegalExprOperandType(interp, pc, value2Ptr);
		goto checkForCatch;
	    }
	}
#else
	/* TODO - consider optimization search for eePtr->constants */
	result = Tcl_GetBooleanFromObj(NULL, value2Ptr, &i2);
	if (result != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}
#endif

	/*
	 * Reuse the valuePtr object already on stack if possible.
	 */

	if (*pc == INST_LOR) {
	    iResult = (i1 || i2);
	} else {
	    iResult = (i1 && i2);
	}
#if 0
	if (Tcl_IsShared(valuePtr)) {
	    TclNewLongObj(objResultPtr, iResult);
	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
	    NEXT_INST_F(1, 2, 1);
	} else {	/* reuse the valuePtr object */
	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
	    TclSetLongObj(valuePtr, iResult);
	    NEXT_INST_F(1, 1, 0);
	}
#endif
	objResultPtr = eePtr->constants[iResult];
	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
	NEXT_INST_F(1, 2, 1);
    }

    /*
     * ---------------------------------------------------------
................................................................................

    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE: {
























































































































































































































































	/*
	 * Any type is allowed but the two operands must have the same type.
	 * We will compute value op value2.
	 */

	double d1 = 0.0;	/* Init. avoids compiler warning. */
	double d2 = 0.0;	/* Init. avoids compiler warning. */
................................................................................
	case INST_JUMP_TRUE4:
	    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;
................................................................................
	Tcl_SetBignumObj(valuePtr, &bigResult);
	TRACE(("%s\n", O2S(valuePtr)));
	NEXT_INST_F(1, 1, 0);
    }

#if 0
    case INST_MOD:
    case INST_LSHIFT:
    case INST_RSHIFT:
    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND: 
    {
	/*
	 * Only integers are allowed. We compute value op value2.
	 */
................................................................................
	    }

	    if ((neg_divisor && (rem > 0)) ||
		    (!neg_divisor && (rem < 0))) {
		rem = -rem;
	    }
	    iResult = rem;
	    break;
	case INST_LSHIFT:
	    /*
	     * Shifts are never usefully 64-bits wide!
	     */
	    FORCE_LONG(value2Ptr, i2, w2);
	    if (valuePtr->typePtr == &tclWideIntType) {
#ifdef TCL_COMPILE_DEBUG
		w2 = Tcl_LongAsWide(i2);
#endif /* TCL_COMPILE_DEBUG */
		wResult = w;
		/*
		 * Shift in steps when the shift gets large to prevent
		 * annoying compiler/processor bugs. [Bug 868467]
		 */
		if (i2 >= 64) {
		    wResult = Tcl_LongAsWide(0);
		} else if (i2 > 60) {
		    wResult = w << 30;
		    wResult <<= 30;
		    wResult <<= i2-60;
		} else if (i2 > 30) {
		    wResult = w << 30;
		    wResult <<= i2-30;
		} else {
		    wResult = w << i2;
		}
		doWide = 1;
		break;
	    }
	    /*
	     * Shift in steps when the shift gets large to prevent annoying
	     * compiler/processor bugs. [Bug 868467]
	     */
	    if (i2 >= 64) {
		iResult = 0;
	    } else if (i2 > 60) {
		iResult = i << 30;
		iResult <<= 30;
		iResult <<= i2-60;
	    } else if (i2 > 30) {
		iResult = i << 30;
		iResult <<= i2-30;
	    } else {
		iResult = i << i2;
	    }
	    break;
	case INST_RSHIFT:
	    /*
	     * The following code is a bit tricky: it ensures that right
	     * shifts propagate the sign bit even on machines where ">>" won't
	     * do it by default.
	     */
	    /*
	     * Shifts are never usefully 64-bits wide!
	     */
	    FORCE_LONG(value2Ptr, i2, w2);
	    if (valuePtr->typePtr == &tclWideIntType) {
#ifdef TCL_COMPILE_DEBUG
		w2 = Tcl_LongAsWide(i2);
#endif /* TCL_COMPILE_DEBUG */
		if (w < 0) {
		    wResult = ~w;
		} else {
		    wResult = w;
		}
		/*
		 * Shift in steps when the shift gets large to prevent
		 * annoying compiler/processor bugs. [Bug 868467]
		 */
		if (i2 >= 64) {
		    wResult = Tcl_LongAsWide(0);
		} else if (i2 > 60) {
		    wResult >>= 30;
		    wResult >>= 30;
		    wResult >>= i2-60;
		} else if (i2 > 30) {
		    wResult >>= 30;
		    wResult >>= i2-30;
		} else {
		    wResult >>= i2;
		}
		if (w < 0) {
		    wResult = ~wResult;
		}
		doWide = 1;
		break;
	    }
	    if (i < 0) {
		iResult = ~i;
	    } else {
		iResult = i;
	    }
	    /*
	     * Shift in steps when the shift gets large to prevent annoying
	     * compiler/processor bugs. [Bug 868467]
	     */
	    if (i2 >= 64) {
		iResult = 0;
	    } else if (i2 > 60) {
		iResult >>= 30;
		iResult >>= 30;
		iResult >>= i2-60;
	    } else if (i2 > 30) {
		iResult >>= 30;
		iResult >>= i2-30;
	    } else {
		iResult >>= i2;
	    }
	    if (i < 0) {
		iResult = ~iResult;
	    }
	    break;
	case INST_BITOR:
	    if (valuePtr->typePtr == &tclWideIntType
		    || value2Ptr->typePtr == &tclWideIntType) {
		/*
		 * Promote to wide
		 */







|







 







<
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







<
<
<
<
<






<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2608
2609
2610
2611
2612
2613
2614






2615






























2616
2617
2618
2619
2620
2621
2622

2623































2624
2625
2626
2627
2628
2629
2630





2631
2632
2633
2634
2635
2636











2637
2638
2639
2640
2641
2642
2643
....
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
....
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
....
4307
4308
4309
4310
4311
4312
4313


4314
4315
4316
4317
4318
4319
4320
....
4485
4486
4487
4488
4489
4490
4491
















































































































4492
4493
4494
4495
4496
4497
4498
 * 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.52 2005/10/07 15:51:27 dgp Exp $
 */

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

#include <math.h>
................................................................................
	 * Operands must be boolean or numeric. No int->double conversions are
	 * performed.
	 */

	int i1, i2, iResult;
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr  = *(tosPtr - 1);





































	result = Tcl_GetBooleanFromObj(NULL, valuePtr, &i1);
	if (result != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}

































	result = Tcl_GetBooleanFromObj(NULL, value2Ptr, &i2);
	if (result != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto checkForCatch;
	}






	if (*pc == INST_LOR) {
	    iResult = (i1 || i2);
	} else {
	    iResult = (i1 && i2);
	}











	objResultPtr = eePtr->constants[iResult];
	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
	NEXT_INST_F(1, 2, 1);
    }

    /*
     * ---------------------------------------------------------
................................................................................

    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE: {
	Tcl_Obj *valuePtr = *(tosPtr - 1);
	Tcl_Obj *value2Ptr = *tosPtr;
	ClientData ptr1, ptr2;
	int iResult, compare, type1, type2;
	double d1, d2, tmp;
	long l1, l2;
	mp_int big1, big2;

	if (TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
	    /* At least one non-numeric argument - compare as strings */
	    goto stringCompare;
	}
	if (type1 == TCL_NUMBER_NAN) {
	    /* NaN first arg: NaN != to everything, other compares are false */
	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}
	if (valuePtr == value2Ptr) {
	    compare = MP_EQ;
	    goto convertComparison;
	}
	if (TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
	    /* At least one non-numeric argument - compare as strings */
	    goto stringCompare;
	}
	if (type2 == TCL_NUMBER_NAN) {
	    /* NaN 2nd arg: NaN != to everything, other compares are false */
	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}
	switch (type1) {
	case TCL_NUMBER_LONG:
	    l1 = *((CONST long *)ptr1);
	    switch (type2) {
	    case TCL_NUMBER_LONG:
		l2 = *((CONST long *)ptr2);
	    longCompare:
		compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
		break;
	    case TCL_NUMBER_DOUBLE:
		d2 = *((CONST double *)ptr2);
		d1 = (double) l1;

		/* 
		 * If the double has a fractional part, or if the
		 * long can be converted to double without loss of
		 * precision, then compare as doubles.
		 */
		if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
			|| (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) {
		    goto doubleCompare;
		}
		/*
		 * Otherwise, to make comparision based on full precision,
		 * need to convert the double to a suitably sized integer.
		 *
		 * Need this to get comparsions like
		 * 	expr 20000000000000003 < 20000000000000004.0 
		 * right.  Converting the first argument to double
		 * will yield two double values that are equivalent
		 * within double precision.  Converting the double to
		 * an integer gets done exactly, then integer comparison
		 * can tell the difference.
		 */
		if (d2 < (double)LONG_MIN) {
		    compare = MP_GT;
		    break;
		}
		if (d2 > (double)LONG_MAX) {
		    compare = MP_LT;
		    break;
		}
		l2 = (long) d2;
		goto longCompare;
	    default:
		/* Second argument is wide or bignum */
		if (Tcl_IsShared(value2Ptr)) {
		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
		} else {
		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
		}
		if (mp_cmp_d(&big2, 0) == MP_LT) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
	    }
	    break;

	case TCL_NUMBER_DOUBLE:
	    d1 = *((CONST double *)ptr1);
	    switch (type2) {
	    case TCL_NUMBER_DOUBLE:
		d2 = *((CONST double *)ptr2);
	    doubleCompare:
		compare = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
		break;
	    case TCL_NUMBER_LONG:
		l2 = *((CONST long *)ptr2);
		d2 = (double) l2;

		if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
			|| (l2 == (long) d2) || (modf(d1, &tmp) != 0.0)) {
		    goto doubleCompare;
		}
		if (d1 < (double)LONG_MIN) {
		    compare = MP_LT;
		    break;
		}
		if (d1 > (double)LONG_MAX) {
		    compare = MP_GT;
		    break;
		}
		l1 = (long) d1;
		goto longCompare;

	    default:
		/* Second argument is wide or bignum */
		if (TclIsInfinite(d1)) {
		    compare = (d1 > 0.0) ? MP_GT : MP_LT;
		    break;
		}
		if (Tcl_IsShared(value2Ptr)) {
		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
		} else {
		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
		}
		if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
		    if (mp_cmp_d(&big2, 0) == MP_LT) {
			compare = MP_GT;
		    } else {
			compare = MP_LT;
		    }
		    mp_clear(&big2);
		    break;
		}
		if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
			&& (modf(d1, &tmp) != 0.0)) {
		    d2 = TclBignumToDouble( &big2);
		    mp_clear(&big2);
		    goto doubleCompare;
		}
		TclInitBignumFromDouble(NULL, d1, &big1);
		goto bigCompare;
	    }
	    break;

	default:
	    /* First argument is wide or bignum */
	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
	    }
	    switch (type2) {
	    case TCL_NUMBER_LONG:
		compare = mp_cmp_d(&big1, 0);
		mp_clear(&big1);
		break;
	    case TCL_NUMBER_DOUBLE:
		d2 = *((CONST double *)ptr2);
		if (TclIsInfinite(d2)) {
		    compare = (d2 > 0.0) ? MP_LT : MP_GT;
		    mp_clear(&big1);
		    break;
		}
		if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
		    compare = mp_cmp_d(&big1, 0);
		    mp_clear(&big1);
		    break;
		}
		if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
			&& (modf(d2, &tmp) != 0.0)) {
		    d1 = TclBignumToDouble( &big1);
		    mp_clear(&big1);
		    goto doubleCompare;
		}
		TclInitBignumFromDouble(NULL, d2, &big2);
		goto bigCompare;
	    default:
		/* Second argument is wide or bignum */
		if (Tcl_IsShared(value2Ptr)) {
		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
		} else {
		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
		}
	    bigCompare:
		compare = mp_cmp(&big1, &big2);
		mp_clear(&big1);
		mp_clear(&big2);
	    }
	}

	/* Turn comparison outcome into appropriate result for opcode */

    convertComparison:
	switch (*pc) {
	case INST_EQ:
	    iResult = (compare == MP_EQ);
	    break;
	case INST_NEQ:
	    iResult = (compare != MP_EQ);
	    break;
	case INST_LT:
	    iResult = (compare == MP_LT);
	    break;
	case INST_GT:
	    iResult = (compare == MP_GT);
	    break;
	case INST_LE:
	    iResult = (compare != MP_GT);
	    break;
	case INST_GE:
	    iResult = (compare != MP_LT);
	    break;
	}

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

    foundResult:
	pc++;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = eePtr->constants[iResult];
	NEXT_INST_F(0, 2, 1);
    }

#if 0
/*
    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE:*/ {
	/*
	 * Any type is allowed but the two operands must have the same type.
	 * We will compute value op value2.
	 */

	double d1 = 0.0;	/* Init. avoids compiler warning. */
	double d2 = 0.0;	/* Init. avoids compiler warning. */
................................................................................
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = eePtr->constants[iResult];
	NEXT_INST_F(0, 2, 1);
    }
#endif

    case INST_LSHIFT:
    case INST_RSHIFT: {
	Tcl_Obj *value2Ptr = *tosPtr;
	Tcl_Obj *valuePtr  = *(tosPtr - 1);
	ClientData ptr1, ptr2;
	int invalid, shift, type1, type2;
................................................................................
	Tcl_SetBignumObj(valuePtr, &bigResult);
	TRACE(("%s\n", O2S(valuePtr)));
	NEXT_INST_F(1, 1, 0);
    }

#if 0
    case INST_MOD:


    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND: 
    {
	/*
	 * Only integers are allowed. We compute value op value2.
	 */
................................................................................
	    }

	    if ((neg_divisor && (rem > 0)) ||
		    (!neg_divisor && (rem < 0))) {
		rem = -rem;
	    }
	    iResult = rem;
















































































































	    break;
	case INST_BITOR:
	    if (valuePtr->typePtr == &tclWideIntType
		    || value2Ptr->typePtr == &tclWideIntType) {
		/*
		 * Promote to wide
		 */