summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tclWinNotify.c37
-rw-r--r--win/tclWinTime.c142
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;
+ }
+}
+