summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
Diffstat (limited to 'unix')
-rw-r--r--unix/tclUnixEvent.c26
-rw-r--r--unix/tclUnixNotfy.c40
-rw-r--r--unix/tclUnixTime.c164
3 files changed, 198 insertions, 32 deletions
diff --git a/unix/tclUnixEvent.c b/unix/tclUnixEvent.c
index 98ab452..036c898 100644
--- a/unix/tclUnixEvent.c
+++ b/unix/tclUnixEvent.c
@@ -8,10 +8,10 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixEvent.c,v 1.5 2004/04/06 22:25:56 dgp Exp $
+ * RCS: @(#) $Id: tclUnixEvent.c,v 1.6 2005/01/21 22:25:35 andreas_kupries Exp $
*/
-#include "tclPort.h"
+#include "tclInt.h"
/*
*----------------------------------------------------------------------
@@ -34,7 +34,7 @@ Tcl_Sleep(ms)
int ms; /* Number of milliseconds to sleep. */
{
struct timeval delay;
- Tcl_Time before, after;
+ Tcl_Time before, after, vdelay;
/*
* The only trick here is that select appears to return early
@@ -52,13 +52,23 @@ Tcl_Sleep(ms)
after.sec += 1;
}
while (1) {
- delay.tv_sec = after.sec - before.sec;
- delay.tv_usec = after.usec - before.usec;
- if (delay.tv_usec < 0) {
- delay.tv_usec += 1000000;
- delay.tv_sec -= 1;
+ /* TIP #233: Scale from virtual time to real-time for select */
+
+ vdelay.sec = after.sec - before.sec;
+ vdelay.usec = after.usec - before.usec;
+
+ if (vdelay.usec < 0) {
+ vdelay.usec += 1000000;
+ vdelay.sec -= 1;
}
+ if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
+ (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
+ }
+
+ delay.tv_sec = vdelay.sec;
+ delay.tv_usec = vdelay.usec;
+
/*
* Special note: must convert delay.tv_sec to int before comparing
* to zero, since delay.tv_usec is unsigned on some platforms.
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index b6ea35a..c02b89d 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixNotfy.c,v 1.19 2004/12/07 00:01:48 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixNotfy.c,v 1.20 2005/01/21 22:25:35 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -652,11 +652,17 @@ Tcl_WaitForEvent(timePtr)
{
FileHandler *filePtr;
FileHandlerEvent *fileEvPtr;
- struct timeval timeout, *timeoutPtr;
int mask;
+ Tcl_Time myTime;
#ifdef TCL_THREADS
int waitForFiles;
+ Tcl_Time *myTimePtr;
#else
+ /* Impl. notes: timeout & timeoutPtr are used if, and only if
+ * threads are not enabled. They are the arguments for the regular
+ * select() used when the core is not thread-enabled. */
+
+ struct timeval timeout, *timeoutPtr;
int numFound;
#endif
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -672,9 +678,23 @@ Tcl_WaitForEvent(timePtr)
*/
if (timePtr) {
- timeout.tv_sec = timePtr->sec;
- timeout.tv_usec = timePtr->usec;
- timeoutPtr = &timeout;
+ /* TIP #233 (Virtualized Time). Is virtual time in effect ?
+ * And do we actually have something to scale ? If yes to both
+ * then we call the handler to do this scaling */
+
+ myTime.sec = timePtr->sec;
+ myTime.usec = timePtr->usec;
+
+ (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+
+#ifdef TCL_THREADS
+ myTimePtr = &myTime;
+#else
+ timeout.tv_sec = myTime.sec;
+ timeout.tv_usec = myTime.usec;
+ timeoutPtr = &timeout;
+#endif
+
#ifndef TCL_THREADS
} else if (tsdPtr->numFdBits == 0) {
/*
@@ -688,7 +708,11 @@ Tcl_WaitForEvent(timePtr)
return -1;
#endif
} else {
+#ifdef TCL_THREADS
+ myTimePtr = NULL;
+#else
timeoutPtr = NULL;
+#endif
}
#ifdef TCL_THREADS
@@ -700,7 +724,7 @@ Tcl_WaitForEvent(timePtr)
Tcl_MutexLock(&notifierMutex);
waitForFiles = (tsdPtr->numFdBits > 0);
- if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) {
+ if (myTimePtr != NULL && myTimePtr->sec == 0 && myTimePtr->usec == 0) {
/*
* Cannot emulate a polling select with a polling condition variable.
* Instead, pretend to wait for files and tell the notifier
@@ -711,7 +735,7 @@ Tcl_WaitForEvent(timePtr)
waitForFiles = 1;
tsdPtr->pollState = POLL_WANT;
- timePtr = NULL;
+ myTimePtr = NULL;
} else {
tsdPtr->pollState = 0;
}
@@ -740,7 +764,7 @@ Tcl_WaitForEvent(timePtr)
FD_ZERO( &(tsdPtr->readyMasks.exceptional) );
if (!tsdPtr->eventReady) {
- Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+ Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, myTimePtr);
}
tsdPtr->eventReady = 0;
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 32cea2d..9c043ee 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.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: tclUnixTime.c,v 1.22 2004/09/27 14:31:20 kennykb Exp $
+ * RCS: @(#) $Id: tclUnixTime.c,v 1.23 2005/01/21 22:25:35 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -45,6 +45,17 @@ static char* lastTZ = NULL; /* Holds the last setting of the
static void SetTZIfNecessary _ANSI_ARGS_((void));
static void CleanupMemory _ANSI_ARGS_((ClientData));
+
+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;
/*
*-----------------------------------------------------------------------------
@@ -92,18 +103,22 @@ unsigned long
TclpGetClicks()
{
unsigned long now;
-#ifdef NO_GETTOD
- struct tms dummy;
-#else
- struct timeval date;
- struct timezone tz;
-#endif
#ifdef NO_GETTOD
- now = (unsigned long) times(&dummy);
+ if (tclGetTimeProcPtr != NativeGetTime) {
+ Tcl_Time time;
+ (*tclGetTimeProcPtr) (&time, tclTimeClientData);
+ now = time.sec*1000000 + time.usec;
+ } else {
+ /* A semi-NativeGetTime, specialized to clicks */
+ struct tms dummy;
+ now = (unsigned long) times(&dummy);
+ }
#else
- gettimeofday(&date, &tz);
- now = date.tv_sec*1000000 + date.tv_usec;
+ Tcl_Time time;
+
+ (*tclGetTimeProcPtr) (&time, tclTimeClientData);
+ now = time.sec*1000000 + time.usec;
#endif
return now;
@@ -235,6 +250,9 @@ TclpGetTimeZone (currentTime)
* Gets the current system time in seconds and microseconds
* since the beginning of the epoch: 00:00 UCT, January 1, 1970.
*
+ * This function is hooked, allowing users to specify their
+ * own virtual system time.
+ *
* Results:
* Returns the current time in timePtr.
*
@@ -248,12 +266,7 @@ void
Tcl_GetTime(timePtr)
Tcl_Time *timePtr; /* Location to store time information. */
{
- struct timeval tv;
- struct timezone tz;
-
- (void) gettimeofday(&tv, &tz);
- timePtr->sec = tv.tv_sec;
- timePtr->usec = tv.tv_usec;
+ (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
}
/*
@@ -384,7 +397,126 @@ TclpLocaltime_unix( timePtr )
{
return TclpLocaltime( 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NativeGetTime (timePtr, clientData)
+ Tcl_Time* timePtr;
+ ClientData clientData;
+{
+ struct timeval tv;
+ struct timezone tz;
+
+ (void) gettimeofday(&tv, &tz);
+ timePtr->sec = tv.tv_sec;
+ timePtr->usec = tv.tv_usec;
+}
/*
*----------------------------------------------------------------------
*
generated by cgit v0.12 at 2024-08-20 16:27:17 (GMT)