Tcl Source Code

Check-in [8d4c5bb62b]
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: Updated TclIncrObj() to more efficiently add native long integers. Also updated IllegalExprOperandType and the INST_UMINUS, INST_UPLUS, INST_BITNOT, and INST_TRY_CVT_TO_NUMERIC sections for performance.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 8d4c5bb62b42586697bc5151e19be0aef32095c3
User & Date: dgp 2005-10-04 21:02:29
Context
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
2005-10-04
21:02
[kennykb-numerics-branch]
* generic/tclExecute.c: Updated TclIncrObj() to more effi...
check-in: 8d4c5bb62b user: dgp tags: kennykb-numerics-branch
18:33
[kennykb-numerics-branch]
* generic/tclExecute.c: Updated TclIncrObj() to more effi...
check-in: 53add32158 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
14
2005-10-04  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

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

	and the INST_UMINUS and INST_BITNOT sections for performance.

	* generic/tclBasic.c:	Updated more callers to make use of
	TclGetNumberFromObj.  Removed some dead code.

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

	[kennykb-numerics-branch]





>
|







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

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Updated TclIncrObj() to more efficiently
	add native long integers.  Also updated IllegalExprOperandType
	and the INST_UMINUS, INST_UPLUS, INST_BITNOT, and
	INST_TRY_CVT_TO_NUMERIC sections for performance.

	* generic/tclBasic.c:	Updated more callers to make use of
	TclGetNumberFromObj.  Removed some dead code.

2005-10-03  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
....
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
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
5413

5414
5415
5416
5417
5418

5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
 * 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.44 2005/10/04 18:33:54 dgp Exp $
 */

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

#include <math.h>
................................................................................
    case INST_TRY_CVT_TO_NUMERIC: {
	/*
	 * Try to convert the topmost stack object to numeric object.
	 * This is done in order to support [expr]'s policy of interpreting
	 * operands if at all possible as numbers first, then strings.
	 */

	double d;
	Tcl_Obj *valuePtr;
#if 0
	char *s;
	Tcl_ObjType *tPtr;
	int converted, needNew, length;
	long i;
	Tcl_WideInt w;

	valuePtr = *tosPtr;
	tPtr = valuePtr->typePtr;
	converted = 0;
	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.
	     */
	    s = Tcl_GetStringFromObj(valuePtr, &length);
	    if (TclLooksLikeInt(s, length)) {
		GET_WIDE_OR_INT(result, valuePtr, i, w);
	    } else {
		result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
	    }
	    if (result == TCL_OK) {
		converted = 1;
	    }
	    result = TCL_OK; /* reset the result variable */
	    tPtr = valuePtr->typePtr;
	}

	/*
	 * Ensure that the topmost stack object, if numeric, has a string rep
	 * the same as the formatted version of its internal rep. This is
	 * used, e.g., to make sure that "expr {0001}" yields "1", not
	 * "0001". 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. Also check if there has been an IEEE floating
	 * point error.
	 */

	objResultPtr = valuePtr;
	needNew = 0;
	if (IS_NUMERIC_TYPE(tPtr)) {
	    if (Tcl_IsShared(valuePtr)) {
		if (valuePtr->bytes != NULL) {
		    /*
		     * We only need to make a copy of the object when it
		     * already had a string rep
		     */
		    needNew = 1;
		    if (tPtr == &tclIntType) {
			i = valuePtr->internalRep.longValue;
			TclNewLongObj(objResultPtr, i);
		    } else if (tPtr == &tclWideIntType) {
			TclGetWide(w,valuePtr);
			TclNewWideIntObj(objResultPtr, w);
		    } else if (tPtr == &tclBignumType) {
			mp_int big;
			Tcl_GetBignumFromObj(NULL, valuePtr, &big);
			objResultPtr = Tcl_NewBignumObj(&big);
		    } else {
			d = valuePtr->internalRep.doubleValue;
			TclNewDoubleObj(objResultPtr, d);
		    }
		    tPtr = objResultPtr->typePtr;
		}
	    } else {
		Tcl_InvalidateStringRep(valuePtr);
	    }

	    if (tPtr == &tclDoubleType) {
		d = objResultPtr->internalRep.doubleValue;
		if (IS_NAN(d)) {
		    TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			    O2S(objResultPtr)));
		    TclExprFloatError(interp, d);


		    result = TCL_ERROR;



		    goto checkForCatch;
		}
	    }
	    converted = converted;  /* lint, converted not used. */
	    TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
		    (converted? "converted" : "not converted"),
		    (needNew? "new Tcl_Obj" : "same Tcl_Obj")));
	} else {

	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
	}
	if (needNew) {
	    NEXT_INST_F(1, 1, 1);
	} else {
	    NEXT_INST_F(1, 0, 0);
	}
