From c92dca4e09cb0da0cb6417cecb0562d2cb9c5987 Mon Sep 17 00:00:00 2001
From: Kevin B Kenny <kennykb@acm.org>
Date: Fri, 14 Feb 2003 22:16:27 +0000
Subject: * win/tclWinTime.c: Added code to test and compensate for forward
 leaps of the performance counter. See the MSDN Knowledge Base article Q274323
 for the hardware problem that makes this necessary on certain machines.

* tests/winTime.test: Revised winTime-2.1 - it had a tolerance of
thousands of seconds, rather than milliseconds. (What's six orders of
magnitude among friends?

Both the above changes are triggered by a problem reported at
http://aspn.activestate.com/ASPN/Mail/Message/ActiveTcl/1536811
although the developers find it difficult to believe that it accounts
for the observed behavior and suspect a fault in the RTC chip.
---
 tests/winTime.test | 25 +++++++++++--------------
 win/tclWinTime.c   | 42 +++++++++++++++++++++++++++++-------------
 2 files changed, 40 insertions(+), 27 deletions(-)

diff --git a/tests/winTime.test b/tests/winTime.test
index a8dec89..4827d63 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -10,13 +10,15 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winTime.test,v 1.6 2000/11/21 21:33:42 andreas_kupries Exp $
+# RCS: @(#) $Id: winTime.test,v 1.7 2003/02/14 22:16:27 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+testConstraint testwinclock [llength [info commands testwinclock]]
+
 # The next two tests will crash on Windows if the check for negative
 # clock values is not done properly.
 
@@ -37,27 +39,22 @@ test winTime-1.2 {TclpGetDate} {pcOnly} {
 # with the Windows clock.  3000 iterations really isn't enough,
 # but how many does a tester have patience for?
 
-test winTime-2.1 {Synchronization of Tcl and Windows clocks} {pcOnly} {
-    set failed 0
-    foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
-    set olddiff [expr { abs ( $tcl_sec - $sys_sec
-			   + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
+test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} {
+    set failed {}
     set ok 1
     for { set i 0 } { $i < 3000 } { incr i } {
 	foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
-	set diff [expr { abs ( $tcl_sec - $sys_sec
-			       + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
-	if { ( $diff > $olddiff + 1000 )
-	     || ( $diff > 11000 ) } {
-	    set failed 1
+	set diff [expr { $tcl_sec - $sys_sec
+			 + 1.0e-6 * ( $tcl_usec - $sys_usec ) }]
+        if { abs($diff) > 0.02 } {
+	    set failed "Tcl clock differs from system clock by $diff sec"
 	    break
 	} else {
-	    set olddiff $diff
-	    after 1
+	    after 10
 	}
     }
     set failed
-} {0}
+} {}
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 70ab93d..63da982 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinTime.c,v 1.13 2003/01/27 02:19:57 mdejong Exp $
+ * RCS: @(#) $Id: tclWinTime.c,v 1.14 2003/02/14 22:16:27 kennykb Exp $
  */
 
 #include "tclWinInt.h"
@@ -252,6 +252,10 @@ Tcl_GetTime(timePtr)
 	
     struct timeb t;
 
+    int useFtime = 1;		/* Flag == TRUE if we need to fall back
+				 * on ftime rather than using the perf
+				 * counter */
+
     /* Initialize static storage on the first trip through. */
 
     /*
@@ -360,22 +364,34 @@ Tcl_GetTime(timePtr)
 	EnterCriticalSection( &timeInfo.cs );
 
 	QueryPerformanceCounter( &curCounter );
-	curFileTime = timeInfo.lastFileTime.QuadPart
-	    + ( ( curCounter.QuadPart - timeInfo.lastCounter.QuadPart )
-		* 10000000 / timeInfo.curCounterFreq.QuadPart );
-	timeInfo.lastFileTime.QuadPart = curFileTime;
-	timeInfo.lastCounter.QuadPart = curCounter.QuadPart;
-	usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10;
-	timePtr->sec = (time_t) ( usecSincePosixEpoch / 1000000 );
-	timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 );
-	
-	LeaveCriticalSection( &timeInfo.cs );
+	/* 
+	 * If it appears to be more than 1.1 seconds since the last trip
+	 * through the calibration loop, the performance counter may
+	 * have jumped. Discard it. See MSDN Knowledge Base article
+	 * Q274323 for a description of the hardware problem that makes
+	 * this test necessary.
+	 */
+	if ( curCounter.QuadPart - timeInfo.lastPerfCounter
+	     < 11 * timeInfo.estPerfCounterFreq / 10 ) {
+	    
+	    curFileTime = timeInfo.lastFileTime.QuadPart
+		+ ( ( curCounter.QuadPart - timeInfo.lastCounter.QuadPart )
+		    * 10000000 / timeInfo.curCounterFreq.QuadPart );
+	    timeInfo.lastFileTime.QuadPart = curFileTime;
+	    timeInfo.lastCounter.QuadPart = curCounter.QuadPart;
+	    usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10;
+	    timePtr->sec = (time_t) ( usecSincePosixEpoch / 1000000 );
+	    timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 );
+	    useFtime = 0;
+	}	    
 
+	LeaveCriticalSection( &timeInfo.cs );
+    }
 	
-    } else {
+    if ( useFtime ) {
 	
 	/* High resolution timer is not available.  Just use ftime */
-	
+
 	ftime(&t);
 	timePtr->sec = t.time;
 	timePtr->usec = t.millitm * 1000;
-- 
cgit v0.12