diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tclWinNotify.c | 37 | ||||
| -rw-r--r-- | win/tclWinTime.c | 142 |
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; + } +} + |