TIP #173 and #209 implementation - see ChangeLog for details

1 files changed, 531 insertions, 292 deletions

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 67570df..91f204b 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -7,17 +7,34 @@
  *
  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclClock.c,v 1.28 2004/05/14 21:43:28 kennykb Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.29 2004/08/18 19:58:59 kennykb Exp $
  */
 
 #include "tclInt.h"
 
 /*
- * The date parsing stuff uses lexx and has tons o statics.
+ * Windows has mktime.  The configurators do not check.
+ */
+
+#ifdef WIN32
+#define HAVE_MKTIME
+#endif
+
+/*
+ * Thread specific data block holding a 'struct tm' for the 'gmtime'
+ * and 'localtime' library calls.
+ */
+
+static Tcl_ThreadDataKey tmKey;
+
+/*
+ * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls
+ * and the statics in the date parsing code.
  */
 
 TCL_DECLARE_MUTEX(clockMutex)
@@ -26,358 +43,580 @@ TCL_DECLARE_MUTEX(clockMutex)
  * Function prototypes for local procedures in this file:
  */
 
-static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
-			    unsigned long clockVal, int useGMT,
-			    char *format));
+static struct tm* ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* ));
+static void TzsetIfNecessary _ANSI_ARGS_(( void ));
 
 /*
  *-------------------------------------------------------------------------
  *
- * Tcl_ClockObjCmd --
+ * TclClockLocaltimeObjCmd --
+ *
+ *	Tcl command that extracts local time using the C library to do
+ *	it.
  *
- *	This procedure is invoked to process the "clock" Tcl command.
- *	See the user documentation for details on what it does.
+ * Usage:
+ *	::tcl::clock::Localtime <tick>
+ *
+ * Parameters:
+ *	<tick> -- A count of seconds from the Posix epoch.
  *
  * Results:
- *	A standard Tcl result.
+ *	Returns a standard Tcl result.  The object result is a Tcl
+ *	list containing the year, month, day, hour, minute, and second
+ *	fields of the local time.  It may return an error if the
+ *	argument exceeds the arithmetic range representable by
+ *	'time_t'.
  *
  * Side effects:
- *	See the user documentation.
+ *	None.
+ *
+ * This function is used as a call of last resort if the current time
+ * zone cannot be determined from environment variables TZ or TCL_TZ.
+ * It attempts to use the 'localtime' library function to extract the
+ * time and return it that way.  This method suffers from Y2038 problems
+ * on most platforms.  It also provides no portable way to get the
+ * name of the time zone.
  *
  *-------------------------------------------------------------------------
  */
 
 int
-Tcl_ClockObjCmd (client, interp, objc, objv)
-    ClientData client;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument values. */
+TclClockLocaltimeObjCmd( ClientData clientData,
+				/* Unused */
+			 Tcl_Interp* interp,
+				/* Tcl interpreter */
+			 int objc,
+				/* Parameter count */
+			 Tcl_Obj* CONST* objv )
+				/* Parameter vector */
 {
-    Tcl_Obj *resultPtr;
-    int index;
-    Tcl_Obj *CONST *objPtr;
-    int useGMT = 0;
-    char *format = "%a %b %d %X %Z %Y";
-    int clickType = 2;
-    int dummy;
-    unsigned long baseClock, clockVal;
-    long zone;
-    Tcl_Obj *baseObjPtr = NULL;
-    char *scanStr;
-    Tcl_Time now;		/* Current time */
+    Tcl_WideInt tick;		/* Time to convert */
+    time_t tock;
+    struct tm* timeVal;		/* Time after conversion */
 
-    static CONST char *switches[] = {
-	"clicks", "format", "scan", "seconds", (char *) NULL
-    };
-    enum command {
-	COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN, COMMAND_SECONDS
-    };
-    static CONST char *clicksSwitches[] = {
-	"-milliseconds", "-microseconds", (char*) NULL
-    };
-    static CONST char *formatSwitches[] = {
-	"-format", "-gmt", (char *) NULL
-    };
-    static CONST char *scanSwitches[] = {
-	"-base", "-gmt", (char *) NULL
-    };
+    Tcl_Obj* returnVec[ 6 ];
+
+    /* Check args */
 
-    resultPtr = Tcl_GetObjResult(interp);
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+    if ( objc != 2 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "seconds" );
 	return TCL_ERROR;
     }
