Tcl Source Code

Check-in [318d5967ce]
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_MULT and INST_DIV and replaced a "goto... label" with a "break from loop" in TclIncrObj() and removed some dead code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:318d5967ce9f076735608113b506dcb661969cbe
User & Date: dgp 2005-10-06 02:51:00
Context
2005-10-06
03:41
[kennykb-numerics-branch]
* generic/tclExecute.c: Improved performance of INST_MULT...
check-in: ac4d98012f user: dgp tags: kennykb-numerics-branch
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4
5
6

7
8
9
10
11
12
13
2005-10-05  Don Porter  <dgp@users.sourceforge.net>

	[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  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Updated TclIncrObj() to more efficiently
	add native long integers.  Also updated IllegalExprOperandType




|
|
>







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

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_MULT and INST_DIV
	and replaced a "goto... label" with a "break from loop" in TclIncrObj()
	and removed some dead code.

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

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Updated TclIncrObj() to more efficiently
	add native long integers.  Also updated IllegalExprOperandType

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
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
....
4446
4447
4448
4449
4450
4451
4452

4453
4454
4455
4456
4457
4458
4459
....
4468
4469
4470
4471
4472
4473
4474


4475
















4476
4477
4478
4479
4480
4481
4482
....
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
....
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
....
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
....
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
....
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
....
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
....
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
....
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
....
5250
5251
5252
5253
5254
5255
5256

5257
5258
5259


5260
5261
5262
5263
5264
5265
5266
....
5311
5312
5313
5314
5315
5316
5317

5318

5319
5320
5321
5322
5323

5324
5325
5326

5327
5328
5329
5330
5331
5332
5333
....
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
 * 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>
................................................................................
		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;
	}

................................................................................

	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;
	}

................................................................................
	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)) {
................................................................................
		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;

................................................................................
		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);
	    }
................................................................................
	    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.
	 */

................................................................................
		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
		/*
		 * We presume that we are running with zero-divide unmasked if
		 * we're on an IEEE box. Otherwise, this statement might cause
		 * demons to fly out our noses.
		 */
		dResult = d1 / d2;
		break;
	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    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
		/*
		 * We presume that we are running with zero-divide unmasked if
		 * we're on an IEEE box. Otherwise, this statement might cause
		 * demons to fly out our noses.
		 */
		dResult = d1 / d2;
		break;
	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    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);
		    goto divideByZero;
................................................................................
	    Tcl_SetBignumObj(valuePtr, &bigResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
#endif
    }

