Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | timerate: extended with ?max-count? optional parameter, code review and more tests |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | sebres-8-5-timerate |
| Files: | files | file ages | folders |
| SHA3-256: |
0f6e941c6ef549e9e1534a83bb6c0723 |
| User & Date: | sebres 2019-02-13 01:10:16 |
Context
|
2019-02-13
| ||
| 01:22 | timerate documentation extended check-in: af42c485d8 user: sebres tags: sebres-8-5-timerate | |
| 01:10 | timerate: extended with ?max-count? optional parameter, code review and more tests check-in: 0f6e941c6e user: sebres tags: sebres-8-5-timerate | |
|
2019-02-12
| ||
| 20:40 | small amend (correct wrong utf-8 prevention for micro sign in RE of check test-case) check-in: f3d1a24b0e user: sergey.brester tags: sebres-8-5-timerate | |
Changes
Changes to generic/tclCmdMZ.c.
3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 .... 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 .... 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 .... 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 .... 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 .... 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 .... 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 .... 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 |
static
double measureOverhead = 0; /* global measure-overhead */
double overhead = -1; /* given measure-overhead */
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
Tcl_WideUInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL;
/* Maximal running time (in milliseconds) */
Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster
* repeat count without time check) */
Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold
* additionally avoid divide to zero (never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
* growth of execution time. */
register Tcl_WideInt start, middle, stop;
................................................................................
break;
case TMRT_CALIBRATE:
calibrate = objv[i];
break;
}
}
if (i >= objc || i < objc-2) {
usage:
Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?");
return TCL_ERROR;
}
objPtr = objv[i++];
if (i < objc) {
result = Tcl_GetWideIntFromObj(interp, objv[i], &maxms);
if (result != TCL_OK) {
return result;
}
}
/* if calibrate */
if (calibrate) {
/* if no time specified for the calibration */
if (maxms == -0x7FFFFFFFFFFFFFFFL) {
Tcl_Obj *clobjv[6];
Tcl_WideInt maxCalTime = 5000;
double lastMeasureOverhead = measureOverhead;
clobjv[0] = objv[0];
i = 1;
if (direct) {
................................................................................
}
i--;
clobjv[i++] = calibrate;
clobjv[i++] = objPtr;
/* set last measurement overhead to max */
measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
/* calibration cycle until it'll be preciser */
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
TclNewLongObj(clobjv[i], (int)maxms);
Tcl_IncrRefCount(clobjv[i]);
................................................................................
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
/* if time is negative - make current overhead more precise */
if (maxms > 0) {
/* set last measurement overhead to max */
measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
} else {
maxms = -maxms;
}
}
if (maxms == -0x7FFFFFFFFFFFFFFFL) {
maxms = 1000;
}
if (overhead == -1) {
overhead = measureOverhead;
}
/* be sure that resetting of result will not smudge the further measurement */
................................................................................
start = now.sec; start *= 1000000; start += now.usec;
middle = start;
/* time to stop execution (in microsecs) */
stop = start + maxms * 1000;
#endif
/* start measurement */
while (1) {
/* eval single iteration */
count++;
if (!direct) {
/* precompiled */
result = TclExecuteByteCode(interp, codePtr);
................................................................................
if (result != TCL_OK) {
/* allow break from measurement cycle (used for conditional stop) */
if (result != TCL_BREAK) {
goto done;
}
/* force stop immediately */
threshold = 1;
stop = -0x7FFFFFFFFFFFFFFFL;
result = TCL_OK;
}
/* don't check time up to threshold */
if (--threshold > 0) continue;
/* check stop time reached, estimate new threshold */
#ifdef TCL_WIDE_CLICKS
middle = TclpGetWideClicks();
#else
Tcl_GetTime(&now);
middle = now.sec; middle *= 1000000; middle += now.usec;
#endif
if (middle >= stop) {
break;
}
/* don't calculate threshold by few iterations, because sometimes first
* iteration(s) can be too fast or slow (cached, delayed clean up, etc) */
if (count < 10) {
threshold = 1; continue;
................................................................................
/* as relation between remaining time and time since last check,
* maximal some % of time (by factor), so avoid growing of the execution time
* if iterations are not consistent, e. g. wax continuously on time) */
threshold = ((stop - middle) / maxIterTm) / factor + 1;
if (threshold > 100000) { /* fix for too large threshold */
threshold = 100000;
}
}
{
Tcl_Obj *objarr[8], **objs = objarr;
Tcl_WideInt val;
const char *fmt;
................................................................................
objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
}
objs[2] = Tcl_NewWideIntObj(count); /* iterations */
/* calculate speed as rate (count) per sec */
if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) {
val = (count * 1000000) / middle;
if (val < 100000) {
if (val < 100) { fmt = "%.3f"; } else
if (val < 1000) { fmt = "%.2f"; } else
{ fmt = "%.1f"; };
objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
} else {
|
| > > | | | > > > > > > | | | > > | | | | > | | > > > > | |
3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 .... 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 .... 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 .... 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 .... 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 .... 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 .... 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 .... 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 |
static
double measureOverhead = 0; /* global measure-overhead */
double overhead = -1; /* given measure-overhead */
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
Tcl_WideUInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = WIDE_MIN;
/* Maximal running time (in milliseconds) */
Tcl_WideUInt maxcnt = WIDE_MAX;
/* Maximal count of iterations. */
Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster
* repeat count without time check) */
Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold
* additionally avoid divide to zero (never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
* growth of execution time. */
register Tcl_WideInt start, middle, stop;
................................................................................
break;
case TMRT_CALIBRATE:
calibrate = objv[i];
break;
}
}
if (i >= objc || i < objc-3) {
usage:
Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??");
return TCL_ERROR;
}
objPtr = objv[i++];
if (i < objc) { /* max-time */
result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms);
if (result != TCL_OK) {
return result;
}
if (i < objc) { /* max-count*/
Tcl_WideInt v;
result = Tcl_GetWideIntFromObj(interp, objv[i], &v);
if (result != TCL_OK) {
return result;
}
maxcnt = (v > 0) ? v : 0;
}
}
/* if calibrate */
if (calibrate) {
/* if no time specified for the calibration */
if (maxms == WIDE_MIN) {
Tcl_Obj *clobjv[6];
Tcl_WideInt maxCalTime = 5000;
double lastMeasureOverhead = measureOverhead;
clobjv[0] = objv[0];
i = 1;
if (direct) {
................................................................................
}
i--;
clobjv[i++] = calibrate;
clobjv[i++] = objPtr;
/* set last measurement overhead to max */
measureOverhead = (double)UWIDE_MAX;
/* calibration cycle until it'll be preciser */
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
TclNewLongObj(clobjv[i], (int)maxms);
Tcl_IncrRefCount(clobjv[i]);
................................................................................
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
/* if time is negative - make current overhead more precise */
if (maxms > 0) {
/* set last measurement overhead to max */
measureOverhead = (double)UWIDE_MAX;
} else {
maxms = -maxms;
}
}
if (maxms == WIDE_MIN) {
maxms = 1000;
}
if (overhead == -1) {
overhead = measureOverhead;
}
/* be sure that resetting of result will not smudge the further measurement */
................................................................................
start = now.sec; start *= 1000000; start += now.usec;
middle = start;
/* time to stop execution (in microsecs) */
stop = start + maxms * 1000;
#endif
/* start measurement */
if (maxcnt > 0)
while (1) {
/* eval single iteration */
count++;
if (!direct) {
/* precompiled */
result = TclExecuteByteCode(interp, codePtr);
................................................................................
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) continue;
/* check stop time reached, estimate new threshold */
#ifdef TCL_WIDE_CLICKS
middle = TclpGetWideClicks();
#else
Tcl_GetTime(&now);
middle = now.sec; middle *= 1000000; middle += now.usec;
#endif
if (middle >= stop || count >= maxcnt) {
break;
}
/* don't calculate threshold by few iterations, because sometimes first
* iteration(s) can be too fast or slow (cached, delayed clean up, etc) */
if (count < 10) {
threshold = 1; continue;
................................................................................
/* as relation between remaining time and time since last check,
* maximal some % of time (by factor), so avoid growing of the execution time
* if iterations are not consistent, e. g. wax continuously on time) */
threshold = ((stop - middle) / maxIterTm) / factor + 1;
if (threshold > 100000) { /* fix for too large threshold */
threshold = 100000;
}
/* consider max-count */
if (threshold > maxcnt - count) {
threshold = maxcnt - count;
}
}
{
Tcl_Obj *objarr[8], **objs = objarr;
Tcl_WideInt val;
const char *fmt;
................................................................................
objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
}
objs[2] = Tcl_NewWideIntObj(count); /* iterations */
/* calculate speed as rate (count) per sec */
if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
if (count < (WIDE_MAX / 1000000)) {
val = (count * 1000000) / middle;
if (val < 100000) {
if (val < 100) { fmt = "%.3f"; } else
if (val < 1000) { fmt = "%.2f"; } else
{ fmt = "%.1f"; };
objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
} else {
|
Changes to generic/tclPort.h.
35 36 37 38 39 40 41 42 43 |
# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) # endif # endif /* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ # define LLONG_MAX (~LLONG_MIN) #endif #endif /* _TCLPORT */ |
> > > |
35 36 37 38 39 40 41 42 43 44 45 46 |
# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) # endif # endif /* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ # define LLONG_MAX (~LLONG_MIN) #endif #define UWIDE_MAX ((Tcl_WideUInt)-1) #define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) #define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ |
Changes to tests/cmdMZ.test.
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
...
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
while executing
"error foo"
invoked from within
"time {error foo}"}}
test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate} msg] $msg
} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}}
test cmdMZ-6.2 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate a b c} msg] $msg
} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate a b} msg] $msg
} {1 {expected integer but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {
regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
................................................................................
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}
# The tests for Tcl_WhileObjCmd are in while.test
# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return
|
|
|
|
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
|
while executing
"error foo"
invoked from within
"time {error foo}"}}
test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate} msg] $msg
} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}}
test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate a b c d} msg] $msg
} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}}
test cmdMZ-6.2.2 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate a b c} msg] $msg
} {1 {expected integer but got "b"}}
test cmdMZ-6.2.3 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate a b} msg] $msg
} {1 {expected integer but got "b"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {
regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
................................................................................
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 {after 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 {after 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}
# The tests for Tcl_WhileObjCmd are in while.test
# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return
|