1 files changed, 541 insertions, 0 deletions
diff --git a/tcl8.6/unix/tclUnixTime.c b/tcl8.6/unix/tclUnixTime.c
new file mode 100644
index 0000000..6a3766d
--- /dev/null
+++ b/tcl8.6/unix/tclUnixTime.c
@@ -0,0 +1,541 @@
+/*
+ * tclUnixTime.c --
+ *
+ *	Contains Unix specific versions of Tcl functions that obtain time
+ *	values from the operating system.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include <locale.h>
+#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)
+#include <mach/mach_time.h>
+#endif
+
+/*
+ * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread
+ * safety, this structure must be in thread-specific data. The 'tmKey'
+ * variable is the key to this buffer.
+ */
+
+static Tcl_ThreadDataKey tmKey;
+typedef struct ThreadSpecificData {
+    struct tm gmtime_buf;
+    struct tm localtime_buf;
+} ThreadSpecificData;
+
+/*
+ * If we fall back on the thread-unsafe versions of gmtime and localtime, use
+ * this mutex to try to protect them.
+ */
+
+TCL_DECLARE_MUTEX(tmMutex)
+
+static char *lastTZ = NULL;	/* Holds the last setting of the TZ
+				 * environment variable, or an empty string if
+				 * the variable was not set. */
+
+/*
+ * Static functions declared in this file.
+ */
+
+static void		SetTZIfNecessary(void);
+static void		CleanupMemory(ClientData clientData);
+static void		NativeScaleTime(Tcl_Time *timebuf,
+			    ClientData clientData);
+static void		NativeGetTime(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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetSeconds --
+ *
+ *	This procedure returns the number of seconds from the epoch. On most
+ *	Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ *	Number of seconds from the epoch.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetSeconds(void)
+{
+    return time(NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetClicks --
+ *
+ *	This procedure returns a value that represents the highest resolution
+ *	clock available on the system. There are no garantees on what the
+ *	resolution will be. In Tcl we will call this value a "click". The
+ *	start time is also system dependant.
+ *
+ * Results:
+ *	Number of clicks from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetClicks(void)
+{
+    unsigned long now;
+
+#ifdef NO_GETTOD
+    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
+    Tcl_Time time;
+
+    tclGetTimeProcPtr(&time, tclTimeClientData);
+    now = time.sec*1000000 + time.usec;
+#endif
+
+    return now;
+}
+#ifdef TCL_WIDE_CLICKS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetWideClicks --
+ *
+ *	This procedure returns a WideInt value that represents the highest
+ *	resolution clock available on the system. There are no garantees on
+ *	what the resolution will be. In Tcl we will call this value a "click".
+ *	The start time is also system dependant.
+ *
+ * Results:
+ *	Number of WideInt clicks from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetWideClicks(void)
+{
+    Tcl_WideInt now;
+
+    if (tclGetTimeProcPtr != NativeGetTime) {
+	Tcl_Time time;
+
+	tclGetTimeProcPtr(&time, tclTimeClientData);
+	now = ((Tcl_WideInt)time.sec)*1000000 + time.usec;
+    } else {
+#ifdef MAC_OSX_TCL
+	now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX);
+#else
+#error Wide high-resolution clicks not implemented on this platform
+#endif
+    }
+
+    return now;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpWideClicksToNanoseconds --
+ *
+ *	This procedure converts click values from the TclpGetWideClicks native
+ *	resolution to nanosecond resolution.
+ *
+ * Results:
+ *	Number of nanoseconds from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclpWideClicksToNanoseconds(
+    Tcl_WideInt clicks)
+{
+    double nsec;
+
+    if (tclGetTimeProcPtr != NativeGetTime) {
+	nsec = clicks * 1000;
+    } else {
+#ifdef MAC_OSX_TCL
+	static mach_timebase_info_data_t tb;
+	static uint64_t maxClicksForUInt64;
+
+	if (!tb.denom) {
+	    mach_timebase_info(&tb);
+	    maxClicksForUInt64 = UINT64_MAX / tb.numer;
+	}
+	if ((uint64_t) clicks < maxClicksForUInt64) {
+	    nsec = ((uint64_t) clicks) * tb.numer / tb.denom;
+	} else {
+	    nsec = ((long double) (uint64_t) clicks) * tb.numer / tb.denom;
+	}
+#else
+#error Wide high-resolution clicks not implemented on this platform
+#endif
+    }
+
+    return nsec;
+}
+#endif /* TCL_WIDE_CLICKS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetTime --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetTime(
+    Tcl_Time *timePtr)		/* Location to store time information. */
+{
+    tclGetTimeProcPtr(timePtr, tclTimeClientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetDate --
+ *
+ *	This function converts between seconds and struct tm. If useGMT is
+ *	true, then the returned date will be in Greenwich Mean Time (GMT).
+ *	Otherwise, it will be in the local time zone.
+ *
+ * Results:
+ *	Returns a static tm structure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpGetDate(
+    const time_t *time,
+    int useGMT)
+{
+    if (useGMT) {
+	return TclpGmtime(time);
+    } else {
+	return TclpLocaltime(time);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGmtime --
+ *
+ *	Wrapper around the 'gmtime' library function to make it thread safe.
+ *
+ * Results:
+ *	Returns a pointer to a 'struct tm' in thread-specific data.
+ *
+ * Side effects:
+ *	Invokes gmtime or gmtime_r as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpGmtime(
+    const time_t *timePtr)	/* Pointer to the number of seconds since the
+				 * local system's epoch */
+{
+    /*
+     * Get a thread-local buffer to hold the returned time.
+     */
+
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);
+
+#ifdef HAVE_GMTIME_R
+    gmtime_r(timePtr, &tsdPtr->gmtime_buf);
+#else
+    Tcl_MutexLock(&tmMutex);
+    memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm));
+    Tcl_MutexUnlock(&tmMutex);
+#endif
+
+    return &tsdPtr->gmtime_buf;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpLocaltime --
+ *
+ *	Wrapper around the 'localtime' library function to make it thread
+ *	safe.
+ *
+ * Results:
+ *	Returns a pointer to a 'struct tm' in thread-specific data.
+ *
+ * Side effects:
+ *	Invokes localtime or localtime_r as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpLocaltime(
+    const time_t *timePtr)	/* Pointer to the number of seconds since the
+				 * local system's epoch */
+{
+    /*
+     * Get a thread-local buffer to hold the returned time.
+     */
+
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);
+
+    SetTZIfNecessary();
+#ifdef HAVE_LOCALTIME_R
+    localtime_r(timePtr, &tsdPtr->localtime_buf);
+#else
+    Tcl_MutexLock(&tmMutex);
+    memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm));
+    Tcl_MutexUnlock(&tmMutex);
+#endif
+
+    return &tsdPtr->localtime_buf;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+    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(
+    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(
+    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(
+    Tcl_Time *timePtr,
+    ClientData clientData)
+{
+    struct timeval tv;
+
+    (void) gettimeofday(&tv, NULL);
+    timePtr->sec = tv.tv_sec;
+    timePtr->usec = tv.tv_usec;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetTZIfNecessary --
+ *
+ *	Determines whether a call to 'tzset' is needed prior to the next call
+ *	to 'localtime' or examination of the 'timezone' variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If 'tzset' has never been called in the current process, or if the
+ *	value of the environment variable TZ has changed since the last call
+ *	to 'tzset', then 'tzset' is called again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetTZIfNecessary(void)
+{
+    const char *newTZ = getenv("TZ");
+
+    Tcl_MutexLock(&tmMutex);
+    if (newTZ == NULL) {
+	newTZ = "";
+    }
+    if (lastTZ == NULL || strcmp(lastTZ, newTZ)) {
+	tzset();
+	if (lastTZ == NULL) {
+	    Tcl_CreateExitHandler(CleanupMemory, NULL);
+	} else {
+	    ckfree(lastTZ);
+	}
+	lastTZ = ckalloc(strlen(newTZ) + 1);
+	strcpy(lastTZ, newTZ);
+    }
+    Tcl_MutexUnlock(&tmMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupMemory --
+ *
+ *	Releases the private copy of the TZ environment variable upon exit
+ *	from Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees allocated memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupMemory(
+    ClientData ignored)
+{
+    ckfree(lastTZ);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */