summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/timerate.n114
-rw-r--r--generic/tclBasic.c1
-rw-r--r--generic/tclClock.c10
-rw-r--r--generic/tclCmdMZ.c343
-rw-r--r--generic/tclCompile.h22
-rw-r--r--generic/tclExecute.c228
-rw-r--r--generic/tclInt.h15
-rw-r--r--unix/tclUnixTime.c71
-rw-r--r--win/tclWinTime.c432
9 files changed, 1049 insertions, 187 deletions
diff --git a/doc/timerate.n b/doc/timerate.n
new file mode 100644
index 0000000..df9a8f7
--- /dev/null
+++ b/doc/timerate.n
@@ -0,0 +1,114 @@
+'\"
+'\" 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?\fR
+.sp
+\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR
+.sp
+\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\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
+It will then return a canonical tcl-list of the form
+.PP
+.CS
+\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
+.CE
+.PP
+which indicates:
+.IP \(bu
+the average amount of time required per iteration, in microseconds (lindex $result 0)
+.IP \(bu
+the count how many times it was executed (lindex $result 2)
+.IP \(bu
+the estimated rate per second (lindex $result 4)
+.IP \(bu
+the estimated real execution time without measurement overhead (lindex $result 6)
+.PP
+Time is measured in elapsed time using heighest 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.
+.PP
+\fI-calibrate\fR
+.
+To measure very fast scripts as exact as posible the calibration process
+may be required.
+
+This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead
+of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR.
+It can take up to 10 seconds if parameter \fItime\fR is not specified.
+.PP
+\fI-overhead double\fR
+.
+This parameter used to supply the measurement overhead of single iteration
+(in microseconds) that should be ignored during whole evaluation process.
+.PP
+\fI-direct\fR
+.
+Causes direct execution per iteration (not compiled variant of evaluation used).
+.PP
+In opposition to \fBtime\fR the execution limited here by fixed time instead of
+repetition count.
+Additionally the compiled variant of the script will be used during whole evaluation
+(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified.
+Therefore it provides more precise results and prevents very long execution time
+by slow scripts resp. scripts with unknown speed.
+
+.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 only (ignoring the
+overhead for operations on variable \fIi\fR) to count to a ten:
+.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 rate of calculating the hour using \fBclock format\fR only, ignoring
+overhead of the rest, without measurement how fast it takes for a whole script:
+.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 7f75892..5c2d7e4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -203,6 +203,7 @@ static const CmdInfo builtInCmds[] = {
{"source", Tcl_SourceObjCmd, NULL, 0},
{"tell", Tcl_TellObjCmd, NULL, 1},
{"time", Tcl_TimeObjCmd, NULL, 1},
+ {"timerate", Tcl_TimeRateObjCmd, NULL, 1},
{"unload", Tcl_UnloadObjCmd, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, 1},
{"vwait", Tcl_VwaitObjCmd, NULL, 1},
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 782c681..b019ef9 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1739,9 +1739,7 @@ ClockClicksObjCmd(
break;
}
case CLICKS_MICROS:
- Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
break;
}
@@ -1810,15 +1808,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 b1ba3ae..2786f0d 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -17,6 +17,7 @@
*/
#include "tclInt.h"
+#include "tclCompile.h"
#include "tclRegexp.h"
static int UniCharIsAscii(int character);
@@ -3952,6 +3953,348 @@ 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_WideInt count = 0; /* Holds repetition count */
+ Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL;
+ /* Maximal running time (in milliseconds) */
+ Tcl_WideInt threshold = 1; /* Current threshold for check time (faster
+ * repeat count without time check) */
+ Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold
+ * additionally avoid divide to zero (never < 1) */
+ 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
+ };
+
+ 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-2) {
+usage:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?");
+ return TCL_ERROR;
+ }
+ objPtr = objv[i++];
+ if (i < objc) {
+ result = Tcl_GetWideIntFromObj(interp, objv[i], &maxms);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /* if calibrate */
+ if (calibrate) {
+
+ /* if no time specified for the calibration */
+ if (maxms == -0x7FFFFFFFFFFFFFFFL) {
+ Tcl_Obj *clobjv[6];
+ Tcl_WideInt maxCalTime = 5000;
+ double lastMeasureOverhead = measureOverhead;
+
+ clobjv[0] = objv[0];
+ i = 1;
+ if (direct) {
+ 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 */
+ TclNewLongObj(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)0x7FFFFFFFFFFFFFFFL;
+
+ /* calibration cycle until it'll be preciser */
+ maxms = -1000;
+ do {
+ lastMeasureOverhead = measureOverhead;
+ TclNewLongObj(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)0x7FFFFFFFFFFFFFFFL;
+ } else {
+ maxms = -maxms;
+ }
+
+ }
+
+ if (maxms == -0x7FFFFFFFFFFFFFFFL) {
+ maxms = 1000;
+ }
+ if (overhead == -1) {
+ overhead = measureOverhead;
+ }
+
+ /* be sure that resetting of result will not smudge the further measurement */
+ 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 */
+ while (1) {
+ /* eval single iteration */
+ count++;
+
+ if (!direct) {
+ /* precompiled */
+ result = TclExecuteByteCode(interp, codePtr);
+ } else {
+ /* eval */
+ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /* don't check time up to threshold */
+ if (--threshold > 0) continue;
+
+ /* check stop time reached, estimate new threshold */
+ #ifdef TCL_WIDE_CLICKS
+ middle = TclpGetWideClicks();
+ #else
+ Tcl_GetTime(&now);
+ middle = now.sec; middle *= 1000000; middle += now.usec;
+ #endif
+ if (middle >= stop) {
+ break;
+ }
+
+ /* don't calculate threshold by few iterations, because sometimes
+ * first iteration(s) can be too fast (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;
+ }
+ /* as relation between remaining time and time since last check */
+ threshold = ((stop - middle) / maxIterTm) / 4;
+ if (threshold > 100000) { /* fix for too large threshold */
+ threshold = 100000;
+ }
+ }
+
+ {
+ 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_WideInt curOverhead = overhead * count;
+ if (middle > curOverhead) {
+ middle -= curOverhead;
+ } else {
+ middle = 1;
+ }
+ }
+ } 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 < (0x7FFFFFFFFFFFFFFFL / 1000000)) {
+ val = (count * 1000000) / middle;
+ if (val < 100000) {
+ if (val < 100) { fmt = "%.3f"; } else
+ if (val < 1000) { fmt = "%.2f"; } else
+ { fmt = "%.1f"; };
+ objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
+ } else {
+ 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_WhileObjCmd --
*
* This procedure is invoked to process the "while" Tcl command. See the
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index bc298ae..ee994d7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -859,6 +859,9 @@ MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp,
*----------------------------------------------------------------
*/
+MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ const CmdFrame *invoker, int word);
+
MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
const CmdFrame *invoker, int word);
@@ -937,6 +940,25 @@ MODULE_SCOPE void TclPrintSource(FILE *outFile,
CONST char *string, int maxChars);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
+
+static inline void
+TclPreserveByteCode(
+ register ByteCode *codePtr)
+{
+ codePtr->refCount++;
+}
+
+static inline void
+TclReleaseByteCode(
+ register ByteCode *codePtr)
+{
+ if (codePtr->refCount-- > 1) {
+ return;
+ }
+ /* Just dropped to refcount==0. Clean up. */
+ TclCleanupByteCode(codePtr);
+}
+
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e85863d..61d0ddc 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1346,48 +1346,29 @@ FreeExprCodeInternalRep(
/*
*----------------------------------------------------------------------
*
- * TclCompEvalObj --
+ * TclCompileObj --
*
- * This procedure evaluates the script contained in a Tcl_Obj by first
- * compiling it and then passing it to TclExecuteByteCode.
+ * This procedure compiles the script contained in a Tcl_Obj.
*
* Results:
- * The return value is one of the return codes defined in tcl.h (such as
- * TCL_OK), and interp->objResultPtr refers to a Tcl object that either
- * contains the result of executing the code or an error message.
+ * A pointer to the corresponding ByteCode, never NULL.
*
* Side effects:
- * Almost certainly, depending on the ByteCode's instructions.
+ * The object is shimmered to bytecode type.
*
*----------------------------------------------------------------------
*/
-int
-TclCompEvalObj(
- Tcl_Interp *interp,
+ByteCode *
+TclCompileObj(
+ Tcl_Interp *interp,
Tcl_Obj *objPtr,
const CmdFrame *invoker,
int word)
{
register Interp *iPtr = (Interp *) interp;
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
- int result;
- Namespace *namespacePtr;
-
- /*
- * Check that the interpreter is ready to execute scripts. Note that we
- * manage the interp's runlevel here: it is a small white lie (maybe), but
- * saves a ++/-- pair at each invocation. Amazingly enough, the impact on
- * performance is noticeable.
- */
-
- iPtr->numLevels++;
- if (TclInterpReady(interp) == TCL_ERROR) {
- result = TCL_ERROR;
- goto done;
- }
-
- namespacePtr = iPtr->varFramePtr->nsPtr;
+ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
/*
* If the object is not already of tclByteCodeType, compile it (and reset
@@ -1418,19 +1399,24 @@ TclCompEvalObj(
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
- /*
- * This byteCode is invalid: free it and recompile.
- */
-
- objPtr->typePtr->freeIntRepProc(objPtr);
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
goto recompileObj;
}
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
+ Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
+ }
+ codePtr->compileEpoch = iPtr->compileEpoch;
+ }
+
+ /*
+ * Check that any compiled locals do refer to the current proc
+ * environment! If not, recompile.
+ */
+
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
+ (codePtr->procPtr == NULL) &&
+ (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
+ goto recompileObj;
}
/*
@@ -1468,77 +1454,68 @@ TclCompEvalObj(
* information.
*/
- if (invoker) {
+ if (invoker == NULL) {
+ return codePtr;
+ } else {
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
- if (hePtr) {
- ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
- int redo = 0;
- CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
-
- *ctxPtr = *invoker;
+ ExtCmdLoc *eclPtr;
+ CmdFrame *ctxCopyPtr;
+ int redo;
- if (invoker->type == TCL_LOCATION_BC) {
- /*
- * Note: Type BC => ctx.data.eval.path is not used.
- * ctx.data.tebc.codePtr used instead
- */
+ if (!hePtr) {
+ return codePtr;
+ }
- TclGetSrcInfoForPc(ctxPtr);
- if (ctxPtr->type == TCL_LOCATION_SOURCE) {
- /*
- * The reference made by 'TclGetSrcInfoForPc' is
- * dead.
- */
+ eclPtr = Tcl_GetHashValue(hePtr);
+ redo = 0;
+ ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ *ctxCopyPtr = *invoker;
- Tcl_DecrRefCount(ctxPtr->data.eval.path);
- ctxPtr->data.eval.path = NULL;
- }
- }
+ if (invoker->type == TCL_LOCATION_BC) {
+ /*
+ * Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr used instead
+ */
- if (word < ctxPtr->nline) {
+ TclGetSrcInfoForPc(ctxCopyPtr);
+ if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
/*
- * Note: We do not care if the line[word] is -1. This
- * is a difference and requires a recompile (location
- * changed from absolute to relative, literal is used
- * fixed and through variable)
- *
- * Example:
- * test info-32.0 using literal of info-24.8
- * (dict with ... vs set body ...).
+ * The reference made by 'TclGetSrcInfoForPc' is dead.
*/
- redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
- && (eclPtr->start != ctxPtr->line[word]))
- || ((eclPtr->type == TCL_LOCATION_BC)
- && (ctxPtr->type == TCL_LOCATION_SOURCE));
+ Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
+ ctxCopyPtr->data.eval.path = NULL;
}
+ }
- TclStackFree(interp, ctxPtr);
+ if (word < ctxCopyPtr->nline) {
+ /*
+ * Note: We do not care if the line[word] is -1. This is a
+ * difference and requires a recompile (location changed from
+ * absolute to relative, literal is used fixed and through
+ * variable)
+ *
+ * Example:
+ * test info-32.0 using literal of info-24.8
+ * (dict with ... vs set body ...).
+ */
- if (redo) {
- goto recompileObj;
- }
+ redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+ && (eclPtr->start != ctxCopyPtr->line[word]))
+ || ((eclPtr->type == TCL_LOCATION_BC)
+ && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
}
- }
-
- /*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
- */
- runCompiledObj:
- codePtr->refCount++;
- result = TclExecuteByteCode(interp, codePtr);
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
+ TclStackFree(interp, ctxCopyPtr);
+ if (!redo) {
+ return codePtr;
+ }
}
- goto done;
}
- recompileObj:
+ recompileObj:
iPtr->errorLine = 1;
/*
@@ -1550,12 +1527,75 @@ TclCompEvalObj(
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
- tclByteCodeType.setFromAnyProc(interp, objPtr);
+ TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
- goto runCompiledObj;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+ return codePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompEvalObj --
+ *
+ * This procedure evaluates the script contained in a Tcl_Obj by first
+ * compiling it and then passing it to TclExecuteByteCode.
+ *
+ * Results:
+ * The return value is one of the return codes defined in tcl.h (such as
+ * TCL_OK), and interp->objResultPtr refers to a Tcl object that either
+ * contains the result of executing the code or an error message.
+ *
+ * Side effects:
+ * Almost certainly, depending on the ByteCode's instructions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompEvalObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ const CmdFrame *invoker,
+ int word)
+{
+ register Interp *iPtr = (Interp *) interp;
+ register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
+ int result;
+
+ /*
+ * Check that the interpreter is ready to execute scripts. Note that we
+ * manage the interp's runlevel here: it is a small white lie (maybe), but
+ * saves a ++/-- pair at each invocation. Amazingly enough, the impact on
+ * performance is noticeable.
+ */
+
+ iPtr->numLevels++;
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /* Compile objPtr to the byte code */
+ codePtr = TclCompileObj(interp, objPtr, invoker, word);
+
+ /*
+ * Increment the code's ref count while it is being executed. If
+ * afterwards no references to it remain, free the code.
+ */
+
+ codePtr->refCount++;
+ result = TclExecuteByteCode(interp, codePtr);
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
- done:
+ done:
iPtr->numLevels--;
return result;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9d60cbc..e37727d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2770,10 +2770,22 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclpFinalizeThreadDataThread(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 Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);
@@ -3016,6 +3028,9 @@ MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData,
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/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 11b0ecf..1b4ea15 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 454709d..0a638e8 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -51,6 +51,7 @@ typedef struct TimeInfo {
* 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
@@ -61,7 +62,6 @@ typedef struct TimeInfo {
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:
@@ -74,6 +74,8 @@ typedef struct TimeInfo {
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
@@ -87,9 +89,10 @@ typedef struct TimeInfo {
} TimeInfo;
static TimeInfo timeInfo = {
- { NULL },
+ { NULL, 0, 0, NULL, NULL, 0 },
0,
0,
+ 1,
(HANDLE) NULL,
(HANDLE) NULL,
(HANDLE) NULL,
@@ -98,11 +101,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 },
@@ -110,6 +115,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.
*/
@@ -123,6 +139,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);
@@ -154,10 +171,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;
+ }
}
/*
@@ -182,19 +208,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;
+ }
}
/*
@@ -252,7 +406,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);
+ }
}
/*
@@ -285,13 +449,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
@@ -304,13 +469,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.
*
@@ -321,6 +493,10 @@ NativeGetTime(
if (!timeInfo.initialized) {
TclpInitLock();
if (!timeInfo.initialized) {
+
+ timeInfo.posixEpoch.LowPart = 0xD53E8000;
+ timeInfo.posixEpoch.HighPart = 0x019DB1DE;
+
timeInfo.perfCounterAvailable =
QueryPerformanceFrequency(&timeInfo.nominalFreq);
@@ -425,22 +601,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);
@@ -449,21 +615,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;
}
/*
@@ -476,27 +639,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;
+ }
}
/*
@@ -517,6 +715,8 @@ NativeGetTime(
*----------------------------------------------------------------------
*/
+void TclWinResetTimerResolution(void);
+
static void
StopCalibration(
ClientData unused) /* Client data is unused */
@@ -892,6 +1092,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,
@@ -951,6 +1153,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. */
@@ -962,15 +1165,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
@@ -982,7 +1194,6 @@ UpdateTimeEachSecond(void)
*/
if (timeInfo.curCounterFreq.QuadPart == 0){
- LeaveCriticalSection(&timeInfo.cs);
timeInfo.perfCounterAvailable = 0;
return;
}
@@ -1001,7 +1212,7 @@ UpdateTimeEachSecond(void)
* estimate the performance counter frequency.
*/
- estFreq = AccumulateSample(curPerfCounter.QuadPart,
+ estFreq = AccumulateSample(curPerfCounter.QuadPart,
(Tcl_WideUInt) curFileTime.QuadPart);
/*
@@ -1021,12 +1232,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,
@@ -1035,21 +1243,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);
generated by cgit v0.12 at 2024-09-21 07:48:47 (GMT)