summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2019-04-23 06:50:02 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2019-04-23 06:50:02 (GMT)
commit2306d1244200b6e5dad26a1c8d4f4c9db32e2cfc (patch)
treebe70648d3ff6e3a74b8e645242ce5223f48cfe9f
parent0f9539f83840432a6d510b8c8afe52e24a11e6b4 (diff)
parenteaf90743ee516f8a7f4b05720416fb49f20dfca2 (diff)
downloadtcl-2306d1244200b6e5dad26a1c8d4f4c9db32e2cfc.zip
tcl-2306d1244200b6e5dad26a1c8d4f4c9db32e2cfc.tar.gz
tcl-2306d1244200b6e5dad26a1c8d4f4c9db32e2cfc.tar.bz2
timerate: code style, doc style
-rw-r--r--doc/timerate.n111
-rw-r--r--generic/tclCmdMZ.c438
-rw-r--r--tests-perf/test-performance.tcl78
3 files changed, 417 insertions, 210 deletions
diff --git a/doc/timerate.n b/doc/timerate.n
index 5820d27..636d9de 100644
--- a/doc/timerate.n
+++ b/doc/timerate.n
@@ -9,16 +9,26 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-timerate \- Time-related execution resp. performance measurement of a script
+timerate \- Calibrated performance measurements of script execution time
.SH SYNOPSIS
-\fBtimerate \fIscript\fR \fI?time ?max-count??\fR
+\fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
-\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time ?max-count??\fR
+\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
-\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time ?max-count??\fR
+\fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.BE
.SH DESCRIPTION
.PP
+The \fBtimerate\fR command does calibrated performance measurement of a Tcl
+command or script, \fIscript\fR. The \fIscript\fR should be written so that it
+can be executed multiple times during the performance measurement process.
+Time is measured in elapsed time using the finest timer resolution as possible,
+not CPU time; if \fIscript\fR interacts with the OS, the cost of that
+interaction is included.
+This command may be used to provide information as to how well a script or
+Tcl command is performing, and can help determine bottlenecks and fine-tune
+application performance.
+.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
@@ -28,47 +38,48 @@ by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
-It will then return a canonical tcl-list of the form
+It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
-.IP \(bu
+.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
-.IP \(bu
+.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])
-.IP \(bu
+.IP \(bu 3
the estimated rate per second ([\fBlindex\fR $result 4])
-.IP \(bu
+.IP \(bu 3
the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6])
.PP
-Time is measured in elapsed time using the finest timer resolution as possible,
-not CPU time.
-This command may be used to provide information as to how well the script or a
-tcl-command is performing and can help determine bottlenecks and fine-tune
-application performance.
+The following options may be supplied to the \fBtimerate\fR command:
.TP
-\fI-calibrate\fR
+\fB\-calibrate\fR
.
-To measure very fast scripts as exact as posible the calibration process
+To measure very fast scripts as exactly as possible, a calibration process
may be required.
-
-The \fI-calibrate\fR option is used to calibrate timerate, calculating the
-estimated overhead of the given script as the default overhead for future
-invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not
-specified, the calibrate procedure runs for up to 10 seconds.
+The \fB\-calibrate\fR option is used to calibrate \fBtimerate\fR itself,
+calculating the estimated overhead of the given script as the default overhead
+for future invocations of the \fBtimerate\fR command. If the \fItime\fR
+parameter is not specified, the calibrate procedure runs for up to 10 seconds.
+.RS
+.PP
+Note that calibration is not thread safe in the current implementation.
+.RE
.TP
-\fI-overhead double\fR
+\fB\-overhead \fIdouble\fR
.
-The \fI-overhead\fR parameter supplies an estimate (in microseconds) of the
+The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
-will be subtracted from the measured time prior to reporting results.
+will be subtracted from the measured time prior to reporting results. This can
+be useful for removing the cost of interpreter state reset commands from the
+script being measured.
.TP
-\fI-direct\fR
+\fB\-direct\fR
.
-The \fI-direct\fR option causes direct execution of the supplied script,
+The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
@@ -76,31 +87,33 @@ lists, and of the uncompiled versions of bytecoded commands.
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the timerate command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
-measurement, as if the script were part of a compiled procedure, if the \fI-direct\fR
+measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
-
-.SH EXAMPLE
+.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
-operations on variable \fIi\fR) to count to a ten:
+operations on variable \fIi\fR) to count to ten:
.PP
.CS
-# calibrate:
-timerate -calibrate {}
-# measure:
-timerate { for {set i 0} {$i<10} {incr i} {} } 5000
+\fI# calibrate\fR
+\fBtimerate\fR -calibrate {}
+
+\fI# measure\fR
+\fBtimerate\fR { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the
-overhead for to perform ten iterations, ignoring the overhead of the management
-of the variable that controls the loop:
+overhead of the management of the variable that controls the loop:
.PP
.CS
-# calibrate for overhead of variable operations:
-set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000
-# measure:
-timerate { for {set i 0} {$i<10} {incr i} {} } 5000
+\fI# calibrate for overhead of variable operations\fR
+set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000
+
+\fI# measure\fR
+\fBtimerate\fR {
+ for {set i 0} {$i<10} {incr i} {}
+} 5000
.CE
.PP
Estimate the speed of calculating the hour of the day using \fBclock format\fR only,
@@ -108,14 +121,18 @@ ignoring overhead of the portion of the script that prepares the time for it to
calculate:
.PP
.CS
-# calibrate:
-timerate -calibrate {}
-# estimate overhead:
+\fI# calibrate\fR
+\fBtimerate\fR -calibrate {}
+
+\fI# estimate overhead\fR
set tm 0
-set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
-# measure using esimated overhead:
+set ovh [lindex [\fBtimerate\fR {
+ incr tm [expr {24*60*60}]
+}] 0]
+
+\fI# measure using estimated overhead\fR
set tm 0
-timerate -overhead $ovh {
+\fBtimerate\fR -overhead $ovh {
clock format $tm -format %H
incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
@@ -123,7 +140,7 @@ timerate -overhead $ovh {
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
-script, timerate, time
+performance measurement, script, time
.\" Local Variables:
.\" mode: nroff
.\" End:
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cb96cda..6792378 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4135,11 +4135,12 @@ Tcl_TimeObjCmd(
*
* This object-based procedure is invoked to process the "timerate" Tcl
* command.
+ *
* This is similar to command "time", except the execution limited by
* given time (in milliseconds) instead of repetition count.
*
* Example:
- * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]`
+ * timerate {after 5} 1000; # equivalent to: time {after 5} [expr 1000/5]
*
* Results:
* A standard Tcl object result.
@@ -4157,39 +4158,40 @@ Tcl_TimeRateObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static double measureOverhead = 0; /* global measure-overhead */
+ 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;
+ 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) */
+ Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max
+ * threshold, additionally avoiding divide to
+ * zero (i.e., never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
* growth of execution time. */
register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
Tcl_Time now;
-#endif
-
+#endif /* !TCL_WIDE_CLICKS */
static const char *const options[] = {
"-direct", "-overhead", "-calibrate", "--", NULL
};
enum options {
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
-
NRE_callback *rootPtr;
- ByteCode *codePtr = NULL;
+ ByteCode *codePtr = NULL;
for (i = 1; i < objc - 1; i++) {
- int index;
+ int index;
+
if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
break;
@@ -4216,9 +4218,11 @@ Tcl_TimeRateObjCmd(
}
}
- if (i >= objc || i < objc-3) {
-usage:
- Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??");
+ 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++];
@@ -4229,6 +4233,7 @@ usage:
}
if (i < objc) { /* max-count*/
Tcl_WideInt v;
+
result = Tcl_GetWideIntFromObj(interp, objv[i], &v);
if (result != TCL_OK) {
return result;
@@ -4237,10 +4242,15 @@ usage:
}
}
- /* if calibrate */
+ /*
+ * If we are doing calibration.
+ */
+
if (calibrate) {
+ /*
+ * If no time specified for the calibration.
+ */
- /* if no time specified for the calibration */
if (maxms == WIDE_MIN) {
Tcl_Obj *clobjv[6];
Tcl_WideInt maxCalTime = 5000;
@@ -4249,18 +4259,24 @@ usage:
clobjv[0] = objv[0];
i = 1;
if (direct) {
- clobjv[i++] = direct;
+ clobjv[i++] = direct;
}
clobjv[i++] = objPtr;
- /* reset last measurement overhead */
- measureOverhead = (double)0;
+ /*
+ * Reset last measurement overhead.
+ */
+
+ measureOverhead = (double) 0;
+
+ /*
+ * Self-call with 100 milliseconds to warm-up, before entering the
+ * calibration cycle.
+ */
- /* self-call with 100 milliseconds to warm-up,
- * before entering the calibration cycle */
TclNewIntObj(clobjv[i], 100);
Tcl_IncrRefCount(clobjv[i]);
- result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
+ result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
@@ -4270,59 +4286,86 @@ usage:
clobjv[i++] = calibrate;
clobjv[i++] = objPtr;
- /* set last measurement overhead to max */
- measureOverhead = (double)UWIDE_MAX;
+ /*
+ * Set last measurement overhead to max.
+ */
+
+ measureOverhead = (double) UWIDE_MAX;
+
+ /*
+ * Run the calibration cycle until it is more precise.
+ */
- /* calibration cycle until it'll be preciser */
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
- TclNewIntObj(clobjv[i], (int)maxms);
+ TclNewIntObj(clobjv[i], (int) maxms);
Tcl_IncrRefCount(clobjv[i]);
- result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
+ result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
}
maxCalTime += maxms;
- /* increase maxms for preciser calibration */
- maxms -= (-maxms / 4);
- /* as long as new value more as 0.05% better */
- } while ( (measureOverhead >= lastMeasureOverhead
+
+ /*
+ * Increase maxms for more precise calibration.
+ */
+
+ maxms -= -maxms / 4;
+
+ /*
+ * As long as new value more as 0.05% better
+ */
+ } while ((measureOverhead >= lastMeasureOverhead
|| measureOverhead / lastMeasureOverhead <= 0.9995)
- && maxCalTime > 0
- );
+ && maxCalTime > 0);
return result;
}
if (maxms == 0) {
- /* reset last measurement overhead */
+ /*
+ * Reset last measurement overhead
+ */
+
measureOverhead = 0;
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
- /* if time is negative - make current overhead more precise */
+ /*
+ * If time is negative, make current overhead more precise.
+ */
+
if (maxms > 0) {
- /* set last measurement overhead to max */
- measureOverhead = (double)UWIDE_MAX;
+ /*
+ * Set last measurement overhead to max.
+ */
+
+ measureOverhead = (double) UWIDE_MAX;
} else {
maxms = -maxms;
}
-
}
if (maxms == WIDE_MIN) {
- maxms = 1000;
+ maxms = 1000;
}
if (overhead == -1) {
overhead = measureOverhead;
}
- /* be sure that resetting of result will not smudge the further measurement */
+ /*
+ * Ensure that resetting of result will not smudge the further
+ * measurement.
+ */
+
Tcl_ResetResult(interp);
- /* compile object */
+ /*
+ * Compile object if needed.
+ */
+
if (!direct) {
if (TclInterpReady(interp) != TCL_OK) {
return TCL_ERROR;
@@ -4331,158 +4374,258 @@ usage:
TclPreserveByteCode(codePtr);
}
- /* get start and stop time */
+ /*
+ * Get start and stop time.
+ */
+
#ifdef TCL_WIDE_CLICKS
start = middle = TclpGetWideClicks();
- /* time to stop execution (in wide clicks) */
+
+ /*
+ * Time to stop execution (in wide clicks).
+ */
+
stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
#else
Tcl_GetTime(&now);
- start = now.sec; start *= 1000000; start += now.usec;
+ start = now.sec;
+ start *= 1000000;
+ start += now.usec;
middle = start;
- /* time to stop execution (in microsecs) */
+
+ /*
+ * Time to stop execution (in microsecs).
+ */
+
stop = start + maxms * 1000;
-#endif
+#endif /* TCL_WIDE_CLICKS */
- /* start measurement */
- if (maxcnt > 0)
- while (1) {
- /* eval single iteration */
- count++;
-
- 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;
+ /*
+ * Start measurement.
+ */
+
+ if (maxcnt > 0) {
+ while (1) {
+ /*
+ * Evaluate a single iteration.
+ */
+
+ count++;
+ 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);
}
- /* 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;
- }
+ if (result != TCL_OK) {
+ /*
+ * Allow break from measurement cycle (used for conditional
+ * stop).
+ */
- /* 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;
- }
+ if (result != TCL_BREAK) {
+ goto done;
+ }
- /* average iteration time in microsecs */
- threshold = (middle - start) / count;
- if (threshold > maxIterTm) {
- maxIterTm = threshold;
- /* interations seems to be longer */
- if (threshold > (maxIterTm * 2)) {
- if ((factor *= 2) > 50) factor = 50;
- } else {
- if (factor < 50) factor++;
+ /*
+ * Force stop immediately.
+ */
+
+ threshold = 1;
+ maxcnt = 0;
+ result = TCL_OK;
}
- } else if (factor > 4) {
- /* interations seems to be shorter */
- if (threshold < (maxIterTm / 2)) {
- if ((factor /= 2) < 4) factor = 4;
- } else {
- factor--;
+
+ /*
+ * 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 /* TCL_WIDE_CLICKS */
+
+ 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;
+ }
+
+ /*
+ * Average iteration time in microsecs.
+ */
+
+ threshold = (middle - start) / count;
+ if (threshold > maxIterTm) {
+ maxIterTm = threshold;
+
+ /*
+ * Iterations seem to be longer.
+ */
+
+ if (threshold > maxIterTm * 2) {
+ factor *= 2;
+ if (factor > 50) {
+ factor = 50;
+ }
+ } else {
+ if (factor < 50) {
+ factor++;
+ }
+ }
+ } else if (factor > 4) {
+ /*
+ * Iterations seem to be shorter.
+ */
+
+ if (threshold < (maxIterTm / 2)) {
+ factor /= 2;
+ if (factor < 4) {
+ factor = 4;
+ }
+ } else {
+ factor--;
+ }
+ }
+
+ /*
+ * 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. was
+ * 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;
}
- }
- /* 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;
+ int digits;
- middle -= start; /* execution time in microsecs */
+ middle -= start; /* execution time in microsecs */
+
+#ifdef TCL_WIDE_CLICKS
+ /*
+ * convert execution time in wide clicks to microsecs.
+ */
- #ifdef TCL_WIDE_CLICKS
- /* convert execution time in wide clicks to microsecs */
middle *= TclpWideClickInMicrosec();
- #endif
+#endif /* TCL_WIDE_CLICKS */
- if (!count) { /* no iterations - avoid divide by zero */
+ if (!count) { /* no iterations - avoid divide by zero */
objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
goto retRes;
}
- /* if not calibrate */
+ /*
+ * If not calibrating...
+ */
+
if (!calibrate) {
- /* minimize influence of measurement overhead */
+ /*
+ * Minimize influence of measurement overhead.
+ */
+
if (overhead > 0) {
- /* estimate the time of overhead (microsecs) */
+ /*
+ * Estimate the time of overhead (microsecs).
+ */
+
Tcl_WideUInt curOverhead = overhead * count;
- if (middle > (Tcl_WideInt)curOverhead) {
+
+ if (middle > (Tcl_WideInt) curOverhead) {
middle -= curOverhead;
} else {
middle = 0;
}
}
} else {
- /* calibration - obtaining new measurement overhead */
- if (measureOverhead > (double)middle / count) {
- measureOverhead = (double)middle / count;
+ /*
+ * Calibration: obtaining new measurement overhead.
+ */
+
+ if (measureOverhead > ((double) middle) / count) {
+ measureOverhead = ((double) middle) / count;
}
objs[0] = Tcl_NewDoubleObj(measureOverhead);
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
objs += 2;
}
- val = middle / count; /* microsecs per iteration */
+ val = middle / count; /* microsecs per iteration */
if (val >= 1000000) {
objs[0] = Tcl_NewWideIntObj(val);
} else {
- if (val < 10) { fmt = "%.6f"; } else
- if (val < 100) { fmt = "%.4f"; } else
- if (val < 1000) { fmt = "%.3f"; } else
- if (val < 10000) { fmt = "%.2f"; } else
- { fmt = "%.1f"; };
- objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
+ if (val < 10) {
+ digits = 6;
+ } else if (val < 100) {
+ digits = 4;
+ } else if (val < 1000) {
+ digits = 3;
+ } else if (val < 10000) {
+ digits = 2;
+ } else {
+ digits = 1;
+ }
+ objs[0] = Tcl_ObjPrintf("%.*f", digits, ((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 */
+ /*
+ * Calculate speed as rate (count) per sec
+ */
+
+ if (!middle) {
+ middle++; /* 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);
+ if (val < 100) {
+ digits = 3;
+ } else if (val < 1000) {
+ digits = 2;
+ } else {
+ digits = 1;
+ }
+ objs[4] = Tcl_ObjPrintf("%.*f",
+ digits, ((double) (count * 1000000)) / middle);
} else {
objs[4] = Tcl_NewWideIntObj(val);
}
@@ -4491,7 +4634,10 @@ usage:
}
retRes:
- /* estimated net execution time (in millisecs) */
+ /*
+ * Estimated net execution time (in millisecs).
+ */
+
if (!calibrate) {
if (middle >= 1) {
objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
@@ -4502,9 +4648,9 @@ usage:
}
/*
- * Construct the result as a list because many programs have always parsed
- * as such (extracting the first element, typically).
- */
+ * Construct the result as a list because many programs have always
+ * parsed as such (extracting the first element, typically).
+ */
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
TclNewLiteralStringObj(objs[3], "#");
@@ -4512,12 +4658,10 @@ usage:
Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
}
-done:
-
+ done:
if (codePtr != NULL) {
TclReleaseByteCode(codePtr);
}
-
return result;
}
diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl
index 1ddecb5..418c999 100644
--- a/tests-perf/test-performance.tcl
+++ b/tests-perf/test-performance.tcl
@@ -94,51 +94,97 @@ proc _test_out_total {} {
puts [lindex $_(itm) $maxi]
puts [string repeat ** 40]
puts ""
+ unset -nocomplain _(itm) _(starttime)
+}
+
+proc _test_start {reptime} {
+ upvar _ _
+ array set _ [list itm {} reptime $reptime starttime [clock milliseconds] -from-run 0]
+}
+
+proc _test_iter {args} {
+ if {[llength $args] > 2} {
+ return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?level? measure-result\""
+ }
+ set lvl 1
+ if {[llength $args] > 1} {
+ set args [lassign $args lvl]
+ }
+ upvar $lvl _ _
+ puts [set _(m) {*}$args]
+ lappend _(itm) $_(m)
+ puts ""
+}
+
+proc _adjust_maxcount {reptime maxcount} {
+ if {[llength $reptime] > 1} {
+ lreplace $reptime 1 1 [expr {min($maxcount,[lindex $reptime 1])}]
+ } else {
+ lappend reptime $maxcount
+ }
}
proc _test_run {args} {
upvar _ _
# parse args:
- set _(out-result) 1
- if {[lindex $args 0] eq "-no-result"} {
- set _(out-result) 0
+ array set _ [set _opts {-no-result 0 -uplevel 0}]
+ while {[llength $args] > 2} {
+ if {[set o [lindex $args 0]] ni $_opts || $_($o)} {
+ break
+ }
+ set _($o) 1
set args [lrange $args 1 end]
}
+ unset -nocomplain _opts o
if {[llength $args] < 2 || [llength $args] > 3} {
return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\""
}
- set outcmd {puts $_(r)}
+ set _(outcmd) {puts}
set args [lassign $args reptime lst]
if {[llength $args]} {
- set outcmd [lindex $args 0]
+ set _(outcmd) [lindex $args 0]
}
# avoid output if only once:
if {[lindex $reptime 0] <= 1 || ([llength $reptime] > 1 && [lindex $reptime 1] == 1)} {
- set _(out-result) 0
+ set _(-no-result) 1
+ }
+ if {![info exists _(itm)]} {
+ array set _ [list itm {} reptime $reptime starttime [clock milliseconds] -from-run 1]
+ } else {
+ array set _ [list reptime $reptime]
}
- array set _ [list itm {} reptime $reptime starttime [clock milliseconds]]
# process measurement:
foreach _(c) [_test_get_commands $lst] {
- puts "% [regsub -all {\n[ \t]*} $_(c) {; }]"
+ {*}$_(outcmd) "% [regsub -all {\n[ \t]*} $_(c) {; }]"
if {[regexp {^\s*\#} $_(c)]} continue
if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
- puts [if 1 [lindex $_(c) 1]]
+ set _(c) [lindex $_(c) 1]
+ if {$_(-uplevel)} {
+ set _(c) [list uplevel 1 $_(c)]
+ }
+ {*}$_(outcmd) [if 1 $_(c)]
continue
}
+ if {$_(-uplevel)} {
+ set _(c) [list uplevel 1 $_(c)]
+ }
+ set _(ittime) $_(reptime)
# if output result (and not once):
- if {$_(out-result)} {
+ if {!$_(-no-result)} {
set _(r) [if 1 $_(c)]
- if {$outcmd ne {}} $outcmd
- if {[llength $_(reptime)] > 1} { # decrement max-count
- lset _(reptime) 1 [expr {[lindex $_(reptime) 1] - 1}]
+ if {$_(outcmd) ne {}} {{*}$_(outcmd) $_(r)}
+ if {[llength $_(ittime)] > 1} { # decrement max-count
+ lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}]
}
}
- puts [set _(m) [timerate $_(c) {*}$_(reptime)]]
+ {*}$_(outcmd) [set _(m) [timerate $_(c) {*}$_(ittime)]]
lappend _(itm) $_(m)
- puts ""
+ {*}$_(outcmd) ""
+ }
+ if {$_(-from-run)} {
+ _test_out_total
}
- _test_out_total
}
}; # end of namespace ::tclTestPerf