-
-    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
-	    != TCL_OK) {
+    if ( Tcl_GetWideIntFromObj( interp, objv[1], &tick ) != TCL_OK ) {
 	return TCL_ERROR;
     }
-    switch ((enum command) index) {
-	case COMMAND_CLICKS:	{		/* clicks */
-	    if (objc == 3) {
-		if (Tcl_GetIndexFromObj(interp, objv[2], clicksSwitches,
-			"option", 0, &clickType) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-	    } else if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?option?");
-		return TCL_ERROR;
-	    }
-	    switch (clickType) {
-	    case 0: 		/* milliseconds */
-		Tcl_GetTime(&now);
-		Tcl_SetWideIntObj(resultPtr,
-			((Tcl_WideInt) now.sec * 1000 + now.usec / 1000));
-		break;
-	    case 1:		/* microseconds */
-		Tcl_GetTime(&now);
-		Tcl_SetWideIntObj(resultPtr,
-			((Tcl_WideInt) now.sec * 1000000 + now.usec));
-		break;
-	    case 2:		/* native clicks */
-		Tcl_SetWideIntObj(resultPtr, (Tcl_WideInt) TclpGetClicks());
-		break;
-	    }
 
-	    return TCL_OK;
-	}
+    /* Convert the time, checking for overflow */
 
-	case COMMAND_FORMAT:			/* format */
-	    if ((objc < 3) || (objc > 7)) {
-		wrongFmtArgs:
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"clockval ?-format string? ?-gmt boolean?");
-		return TCL_ERROR;
-	    }
+    tock = (time_t) tick;
+    if ( (Tcl_WideInt) tock != tick ) {
+	Tcl_SetObjResult
+	    ( interp, 
+	      Tcl_NewStringObj("number too large to represent as a Posix time", 
+			       -1) );
+	Tcl_SetErrorCode( interp, "CLOCK", "argTooLarge", (char*) NULL );
+	return TCL_ERROR;
+    }
+    TzsetIfNecessary();
+    timeVal = ThreadSafeLocalTime( &tock );
+
+    /* Package the results */
+
+    returnVec[0] = Tcl_NewIntObj( timeVal->tm_year + 1900 );
+    returnVec[1] = Tcl_NewIntObj( timeVal->tm_mon + 1);
+    returnVec[2] = Tcl_NewIntObj( timeVal->tm_mday );
+    returnVec[3] = Tcl_NewIntObj( timeVal->tm_hour );
+    returnVec[4] = Tcl_NewIntObj( timeVal->tm_min );
+    returnVec[5] = Tcl_NewIntObj( timeVal->tm_sec );
+    Tcl_SetObjResult( interp, Tcl_NewListObj( 6, returnVec ) );
+    return TCL_OK;
 
-	    if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)
-		    != TCL_OK) {
-		return TCL_ERROR;
-	    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ThreadSafeLocalTime --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    objPtr = objv+3;
-	    objc -= 3;
-	    while (objc > 1) {
-		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
-			"switch", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch (index) {
-		    case 0:		/* -format */
-			format = Tcl_GetStringFromObj(objPtr[1], &dummy);
-			break;
-		    case 1:		/* -gmt */
-			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
-				&useGMT) != TCL_OK) {
-			    return TCL_ERROR;
-			}
-			break;
-		}
-		objPtr += 2;
-		objc -= 2;
-	    }
-	    if (objc != 0) {
-		goto wrongFmtArgs;
-	    }
-	    return FormatClock(interp, (unsigned long) clockVal, useGMT,
-		    format);
-
-	case COMMAND_SCAN:			/* scan */
-	    if ((objc < 3) || (objc > 7)) {
-		wrongScanArgs:
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"dateString ?-base clockValue? ?-gmt boolean?");
-		return TCL_ERROR;
-	    }
+static struct tm *
+ThreadSafeLocalTime(timePtr)
+    CONST time_t *timePtr;	/* Pointer to the number of seconds
+				 * since the local system's epoch
+				 */
 
