613 lines
13 KiB
C
613 lines
13 KiB
C
|
/*
|
|||
|
* 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);
|
|||
|
}
|
|||
|
|
|||
|
/*
|
|||
|
*----------------------------------------------------------------------
|
|||
|
*
|
|||
|
* TclpGetMicroseconds --
|
|||
|
*
|
|||
|
* This procedure returns the number of microseconds from the epoch.
|
|||
|
* On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
|
|||
|
*
|
|||
|
* Results:
|
|||
|
* Number of microseconds from the epoch.
|
|||
|
*
|
|||
|
* Side effects:
|
|||
|
* None.
|
|||
|
*
|
|||
|
*----------------------------------------------------------------------
|
|||
|
*/
|
|||
|
|
|||
|
Tcl_WideInt
|
|||
|
TclpGetMicroseconds(void)
|
|||
|
{
|
|||
|
Tcl_Time time;
|
|||
|
|
|||
|
tclGetTimeProcPtr(&time, tclTimeClientData);
|
|||
|
return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
|
|||
|
}
|
|||
|
|
|||
|
/*
|
|||
|
*----------------------------------------------------------------------
|
|||
|
*
|
|||
|
* 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 dependent.
|
|||
|
*
|
|||
|
* 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 dependent.
|
|||
|
*
|
|||
|
* 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;
|
|||
|
}
|
|||
|
|
|||
|
/*
|
|||
|
*----------------------------------------------------------------------
|
|||
|
*
|
|||
|
* TclpWideClickInMicrosec --
|
|||
|
*
|
|||
|
* This procedure return scale to convert click values from the
|
|||
|
* TclpGetWideClicks native resolution to microsecond resolution
|
|||
|
* and back.
|
|||
|
*
|
|||
|
* Results:
|
|||
|
* 1 click in microseconds as double.
|
|||
|
*
|
|||
|
* Side effects:
|
|||
|
* None.
|
|||
|
*
|
|||
|
*----------------------------------------------------------------------
|
|||
|
*/
|
|||
|
|
|||
|
double
|
|||
|
TclpWideClickInMicrosec(void)
|
|||
|
{
|
|||
|
if (tclGetTimeProcPtr != NativeGetTime) {
|
|||
|
return 1.0;
|
|||
|
} else {
|
|||
|
#ifdef MAC_OSX_TCL
|
|||
|
static int initialized = 0;
|
|||
|
static double scale = 0.0;
|
|||
|
|
|||
|
if (initialized) {
|
|||
|
return scale;
|
|||
|
} else {
|
|||
|
mach_timebase_info_data_t tb;
|
|||
|
|
|||
|
mach_timebase_info(&tb);
|
|||
|
/* value of tb.numer / tb.denom = 1 click in nanoseconds */
|
|||
|
scale = ((double)tb.numer) / tb.denom / 1000;
|
|||
|
initialized = 1;
|
|||
|
return scale;
|
|||
|
}
|
|||
|
#else
|
|||
|
#error Wide high-resolution clicks not implemented on this platform
|
|||
|
#endif
|
|||
|
}
|
|||
|
}
|
|||
|
#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:
|
|||
|
*/
|