#if 0
    case INST_UPLUS: {
	/*
	 * Operand must be numeric.
	 */

	double d;
	Tcl_ObjType *tPtr;
	Tcl_Obj *valuePtr;

	valuePtr = *tosPtr;
	tPtr = valuePtr->typePtr;
	if (IS_INTEGER_TYPE(tPtr)
		|| ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
	    /*
	     * We already have a numeric internal rep, either some kind of
	     * integer, or a "pure" double.  (Need "pure" so that we know the
	     * string rep of the double would not prefer to be interpreted as
	     * an integer.)
	     */
	} else {
	    /*
	     * Otherwise, we need to generate a numeric internal rep. from
	     * the string rep.
	     */
	    int length;
	    long i;	/* Set but never used, needed in GET_WIDE_OR_INT */
	    Tcl_WideInt w;
	    char *s = Tcl_GetStringFromObj(valuePtr, &length);

	    if (TclLooksLikeInt(s, length)) {
		GET_WIDE_OR_INT(result, valuePtr, i, w);
	    } else {
		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
	    }
	    if (result != TCL_OK) {
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
			s, (tPtr? tPtr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto checkForCatch;
	    }
	    tPtr = valuePtr->typePtr;
	}

	/*
	 * Ensure that the operand's string rep is the same as the formatted
	 * version of its internal rep. This makes sure that "expr +000123"
	 * yields "83", not "000123". We implement this by _discarding_ the
	 * string rep since we know it will be regenerated, if needed later,
	 * by formatting the internal rep's value.
	 */

	if (Tcl_IsShared(valuePtr)) {
	    if (tPtr == &tclIntType) {
		TclNewLongObj(objResultPtr, valuePtr->internalRep.longValue);
	    } else if (tPtr == &tclWideIntType) {
		Tcl_WideInt w;

		TclGetWide(w,valuePtr);
		TclNewWideIntObj(objResultPtr, w);
	    } else {
		TclNewDoubleObj(objResultPtr, valuePtr->internalRep.doubleValue);
	    }
	    TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
	    NEXT_INST_F(1, 1, 1);
	} else {
	    TclInvalidateStringRep(valuePtr);
	    TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
	    NEXT_INST_F(1, 0, 0);
	}
    }
#endif

    case INST_LNOT: {
	int b;
	Tcl_Obj *valuePtr = *tosPtr;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for eePtr->constants */
	result = Tcl_GetBooleanFromObj(NULL, valuePtr, &b);
................................................................................
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = eePtr->constants[!b];
	NEXT_INST_F(1, 1, 1);
    }

    case INST_BITNOT: {
#if 0
	long i;
	int negate_value = 1;
	Tcl_WideInt w;
	Tcl_ObjType *tPtr;

	valuePtr = *tosPtr;
	tPtr = valuePtr->typePtr;
	if (IS_INTEGER_TYPE(tPtr)
		|| ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
	    /*
	     * We already have a numeric internal rep, either some kind of
	     * integer, or a "pure" double.  (Need "pure" so that we know the
	     * string rep of the double would not prefer to be interpreted as
	     * an integer.)
	     */
	} else {
	    /*
	     * Otherwise, we need to generate a numeric internal rep. from
	     * the string rep.
	     */
	    int length;
	    char *s = Tcl_GetStringFromObj(valuePtr, &length);
	    if (TclLooksLikeInt(s, length)) {
		GET_WIDE_OR_INT(result, valuePtr, i, w);

		/*
		 * An integer was parsed. If parsing a literal that is the
		 * smallest long value, then it would have been promoted to a
		 * wide since it would not fit in a long type without the
		 * leading '-'. Convert back to the smallest possible long.
		 */

		if ((result == TCL_OK) &&
			(valuePtr->typePtr == &tclWideIntType) &&
			(w == -Tcl_LongAsWide(LONG_MIN))) {
		    valuePtr->typePtr = &tclIntType;
		    valuePtr->internalRep.longValue = LONG_MIN;
		    negate_value = 0;
		}
	    } else {
		result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
	    }
	    if (result != TCL_OK) {
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s,
			(tPtr? tPtr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto checkForCatch;
	    }
	    tPtr = valuePtr->typePtr;
	}
	if (Tcl_IsShared(valuePtr)) {
	    /* Create a new object. */
	    if (tPtr == &tclIntType) {
		i = valuePtr->internalRep.longValue;
		if (negate_value) {
		    i = -i;
		}
		TclNewLongObj(objResultPtr, i);
		TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
	    } else if (tPtr == &tclWideIntType) {
		TclGetWide(w,valuePtr);
		TclNewWideIntObj(objResultPtr, -w);
		TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
	    } else {
		d = valuePtr->internalRep.doubleValue;
		TclNewDoubleObj(objResultPtr, -d);
		TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
	    }
	    NEXT_INST_F(1, 1, 1);
	}
	/*
	 * valuePtr is unshared. Modify it directly.
	 */
	if (tPtr == &tclIntType) {
	    i = valuePtr->internalRep.longValue;
	    if (negate_value) {
		i = -i;
	    }
	    TclSetLongObj(valuePtr, i);
	    TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
	} else if (tPtr == &tclWideIntType) {
	    TclGetWide(w,valuePtr);
	    TclSetWideIntObj(valuePtr, -w);
	    TRACE_WITH_OBJ((LLD" => ", w), valuePtr);
	} else {
	    d = valuePtr->internalRep.doubleValue;
	    TclSetDoubleObj(valuePtr, -d);
	    TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
	}
	NEXT_INST_F(1, 0, 0);
#else
	mp_int big;
	ClientData ptr;
	int type;
	Tcl_Obj *valuePtr = *tosPtr;

	result = TclGetNumberFromObj(NULL, valuePtr, &ptr, &type);
	if ((result != TCL_OK)
................................................................................
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l);
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l);
	    NEXT_INST_F(1, 0, 0);
	}

	if (type == TCL_NUMBER_WIDE) {
	    TclBNInitBignumFromWideInt(&big, *((CONST Tcl_WideInt*)ptr));
	} else {


	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
	    }
	}
	/* ~a = - a - 1 */
................................................................................
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l);
		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */
	}

	case TCL_NUMBER_WIDE:

	case TCL_NUMBER_BIG: {
	    switch (type) {
	    case TCL_NUMBER_LONG:
		TclBNInitBignumFromLong(&big, *((CONST long *)ptr));
		break;

	    case TCL_NUMBER_WIDE:
		TclBNInitBignumFromWideInt(&big, *((CONST Tcl_WideInt*)ptr));
		break;

	    case TCL_NUMBER_BIG:
		if (Tcl_IsShared(valuePtr)) {
		    Tcl_GetBignumFromObj(NULL, valuePtr, &big);
		} else {
		    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
		}
	    }
................................................................................
	    Tcl_SetBignumObj(valuePtr, &big);
	    NEXT_INST_F(1, 0, 0);
	}
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    NEXT_INST_F(1, 0, 0);
	}