#else
	valuePtr = *tosPtr;
	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
	if ((result == TCL_OK) || valuePtr->typePtr == &tclDoubleType) {
	    /* Value is now numeric (including NaN) */

#ifndef ACCEPT_NAN
	    if ((*pc == INST_TRY_CVT_TO_NUMERIC) && (result != TCL_OK)) {








		/* Numeric conversion of NaN -> error */
		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));
		TclExprFloatError(interp, valuePtr->internalRep.doubleValue);

		goto checkForCatch;
	    }
#else
	    result = TCL_OK;
#endif

	    /*
	     * Ensure that the numeric value has a string rep the same as
	     * the formatted version of its internal rep. This is used, e.g.,
	     * to make sure that "expr {0001}" yields "1", not "0001".
	     * 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 (valuePtr->bytes == NULL) {
		TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	    if (Tcl_IsShared(valuePtr)) {
		/*
		 * Here we do some surgery within the Tcl_Obj internals.
		 * We want to copy the intrep, but not the string, so we
		 * temporarily hide the string so we do not copy it.
		 */
		char *savedString = valuePtr->bytes;
		valuePtr->bytes = NULL;
		objResultPtr = Tcl_DuplicateObj(valuePtr);
		valuePtr->bytes = savedString;
		TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 1);
	    }
	    TclInvalidateStringRep(valuePtr);
	    result = TCL_OK;
	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	/* Non-numeric argument... */
	if (*pc == INST_UPLUS) {
	    /* ... +$NonNumeric => raise an error */
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto checkForCatch;
	} else {
	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
	    result = TCL_OK;
	    NEXT_INST_F(1, 0, 0);
	}
#endif
    }

    case INST_BREAK:
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	result = TCL_BREAK;






|







 







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

<
>
>
>
>
>
>
>
>



|
>
|
|
<
<

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







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
5296
5297
5298
5299
5300
5301
5302
5303
5304







5305




















5306



































5307

















5308
5309
5310
5311
5312
5313
5314






5315
5316
5317




5318
5319





5320
5321

5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336


5337
5338
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
 * 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.45 2005/10/04 21:02:30 dgp Exp $
 */

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

#include <math.h>
................................................................................
    case INST_TRY_CVT_TO_NUMERIC: {
	/*
	 * Try to convert the topmost stack object to numeric object.
	 * This is done in order to support [expr]'s policy of interpreting
	 * operands if at all possible as numbers first, then strings.
	 */

	ClientData ptr;
	int type;







	Tcl_Obj *valuePtr = *tosPtr;
























































	if (TclGetNumberFromObj(NULL, valuePtr, &ptr, &type) != TCL_OK) {

















	    if (*pc == INST_UPLUS) {
		/* ... +$NonNumeric => raise an error */
		result = TCL_ERROR;
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto checkForCatch;






	    } else {
		/* ... TryConvertToNumeric($NonNumeric) is acceptable */
		TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));




		NEXT_INST_F(1, 0, 0);
	    }





	}
#ifndef ACCEPT_NAN

	if (type == TCL_NUMBER_NAN) {
	    result = TCL_ERROR;
	    if (*pc == INST_UPLUS) {
		/* ... +$NonNumeric => raise an error */
		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
		IllegalExprOperandType(interp, pc, valuePtr);
	    } else {
		/* Numeric conversion of NaN -> error */
		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));
		TclExprFloatError(interp, *((CONST double *)ptr));
	    }
	    goto checkForCatch;
	}


#endif

	/*
	 * Ensure that the numeric value has a string rep the same as
	 * the formatted version of its internal rep. This is used, e.g.,
	 * to make sure that "expr {0001}" yields "1", not "0001".
	 * 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 (valuePtr->bytes == NULL) {
	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	if (Tcl_IsShared(valuePtr)) {
	    /*
	     * Here we do some surgery within the Tcl_Obj internals.
	     * We want to copy the intrep, but not the string, so we
	     * temporarily hide the string so we do not copy it.
	     */
	    char *savedString = valuePtr->bytes;
	    valuePtr->bytes = NULL;
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
	    valuePtr->bytes = savedString;
	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 1);
	}
	TclInvalidateStringRep(valuePtr);

	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
	NEXT_INST_F(1, 0, 0);















    }

    case INST_BREAK:
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	result = TCL_BREAK;