merge 8.7 (TIP#527, New measurement facilities in TCL: New command timerate, performance test suite)

1 files changed, 71 insertions, 0 deletions

diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 53545f4..0a0faa2 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -59,6 +59,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
@@ -191,6 +217,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 */
 
 /*