#endif
    }

#if 0
    case INST_BITNOT: {
	/*
	 * The operand must be an integer. If the operand object is unshared
	 * modify it directly, otherwise modify a copy.  Free any old string
	 * representation since it is now invalid.
	 */

	Tcl_ObjType *tPtr;
	Tcl_Obj *valuePtr;
	Tcl_WideInt w;
	long i;

	valuePtr = *tosPtr;
	tPtr = valuePtr->typePtr;
	if (!IS_INTEGER_TYPE(tPtr)) {
	    REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
	    if (result != TCL_OK) {   /* try to convert to double */
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
			O2S(valuePtr), (tPtr? tPtr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto checkForCatch;
	    }
	}

	if (valuePtr->typePtr == &tclWideIntType) {
	    TclGetWide(w,valuePtr);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewWideIntObj(objResultPtr, ~w);
		TRACE(("0x%llx => (%llu)\n", w, ~w));
		NEXT_INST_F(1, 1, 1);
	    } else {
		/*
		 * valuePtr is unshared. Modify it directly.
		 */
		TclSetWideIntObj(valuePtr, ~w);
		TRACE(("0x%llx => (%llu)\n", w, ~w));
		NEXT_INST_F(1, 0, 0);
	    }
	} else {
	    i = valuePtr->internalRep.longValue;
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~i);
		TRACE(("0x%lx => (%lu)\n", i, ~i));
		NEXT_INST_F(1, 1, 1);
	    } else {
		/*
		 * valuePtr is unshared. Modify it directly.
		 */
		TclSetLongObj(valuePtr, ~i);
		TRACE(("0x%lx => (%lu)\n", i, ~i));
		NEXT_INST_F(1, 0, 0);
	    }
	}
    }
#endif

    case INST_CALL_BUILTIN_FUNC1: {
	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
    }

    case INST_CALL_FUNC1: {
	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
    }







|







 







>












>







 







>







 







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







 







|







 







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












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







 







<







 







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







 







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







 







<







 







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







 







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







 







>


|
>
>







 







>

>





>



>







 







<


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







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
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
....
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
....
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
....
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
....
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
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
....
4630
4631
4632
4633
4634
4635
4636

4637
4638
4639
4640
4641
4642
4643
....
4740
4741
4742
4743
4744
4745
4746














4747
4748
4749
4750
4751
4752
4753
....
4952
4953
4954
4955
4956
4957
4958














4959
4960
4961
4962
4963
4964
4965
....
5007
5008
5009
5010
5011
5012
5013

5014
5015
5016
5017
5018
5019
5020
....
5099
5100
5101
5102
5103
5104
5105









































































5106
5107
5108
5109
5110
5111
5112
....
5118
5119
5120
5121
5122
5123
5124




























































































5125
5126
5127
5128
5129
5130
5131
....
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
....
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
....
5238
5239
5240
5241
5242
5243
5244

5245
5246

























































5247
5248
5249
5250
5251
5252
5253
 * 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.47 2005/10/06 02:51:00 dgp Exp $
 */

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

#include <math.h>
................................................................................
		TclSetLongObj(valuePtr, iResult);
	    }
	    NEXT_INST_F(1, 1, 0);
	}
    }
#endif

    case INST_DIV:
    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
		) {
	    result = TCL_ERROR;
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr), 
		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	}

................................................................................

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

