summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-03-05 17:34:31 (GMT)
committersebres <sebres@users.sourceforge.net>2019-03-05 17:34:31 (GMT)
commitdf27b4e4e05a39d0241a2d4bc5aa87aee5851750 (patch)
tree619cd0773039ed7e42e7ecb6093f7bb5cc64096b
parent10591b96c8e649549d81f6672d42003de5450043 (diff)
parent78000f7f87aa86ac0fb04fbb8402c4fc2054d0fa (diff)
downloadtcl-df27b4e4e05a39d0241a2d4bc5aa87aee5851750.zip
tcl-df27b4e4e05a39d0241a2d4bc5aa87aee5851750.tar.gz
tcl-df27b4e4e05a39d0241a2d4bc5aa87aee5851750.tar.bz2
merge 8.6 (TIP#527, New measurement facilities in TCL: New command timerate, performance test suite)
-rw-r--r--doc/timerate.n129
-rw-r--r--generic/tclBasic.c28
-rw-r--r--generic/tclClock.c9
-rw-r--r--generic/tclCmdMZ.c387
-rw-r--r--generic/tclInt.h15
-rw-r--r--generic/tclPort.h3
-rw-r--r--library/tclIndex3
-rw-r--r--tests-perf/clock.perf.tcl411
-rw-r--r--tests-perf/test-performance.tcl144
-rw-r--r--tests-perf/timer-event.perf.tcl182
-rw-r--r--tests/cmdMZ.test64
-rw-r--r--tools/tcltk-man2html-utils.tcl1
-rw-r--r--unix/tclUnixTime.c71
-rw-r--r--win/tclWinTime.c428
14 files changed, 1777 insertions, 98 deletions
diff --git a/doc/timerate.n b/doc/timerate.n
new file mode 100644
index 0000000..3c764c8
--- /dev/null
+++ b/doc/timerate.n
@@ -0,0 +1,129 @@
+'\"
+'\" Copyright (c) 2005 Sergey Brester aka sebres.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH timerate n "" Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+timerate \- Time-related execution resp. performance measurement of a script
+.SH SYNOPSIS
+\fBtimerate \fIscript\fR \fI?time ?max-count??\fR
+.sp
+\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time ?max-count??\fR
+.sp
+\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time ?max-count??\fR
+.BE
+.SH DESCRIPTION
+.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.
+.sp
+The parameter \fImax-count\fR could additionally impose a further restriction
+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
+.PP
+.CS
+\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
+.CE
+.PP
+which indicates:
+.IP \(bu
+the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
+.IP \(bu
+the count how many times it was executed ([\fBlindex\fR $result 2])
+.IP \(bu
+the estimated rate per second ([\fBlindex\fR $result 4])
+.IP \(bu
+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.
+.TP
+\fI-calibrate\fR
+.
+To measure very fast scripts as exact as posible the 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.
+.TP
+\fI-overhead double\fR
+.
+The \fI-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.
+.TP
+\fI-direct\fR
+.
+The \fI-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.
+.PP
+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
+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
+Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
+operations on variable \fIi\fR) to count to a ten:
+.PP
+.CS
+# calibrate:
+timerate -calibrate {}
+# measure:
+timerate { 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:
+.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
+.CE
+.PP
+Estimate the speed of calculating the hour of the day using \fBclock format\fR only,
+ignoring overhead of the portion of the script that prepares the time for it to
+calculate:
+.PP
+.CS
+# calibrate:
+timerate -calibrate {}
+# estimate overhead:
+set tm 0
+set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
+# measure using esimated overhead:
+set tm 0
+timerate -overhead $ovh {
+ clock format $tm -format %H
+ incr tm [expr {24*60*60}]; # overhead for this is ignored
+} 5000
+.CE
+.SH "SEE ALSO"
+time(n)
+.SH KEYWORDS
+script, timerate, time
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 25b6f78..47579a4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -319,6 +319,9 @@ static const CmdInfo builtInCmds[] = {
{"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0},
{"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE},
{"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE},
+#ifdef TCL_TIMERATE
+ {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE},
+#endif
{"unload", Tcl_UnloadObjCmd, NULL, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE},
{"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE},
@@ -559,7 +562,7 @@ Tcl_CreateInterp(void)
const BuiltinFuncDef *builtinFuncPtr;
const OpCmdInfo *opcmdInfoPtr;
const CmdInfo *cmdInfoPtr;
- Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
+ Tcl_Namespace *nsPtr;
Tcl_HashEntry *hPtr;
int isNew;
CancelInfo *cancelInfo;
@@ -974,6 +977,17 @@ Tcl_CreateInterp(void)
Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
NRCoroInjectObjCmd, NULL, NULL);
+ /* Create an unsupported command for timerate */
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate",
+ Tcl_TimeRateObjCmd, NULL, NULL);
+
+ /* Export unsupported commands */
+ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
+ if (nsPtr) {
+ Tcl_Export(interp, nsPtr, "*", 1);
+ }
+
+
#ifdef USE_DTRACE
/*
* Register the tcl::dtrace command.
@@ -986,8 +1000,8 @@ Tcl_CreateInterp(void)
* Register the builtin math functions.
*/
- mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
- if (mathfuncNSPtr == NULL) {
+ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
+ if (nsPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
@@ -997,18 +1011,18 @@ Tcl_CreateInterp(void)
strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
Tcl_CreateObjCommand(interp, mathFuncName,
builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
- Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
+ Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
}
/*
* Register the mathematical "operator" commands. [TIP #174]
*/
- mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
- if (mathopNSPtr == NULL) {
+ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
+ if (nsPtr == NULL) {
Tcl_Panic("can't create math operator namespace");
}
- Tcl_Export(interp, mathopNSPtr, "*", 1);
+ Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 233ddd2..aeff164 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1772,8 +1772,7 @@ ClockClicksObjCmd(
#endif
break;
case CLICKS_MICROS:
- Tcl_GetTime(&now);
- clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
+ clicks = TclpGetMicroseconds();
break;
}
@@ -1843,15 +1842,11 @@ ClockMicrosecondsObjCmd(
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
- Tcl_Time now;
-
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
return TCL_OK;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index bd93205..7349515 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -17,6 +17,7 @@
*/
#include "tclInt.h"
+#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
@@ -4030,7 +4031,7 @@ Tcl_TimeObjCmd(
start = TclpGetWideClicks();
#endif
while (i-- > 0) {
- result = Tcl_EvalObjEx(interp, objPtr, 0);
+ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
if (result != TCL_OK) {
return result;
}
@@ -4070,6 +4071,390 @@ Tcl_TimeObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_TimeRateObjCmd --
+ *
+ * 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]`
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TimeRateObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ 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;
+#ifndef TCL_WIDE_CLICKS
+ Tcl_Time now;
+#endif
+
+ 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;
+
+ for (i = 1; i < objc - 1; i++) {
+ int index;
+ if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ break;
+ }
+ if (index == TMRT_LAST) {
+ i++;
+ break;
+ }
+ switch (index) {
+ case TMRT_EV_DIRECT:
+ direct = objv[i];
+ break;
+ case TMRT_OVERHEAD:
+ if (++i >= objc - 1) {
+ goto usage;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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) {
+ clobjv[i++] = direct;
+ }
+ clobjv[i++] = objPtr;
+
+ /* reset last measurement overhead */
+ measureOverhead = (double)0;
+
+ /* 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);
+ Tcl_DecrRefCount(clobjv[i]);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ 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;
+ TclNewIntObj(clobjv[i], (int)maxms);
+ Tcl_IncrRefCount(clobjv[i]);
+ result = Tcl_TimeRateObjCmd(dummy, 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
+ || measureOverhead / lastMeasureOverhead <= 0.9995)
+ && maxCalTime > 0
+ );
+
+ return result;
+ }
+ if (maxms == 0) {
+ /* 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 (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 */
+ Tcl_ResetResult(interp);
+
+ /* compile object */
+ 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
+ start = middle = TclpGetWideClicks();
+ /* time to stop execution (in wide clicks) */
+ stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
+#else
+ Tcl_GetTime(&now);
+ 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 */
+ 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) 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;
+ }
+
+ /* 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++;
+ }
+ } else if (factor > 4) {
+ /* interations seems to be shorter */
+ if (threshold < (maxIterTm / 2)) {
+ if ((factor /= 2) < 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. 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;
+
+ middle -= start; /* execution time in microsecs */
+
+ #ifdef TCL_WIDE_CLICKS
+ /* convert execution time in wide clicks to microsecs */
+ middle *= TclpWideClickInMicrosec();
+ #endif
+
+ /* if not calibrate */
+ if (!calibrate) {
+ /* minimize influence of measurement overhead */
+ if (overhead > 0) {
+ /* estimate the time of overhead (microsecs) */
+ Tcl_WideUInt curOverhead = overhead * count;
+ 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;
+ }
+ objs[0] = Tcl_NewDoubleObj(measureOverhead);
+ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
+ objs += 2;
+ }
+
+ 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);
+ }
+
+ 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 {
+ objs[4] = Tcl_NewWideIntObj(val);
+ }
+ } else {
+ objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
+ }
+
+ /* estimated net execution time (in millisecs) */
+ if (!calibrate) {
+ objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
+ TclNewLiteralStringObj(objs[7], "nett-ms");
+ }
+
+ /*
+ * 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], "#");
+ TclNewLiteralStringObj(objs[5], "#/sec");
+ Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
+ }
+
+done:
+
+ if (codePtr != NULL) {
+ TclReleaseByteCode(codePtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_TryObjCmd, TclNRTryObjCmd --
*
* This procedure is invoked to process the "try" Tcl command. See the
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3525bf5..3a77196 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3259,10 +3259,22 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclFinalizeThreadDataThread(void);
MODULE_SCOPE void TclFinalizeThreadStorage(void);
+
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
+MODULE_SCOPE double TclpWideClickInMicrosec(void);
+#else
+# ifdef _WIN32
+# define TCL_WIDE_CLICKS 1
+MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
+MODULE_SCOPE double TclpWideClickInMicrosec(void);
+# define TclpWideClicksToNanoseconds(clicks) \
+ ((double)(clicks) * TclpWideClickInMicrosec() * 1000)
+# endif
#endif
+MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
+
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
@@ -3538,6 +3550,9 @@ MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
diff --git a/generic/tclPort.h b/generic/tclPort.h
index d3f6233..58e1f5e 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -27,5 +27,8 @@
#define UWIDE_MAX ((Tcl_WideUInt)-1)
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))
+#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 */
diff --git a/library/tclIndex b/library/tclIndex
index 87a2814..5a702ad 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -73,3 +73,6 @@ set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.
set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+if {[namespace exists ::tcl::unsupported]} {
+ set auto_index(timerate) {namespace import ::tcl::unsupported::timerate}
+}
diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl
new file mode 100644
index 0000000..d574c2c
--- /dev/null
+++ b/tests-perf/clock.perf.tcl
@@ -0,0 +1,411 @@
+#!/usr/bin/tclsh
+# ------------------------------------------------------------------------
+#
+# test-performance.tcl --
+#
+# This file provides common performance tests for comparison of tcl-speed
+# degradation by switching between branches.
+# (currently for clock ensemble only)
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2014 Serg G. Brester (aka sebres)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+
+array set in {-time 500}
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+ array set in $argv
+}
+
+## common test performance framework:
+if {![namespace exists ::tclTestPerf]} {
+ source [file join [file dirname [info script]] test-performance.tcl]
+}
+
+namespace eval ::tclTestPerf-TclClock {
+
+namespace path {::tclTestPerf}
+
+## set testing defaults:
+set ::env(TCL_TZ) :CET
+
+# warm-up interpeter compiler env, clock platform-related features:
+
+## warm-up test-related features (load clock.tcl, system zones, locales, etc.):
+clock scan "" -gmt 1
+clock scan ""
+clock scan "" -timezone :CET
+clock scan "" -format "" -locale en
+clock scan "" -format "" -locale de
+
+## ------------------------------------------
+
+proc test-format {{reptime 1000}} {
+ _test_run $reptime {
+ # Format : short, week only (in gmt)
+ {clock format 1482525936 -format "%u" -gmt 1}
+ # Format : short, week only (system zone)
+ {clock format 1482525936 -format "%u"}
+ # Format : short, week only (CEST)
+ {clock format 1482525936 -format "%u" -timezone :CET}
+ # Format : date only (in gmt)
+ {clock format 1482525936 -format "%Y-%m-%d" -gmt 1}
+ # Format : date only (system zone)
+ {clock format 1482525936 -format "%Y-%m-%d"}
+ # Format : date only (CEST)
+ {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET}
+ # Format : time only (in gmt)
+ {clock format 1482525936 -format "%H:%M" -gmt 1}
+ # Format : time only (system zone)
+ {clock format 1482525936 -format "%H:%M"}
+ # Format : time only (CEST)
+ {clock format 1482525936 -format "%H:%M" -timezone :CET}
+ # Format : time only (in gmt)
+ {clock format 1482525936 -format "%H:%M:%S" -gmt 1}
+ # Format : time only (system zone)
+ {clock format 1482525936 -format "%H:%M:%S"}
+ # Format : time only (CEST)
+ {clock format 1482525936 -format "%H:%M:%S" -timezone :CET}
+ # Format : default (in gmt)
+ {clock format 1482525936 -gmt 1 -locale en}
+ # Format : default (system zone)
+ {clock format 1482525936 -locale en}
+ # Format : default (CEST)
+ {clock format 1482525936 -timezone :CET -locale en}
+ # Format : ISO date-time (in gmt, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1}
+ # Format : ISO date-time (system zone, CEST, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"}
+ # Format : ISO date-time (CEST, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET}
+ # Format : ISO date-time (system zone, CEST)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"}
+ # Format : julian day with time (in gmt):
+ {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1}
+ # Format : julian day with time (system zone):
+ {clock format 1246379415 -format "%J %H:%M:%S"}
+
+ # Format : locale date-time (en):
+ {clock format 1246379415 -format "%x %X" -locale en}
+ # Format : locale date-time (de):
+ {clock format 1246379415 -format "%x %X" -locale de}
+
+ # Format : locale lookup table month:
+ {clock format 1246379400 -format "%b" -locale en -gmt 1}
+ # Format : locale lookup 2 tables - month and day:
+ {clock format 1246379400 -format "%b %Od" -locale en -gmt 1}
+ # Format : locale lookup 3 tables - week, month and day:
+ {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1}
+ # Format : locale lookup 4 tables - week, month, day and year:
+ {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1}
+
+ # Format : dynamic clock value (without converter caches):
+ setup {set i 0}
+ {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
+ cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
+ # Format : dynamic clock value (without any converter caches, zone range overflow):
+ setup {set i 0}
+ {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
+ cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
+
+ # Format : dynamic format (cacheable)
+ {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1}
+
+ # Format : all (in gmt, locale en)
+ {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en}
+ # Format : all (in CET, locale de)
+ {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de}
+ }
+}
+
+proc test-scan {{reptime 1000}} {
+ _test_run $reptime {
+ # Scan : date (in gmt)
+ {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1}
+ # Scan : date (system time zone, with base)
+ {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0}
+ # Scan : date (system time zone, without base)
+ {clock scan "25.11.2015" -format "%d.%m.%Y"}
+ # Scan : greedy match
+ {clock scan "111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1}
+ # Scan : greedy match (space separated)
+ {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1}
+
+ # Scan : time (in gmt)
+ {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1}
+ # Scan : time (system time zone, with base)
+ {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000}
+ # Scan : time (gmt, without base)
+ {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1}
+ # Scan : time (system time zone, without base)
+ {clock scan "10:35:55" -format "%H:%M:%S"}
+
+ # Scan : date-time (in gmt)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1}
+ # Scan : date-time (system time zone with base)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0}
+ # Scan : date-time (system time zone without base)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"}
+
+ # Scan : julian day in gmt
+ {clock scan 2451545 -format %J -gmt 1}
+ # Scan : julian day in system TZ
+ {clock scan 2451545 -format %J}
+ # Scan : julian day in other TZ
+ {clock scan 2451545 -format %J -timezone +0200}
+ # Scan : julian day with time:
+ {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"}
+ # Scan : julian day with time (greedy match):
+ {clock scan "2451545 102030" -format "%J%H%M%S"}
+
+ # Scan : century, lookup table month
+ {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1}
+ # Scan : century, lookup table month and day (both entries are first)
+ {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1}
+ # Scan : century, lookup table month and day (list scan: entries with position 12 / 31)
+ {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1}
+
+ # Scan : ISO date-time (CEST)
+ {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"}
+ {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
+ # Scan : ISO date-time (UTC)
+ {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"}
+ {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"}
+
+ # Scan : locale date-time (en):
+ {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en}
+ # Scan : locale date-time (de):
+ {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de}
+
+ # Scan : dynamic format (cacheable)
+ {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1}
+
+ break
+ # # Scan : long format test (allock chain)
+ # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1}
+ # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc):
+ # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
+ # # Scan : again:
+ # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
+ } {puts [clock format $_(r) -locale en]}
+}
+
+proc test-freescan {{reptime 1000}} {
+ _test_run $reptime {
+ # FreeScan : relative date
+ {clock scan "5 years 18 months 385 days" -base 0 -gmt 1}
+ # FreeScan : relative date with relative weekday
+ {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1}
+ # FreeScan : relative date with ordinal month
+ {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1}
+ # FreeScan : relative date with ordinal month and relative weekday
+ {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1}
+ # FreeScan : ordinal month
+ {clock scan "next January" -base 0 -gmt 1}
+ # FreeScan : relative week
+ {clock scan "next Fri" -base 0 -gmt 1}
+ # FreeScan : relative weekday and week offset
+ {clock scan "next January + 2 week" -base 0 -gmt 1}
+ # FreeScan : time only with base
+ {clock scan "19:18:30" -base 148863600 -gmt 1}
+ # FreeScan : time only without base, gmt
+ {clock scan "19:18:30" -gmt 1}
+ # FreeScan : time only without base, system
+ {clock scan "19:18:30"}
+ # FreeScan : date, system time zone
+ {clock scan "05/08/2016 20:18:30"}
+ # FreeScan : date, supplied time zone
+ {clock scan "05/08/2016 20:18:30" -timezone :CET}
+ # FreeScan : date, supplied gmt (equivalent -timezone :GMT)
+ {clock scan "05/08/2016 20:18:30" -gmt 1}
+ # FreeScan : date, supplied time zone gmt
+ {clock scan "05/08/2016 20:18:30" -timezone :GMT}
+ # FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500)
+ {clock scan "20:18:30 -0500" -base 148863600 -gmt 1}
+ # FreeScan : time only, zone in string (exchange zones between system / gmt)
+ {clock scan "19:18:30 GMT" -base 148863600}
+ # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST
+ {clock scan "19:18:30 MST" -base 148863600 -gmt 1
+ clock scan "19:18:30 EST" -base 148863600
+ }
+ } {puts [clock format $_(r) -locale en]}
+}
+
+proc test-add {{reptime 1000}} {
+ set tests {
+ # Add : years
+ {clock add 1246379415 5 years -gmt 1}
+ # Add : months
+ {clock add 1246379415 18 months -gmt 1}
+ # Add : weeks
+ {clock add 1246379415 20 weeks -gmt 1}
+ # Add : days
+ {clock add 1246379415 385 days -gmt 1}
+ # Add : weekdays
+ {clock add 1246379415 3 weekdays -gmt 1}
+
+ # Add : hours
+ {clock add 1246379415 5 hours -gmt 1}
+ # Add : minutes
+ {clock add 1246379415 55 minutes -gmt 1}
+ # Add : seconds
+ {clock add 1246379415 100 seconds -gmt 1}
+
+ # Add : +/- in gmt
+ {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1}
+ # Add : +/- in system timezone
+ {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET}
+
+ # Add : gmt
+ {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1}
+ # Add : system timezone
+ {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET}
+
+ # Add : all in gmt
+ {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1}
+ # Add : all in system timezone
+ {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET}
+
+ }
+ # if does not support add of weekdays:
+ if {[catch {clock add 0 3 weekdays -gmt 1}]} {
+ regsub -all {\mweekdays\M} $tests "days" tests
+ }
+ _test_run $reptime $tests {puts [clock format $_(r) -locale en]}
+}
+
+proc test-convert {{reptime 1000}} {
+ _test_run $reptime {
+ # Convert locale (en -> de):
+ {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Convert locale (de -> en):
+ {clock format [clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de] -format "%a %b %d %Y" -gmt 1 -locale en}
+
+ # Convert TZ: direct
+ {clock format [clock scan "19:18:30" -base 148863600 -timezone EST] -timezone MST}
+ {clock format [clock scan "19:18:30" -base 148863600 -timezone MST] -timezone EST}
+ # Convert TZ: included in scan string & format
+ {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone MST}
+ {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST}
+
+ # Format locale 1x: comparison values
+ {clock format 0 -gmt 1 -locale en}
+ {clock format 0 -gmt 1 -locale de}
+ {clock format 0 -gmt 1 -locale fr}
+ # Format locale 2x: without switching locale (en, en)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
+ # Format locale 2x: with switching locale (en, de)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de}
+ # Format locale 3x: without switching locale (en, en, en)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
+ # Format locale 3x: with switching locale (en, de, fr)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de; clock format 0 -gmt 1 -locale fr}
+
+ # Scan locale 2x: without switching locale (en, en) + (de, de)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en}
+ {clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Scan locale 2x: with switching locale (en, de)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Scan locale 3x: with switching locale (en, de, fr)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "mar. mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale fr}
+
+ # Format TZ 2x: comparison values
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
+ {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 2x: without switching
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
+ {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 2x: with switching
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 3x: with switching (CET, EST, MST)
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 3x: with switching (GMT, EST, MST)
+ {clock format 0 -gmt 1 -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
+
+ # FreeScan TZ 2x (+1 system-default): without switching TZ
+ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 MST" -base 148863600}
+ {clock scan "19:18:30 EST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
+ # FreeScan TZ 2x (+1 system-default): with switching TZ
+ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
+ # FreeScan TZ 2x (+1 gmt, +1 system-default)
+ {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600}
+
+ # Scan TZ: comparison included in scan string vs. given
+ {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
+ {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"}
+ {clock scan "2009-06-30T18:30:00" -timezone CET -format "%Y-%m-%dT%H:%M:%S"}
+ }
+}
+
+proc test-other {{reptime 1000}} {
+ _test_run $reptime {
+ # Bad zone
+ {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}}
+
+ # Scan : julian day (overflow)
+ {catch {clock scan 5373485 -format %J}}
+
+ # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference)
+ {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
+ # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference)
+ {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
+ }
+}
+
+proc test-ensemble-perf {{reptime 1000}} {
+ _test_run $reptime {
+ # Clock clicks (ensemble)
+ {clock clicks}
+ # Clock clicks (direct)
+ {::tcl::clock::clicks}
+ # Clock seconds (ensemble)
+ {clock seconds}
+ # Clock seconds (direct)
+ {::tcl::clock::seconds}
+ # Clock microseconds (ensemble)
+ {clock microseconds}
+ # Clock microseconds (direct)
+ {::tcl::clock::microseconds}
+ # Clock scan (ensemble)
+ {clock scan ""}
+ # Clock scan (direct)
+ {::tcl::clock::scan ""}
+ # Clock format (ensemble)
+ {clock format 0 -f %s}
+ # Clock format (direct)
+ {::tcl::clock::format 0 -f %s}
+ }
+}
+
+proc test {{reptime 1000}} {
+ puts ""
+ test-ensemble-perf [expr {$reptime / 2}]; #fast enough
+ test-format $reptime
+ test-scan $reptime
+ test-freescan $reptime
+ test-add $reptime
+ test-convert [expr {$reptime / 2}]; #fast enough
+ test-other $reptime
+
+ puts \n**OK**
+}
+
+}; # end of ::tclTestPerf-TclClock
+
+# ------------------------------------------------------------------------
+
+# if calling direct:
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+ ::tclTestPerf-TclClock::test $in(-time)
+}
diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl
new file mode 100644
index 0000000..4629cd4
--- /dev/null
+++ b/tests-perf/test-performance.tcl
@@ -0,0 +1,144 @@
+# ------------------------------------------------------------------------
+#
+# test-performance.tcl --
+#
+# This file provides common performance tests for comparison of tcl-speed
+# degradation or regression by switching between branches.
+#
+# To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl".
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2014 Serg G. Brester (aka sebres)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+
+namespace eval ::tclTestPerf {
+# warm-up interpeter compiler env, calibrate timerate measurement functionality:
+
+# if no timerate here - import from unsupported:
+if {[namespace which -command timerate] eq {}} {
+ namespace inscope ::tcl::unsupported {namespace export timerate}
+ namespace import ::tcl::unsupported::timerate
+}
+
+# if not yet calibrated:
+if {[lindex [timerate {} 10] 6] >= (10-1)} {
+ puts -nonewline "Calibration ... "; flush stdout
+ puts "done: [lrange \
+ [timerate -calibrate {}] \
+ 0 1]"
+}
+
+proc {**STOP**} {args} {
+ return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]"
+}
+
+proc _test_get_commands {lst} {
+ regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup|$))} $lst "\n{\\1}"
+}
+
+proc _test_out_total {} {
+ upvar _ _
+
+ set tcnt [llength $_(itm)]
+ if {!$tcnt} {
+ puts ""
+ return
+ }
+
+ set mintm 0x7fffffff
+ set maxtm 0
+ set nett 0
+ set wtm 0
+ set wcnt 0
+ set i 0
+ foreach tm $_(itm) {
+ if {[llength $tm] > 6} {
+ set nett [expr {$nett + [lindex $tm 6]}]
+ }
+ set wtm [expr {$wtm + [lindex $tm 0]}]
+ set wcnt [expr {$wcnt + [lindex $tm 2]}]
+ set tm [lindex $tm 0]
+ if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
+ if {$tm < $mintm} {set mintm $tm; set mini $i}
+ incr i
+ }
+
+ puts [string repeat ** 40]
+ set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]]
+ if {$nett > 0} {
+ append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]]
+ }
+ puts "Total $s:"
+ lset _(m) 0 [format %.6f $wtm]
+ lset _(m) 2 $wcnt
+ lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]]
+ if {[llength $_(m)] > 6} {
+ lset _(m) 6 [format %.3f $nett]
+ }
+ puts $_(m)
+ puts "Average:"
+ lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
+ lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
+ if {[llength $_(m)] > 6} {
+ lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]
+ lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]]
+ }
+ puts $_(m)
+ puts "Min:"
+ puts [lindex $_(itm) $mini]
+ puts "Max:"
+ puts [lindex $_(itm) $maxi]
+ puts [string repeat ** 40]
+ puts ""
+}
+
+proc _test_run {args} {
+ upvar _ _
+ # parse args:
+ set _(out-result) 1
+ if {[lindex $args 0] eq "-no-result"} {
+ set _(out-result) 0
+ set args [lrange $args 1 end]
+ }
+ 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 args [lassign $args reptime lst]
+ if {[llength $args]} {
+ 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
+ }
+ array set _ [list itm {} reptime $reptime starttime [clock milliseconds]]
+
+ # process measurement:
+ foreach _(c) [_test_get_commands $lst] {
+ puts "% [regsub -all {\n[ \t]*} $_(c) {; }]"
+ if {[regexp {^\s*\#} $_(c)]} continue
+ if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
+ puts [if 1 [lindex $_(c) 1]]
+ continue
+ }
+ # if output result (and not once):
+ if {$_(out-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}]
+ }
+ }
+ puts [set _(m) [timerate $_(c) {*}$_(reptime)]]
+ lappend _(itm) $_(m)
+ puts ""
+ }
+ _test_out_total
+}
+
+}; # end of namespace ::tclTestPerf
diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl
new file mode 100644
index 0000000..805f0f8
--- /dev/null
+++ b/tests-perf/timer-event.perf.tcl
@@ -0,0 +1,182 @@
+#!/usr/bin/tclsh
+
+# ------------------------------------------------------------------------
+#
+# timer-event.perf.tcl --
+#
+# This file provides performance tests for comparison of tcl-speed
+# of timer events (event-driven tcl-handling).
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2014 Serg G. Brester (aka sebres)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+
+
+if {![namespace exists ::tclTestPerf]} {
+ source [file join [file dirname [info script]] test-performance.tcl]
+}
+
+
+namespace eval ::tclTestPerf-Timer-Event {
+
+namespace path {::tclTestPerf}
+
+proc test-queue {{reptime {1000 10000}}} {
+
+ set howmuch [lindex $reptime 1]
+
+ # because of extremely short measurement times by tests below, wait a little bit (warming-up),
+ # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison)
+ timerate {after 0} 156
+
+ puts "*** up to $howmuch events ***"
+ # single iteration by update, so using -no-result (measure only):
+ _test_run -no-result $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch \\# \#] {
+ # generate up to $howmuch idle-events:
+ {after idle {set foo bar}}
+ # update / after idle:
+ {update; if {![llength [after info]]} break}
+
+ # generate up to $howmuch idle-events:
+ {after idle {set foo bar}}
+ # update idletasks / after idle:
+ {update idletasks; if {![llength [after info]]} break}
+
+ # generate up to $howmuch immediate events:
+ {after 0 {set foo bar}}
+ # update / after 0:
+ {update; if {![llength [after info]]} break}
+
+ # generate up to $howmuch 1-ms events:
+ {after 1 {set foo bar}}
+ setup {after 1}
+ # update / after 1:
+ {update; if {![llength [after info]]} break}
+
+ # generate up to $howmuch immediate events (+ 1 event of the second generation):
+ {after 0 {after 0 {}}}
+ # update / after 0 (double generation):
+ {update; if {![llength [after info]]} break}
+
+ # cancel forwards "after idle" / $howmuch idle-events in queue:
+ setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime}
+ setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
+ {after cancel $ev([incr i]); if {$i >= $le} break}
+ cleanup {update; unset -nocomplain ev}
+ # cancel backwards "after idle" / $howmuch idle-events in queue:
+ setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime}
+ setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
+ {after cancel $ev([incr i -1]); if {$i <= 1} break}
+ cleanup {update; unset -nocomplain ev}
+
+ # cancel forwards "after 0" / $howmuch timer-events in queue:
+ setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
+ setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
+ {after cancel $ev([incr i]); if {$i >= $howmuch} break}
+ cleanup {update; unset -nocomplain ev}
+ # cancel backwards "after 0" / $howmuch timer-events in queue:
+ setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
+ setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
+ {after cancel $ev([incr i -1]); if {$i <= 1} break}
+ cleanup {update; unset -nocomplain ev}
+
+ # end $howmuch events.
+ cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}}
+ }]
+}
+
+proc test-access {{reptime {1000 5000}}} {
+ set howmuch [lindex $reptime 1]
+
+ _test_run $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch] {
+ # event random access: after idle + after info (by $howmuch events)
+ setup {set i -1; timerate {set ev([incr i]) [after idle {}]} {*}$reptime}
+ {after info $ev([expr {int(rand()*$i)}])}
+ cleanup {update; unset -nocomplain ev}
+ # event random access: after 0 + after info (by $howmuch events)
+ setup {set i -1; timerate {set ev([incr i]) [after 0 {}]} {*}$reptime}
+ {after info $ev([expr {int(rand()*$i)}])}
+ cleanup {update; unset -nocomplain ev}
+
+ # end $howmuch events.
+ cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}}
+ }]
+}
+
+proc test-exec {{reptime 1000}} {
+ _test_run $reptime {
+ # after idle + after cancel
+ {after cancel [after idle {set foo bar}]}
+ # after 0 + after cancel
+ {after cancel [after 0 {set foo bar}]}
+ # after idle + update idletasks
+ {after idle {set foo bar}; update idletasks}
+ # after idle + update
+ {after idle {set foo bar}; update}
+ # immediate: after 0 + update
+ {after 0 {set foo bar}; update}
+ # delayed: after 1 + update
+ {after 1 {set foo bar}; update}
+ # empty update:
+ {update}
+ # empty update idle tasks:
+ {update idletasks}
+
+ # simple shortest sleep:
+ {after 0}
+ }
+}
+
+proc test-nrt-capability {{reptime 1000}} {
+ _test_run $reptime {
+ # comparison values:
+ {after 0 {set a 5}; update}
+ {after 0 {set a 5}; vwait a}
+
+ # conditional vwait with very brief wait-time:
+ {after 1 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}}
+ {after 0 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}}
+ }
+}
+
+proc test-long {{reptime 1000}} {
+ _test_run $reptime {
+ # in-between important event by amount of idle events:
+ {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;}
+ cleanup {foreach i [after info] {after cancel $i}}
+ # in-between important event (of new generation) by amount of idle events:
+ {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;}
+ cleanup {foreach i [after info] {after cancel $i}}
+ }
+}
+
+proc test {{reptime 1000}} {
+ test-exec $reptime
+ foreach howmuch {5000 50000} {
+ test-access [list $reptime $howmuch]
+ }
+ test-nrt-capability $reptime
+ test-long $reptime
+
+ puts ""
+ foreach howmuch { 10000 20000 40000 60000 } {
+ test-queue [list $reptime $howmuch]
+ }
+
+ puts \n**OK**
+}
+
+}; # end of ::tclTestPerf-Timer-Event
+
+# ------------------------------------------------------------------------
+
+# if calling direct:
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+ array set in {-time 500}
+ array set in $argv
+ ::tclTestPerf-Timer-Event::test $in(-time)
+}
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index a5f3009..45231c8 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -342,6 +342,70 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
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} {
+ set m1 [timerate {after 0} 20]
+ set m2 [timerate {after 1} 20]
+ list \
+ [expr {[lindex $m1 0] < [lindex $m2 0]}] \
+ [expr {[lindex $m1 0] < 100}] \
+ [expr {[lindex $m2 0] >= 500}] \
+ [expr {[lindex $m1 2] > 1000}] \
+ [expr {[lindex $m2 2] <= 50}] \
+ [expr {[lindex $m1 4] > 10000}] \
+ [expr {[lindex $m2 4] < 10000}] \
+ [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \
+ [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}]
+} [lrepeat 9 1]
+test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
+ list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
+} {1 foo {foo
+ while executing
+"error foo"
+ invoked from within
+"timerate {error foo} 1"}}
+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
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index b69e601..5a4550b 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -149,6 +149,7 @@ proc process-text {text} {
{\(em} "&#8212;" \
{\(en} "&#8211;" \
{\(fm} "&#8242;" \
+ {\(mc} "&#181;" \
{\(mu} "&#215;" \
{\(mi} "&#8722;" \
{\(->} "<font size=\"+1\">&#8594;</font>" \
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 6a73ac2..d95d39b 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -87,6 +87,32 @@ TclpGetSeconds(void)
/*
*----------------------------------------------------------------------
*
+ * TclpGetMicroseconds --
+ *
+ * This procedure returns the number of microseconds from the epoch.
+ * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ * Number of microseconds from the epoch.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetMicroseconds(void)
+{
+ Tcl_Time time;
+
+ tclGetTimeProcPtr(&time, tclTimeClientData);
+ return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpGetClicks --
*
* This procedure returns a value that represents the highest resolution
@@ -219,6 +245,51 @@ TclpWideClicksToNanoseconds(
return nsec;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpWideClickInMicrosec --
+ *
+ * This procedure return scale to convert click values from the
+ * TclpGetWideClicks native resolution to microsecond resolution
+ * and back.
+ *
+ * Results:
+ * 1 click in microseconds as double.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclpWideClickInMicrosec(void)
+{
+ if (tclGetTimeProcPtr != NativeGetTime) {
+ return 1.0;
+ } else {
+#ifdef MAC_OSX_TCL
+ static int initialized = 0;
+ static double scale = 0.0;
+
+ if (initialized) {
+ return scale;
+ } else {
+ mach_timebase_info_data_t tb;
+
+ mach_timebase_info(&tb);
+ /* value of tb.numer / tb.denom = 1 click in nanoseconds */
+ scale = ((double)tb.numer) / tb.denom / 1000;
+ initialized = 1;
+ return scale;
+ }
+#else
+#error Wide high-resolution clicks not implemented on this platform
+#endif
+ }
+}
#endif /* TCL_WIDE_CLICKS */
/*
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index dd603d1..19c53c8 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -53,6 +53,7 @@ typedef struct {
* initialized. */
int perfCounterAvailable; /* Flag == 1 if the hardware has a performance
* counter. */
+ DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */
HANDLE calibrationThread; /* Handle to the thread that keeps the virtual
* clock calibrated. */
HANDLE readyEvent; /* System event used to trigger the requesting
@@ -63,7 +64,6 @@ typedef struct {
LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance
* counter, that is, the value returned from
* QueryPerformanceFrequency. */
-
/*
* The following values are used for calculating virtual time. Virtual
* time is always equal to:
@@ -76,6 +76,8 @@ typedef struct {
ULARGE_INTEGER fileTimeLastCall;
LARGE_INTEGER perfCounterLastCall;
LARGE_INTEGER curCounterFreq;
+ LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since
+ * the windows epoch. */
/*
* Data used in developing the estimate of performance counter frequency
@@ -92,6 +94,7 @@ static TimeInfo timeInfo = {
{ NULL, 0, 0, NULL, NULL, 0 },
0,
0,
+ 1,
(HANDLE) NULL,
(HANDLE) NULL,
(HANDLE) NULL,
@@ -100,11 +103,13 @@ static TimeInfo timeInfo = {
(ULARGE_INTEGER) (DWORDLONG) 0,
(LARGE_INTEGER) (Tcl_WideInt) 0,
(LARGE_INTEGER) (Tcl_WideInt) 0,
+ (LARGE_INTEGER) (Tcl_WideInt) 0,
#else
- 0,
- 0,
- 0,
- 0,
+ {0, 0},
+ {0, 0},
+ {0, 0},
+ {0, 0},
+ {0, 0},
#endif
{ 0 },
{ 0 },
@@ -112,6 +117,17 @@ static TimeInfo timeInfo = {
};
/*
+ * Scale to convert wide click values from the TclpGetWideClicks native
+ * resolution to microsecond resolution and back.
+ */
+static struct {
+ int initialized; /* 1 if initialized, 0 otherwise */
+ int perfCounter; /* 1 if performance counter usable for wide clicks */
+ double microsecsScale; /* Denominator scale between clock / microsecs */
+} wideClick = {0, 0.0};
+
+
+/*
* Declarations for functions defined later in this file.
*/
@@ -127,6 +143,7 @@ static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
Tcl_WideUInt fileTime);
static void NativeScaleTime(Tcl_Time* timebuf,
ClientData clientData);
+static Tcl_WideInt NativeGetMicroseconds(void);
static void NativeGetTime(Tcl_Time* timebuf,
ClientData clientData);
@@ -158,10 +175,19 @@ ClientData tclTimeClientData = NULL;
unsigned long
TclpGetSeconds(void)
{
- Tcl_Time t;
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return usecSincePosixEpoch / 1000000;
+ } else {
+ Tcl_Time t;
- tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
- return t.sec;
+ tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
+ return t.sec;
+ }
}
/*
@@ -186,19 +212,147 @@ TclpGetSeconds(void)
unsigned long
TclpGetClicks(void)
{
- /*
- * Use the Tcl_GetTime abstraction to get the time in microseconds, as
- * nearly as we can, and return it.
- */
+ Tcl_WideInt usecSincePosixEpoch;
- Tcl_Time now; /* Current Tcl time */
- unsigned long retval; /* Value to return */
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return (unsigned long)usecSincePosixEpoch;
+ } else {
+ /*
+ * Use the Tcl_GetTime abstraction to get the time in microseconds, as
+ * nearly as we can, and return it.
+ */
- tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ Tcl_Time now; /* Current Tcl time */
- retval = (now.sec * 1000000) + now.usec;
- return retval;
+ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ return (unsigned long)(now.sec * 1000000) + now.usec;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetWideClicks --
+ *
+ * This procedure returns a WideInt value that represents the highest
+ * resolution clock in microseconds available on the system.
+ *
+ * Results:
+ * Number of microseconds (from some start time).
+ *
+ * Side effects:
+ * This should be used for time-delta resp. for measurement purposes
+ * only, because on some platforms can return microseconds from some
+ * start time (not from the epoch).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetWideClicks(void)
+{
+ LARGE_INTEGER curCounter;
+
+ if (!wideClick.initialized) {
+ LARGE_INTEGER perfCounterFreq;
+
+ /*
+ * The frequency of the performance counter is fixed at system boot and
+ * is consistent across all processors. Therefore, the frequency need
+ * only be queried upon application initialization.
+ */
+ if (QueryPerformanceFrequency(&perfCounterFreq)) {
+ wideClick.perfCounter = 1;
+ wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
+ } else {
+ /* fallback using microseconds */
+ wideClick.perfCounter = 0;
+ wideClick.microsecsScale = 1;
+ }
+
+ wideClick.initialized = 1;
+ }
+ if (wideClick.perfCounter) {
+ if (QueryPerformanceCounter(&curCounter)) {
+ return (Tcl_WideInt)curCounter.QuadPart;
+ }
+ /* fallback using microseconds */
+ wideClick.perfCounter = 0;
+ wideClick.microsecsScale = 1;
+ return TclpGetMicroseconds();
+ } else {
+ return TclpGetMicroseconds();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpWideClickInMicrosec --
+ *
+ * This procedure return scale to convert wide click values from the
+ * TclpGetWideClicks native resolution to microsecond resolution
+ * and back.
+ *
+ * Results:
+ * 1 click in microseconds as double.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+double
+TclpWideClickInMicrosec(void)
+{
+ if (!wideClick.initialized) {
+ (void)TclpGetWideClicks(); /* initialize */
+ }
+ return wideClick.microsecsScale;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetMicroseconds --
+ *
+ * This procedure returns a WideInt value that represents the highest
+ * resolution clock in microseconds available on the system.
+ *
+ * Results:
+ * Number of microseconds (from the epoch).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetMicroseconds(void)
+{
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return usecSincePosixEpoch;
+ } else {
+ /*
+ * Use the Tcl_GetTime abstraction to get the time in microseconds, as
+ * nearly as we can, and return it.
+ */
+
+ Tcl_Time now;
+
+ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
+ }
}
/*
@@ -227,7 +381,17 @@ void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
- tclGetTimeProcPtr(timePtr, tclTimeClientData);
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ } else {
+ tclGetTimeProcPtr(timePtr, tclTimeClientData);
+ }
}
/*
@@ -260,13 +424,14 @@ NativeScaleTime(
/*
*----------------------------------------------------------------------
*
- * NativeGetTime --
+ * NativeGetMicroseconds --
*
- * TIP #233: Gets the current system time in seconds and microseconds
- * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ * Gets the current system time in microseconds since the beginning
+ * of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
- * Returns the current time in timePtr.
+ * Returns the wide integer with number of microseconds from the epoch, or
+ * 0 if high resolution timer is not available.
*
* Side effects:
* On the first call, initializes a set of static variables to keep track
@@ -279,13 +444,20 @@ NativeScaleTime(
*----------------------------------------------------------------------
*/
-static void
-NativeGetTime(
- Tcl_Time *timePtr,
- ClientData clientData)
-{
- struct _timeb t;
+static inline Tcl_WideInt
+NativeCalc100NsTicks(
+ ULONGLONG fileTimeLastCall,
+ LONGLONG perfCounterLastCall,
+ LONGLONG curCounterFreq,
+ LONGLONG curCounter
+) {
+ return fileTimeLastCall +
+ ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
+}
+static Tcl_WideInt
+NativeGetMicroseconds(void)
+{
/*
* Initialize static storage on the first trip through.
*
@@ -296,6 +468,10 @@ NativeGetTime(
if (!timeInfo.initialized) {
TclpInitLock();
if (!timeInfo.initialized) {
+
+ timeInfo.posixEpoch.LowPart = 0xD53E8000;
+ timeInfo.posixEpoch.HighPart = 0x019DB1DE;
+
timeInfo.perfCounterAvailable =
QueryPerformanceFrequency(&timeInfo.nominalFreq);
@@ -400,22 +576,12 @@ NativeGetTime(
* time.
*/
- ULARGE_INTEGER fileTimeLastCall;
- LARGE_INTEGER perfCounterLastCall, curCounterFreq;
+ ULONGLONG fileTimeLastCall;
+ LONGLONG perfCounterLastCall, curCounterFreq;
/* Copy with current data of calibration cycle */
LARGE_INTEGER curCounter;
/* Current performance counter. */
- Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
- * ticks since the Windows epoch. */
- static LARGE_INTEGER posixEpoch;
- /* Posix epoch expressed as 100-ns ticks since
- * the windows epoch. */
- Tcl_WideInt usecSincePosixEpoch;
- /* Current microseconds since Posix epoch. */
-
- posixEpoch.LowPart = 0xD53E8000;
- posixEpoch.HighPart = 0x019DB1DE;
QueryPerformanceCounter(&curCounter);
@@ -424,21 +590,18 @@ NativeGetTime(
*/
EnterCriticalSection(&timeInfo.cs);
- fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart;
- perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart;
- curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart;
+ fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart;
+ perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart;
+ curCounterFreq = timeInfo.curCounterFreq.QuadPart;
LeaveCriticalSection(&timeInfo.cs);
/*
* If calibration cycle occurred after we get curCounter
*/
- if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) {
- usecSincePosixEpoch =
- (fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
+ if (curCounter.QuadPart <= perfCounterLastCall) {
+ /* Calibrated file-time is saved from posix in 100-ns ticks */
+ return fileTimeLastCall / 10;
}
/*
@@ -451,27 +614,62 @@ NativeGetTime(
* loop should recover.
*/
- if (curCounter.QuadPart - perfCounterLastCall.QuadPart <
- 11 * curCounterFreq.QuadPart / 10
+ if (curCounter.QuadPart - perfCounterLastCall <
+ 11 * curCounterFreq * timeInfo.calibrationInterv / 10
) {
- curFileTime = fileTimeLastCall.QuadPart +
- ((curCounter.QuadPart - perfCounterLastCall.QuadPart)
- * 10000000 / curCounterFreq.QuadPart);
-
- usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
+ /* Calibrated file-time is saved from posix in 100-ns ticks */
+ return NativeCalc100NsTicks(fileTimeLastCall,
+ perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10;
}
}
/*
- * High resolution timer is not available. Just use ftime.
+ * High resolution timer is not available.
*/
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeGetTime --
+ *
+ * TIP #233: Gets the current system time in seconds and microseconds
+ * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ * Returns the current time in timePtr.
+ *
+ * Side effects:
+ * See NativeGetMicroseconds for more information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NativeGetTime(
+ Tcl_Time *timePtr,
+ ClientData clientData)
+{
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /*
+ * Try to use high resolution timer.
+ */
+ if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ } else {
+ /*
+ * High resolution timer is not available. Just use ftime.
+ */
+
+ struct _timeb t;
- _ftime(&t);
- timePtr->sec = (long)t.time;
- timePtr->usec = t.millitm * 1000;
+ _ftime(&t);
+ timePtr->sec = (long)t.time;
+ timePtr->usec = t.millitm * 1000;
+ }
}
/*
@@ -492,6 +690,8 @@ NativeGetTime(
*----------------------------------------------------------------------
*/
+void TclWinResetTimerResolution(void);
+
static void
StopCalibration(
ClientData unused) /* Client data is unused */
@@ -782,6 +982,8 @@ CalibrationThread(
QueryPerformanceFrequency(&timeInfo.curCounterFreq);
timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;
+ /* Calibrated file-time will be saved from posix in 100-ns ticks */
+ timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart;
ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart,
timeInfo.perfCounterLastCall.QuadPart,
@@ -841,6 +1043,7 @@ UpdateTimeEachSecond(void)
/* Current value returned from
* QueryPerformanceCounter. */
FILETIME curSysTime; /* Current system time. */
+ static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */
LARGE_INTEGER curFileTime; /* File time at the time this callback was
* scheduled. */
Tcl_WideInt estFreq; /* Estimated perf counter frequency. */
@@ -852,15 +1055,24 @@ UpdateTimeEachSecond(void)
* step over 1 second. */
/*
- * Sample performance counter and system time.
+ * Sample performance counter and system time (from posix epoch).
*/
- QueryPerformanceCounter(&curPerfCounter);
GetSystemTimeAsFileTime(&curSysTime);
curFileTime.LowPart = curSysTime.dwLowDateTime;
curFileTime.HighPart = curSysTime.dwHighDateTime;
-
- EnterCriticalSection(&timeInfo.cs);
+ curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart;
+ /* If calibration still not needed (check for possible time switch) */
+ if ( curFileTime.QuadPart > lastFileTime.QuadPart
+ && curFileTime.QuadPart < lastFileTime.QuadPart +
+ (timeInfo.calibrationInterv * 10000000)
+ ) {
+ /* again in next one second */
+ return;
+ }
+ QueryPerformanceCounter(&curPerfCounter);
+
+ lastFileTime.QuadPart = curFileTime.QuadPart;
/*
* We devide by timeInfo.curCounterFreq.QuadPart in several places. That
@@ -872,7 +1084,6 @@ UpdateTimeEachSecond(void)
*/
if (timeInfo.curCounterFreq.QuadPart == 0){
- LeaveCriticalSection(&timeInfo.cs);
timeInfo.perfCounterAvailable = 0;
return;
}
@@ -911,12 +1122,9 @@ UpdateTimeEachSecond(void)
* is estFreq * 20000000 / (vt1 - vt0)
*/
- vt0 = 10000000 * (curPerfCounter.QuadPart
- - timeInfo.perfCounterLastCall.QuadPart)
- / timeInfo.curCounterFreq.QuadPart
- + timeInfo.fileTimeLastCall.QuadPart;
- vt1 = 20000000 + curFileTime.QuadPart;
-
+ vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
+ timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart,
+ curPerfCounter.QuadPart);
/*
* If we've gotten more than a second away from system time, then drifting
* the clock is going to be pretty hopeless. Just let it jump. Otherwise,
@@ -925,21 +1133,75 @@ UpdateTimeEachSecond(void)
tdiff = vt0 - curFileTime.QuadPart;
if (tdiff > 10000000 || tdiff < -10000000) {
- timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart;
- timeInfo.curCounterFreq.QuadPart = estFreq;
+ /* jump to current system time, use curent estimated frequency */
+ vt0 = curFileTime.QuadPart;
} else {
- driftFreq = estFreq * 20000000 / (vt1 - vt0);
+ /* calculate new frequency and estimate drift to the next second */
+ vt1 = 20000000 + curFileTime.QuadPart;
+ driftFreq = (estFreq * 20000000 / (vt1 - vt0));
+ /*
+ * Avoid too large drifts (only half of the current difference),
+ * that allows also be more accurate (aspire to the smallest tdiff),
+ * so then we can prolong calibration interval by tdiff < 100000
+ */
+ driftFreq = timeInfo.curCounterFreq.QuadPart +
+ (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2;
- if (driftFreq > 1003*estFreq/1000) {
- driftFreq = 1003*estFreq/1000;
- } else if (driftFreq < 997*estFreq/1000) {
- driftFreq = 997*estFreq/1000;
+ /*
+ * Average between estimated, 2 current and 5 drifted frequencies,
+ * (do the soft drifting as possible)
+ */
+ estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8;
+ }
+
+ /* Avoid too large discrepancy from nominal frequency */
+ if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) {
+ estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000;
+ vt0 = curFileTime.QuadPart;
+ } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) {
+ estFreq = 997*timeInfo.nominalFreq.QuadPart/1000;
+ vt0 = curFileTime.QuadPart;
+ } else if (vt0 != curFileTime.QuadPart) {
+ /*
+ * Be sure the clock ticks never backwards (avoid it by negative drifting)
+ * just compare native time (in 100-ns) before and hereafter using
+ * new calibrated values) and do a small adjustment (short time freeze)
+ */
+ LARGE_INTEGER newPerfCounter;
+ Tcl_WideInt nt0, nt1;
+
+ QueryPerformanceCounter(&newPerfCounter);
+ nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
+ timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart,
+ newPerfCounter.QuadPart);
+ nt1 = NativeCalc100NsTicks(vt0,
+ curPerfCounter.QuadPart, estFreq,
+ newPerfCounter.QuadPart);
+ if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */
+ /* first adjust with a micro jump (short frozen time is acceptable) */
+ vt0 += nt0 - nt1;
+ /* if drift unavoidable (e. g. we had a time switch), then reset it */
+ vt1 = vt0 - curFileTime.QuadPart;
+ if (vt1 > 10000000 || vt1 < -10000000) {
+ /* larger jump resp. shift relative new file-time */
+ vt0 = curFileTime.QuadPart;
+ }
}
+ }
+
+ /* In lock commit new values to timeInfo (hold lock as short as possible) */
+ EnterCriticalSection(&timeInfo.cs);
- timeInfo.fileTimeLastCall.QuadPart = vt0;
- timeInfo.curCounterFreq.QuadPart = driftFreq;
+ /* grow calibration interval up to 10 seconds (if still precise enough) */
+ if (tdiff < -100000 || tdiff > 100000) {
+ /* too long drift - reset calibration interval to 1000 second */
+ timeInfo.calibrationInterv = 1;
+ } else if (timeInfo.calibrationInterv < 10) {
+ timeInfo.calibrationInterv++;
}
+ timeInfo.fileTimeLastCall.QuadPart = vt0;
+ timeInfo.curCounterFreq.QuadPart = estFreq;
timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart;
LeaveCriticalSection(&timeInfo.cs);