-	    objPtr = objv+3;
-	    objc -= 3;
-	    while (objc > 1) {
-		if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
-			"switch", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch (index) {
-		    case 0:		/* -base */
-			baseObjPtr = objPtr[1];
-			break;
-		    case 1:		/* -gmt */
-			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
-				&useGMT) != TCL_OK) {
-			    return TCL_ERROR;
-			}
-			break;
-		}
-		objPtr += 2;
-		objc -= 2;
-	    }
-	    if (objc != 0) {
-		goto wrongScanArgs;
-	    }
+{
+    /*
+     * Get a thread-local buffer to hold the returned time.
+     */
 
-	    if (baseObjPtr != NULL) {
-		if (Tcl_GetLongFromObj(interp, baseObjPtr,
-			(long*) &baseClock) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-	    } else {
-		baseClock = TclpGetSeconds();
-	    }
+    struct tm *tmPtr = (struct tm *)
+	    Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
+#ifdef HAVE_LOCALTIME_R
+    localtime_r(timePtr, tmPtr);
+#else
+    Tcl_MutexLock(&clockMutex);
+    memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm));
+    Tcl_MutexUnlock(&clockMutex);
+#endif    
+    return tmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclClockMktimeObjCmd --
+ *
+ *	Determine seconds from the epoch, given the fields of a local
+ *	time.
+ *
+ * Usage:
+ *	mktime <year> <month> <day> <hour> <minute> <second>
+ *
+ * Parameters:
+ *	year -- Calendar year
+ *	month -- Calendar month
+ *	day -- Calendar day
+ *	hour -- Hour of day (00-23)
+ *	minute -- Minute of hour
+ *	second -- Second of minute
+ *
+ * Results:
+ *	Returns the given local time.
+ *
+ * Errors:
+ *	Returns an error if the 'mktime' function does not exist in the
+ *	C library, or if the given time cannot be converted.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    if (useGMT) {
-		zone = -50000; /* Force GMT */
-	    } else {
-		zone = TclpGetTimeZone((unsigned long) baseClock);
-	    }
+int
+TclClockMktimeObjCmd(  ClientData clientData,
+		       			/* Unused */
+		       Tcl_Interp* interp,
+		       			/* Tcl interpreter */
+		       int objc,
+		       			/* Parameter count */
+		       Tcl_Obj* CONST* objv )
+     					/* Parameter vector */
+{
+    int i;
+    struct tm toConvert;	/* Time to be converted */
+    time_t convertedTime;	/* Time converted from mktime */
 
-	    scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
-	    Tcl_MutexLock(&clockMutex);
-	    if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
-		    (unsigned long *) &clockVal) < 0) {
-		Tcl_MutexUnlock(&clockMutex);
-		Tcl_AppendStringsToObj(resultPtr,
-			"unable to convert date-time string \"",
-			scanStr, "\"", (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_MutexUnlock(&clockMutex);
+#ifndef HAVE_MKTIME
+    Tcl_SetObjResult( interp,
+		      Tcl_NewStringObj( "cannot determine local time", -1 ) );
+    return TCL_ERROR;
+#else
 
-	    Tcl_SetLongObj(resultPtr, (long) clockVal);
-	    return TCL_OK;
+    /* Convert parameters */
 
-	case COMMAND_SECONDS:			/* seconds */
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
-	    return TCL_OK;
-	default:
-	    return TCL_ERROR;	/* Should never be reached. */
+    if ( objc != 7 ) {
+	Tcl_WrongNumArgs( interp, 1, objv,
+			  "year month day hour minute second" );
+	return TCL_ERROR;
+    }
+    if ( Tcl_GetIntFromObj( interp, objv[1], &i ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    toConvert.tm_year = i - 1900;
+    if ( Tcl_GetIntFromObj( interp, objv[2], &i ) != TCL_OK ) {
+	return TCL_ERROR;
     }
+    toConvert.tm_mon = i;
+    if ( Tcl_GetIntFromObj( interp, objv[3], &i ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    toConvert.tm_mday = i;
+    if ( Tcl_GetIntFromObj( interp, objv[4], &i ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    toConvert.tm_hour = i;
+    if ( Tcl_GetIntFromObj( interp, objv[5], &i ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    toConvert.tm_min = i;
+    if ( Tcl_GetIntFromObj( interp, objv[6], &i ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    toConvert.tm_sec = i;
+    toConvert.tm_isdst = -1;
+    toConvert.tm_wday = 0;
+    toConvert.tm_yday = 0;
+
+    /* Convert the time.  It is rumored that mktime is not thread
+     * safe on some platforms. */
+
+    TzsetIfNecessary();
+    Tcl_MutexLock( &clockMutex );
+    convertedTime = mktime( &toConvert );
+    Tcl_MutexUnlock( &clockMutex );
+
+    /* Return the converted time, or an error if conversion fails */
+
+    if ( convertedTime == -1 ) {
+	Tcl_SetObjResult
+	    ( interp,
+	      Tcl_NewStringObj( "time value too large/small to represent", 
+				-1 ) );
+	return TCL_ERROR;
+    } else {
+	Tcl_SetObjResult( interp,
+			  Tcl_NewWideIntObj( (Tcl_WideInt) convertedTime ) );
+	return TCL_OK;
+    }
+
+#endif
+
 }
 
-/*
- *-----------------------------------------------------------------------------
+
+/*----------------------------------------------------------------------
  *
- * FormatClock --
+ * TclClockClicksObjCmd --
  *
- *      Formats a time value based on seconds into a human readable
- *	string.
+ *	Returns a high-resolution counter.
  *
  * Results:
- *      Standard Tcl result.
+ *	Returns a standard Tcl result.
  *
  * Side effects:
- *      None.
+ *	None.
+ *
+ * This function implements the 'clock clicks' Tcl command.  Refer
+ * to the user documentation for details on what it does.
  *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-static int
-FormatClock(interp, clockVal, useGMT, format)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    unsigned long clockVal;	       	/* Time in seconds. */
-    int useGMT;				/* Boolean */
-    char *format;			/* Format string */
+int
+TclClockClicksObjCmd( clientData, interp, objc, objv )
+    ClientData clientData;	/* Client data is unused */
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int objc;			/* Parameter count */
+    Tcl_Obj* CONST* objv;	/* Parameter values */
 {
-    struct tm *timeDataPtr;
-    Tcl_DString buffer;
-    int bufSize;
-    char *p;
-    int result;
-    time_t tclockVal;
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
-    int savedTimeZone = 0;	/* lint. */
-    char *savedTZEnv = NULL;	/* lint. */
+    static CONST char *clicksSwitches[] = {
+	"-milliseconds", "-microseconds", (char*) NULL
+    };
+    enum ClicksSwitch {
+	CLICKS_MILLIS,   CLICKS_MICROS,   CLICKS_NATIVE
+    };
+    int index = CLICKS_NATIVE;
+    Tcl_Time now;
+
+    switch ( objc ) {
+        case 1:
+	    break;
+        case 2:
+	    if ( Tcl_GetIndexFromObj( interp, objv[1], clicksSwitches,
+				      "option", 0, &index) != TCL_OK ) {
+		return TCL_ERROR;
+	    }
+	    break;
+        default:
+	    Tcl_WrongNumArgs( interp, 1, objv, "?option?" );
+	    return TCL_ERROR;
+    }
+
+    switch ( index ) {
+        case CLICKS_MILLIS:
+	    Tcl_GetTime( &now );
+	    Tcl_SetObjResult( interp,
+			      Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000
+						 + now.usec / 1000 ) );
+	    break;
+        case CLICKS_NATIVE:
+#if 0
+	    /* 
+	     * The following code will be used once this is incorporated
+	     * into Tcl.  But TEA bugs prevent it for right now. :(
+	     * So we fall through this case and return the microseconds
+	     * instead.
+	     */
+	    Tcl_SetObjResult( interp,
+			      Tcl_NewWideIntObj( (Tcl_WideInt) TclpGetClicks() ) );
+	    break;
 #endif
+        case CLICKS_MICROS:
+	    Tcl_GetTime( &now );
+	    Tcl_SetObjResult( interp,
+			      Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec 
+						   * 1000000 )
+						 + now.usec ) );
+	    break;
+    }
 
-#ifdef HAVE_TZSET
-    /*
-     * Some systems forgot to call tzset in localtime, make sure its done.
-     */
-    static int  calledTzset = 0;
+    return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TclClockMillisecondsObjCmd -
+ *
+ *	Returns a count of milliseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock milliseconds' Tcl command.  Refer
+ * to the user documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    Tcl_MutexLock(&clockMutex);
-    if (!calledTzset) {
-        tzset();
-        calledTzset = 1;
+int
+TclClockMillisecondsObjCmd( clientData, interp, objc, objv )
+    ClientData clientData;	/* Client data is unused */
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int objc;			/* Parameter count */
+    Tcl_Obj* CONST* objv;	/* Parameter values */
+{
+    Tcl_Time now;
+    if ( objc != 1 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "" );
+	return TCL_ERROR;
     }
-    Tcl_MutexUnlock(&clockMutex);
-#endif
+    Tcl_GetTime( &now );
+    Tcl_SetObjResult( interp,
+		      Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000
+					 + now.usec / 1000 ) );
+    return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TclClockMicrosecondsObjCmd -
+ *
+ *	Returns a count of microseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock microseconds' Tcl command.  Refer
+ * to the user documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    /*
-     * If the user gave us -format "", just return now
-     */
-    if (*format == '\0') {
-	return TCL_OK;
+int
+TclClockMicrosecondsObjCmd( clientData, interp, objc, objv )
+    ClientData clientData;	/* Client data is unused */
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int objc;			/* Parameter count */
+    Tcl_Obj* CONST* objv;	/* Parameter values */
+{
+    Tcl_Time now;
+    if ( objc != 1 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "" );
+	return TCL_ERROR;
     }
+    Tcl_GetTime( &now );
+    Tcl_SetObjResult( interp,
+		      Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec * 1000000 )
+					 + now.usec ) );
+    return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TclClockSecondsObjCmd -
+ *
+ *	Returns a count of microseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock seconds' Tcl command.  Refer
+ * to the user documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
 
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
-    /*
-     * This is a kludge for systems not having the timezone string in
-     * struct tm.  No matter what was specified, they use the local
-     * timezone string.  Since this kludge requires fiddling with the
-     * TZ environment variable, it will mess up if done on multiple
-     * threads at once.  Protect it with a the clock mutex.
-     */
-
-    Tcl_MutexLock(&clockMutex);
-    if (useGMT) {
-        CONST char *varValue;
+int
+TclClockSecondsObjCmd( clientData, interp, objc, objv )
+    ClientData clientData;	/* Client data is unused */
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int objc;			/* Parameter count */
+    Tcl_Obj* CONST* objv;	/* Parameter values */
+{
+    Tcl_Time now;
+    if ( objc != 1 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "" );
+	return TCL_ERROR;
+    }
+    Tcl_GetTime( &now );
+    Tcl_SetObjResult( interp, Tcl_NewWideIntObj( (Tcl_WideInt) now.sec ) );
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TzsetIfNecessary --
+ *
+ *	Calls the tzset() library function if the contents of the TZ
+ *	environment variable has changed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls tzset.
+ *
+ *----------------------------------------------------------------------
+ */
 
-        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
-        if (varValue != NULL) {
-	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
-        } else {
-            savedTZEnv = NULL;
+static void
+TzsetIfNecessary()
+{
+    static char* tzWas = NULL;	/* Previous value of TZ, protected by
+				 * clockMutex. */
+    CONST char* tzIsNow;	/* Current value of TZ */
+
+    Tcl_MutexLock( &clockMutex );
+    tzIsNow = getenv( "TZ" );
+    if ( tzIsNow != NULL
+	 && ( tzWas == NULL || strcmp( tzIsNow, tzWas ) != 0 ) ) {
+	tzset();
+	if ( tzWas != NULL ) {
+	    ckfree( tzWas );
 	}
-        Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
-        savedTimeZone = timezone;
-        timezone = 0;
-        tzset();
+	tzWas = ckalloc( strlen( tzIsNow ) + 1 );
+	strcpy( tzWas, tzIsNow );
+    } else if ( tzIsNow == NULL && tzWas != NULL ) {
+	tzset();
+	ckfree( tzWas );
+	tzWas = NULL;
     }
-#endif
+    Tcl_MutexUnlock( &clockMutex );
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclClockOldscanObjCmd --
+ *
+ *	Implements the legacy 'clock scan' Tcl command when no '-format'
+ *	option is supplied.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * This function implements the 'clock scan' Tcl command when no
+ * -format group is present. Refer to the user documentation to see
+ * what it does.
+ *
+ *-------------------------------------------------------------------------
+ */
 
-    tclockVal = clockVal;
-    timeDataPtr = TclpGetDate(&tclockVal, useGMT);
+int
+TclClockOldscanObjCmd( ClientData clientData, /* unused */
+		       Tcl_Interp* interp, /* Tcl interpreter */
+		       int objc, /* Parameter count */
+		       Tcl_Obj *CONST * objv /* Parameter vector */
+		       )
+{
+    int index;
+    Tcl_Obj *CONST *objPtr;
+    char *scanStr;
+    Tcl_Obj *baseObjPtr = NULL;
+    int useGMT = 0;
+    unsigned long baseClock;
+    long clockVal;
+    long zone;
+    Tcl_Obj *resultPtr;
+    int dummy;
 
-    /*
-     * Make a guess at the upper limit on the substituted string size
-     * based on the number of percents in the string.
-     */
+    static CONST char *scanSwitches[] = {
+	"-base", "-gmt", (char *) NULL
+    };
 
-    for (bufSize = 1, p = format; *p != '\0'; p++) {
-	if (*p == '%') {
-	    bufSize += 40;
-	} else {
-	    bufSize++;
+    if ((objc < 2) || (objc > 6)) {
+    wrongScanArgs:
+	Tcl_WrongNumArgs(interp, 2, objv,
+			 "dateString ?-base clockValue? ?-gmt boolean?");
+	return TCL_ERROR;
+    }
+    objPtr = objv+2;
+    objc -= 2;
+    while (objc > 1) {
+	if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
+				"switch", 0, &index) != TCL_OK) {
+	    return TCL_ERROR;
 	}
+	switch (index) {
+	case 0:		/* -base */
+	    baseObjPtr = objPtr[1];
+	    break;
+	case 1:		/* -gmt */
+	    if (Tcl_GetBooleanFromObj(interp, objPtr[1],
+				      &useGMT) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    break;
+	}
+	objPtr += 2;
+	objc -= 2;
     }
-
-    Tcl_DStringInit(&buffer);
-    Tcl_DStringSetLength(&buffer, bufSize);
-
-    /* If we haven't locked the clock mutex up above, lock it now. */
-
-#if defined(HAVE_TM_ZONE) || defined(WIN32)
-    Tcl_MutexLock(&clockMutex);
-#endif
-    result = TclpStrftime(buffer.string, (unsigned int) bufSize, format,
-	    timeDataPtr, useGMT);
-#if defined(HAVE_TM_ZONE) || defined(WIN32)
-    Tcl_MutexUnlock(&clockMutex);
-#endif
-
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
+    if (objc != 0) {
+	goto wrongScanArgs;
+    }
+    
+    if (baseObjPtr != NULL) {
+	if (Tcl_GetLongFromObj(interp, baseObjPtr,
+			       (long*) &baseClock) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	baseClock = TclpGetSeconds();
+    }
+    
     if (useGMT) {
-        if (savedTZEnv != NULL) {
-            Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
-            ckfree(savedTZEnv);
-        } else {
-            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
-        }
-        timezone = savedTimeZone;
-        tzset();
+	zone = -50000; /* Force GMT */
+    } else {
+	zone = TclpGetTimeZone((unsigned long) baseClock);
     }
-    Tcl_MutexUnlock(&clockMutex);
-#endif
-
-    if (result == 0) {
-	/*
-	 * A zero return is the error case (can also mean the strftime
-	 * didn't get enough space to write into).  We know it doesn't
-	 * mean that we wrote zero chars because the check for an empty
-	 * format string is above.
-	 */
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad format string \"", format, "\"", (char *) NULL);
+    
+    scanStr = Tcl_GetStringFromObj(objv[1], &dummy);
+    Tcl_MutexLock(&clockMutex);
+    if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
+		   &clockVal) < 0) {
+	Tcl_MutexUnlock(&clockMutex);
+	resultPtr = Tcl_NewObj();
+	Tcl_AppendStringsToObj(resultPtr,
+			       "unable to convert date-time string \"",
+			       scanStr, "\"", (char *) NULL);
+	Tcl_SetObjResult( interp, resultPtr );
 	return TCL_ERROR;
     }
-
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1);
-
-    Tcl_DStringFree(&buffer);
+    Tcl_MutexUnlock(&clockMutex);
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) clockVal ) );
     return TCL_OK;
+
 }