* 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.

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;
+}
 /*
  *----------------------------------------------------------------------
  *