* generic/tclStubInit.c: Regenerated the stubs support code from

	* generic/tclDecls.h:    the modified tcl.decls (TIP #233, see below).

	* doc/GetTime.3:       Implemented TIP #233, i.e. the
	* generic/tcl.decls:   'Virtualization of Tcl's Sense of Time'.
	* generic/tcl.h:       Declared, implemented, and documented the
	* generic/tclInt.h:    specified new API functions. Moved the
	* unix/tclUnixEvent.c: native (OS) access to time information
	* unix/tclUnixNotfy.c: into standard handler functions. Inserted
	* unix/tclUnixTime.c:  hooks calling on the handlers where native
	* win/tclWinNotify.c:  access was done before, and where scaling
	* win/tclWinTime.c:    between domains (real/virtual) is required.

2 files changed, 169 insertions, 10 deletions

diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 3bcfd2b..5c02108 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinNotify.c,v 1.16 2004/04/06 22:25:58 dgp Exp $
+ * RCS: @(#) $Id: tclWinNotify.c,v 1.17 2005/01/21 22:25:35 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -444,7 +444,17 @@ Tcl_WaitForEvent(
      */
 
     if (timePtr) {
-	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+        /* TIP #233 (Virtualized Time). Convert virtual domain delay
+	 * to real-time.
+	 */
+
+        Tcl_Time myTime;
+        myTime.sec  = timePtr->sec;
+	myTime.usec = timePtr->usec;
+
+	(*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+
+	timeout = myTime.sec * 1000 + myTime.usec / 1000;
     } else {
 	timeout = INFINITE;
     }
@@ -544,15 +554,24 @@ Tcl_Sleep(ms)
 
     Tcl_Time now;		/* Current wall clock time */
     Tcl_Time desired;		/* Desired wakeup time */
-    DWORD sleepTime = ms;	/* Time to sleep */
+    Tcl_Time vdelay;            /* Time to sleep, for scaling virtual -> real */
+    DWORD sleepTime;		/* Time to sleep, real-time */
+
+    vdelay.sec  = ms / 1000;
+    vdelay.usec = (ms % 1000) * 1000;
 
     Tcl_GetTime( &now );
-    desired.sec = now.sec + ( ms / 1000 );
-    desired.usec = now.usec + 1000 * ( ms % 1000 );
+    desired.sec  = now.sec  + vdelay.sec;
+    desired.usec = now.usec + vdelay.usec;
     if ( desired.usec > 1000000 ) {
 	++desired.sec;
 	desired.usec -= 1000000;
     }
+
+    /* TIP #233: Scale delay from virtual to real-time */
+
+    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
+    sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
 	
     for ( ; ; ) {
 	Sleep( sleepTime );
@@ -563,8 +582,12 @@ Tcl_Sleep(ms)
 	     && ( now.usec >= desired.usec ) ) {
 	    break;
 	}
-	sleepTime = ( ( 1000 * ( desired.sec - now.sec ) )
-		      + ( ( desired.usec - now.usec ) / 1000 ) );
+
+	vdelay.sec  = desired.sec  - now.sec;
+	vdelay.usec = desired.usec - now.usec;
+
+	(*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
+	sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
     }
 
 }
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 48460bb..47294df 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.28 2004/09/07 17:39:00 kennykb Exp $
+ * RCS: @(#) $Id: tclWinTime.c,v 1.29 2005/01/21 22:25:35 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -138,6 +138,17 @@ static Tcl_WideInt		AccumulateSample _ANSI_ARGS_((
 			    Tcl_WideInt perfCounter,
 			    Tcl_WideUInt fileTime
 			));
+
+static void NativeScaleTime _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
+static void NativeGetTime   _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
+
+/* TIP #233 (Virtualized Time)
+ * Data for the time hooks, if any.
+ */
+
+Tcl_GetTimeProc*   tclGetTimeProcPtr    = NativeGetTime;
+Tcl_ScaleTimeProc* tclScaleTimeProcPtr  = NativeScaleTime;
+ClientData         tclTimeClientData    = NULL;
 
 /*
  *----------------------------------------------------------------------
@@ -160,7 +171,8 @@ unsigned long
 TclpGetSeconds()
 {
     Tcl_Time t;
-    Tcl_GetTime( &t );
+    /* Tcl_GetTime inlined */
+    (*tclGetTimeProcPtr) (&t, tclTimeClientData);
     return t.sec;
 }
 
@@ -195,7 +207,9 @@ TclpGetClicks()
     Tcl_Time now;		/* Current Tcl time */
     unsigned long retval;	/* Value to return */
 
-    Tcl_GetTime( &now );
+    /* Tcl_GetTime inlined */
+    (*tclGetTimeProcPtr) (&now, tclTimeClientData);
+
     retval = ( now.sec * 1000000 ) + now.usec;
     return retval;
 
@@ -258,6 +272,64 @@ void
 Tcl_GetTime(timePtr)
     Tcl_Time *timePtr;		/* Location to store time information. */
 {
+    (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeScaleTime --
+ *
+ *	TIP #233
+ *	Scale from virtual time to the real-time. For native scaling the
+ *	relationship is 1:1 and nothing has to be done.
+ *
+ * Results:
+ *	Scales the time in timePtr.
+ *
+ * Side effects:
+ *	See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NativeScaleTime (timePtr, clientData)
+     Tcl_Time*  timePtr;
+     ClientData clientData;
+{
+  /* Native scale is 1:1. Nothing is done */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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:
+ *	On the first call, initializes a set of static variables to
+ *	keep track of the base value of the performance counter, the
+ *	corresponding wall clock (obtained through ftime) and the
+ *	frequency of the performance counter.  Also spins a thread
+ *	whose function is to wake up periodically and monitor these
+ *	values, adjusting them as necessary to correct for drift
+ *	in the performance counter's oscillator.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NativeGetTime (timePtr, clientData)
+     Tcl_Time*  timePtr;
+     ClientData clientData;
+{
 	
     struct timeb t;
 
@@ -1182,3 +1254,67 @@ TclpLocaltime( timePtr )
      */
     return localtime( timePtr );
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimeProc --
+ *
+ *      TIP #233 (Virtualized Time)
+ *	Registers two handlers for the virtualization of Tcl's
+ *	access to time information.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Remembers the handlers, alters core behaviour.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimeProc (getProc, scaleProc, clientData)
+     Tcl_GetTimeProc*   getProc;
+     Tcl_ScaleTimeProc* scaleProc;
+     ClientData         clientData;
+{
+    tclGetTimeProcPtr   = getProc;
+    tclScaleTimeProcPtr = scaleProc;
+    tclTimeClientData   = clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_QueryTimeProc --
+ *
+ *      TIP #233 (Virtualized Time)
+ *	Query which time handlers are registered.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_QueryTimeProc (getProc, scaleProc, clientData)
+     Tcl_GetTimeProc**   getProc;
+     Tcl_ScaleTimeProc** scaleProc;
+     ClientData*         clientData;
+{
+    if (getProc) {
+        *getProc    = tclGetTimeProcPtr;
+    }
+    if (scaleProc) {
+        *scaleProc  = tclScaleTimeProcPtr;
+    }
+    if (clientData) {
+        *clientData = tclTimeClientData;
+    }
+}
+