[MLton-commit] r6839
Wesley Terpstra
wesley at mlton.org
Sun Sep 7 09:34:28 PDT 2008
Improved the resolution of the clock used by MLton/MinGW. gettimeofday now properly reports microsecond accurate timestamps (as opposed to 10-20ms). Furthermore, added the windows multimedia library (winmm) call needed to reduce the latency of sleeps/itimers down to 1-2ms, the best one can hope for under win32.
The mutex regression now passes. The threads didn't have enough work to do to ensure that they were still busy (on a fast computer) for the 10ms required to preempt them.
----------------------------------------------------------------------
U mlton/trunk/bin/mlton-script
U mlton/trunk/bin/regression
U mlton/trunk/package/mingw/mlton.bat
U mlton/trunk/regression/mutex.sml
U mlton/trunk/runtime/platform/mingw.c
----------------------------------------------------------------------
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2008-09-06 21:50:54 UTC (rev 6838)
+++ mlton/trunk/bin/mlton-script 2008-09-07 16:34:17 UTC (rev 6839)
@@ -109,7 +109,7 @@
-target-link-opt darwin "$darwinLinkOpts" \
-target-link-opt freebsd '-L/usr/local/lib/' \
-target-link-opt mingw \
- '-lws2_32 -lkernel32 -lpsapi -lnetapi32' \
+ '-lws2_32 -lkernel32 -lpsapi -lnetapi32 -lwinmm' \
-target-link-opt netbsd \
'-Wl,-R/usr/pkg/lib -L/usr/pkg/lib/' \
-target-link-opt openbsd '-L/usr/local/lib/' \
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2008-09-06 21:50:54 UTC (rev 6838)
+++ mlton/trunk/bin/regression 2008-09-07 16:34:17 UTC (rev 6839)
@@ -160,7 +160,7 @@
case `host-os` in
mingw)
case "$f" in
- cmdline|command-line|filesys|mutex|posix-exit|signals2|unixpath)
+ cmdline|command-line|filesys|posix-exit|signals2|unixpath)
continue
;;
esac
Modified: mlton/trunk/package/mingw/mlton.bat
===================================================================
--- mlton/trunk/package/mingw/mlton.bat 2008-09-06 21:50:54 UTC (rev 6838)
+++ mlton/trunk/package/mingw/mlton.bat 2008-09-07 16:34:17 UTC (rev 6839)
@@ -37,7 +37,7 @@
set ccopts=-O1 -fno-strict-aliasing -fomit-frame-pointer -w
set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2
set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2
-set linkopts=-lm -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32
+set linkopts=-lm -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32 -lwinmm
"%mlton%" @MLton load-world "%world%" ram-slop 0.5 -- "%lib%" -cc "%cc%" -ar-script "%bin%\static-library.bat" -cc-opt-quote "-I%lib%\include" -cc-opt "%ccopts%" -mlb-path-map "%lib%\mlb-path-map" -link-opt "%linkopts%" %*
Modified: mlton/trunk/regression/mutex.sml
===================================================================
--- mlton/trunk/regression/mutex.sml 2008-09-06 21:50:54 UTC (rev 6838)
+++ mlton/trunk/regression/mutex.sml 2008-09-07 16:34:17 UTC (rev 6839)
@@ -155,7 +155,7 @@
; if !gotIt
then raise Fail "bug"
else (gotIt := true
- ; for (0, 1000, fn _ => ())
+ ; for (0, 100000, fn _ => ())
; gotIt := false
; Mutex.unlock m
; loop (i - 1)))
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2008-09-06 21:50:54 UTC (rev 6838)
+++ mlton/trunk/runtime/platform/mingw.c 2008-09-07 16:34:17 UTC (rev 6839)
@@ -73,28 +73,69 @@
#define EPOCHFILETIME (116444736000000000LL)
#endif
-/* Based on notes by Wu Yongwei:
+/* Based on notes by Wu Yongwei and IBM:
* http://mywebpage.netscape.com/yongweiwutime.htm
+ * http://www.ibm.com/developerworks/library/i-seconds/
+ *
+ * The basic plan is to get an initial time using GetSystemTime
+ * that is good up to ~10ms accuracy. From then on, we compute
+ * using deltas with the high-resolution (> microsecond range)
+ * performance timers. A 64-bit accumulator holds microseconds
+ * since (*nix) epoch. This is good for over 500,000 years before
+ * wrap-around becomes a concern. However, we do need to watch
+ * out for wrap-around with the QueryPerformanceCounter, because
+ * it could be measuring at a higher frequency than microseconds.
*/
int gettimeofday (struct timeval *tv,
__attribute__ ((unused)) struct timezone *tz) {
- FILETIME ft;
- LARGE_INTEGER li;
- __int64 t;
- static bool tzInit = FALSE;
+ static LARGE_INTEGER frequency;
+ static LARGE_INTEGER baseCounter;
+ static LARGE_INTEGER microSeconds; /* static vars start = 0 */
- unless (tzInit) {
- tzInit = TRUE;
+ LARGE_INTEGER deltaCounter;
+ LARGE_INTEGER nowMicroSeconds;
+
+ if (microSeconds.QuadPart == 0) {
+ FILETIME ft;
+
+ /* tzset prepares the localtime function. I don't
+ * really understand why it's here and not there,
+ * but this has been the case since before svn logs.
+ * So I leave it here to preserve the status-quo.
+ */
tzset();
+
+ GetSystemTimeAsFileTime (&ft);
+ QueryPerformanceCounter(&baseCounter);
+ QueryPerformanceFrequency(&frequency);
+ if (frequency.QuadPart == 0)
+ die("no high resolution clock");
+
+ microSeconds.LowPart = ft.dwLowDateTime;
+ microSeconds.HighPart = ft.dwHighDateTime;
+ microSeconds.QuadPart -= EPOCHFILETIME;
+ microSeconds.QuadPart /= 10; /* 100ns -> 1ms */
}
- GetSystemTimeAsFileTime (&ft);
- li.LowPart = ft.dwLowDateTime;
- li.HighPart = ft.dwHighDateTime;
- t = li.QuadPart;
- t -= EPOCHFILETIME;
- t /= 10;
- tv->tv_sec = (long)(t / 1000000);
- tv->tv_usec = (long)(t % 1000000);
+
+ QueryPerformanceCounter(&deltaCounter);
+ deltaCounter.QuadPart -= baseCounter.QuadPart;
+ nowMicroSeconds = microSeconds;
+ nowMicroSeconds.QuadPart +=
+ 1000000 * deltaCounter.QuadPart / frequency.QuadPart;
+
+ tv->tv_sec = (long)(nowMicroSeconds.QuadPart / 1000000);
+ tv->tv_usec = (long)(nowMicroSeconds.QuadPart % 1000000);
+
+ /* Watch out for wrap-around in the PerformanceCounter.
+ * We expect the delta * 1000000 to fit inside a 64 bit integer.
+ * To be safe, we will rebase the clock whenever it exceeds 32 bits.
+ * We don't want to rebase all the time because it introduces drift.
+ */
+ if (nowMicroSeconds.HighPart != 0) {
+ microSeconds = nowMicroSeconds;
+ baseCounter.QuadPart += deltaCounter.QuadPart;
+ }
+
return 0;
}
@@ -178,7 +219,7 @@
/* This call improves the resolution of the scheduler from
* 16ms to about 2ms in my testing. Sadly, it requires winmm.
*/
- //timeBeginPeriod(1);
+ timeBeginPeriod(1);
TimerQueue = CreateTimerQueue();
if (TimerQueue == NULL) { errno = ENOMEM; return -1; }
More information about the MLton-commit
mailing list