................................................................................
	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);

	    switch (*pc) {
	    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
		/*
		 * We presume that we are running with zero-divide unmasked if
		 * we're on an IEEE box. Otherwise, this statement might cause
		 * demons to fly out our noses.
		 */
		dResult = d1 / d2;
		break;
	    }

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

	    if (TclIsNaN(dResult)) {
................................................................................
		NEXT_INST_F(1, 2, 1);
	    }
	    TclSetDoubleObj(valuePtr, dResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

	if ((*pc == INST_MULT) && (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;

................................................................................
		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);

	} 

	if ((*pc != INST_MULT) 
		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    Tcl_WideInt w1, w2, wResult;
	    Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
	    Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);

	    if (w2 == 0) {
		TRACE(("%s %s => DIVIDE BY ZERO\n",
			O2S(valuePtr), O2S(value2Ptr)));
		goto divideByZero;
	    }

#ifdef TCL_WIDE_INT_IS_LONG
	    /* Need a bignum to represent (LONG_MIN / -1) */
	    if ((w1 == LONG_MIN) && (w2 == -1)) {
		goto overflow;
	    }
#endif
	    wResult = w1 / w2;

	    /* Force Tcl's integer division rules */
	    /* TODO: examine for logic simplification */
	    if (((wResult < 0) || ((wResult == 0) &&
		    ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
		    ((wResult * w2) != w1)) {
		wResult -= 1;
	    }

	    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);
	}

    overflow:
	{
	    mp_int big1, big2, bigResult, bigRemainder;
	    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);
	    switch (*pc) {
	    case INST_MULT:
		mp_mul(&big1, &big2, &bigResult);
		break;
	    case INST_DIV:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    mp_clear(&big1);
		    mp_clear(&big2);
		    goto divideByZero;
		}
		mp_init(&bigRemainder);
		mp_div(&big1, &big2, &bigResult, &bigRemainder);
		/* TODO: internals intrusion */
		if (!mp_iszero(&bigRemainder) 
			&& (bigRemainder.sign != big2.sign)) {
		    /* Convert to Tcl's integer division rules */
		    mp_sub_d(&bigResult, 1, &bigResult);
		    mp_add(&bigRemainder, &big2, &bigRemainder);
		}
		if (*pc == INST_MOD) {
		    mp_copy(&bigRemainder, &bigResult);
		}
		mp_clear(&bigRemainder);
		break;
	    }
	    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);
	    }
................................................................................
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
    }

    case INST_ADD:
    case INST_SUB:

    case INST_MOD:
    case INST_EXPON: {
	/*
	 * Operands must be numeric and ints get converted to floats if
	 * necessary. We compute value op value2.
	 */

................................................................................
		break;
	    case INST_SUB:
		dResult = d1 - d2;
		break;
	    case INST_MULT:
		dResult = d1 * d2;
		break;














	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    switch (*pc) {
	    case INST_ADD:
		dResult = d1 + d2;
		break;
	    case INST_SUB:
		dResult = d1 - d2;
		break;














	    case INST_EXPON:
		if (d1==0.0 && d2<0.0) {
		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
		    goto exponOfZero;
		}
		dResult = pow(d1, d2);
		break;
................................................................................
	    switch (*pc) {
	    case INST_ADD:
		mp_add(&big1, &big2, &bigResult);
		break;
	    case INST_SUB:
		mp_sub(&big1, &big2, &bigResult);
		break;

	    case INST_MOD:
		if (mp_iszero(&big2)) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    mp_clear(&big1);
		    mp_clear(&big2);
		    goto divideByZero;
................................................................................
	    Tcl_SetBignumObj(valuePtr, &bigResult);
	    TRACE(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}
#endif
    }










































































    case INST_LNOT: {
	int b;
	Tcl_Obj *valuePtr = *tosPtr;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for eePtr->constants */
	result = Tcl_GetBooleanFromObj(NULL, valuePtr, &b);
................................................................................
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = eePtr->constants[!b];
	NEXT_INST_F(1, 1, 1);
    }

    case INST_BITNOT: {




























































































	mp_int big;
	ClientData ptr;
	int type;
	Tcl_Obj *valuePtr = *tosPtr;

	result = TclGetNumberFromObj(NULL, valuePtr, &ptr, &type);
	if ((result != TCL_OK)
................................................................................
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l);
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l);
	    NEXT_INST_F(1, 0, 0);
	}
#ifndef NO_WIDE_TYPE
	if (type == TCL_NUMBER_WIDE) {
	    TclBNInitBignumFromWideInt(&big, *((CONST Tcl_WideInt*)ptr));
	} else 
#endif
	{
	    if (Tcl_IsShared(valuePtr)) {
		Tcl_GetBignumFromObj(NULL, valuePtr, &big);
	    } else {
		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
	    }
	}
	/* ~a = - a - 1 */
................................................................................
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l);
		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */
	}
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
#endif
	case TCL_NUMBER_BIG: {
	    switch (type) {
	    case TCL_NUMBER_LONG:
		TclBNInitBignumFromLong(&big, *((CONST long *)ptr));
		break;
#ifndef NO_WIDE_TYPE
	    case TCL_NUMBER_WIDE:
		TclBNInitBignumFromWideInt(&big, *((CONST Tcl_WideInt*)ptr));
		break;
#endif
	    case TCL_NUMBER_BIG:
		if (Tcl_IsShared(valuePtr)) {
		    Tcl_GetBignumFromObj(NULL, valuePtr, &big);
		} else {
		    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
		}
	    }
................................................................................
	    Tcl_SetBignumObj(valuePtr, &big);
	    NEXT_INST_F(1, 0, 0);
	}
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    NEXT_INST_F(1, 0, 0);
	}

    }


























































    case INST_CALL_BUILTIN_FUNC1: {
	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
    }

    case INST_CALL_FUNC1: {
	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
    }