Tcl Source Code

Check-in [645515e90f]
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:merge 8.6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256:645515e90f59a47e720726362dac5ad80b6394153bb643eed907d114dcdc7040
User & Date: sebres 2019-05-17 10:40:17
Context
2019-05-22
07:35
Start of logging API implementation check-in: 412a238782 user: dkf tags: tip-390
2019-05-21
11:40
merge 8.6 (fixed optimization for create/search hash entries with the same keys) check-in: 145a4e3e51 user: sebres tags: core-8-branch
2019-05-17
14:42
merge 8.7 Leaf check-in: 4d59245e22 user: dgp tags: core-8-7-a3-rc
14:42
merge 8.7 Leaf check-in: b948d2dca4 user: dgp tags: tip-445-api-fix
14:22
Merge 8.7 check-in: 592c6ff5b4 user: jan.nijtmans tags: utf-max
10:57
merge 8.7 check-in: a4a961564b user: sebres tags: tip-534-sebres-fast-number-hash
10:40
merge 8.6 check-in: 645515e90f user: sebres tags: core-8-branch
2019-05-16
18:19
merge 8.5 check-in: 594a6ef663 user: sebres tags: core-8-6-branch
2019-05-14
19:26
Merge 8.6 check-in: 2c56cc8106 user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCmdMZ.c.

4184
4185
4186
4187
4188
4189
4190

4191
4192
4193
4194
4195
4196
4197
....
4368
4369
4370
4371
4372
4373
4374









4375
4376
4377
4378
4379
4380
4381
....
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
....
4656
4657
4658
4659
4660
4661
4662





4663
4664
4665
4666
4667
4668
4669
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;


    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
................................................................................

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);









    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
................................................................................
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }
	    if (result != TCL_OK) {
		/*
		 * Allow break from measurement cycle (used for conditional
		 * stop).

		 */

		if (result != TCL_BREAK) {

		    goto done;
		}


		/*
		 * Force stop immediately.
		 */

		threshold = 1;
		maxcnt = 0;

		result = TCL_OK;



	    }

	    /*
	     * Don't check time up to threshold.
	     */

	    if (--threshold > 0) {
................................................................................
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {





	TclReleaseByteCode(codePtr);
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------







>







 







>
>
>
>
>
>
>
>
>







 







<
|
|
<
>
|

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







 







>
>
>
>
>







4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
....
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
....
4424
4425
4426
4427
4428
4429
4430

4431
4432

4433
4434
4435
4436
4437
4438


4439
4440
4441
4442

4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
....
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;
    int codeOptimized = 0;

    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
................................................................................

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);
	/* 
	 * Replace last compiled done instruction with continue: it's a part of
	 * iteration, this way evaluation will be more similar to a cycle (also
	 * avoids extra overhead to set result to interp, etc.)
	 */
	if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
	    codeOptimized = 1;
	}
    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
................................................................................
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }

	    /*
	     * Allow break and continue from measurement cycle (used for

	     * conditional stop and flow control of iterations).
	     */

	    switch (result) {
		case TCL_OK:
		    break;


		case TCL_BREAK:
		    /*
		     * Force stop immediately.
		     */

		    threshold = 1;
		    maxcnt = 0;
		case TCL_CONTINUE:
		    result = TCL_OK;
		    break;
		default:
		    goto done;
	    }

	    /*
	     * Don't check time up to threshold.
	     */

	    if (--threshold > 0) {
................................................................................
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {
	if ( codeOptimized
	  && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
	) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
	}
	TclReleaseByteCode(codePtr);
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------

Changes to tests/cmdMZ.test.

398
399
400
401
402
403
404








405
406
407
408
409
410
411
...
412
413
414
415
416
417
418






419
420
421
422
423
424
425
test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
    set m1 [timerate {break}]
    list \
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]








} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
................................................................................
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}







test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation








>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
    set m1 [timerate {break}]
    list \
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} {
    set m1 [timerate {continue; return -code error "unexpected"} 1000 10]
    list \
    [expr {[lindex $m1 0] < 1000}] \
    [expr {[lindex $m1 2] == 10}] \
    [expr {[lindex $m1 4] > 1000}] \
    [expr {[lindex $m1 6] < 100}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
................................................................................
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}
test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} {
    set m1 {set m2 ok}
    if 1 $m1
    timerate $m1 1000 10
    if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop
} ok

test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation