diff options
Diffstat (limited to 'generic/tclClock.c')
| -rw-r--r-- | generic/tclClock.c | 2596 |
1 files changed, 289 insertions, 2307 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index c38af6b..d44e9dc 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -8,16 +8,12 @@ * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. - * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. * * 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 "tclStrIdxTree.h" -#include "tclDate.h" -#include "tclCompile.h" /* * Windows has mktime. The configurators do not check. @@ -28,6 +24,21 @@ #endif /* + * Constants + */ + +#define JULIAN_DAY_POSIX_EPOCH 2440588 +#define SECONDS_PER_DAY 86400 +#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ + * SECONDS_PER_DAY) +#define FOUR_CENTURIES 146097 /* days */ +#define JDAY_1_JAN_1_CE_JULIAN 1721424 +#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 +#define ONE_CENTURY_GREGORIAN 36524 /* days */ +#define FOUR_YEARS 1461 /* days */ +#define ONE_YEAR 365 /* days */ + +/* * Table of the days in each month, leap and common years */ @@ -44,13 +55,70 @@ static const int daysInPriorMonths[2][13] = { * Enumeration of the string literals used in [clock] */ -CLOCK_LITERAL_ARRAY(Literals); +typedef enum ClockLiteral { + LIT__NIL, + LIT__DEFAULT_FORMAT, + LIT_BCE, LIT_C, + LIT_CANNOT_USE_GMT_AND_TIMEZONE, + LIT_CE, + LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, + LIT_ERA, LIT_GMT, LIT_GREGORIAN, + LIT_INTEGER_VALUE_TOO_LARGE, + LIT_ISO8601WEEK, LIT_ISO8601YEAR, + LIT_JULIANDAY, LIT_LOCALSECONDS, + LIT_MONTH, + LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, + LIT_YEAR, + LIT__END +} ClockLiteral; +static const char *const literals[] = { + "", + "%a %b %d %H:%M:%S %Z %Y", + "BCE", "C", + "cannot use -gmt and -timezone in same call", + "CE", + "dayOfMonth", "dayOfWeek", "dayOfYear", + "era", ":GMT", "gregorian", + "integer value too large to represent", + "iso8601Week", "iso8601Year", + "julianDay", "localSeconds", + "month", + "seconds", "tzName", "tzOffset", + "year" +}; + +/* + * Structure containing the client data for [clock] + */ + +typedef struct ClockClientData { + size_t refCount; /* Number of live references. */ + Tcl_Obj **literals; /* Pool of object literals. */ +} ClockClientData; -/* Msgcat literals for exact match (mcKey) */ -CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, ""); -/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ -CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); +/* + * Structure containing the fields used in [clock format] and [clock scan] + */ +typedef struct TclDateFields { + Tcl_WideInt seconds; /* Time expressed in seconds from the Posix + * epoch */ + Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds + * from the Posix epoch */ + int tzOffset; /* Time zone offset in seconds east of + * Greenwich */ + Tcl_Obj *tzName; /* Time zone name */ + int julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ +} TclDateFields; static const char *const eras[] = { "CE", "BCE", NULL }; /* @@ -71,23 +139,26 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ +static int ConvertUTCToLocal(Tcl_Interp *, + TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[], - Tcl_WideInt rangesVal[2]); + TclDateFields *, int, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); -static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, - TclDateFields *, Tcl_Obj *timezoneObj, int); +static int ConvertLocalToUTC(Tcl_Interp *, + TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[], - Tcl_WideInt rangesVal[2]); + TclDateFields *, int, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); -static int ClockConfigureObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, + int, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); +static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); +static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); +static int IsGregorianLeapYear(TclDateFields *); static int WeekdayOnOrBefore(int, int); static int ClockClicksObjCmd( ClientData clientData, Tcl_Interp *interp, @@ -95,10 +166,6 @@ static int ClockClicksObjCmd( static int ClockConvertlocaltoutcObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); - -static int ClockGetDateFields(ClientData clientData, - Tcl_Interp *interp, TclDateFields *fields, - Tcl_Obj *timezoneObj, int changeover); static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -117,28 +184,13 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockSecondsObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int ClockFormatObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int ClockScanObjCmd( +static int ClockParseformatargsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockScanCommit( - ClientData clientData, register DateInfo *info, - register ClockFmtScnCmdArgs *opts); -static int ClockFreeScan( - register DateInfo *info, - Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); -static int ClockCalcRelTime( - register DateInfo *info, ClockFmtScnCmdArgs *opts); -static int ClockAddObjCmd( +static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static struct tm * ThreadSafeLocalTime(const time_t *); -static unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); @@ -150,32 +202,22 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::<name>". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ - CompileProc *compileProc; /* The compiler for the command. */ - ClientData clientData; /* Any clientData to give the command (if NULL - * a reference to ClockClientData will be sent) */ }; static const struct ClockCommand clockCommands[] = { - {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, - {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, - {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, - {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, - {"configure", ClockConfigureObjCmd, NULL, NULL}, - {"Oldscan", TclClockOldscanObjCmd, NULL, NULL}, - {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, - {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, - {"GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, - {"GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, - {NULL, NULL, NULL, NULL} + { "getenv", ClockGetenvObjCmd }, + { "Oldscan", TclClockOldscanObjCmd }, + { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, + { "GetDateFields", ClockGetdatefieldsObjCmd }, + { "GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd }, + { "GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd }, + { "ParseFormatArgs", ClockParseformatargsObjCmd }, + { NULL, NULL } }; /* @@ -204,10 +246,22 @@ TclClockInit( char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ - Command *cmdPtr; ClockClientData *data; int i; + /* Structure of the 'clock' ensemble */ + + static const EnsembleImplMap clockImplMap[] = { + {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0}, + {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, + {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, + {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, + {NULL, NULL, NULL, NULL, NULL, 0} + }; + /* * Safe interps get [::clock] as alias to a master, so do not need their * own copies of the support routines. @@ -225,918 +279,27 @@ TclClockInit( data->refCount = 0; data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { - Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); + data->literals[i] = Tcl_NewStringObj(literals[i], -1); + Tcl_IncrRefCount(data->literals[i]); } - data->mcLiterals = NULL; - data->mcLitIdxs = NULL; - data->LastTZEpoch = 0; - data->currentYearCentury = ClockDefaultYearCentury; - data->yearOfCenturySwitch = ClockDefaultCenturySwitch; - data->SystemTimeZone = NULL; - data->SystemSetupTZData = NULL; - data->GMTSetupTimeZone = NULL; - data->GMTSetupTZData = NULL; - data->AnySetupTimeZone = NULL; - data->AnySetupTZData = NULL; - data->LastUnnormSetupTimeZone = NULL; - data->LastSetupTimeZone = NULL; - data->LastSetupTZData = NULL; - - data->CurrentLocale = NULL; - data->CurrentLocaleDict = NULL; - data->LastUnnormUsedLocale = NULL; - data->LastUsedLocale = NULL; - data->LastUsedLocaleDict = NULL; - - data->lastBase.timezoneObj = NULL; - data->UTC2Local.timezoneObj = NULL; - data->UTC2Local.tzName = NULL; - data->Local2UTC.timezoneObj = NULL; /* * Install the commands. + * TODO - Let Tcl_MakeEnsemble do this? */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { - ClientData clientData; - strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); - if (!(clientData = clockCmdPtr->clientData)) { - clientData = data; - data->refCount++; - } - cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName, - clockCmdPtr->objCmdProc, clientData, - clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); - cmdPtr->compileProc = clockCmdPtr->compileProc ? - clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; - } -} - -/* - *---------------------------------------------------------------------- - * - * ClockConfigureClear -- - * - * Clean up cached resp. run-time storages used in clock commands. - * - * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear". - * - * Results: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -ClockConfigureClear( - ClockClientData *data) -{ - ClockFrmScnClearCaches(); - - data->LastTZEpoch = 0; - Tcl_UnsetObjRef(data->SystemTimeZone); - Tcl_UnsetObjRef(data->SystemSetupTZData); - Tcl_UnsetObjRef(data->GMTSetupTimeZone); - Tcl_UnsetObjRef(data->GMTSetupTZData); - Tcl_UnsetObjRef(data->AnySetupTimeZone); - Tcl_UnsetObjRef(data->AnySetupTZData); - Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone); - Tcl_UnsetObjRef(data->LastSetupTimeZone); - Tcl_UnsetObjRef(data->LastSetupTZData); - - Tcl_UnsetObjRef(data->CurrentLocale); - Tcl_UnsetObjRef(data->CurrentLocaleDict); - Tcl_UnsetObjRef(data->LastUnnormUsedLocale); - Tcl_UnsetObjRef(data->LastUsedLocale); - Tcl_UnsetObjRef(data->LastUsedLocaleDict); - - Tcl_UnsetObjRef(data->lastBase.timezoneObj); - Tcl_UnsetObjRef(data->UTC2Local.timezoneObj); - Tcl_UnsetObjRef(data->UTC2Local.tzName); - Tcl_UnsetObjRef(data->Local2UTC.timezoneObj); -} - -/* - *---------------------------------------------------------------------- - * - * ClockDeleteCmdProc -- - * - * Remove a reference to the clock client data, and clean up memory - * when it's all gone. - * - * Results: - * None. - * - *---------------------------------------------------------------------- - */ -static void -ClockDeleteCmdProc( - ClientData clientData) /* Opaque pointer to the client data */ -{ - ClockClientData *data = clientData; - int i; - - if (data->refCount-- <= 1) { - for (i = 0; i < LIT__END; ++i) { - Tcl_DecrRefCount(data->literals[i]); - } - if (data->mcLiterals != NULL) { - for (i = 0; i < MCLIT__END; ++i) { - Tcl_DecrRefCount(data->mcLiterals[i]); - } - data->mcLiterals = NULL; - } - if (data->mcLitIdxs != NULL) { - for (i = 0; i < MCLIT__END; ++i) { - Tcl_DecrRefCount(data->mcLitIdxs[i]); - } - data->mcLitIdxs = NULL; - } - - ClockConfigureClear(data); - - ckfree(data->literals); - ckfree(data); - } -} - -/* - *---------------------------------------------------------------------- - * - * NormTimezoneObj -- - * - * Normalizes the timezone object (used for caching puposes). - * - * If already cached time zone could be found, returns this - * object (last setup or last used, system (current) or gmt). - * - * Results: - * Normalized tcl object pointer. - * - *---------------------------------------------------------------------- - */ - -static inline Tcl_Obj * -NormTimezoneObj( - ClockClientData *dataPtr, /* Client data containing literal pool */ - Tcl_Obj *timezoneObj) -{ - const char *tz; - if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone - && dataPtr->LastSetupTimeZone != NULL - ) { - return dataPtr->LastSetupTimeZone; - } - if ( timezoneObj == dataPtr->LastSetupTimeZone - || timezoneObj == dataPtr->literals[LIT_GMT] - || timezoneObj == dataPtr->SystemTimeZone - || timezoneObj == dataPtr->AnySetupTimeZone - ) { - return timezoneObj; - } - - tz = TclGetString(timezoneObj); - if (dataPtr->AnySetupTimeZone != NULL && - (timezoneObj == dataPtr->AnySetupTimeZone - || strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0 - ) - ) { - timezoneObj = dataPtr->AnySetupTimeZone; - } - else - if (dataPtr->SystemTimeZone != NULL && - (timezoneObj == dataPtr->SystemTimeZone - || strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0 - ) - ) { - timezoneObj = dataPtr->SystemTimeZone; - } - else - if ( - strcmp(tz, Literals[LIT_GMT]) == 0 - ) { - timezoneObj = dataPtr->literals[LIT_GMT]; - } - return timezoneObj; -} - -/* - *---------------------------------------------------------------------- - * - * ClockGetSystemLocale -- - * - * Returns system locale. - * - * Executes ::tcl::clock::GetSystemLocale in given interpreter. - * - * Results: - * Returns system locale tcl object. - * - *---------------------------------------------------------------------- - */ - -static inline Tcl_Obj * -ClockGetSystemLocale( - ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) { - return NULL; - } - - return Tcl_GetObjResult(interp); -} -/* - *---------------------------------------------------------------------- - * - * ClockGetCurrentLocale -- - * - * Returns current locale. - * - * Executes ::tcl::clock::mclocale in given interpreter. - * - * Results: - * Returns current locale tcl object. - * - *---------------------------------------------------------------------- - */ - -static inline Tcl_Obj * -ClockGetCurrentLocale( - ClockClientData *dataPtr, /* Client data containing literal pool */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) { - return NULL; + data->refCount++; + Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data, + ClockDeleteCmdProc); } - Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp)); - Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict); + /* Make the clock ensemble */ - return dataPtr->CurrentLocale; -} - -/* - *---------------------------------------------------------------------- - * - * NormLocaleObj -- - * - * Normalizes the locale object (used for caching puposes). - * - * If already cached locale could be found, returns this - * object (current, system (OS) or last used locales). - * - * Results: - * Normalized tcl object pointer. - * - *---------------------------------------------------------------------- - */ - -static Tcl_Obj * -NormLocaleObj( - ClockClientData *dataPtr, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *localeObj, - Tcl_Obj **mcDictObj) -{ - const char *loc; - if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale - || localeObj == dataPtr->literals[LIT_C] - || localeObj == dataPtr->literals[LIT_CURRENT] - ) { - if (dataPtr->CurrentLocale == NULL) { - ClockGetCurrentLocale(dataPtr, interp); - } - *mcDictObj = dataPtr->CurrentLocaleDict; - return dataPtr->CurrentLocale; - } - if ( localeObj == dataPtr->LastUsedLocale - || localeObj == dataPtr->LastUnnormUsedLocale - ) { - *mcDictObj = dataPtr->LastUsedLocaleDict; - return dataPtr->LastUsedLocale; - } - - loc = TclGetString(localeObj); - if ( dataPtr->CurrentLocale != NULL - && ( localeObj == dataPtr->CurrentLocale - || (localeObj->length == dataPtr->CurrentLocale->length - && strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0 - ) - ) - ) { - *mcDictObj = dataPtr->CurrentLocaleDict; - localeObj = dataPtr->CurrentLocale; - } - else - if ( dataPtr->LastUsedLocale != NULL - && ( localeObj == dataPtr->LastUsedLocale - || (localeObj->length == dataPtr->LastUsedLocale->length - && strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0 - ) - ) - ) { - *mcDictObj = dataPtr->LastUsedLocaleDict; - Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj); - localeObj = dataPtr->LastUsedLocale; - } - else - if ( - (localeObj->length == 1 /* C */ - && strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0) - || (localeObj->length == 7 /* current */ - && strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0) - ) { - if (dataPtr->CurrentLocale == NULL) { - ClockGetCurrentLocale(dataPtr, interp); - } - *mcDictObj = dataPtr->CurrentLocaleDict; - localeObj = dataPtr->CurrentLocale; - } - else - if ( - (localeObj->length == 6 /* system */ - && strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0) - ) { - Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj); - localeObj = ClockGetSystemLocale(dataPtr, interp); - Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj); - *mcDictObj = NULL; - } - else - { - *mcDictObj = NULL; - } - return localeObj; -} - -/* - *---------------------------------------------------------------------- - * - * ClockMCDict -- - * - * Retrieves a localized storage dictionary object for the given - * locale object. - * - * This corresponds with call `::tcl::clock::mcget locale`. - * Cached representation stored in options (for further access). - * - * Results: - * Tcl-object contains smart reference to msgcat dictionary. - * - *---------------------------------------------------------------------- - */ - -MODULE_SCOPE Tcl_Obj * -ClockMCDict(ClockFmtScnCmdArgs *opts) -{ - ClockClientData *dataPtr = opts->clientData; - - /* if dict not yet retrieved */ - if (opts->mcDictObj == NULL) { - - /* if locale was not yet used */ - if ( !(opts->flags & CLF_LOCALE_USED) ) { - - opts->localeObj = NormLocaleObj(opts->clientData, opts->interp, - opts->localeObj, &opts->mcDictObj); - - if (opts->localeObj == NULL) { - Tcl_SetObjResult(opts->interp, - Tcl_NewStringObj("locale not specified and no default locale set", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL); - return NULL; - } - opts->flags |= CLF_LOCALE_USED; - - /* check locale literals already available (on demand creation) */ - if (dataPtr->mcLiterals == NULL) { - int i; - dataPtr->mcLiterals = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); - for (i = 0; i < MCLIT__END; ++i) { - Tcl_InitObjRef(dataPtr->mcLiterals[i], - Tcl_NewStringObj(MsgCtLiterals[i], -1)); - } - } - } - - if (opts->mcDictObj == NULL) { - Tcl_Obj *callargs[2]; - /* get msgcat dictionary - ::tcl::clock::mcget locale */ - callargs[0] = dataPtr->literals[LIT_MCGET]; - callargs[1] = opts->localeObj; - - if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) { - return NULL; - } - - opts->mcDictObj = Tcl_GetObjResult(opts->interp); - /* be sure that object reference not increases (dict changeable) */ - if (opts->mcDictObj->refCount > 0) { - /* smart reference (shared dict as object with no ref-counter) */ - opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj); - } - if ( opts->localeObj == dataPtr->CurrentLocale ) { - Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj); - } else if ( opts->localeObj == dataPtr->LastUsedLocale ) { - Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj); - } else { - Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj); - Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale); - Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj); - } - Tcl_ResetResult(opts->interp); - } - } - - return opts->mcDictObj; -} - -/* - *---------------------------------------------------------------------- - * - * ClockMCGet -- - * - * Retrieves a msgcat value for the given literal integer mcKey - * from localized storage (corresponding given locale object) - * by mcLiterals[mcKey] (e. g. MONTHS_FULL). - * - * Results: - * Tcl-object contains localized value. - * - *---------------------------------------------------------------------- - */ - -MODULE_SCOPE Tcl_Obj * -ClockMCGet( - ClockFmtScnCmdArgs *opts, - int mcKey) -{ - ClockClientData *dataPtr = opts->clientData; - - Tcl_Obj *valObj = NULL; - - if (opts->mcDictObj == NULL) { - ClockMCDict(opts); - if (opts->mcDictObj == NULL) - return NULL; - } - - Tcl_DictObjGet(opts->interp, opts->mcDictObj, - dataPtr->mcLiterals[mcKey], &valObj); - - return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */ -} - -/* - *---------------------------------------------------------------------- - * - * ClockMCGetIdx -- - * - * Retrieves an indexed msgcat value for the given literal integer mcKey - * from localized storage (corresponding given locale object) - * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). - * - * Results: - * Tcl-object contains localized indexed value. - * - *---------------------------------------------------------------------- - */ - -MODULE_SCOPE Tcl_Obj * -ClockMCGetIdx( - ClockFmtScnCmdArgs *opts, - int mcKey) -{ - ClockClientData *dataPtr = opts->clientData; - - Tcl_Obj *valObj = NULL; - - if (opts->mcDictObj == NULL) { - ClockMCDict(opts); - if (opts->mcDictObj == NULL) - return NULL; - } - - /* try to get indices object */ - if (dataPtr->mcLitIdxs == NULL) { - return NULL; - } - - if (Tcl_DictObjGet(NULL, opts->mcDictObj, - dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK - ) { - return NULL; - } - - return valObj; -} - -/* - *---------------------------------------------------------------------- - * - * ClockMCSetIdx -- - * - * Sets an indexed msgcat value for the given literal integer mcKey - * in localized storage (corresponding given locale object) - * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). - * - * Results: - * Returns a standard Tcl result. - * - *---------------------------------------------------------------------- - */ - -MODULE_SCOPE int -ClockMCSetIdx( - ClockFmtScnCmdArgs *opts, - int mcKey, Tcl_Obj *valObj) -{ - ClockClientData *dataPtr = opts->clientData; - - if (opts->mcDictObj == NULL) { - ClockMCDict(opts); - if (opts->mcDictObj == NULL) - return TCL_ERROR; - } - - /* if literal storage for indices not yet created */ - if (dataPtr->mcLitIdxs == NULL) { - int i; - dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); - for (i = 0; i < MCLIT__END; ++i) { - Tcl_InitObjRef(dataPtr->mcLitIdxs[i], - Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); - } - } - - return Tcl_DictObjPut(opts->interp, opts->mcDictObj, - dataPtr->mcLitIdxs[mcKey], valObj); -} - -/* - *---------------------------------------------------------------------- - * - * ClockConfigureObjCmd -- - * - * This function is invoked to process the Tcl "clock configure" command. - * - * Usage: - * ::tcl::clock::configure ?-option ?value?? - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -ClockConfigureObjCmd( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter vector */ -{ - ClockClientData *dataPtr = clientData; - - static const char *const options[] = { - "-system-tz", "-setup-tz", "-default-locale", - "-clear", - "-year-century", "-century-switch", - NULL - }; - enum optionInd { - CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE, - CLOCK_CLEAR_CACHE, - CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, - CLOCK_SETUP_GMT, CLOCK_SETUP_NOP - }; - int optionIndex; /* Index of an option. */ - int i; - - for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i++], options, - "option", 0, &optionIndex) != TCL_OK) { - Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[i-1]), NULL); - return TCL_ERROR; - } - switch (optionIndex) { - case CLOCK_SYSTEM_TZ: - if (1) { - /* validate current tz-epoch */ - unsigned long lastTZEpoch = TzsetGetEpoch(); - if (i < objc) { - if (dataPtr->SystemTimeZone != objv[i]) { - Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i]); - Tcl_UnsetObjRef(dataPtr->SystemSetupTZData); - } - dataPtr->LastTZEpoch = lastTZEpoch; - } - if (i+1 >= objc && dataPtr->SystemTimeZone != NULL - && dataPtr->LastTZEpoch == lastTZEpoch) { - Tcl_SetObjResult(interp, dataPtr->SystemTimeZone); - } - } - break; - case CLOCK_SETUP_TZ: - if (i < objc) { - /* differentiate GMT and system zones, because used often */ - Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]); - Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]); - if (dataPtr->LastSetupTimeZone != timezoneObj) { - Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->LastSetupTZData); - } - if (timezoneObj == dataPtr->literals[LIT_GMT]) { - optionIndex = CLOCK_SETUP_GMT; - } else if (timezoneObj == dataPtr->SystemTimeZone) { - optionIndex = CLOCK_SETUP_NOP; - } - switch (optionIndex) { - case CLOCK_SETUP_GMT: - if (i < objc) { - if (dataPtr->GMTSetupTimeZone != timezoneObj) { - Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->GMTSetupTZData); - } - } - break; - case CLOCK_SETUP_TZ: - if (i < objc) { - if (dataPtr->AnySetupTimeZone != timezoneObj) { - Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->AnySetupTZData); - } - } - break; - } - } - if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) { - Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone); - } - break; - case CLOCK_CURRENT_LOCALE: - if (i < objc) { - if (dataPtr->CurrentLocale != objv[i]) { - Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]); - Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict); - } - } - if (i+1 >= objc && dataPtr->CurrentLocale != NULL) { - Tcl_SetObjResult(interp, dataPtr->CurrentLocale); - } - break; - case CLOCK_YEAR_CENTURY: - if (i < objc) { - int year; - if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { - return TCL_ERROR; - } - dataPtr->currentYearCentury = year; - if (i+1 >= objc) { - Tcl_SetObjResult(interp, objv[i]); - } - continue; - } - if (i+1 >= objc) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj(dataPtr->currentYearCentury)); - } - break; - case CLOCK_CENTURY_SWITCH: - if (i < objc) { - int year; - if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { - return TCL_ERROR; - } - dataPtr->yearOfCenturySwitch = year; - Tcl_SetObjResult(interp, objv[i]); - continue; - } - if (i+1 >= objc) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj(dataPtr->yearOfCenturySwitch)); - } - break; - case CLOCK_CLEAR_CACHE: - ClockConfigureClear(dataPtr); - break; - } - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * ClockGetTZData -- - * - * Retrieves tzdata table for given normalized timezone. - * - * Results: - * Returns a tcl object with tzdata. - * - * Side effects: - * The tzdata can be cached in ClockClientData structure. - * - *---------------------------------------------------------------------- - */ - -static inline Tcl_Obj * -ClockGetTZData( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *timezoneObj) /* Name of the timezone */ -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; - Tcl_Obj *ret, **out = NULL; - - /* if cached (if already setup this one) */ - if ( dataPtr->LastSetupTZData != NULL - && ( timezoneObj == dataPtr->LastSetupTimeZone - || timezoneObj == dataPtr->LastUnnormSetupTimeZone - ) - ) { - return dataPtr->LastSetupTZData; - } - - /* differentiate GMT and system zones, because used often */ - /* simple caching, because almost used the tz-data of last timezone - */ - if (timezoneObj == dataPtr->SystemTimeZone) { - if (dataPtr->SystemSetupTZData != NULL) { - return dataPtr->SystemSetupTZData; - } - out = &dataPtr->SystemSetupTZData; - } - else - if (timezoneObj == dataPtr->GMTSetupTimeZone) { - if (dataPtr->GMTSetupTZData != NULL) { - return dataPtr->GMTSetupTZData; - } - out = &dataPtr->GMTSetupTZData; - } - else - if (timezoneObj == dataPtr->AnySetupTimeZone) { - if (dataPtr->AnySetupTZData != NULL) { - return dataPtr->AnySetupTZData; - } - out = &dataPtr->AnySetupTZData; - } - - ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA], - timezoneObj, TCL_LEAVE_ERR_MSG); - - /* cache using corresponding slot and as last used */ - if (out != NULL) { - Tcl_SetObjRef(*out, ret); - } - Tcl_SetObjRef(dataPtr->LastSetupTZData, ret); - if (dataPtr->LastSetupTimeZone != timezoneObj) { - Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone); - } - return ret; -} - -/* - *---------------------------------------------------------------------- - * - * ClockGetSystemTimeZone -- - * - * Returns system (current) timezone. - * - * If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone - * in given interpreter and caches its result. - * - * Results: - * Returns normalized timezone object. - * - *---------------------------------------------------------------------- - */ - -static Tcl_Obj * -ClockGetSystemTimeZone( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals; - - /* if known (cached and same epoch) - return now */ - if (dataPtr->SystemTimeZone != NULL - && dataPtr->LastTZEpoch == TzsetGetEpoch()) { - return dataPtr->SystemTimeZone; - } - - Tcl_UnsetObjRef(dataPtr->SystemTimeZone); - Tcl_UnsetObjRef(dataPtr->SystemSetupTZData); - - literals = dataPtr->literals; - - if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { - return NULL; - } - if (dataPtr->SystemTimeZone == NULL) { - Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp)); - } - return dataPtr->SystemTimeZone; -} - -/* - *---------------------------------------------------------------------- - * - * ClockSetupTimeZone -- - * - * Sets up the timezone. Loads tzdata, etc. - * - * Results: - * Returns normalized timezone object. - * - *---------------------------------------------------------------------- - */ - -MODULE_SCOPE Tcl_Obj * -ClockSetupTimeZone( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *timezoneObj) -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; - Tcl_Obj *callargs[2]; - - /* if cached (if already setup this one) */ - if ( dataPtr->LastSetupTimeZone != NULL - && ( timezoneObj == dataPtr->LastSetupTimeZone - || timezoneObj == dataPtr->LastUnnormSetupTimeZone - ) - ) { - return dataPtr->LastSetupTimeZone; - } - - /* differentiate GMT and system zones, because used often and already set */ - timezoneObj = NormTimezoneObj(dataPtr, timezoneObj); - if ( timezoneObj == dataPtr->GMTSetupTimeZone - || timezoneObj == dataPtr->SystemTimeZone - || timezoneObj == dataPtr->AnySetupTimeZone - ) { - return timezoneObj; - } - - callargs[0] = literals[LIT_SETUPTIMEZONE]; - callargs[1] = timezoneObj; - - if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { - return dataPtr->LastSetupTimeZone; - } - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * ClockFormatNumericTimeZone -- - * - * Formats a time zone as +hhmmss - * - * Parameters: - * z - Time zone in seconds east of Greenwich - * - * Results: - * Returns the time zone object (formatted in a numeric form) - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -ClockFormatNumericTimeZone(int z) { - char sign = '+'; - int h, m; - if ( z < 0 ) { - z = -z; - sign = '-'; - } - h = z / 3600; - z %= 3600; - m = z / 60; - z %= 60; - if (z != 0) { - return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z); - } - return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); + TclMakeEnsemble(interp, "clock", clockImplMap); } /* @@ -1148,11 +311,11 @@ ClockFormatNumericTimeZone(int z) { * is available. * * Usage: - * ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover + * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover * * Parameters: * dict - Dictionary containing a 'localSeconds' entry. - * timezone - Time zone + * tzdata - Time zone data * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: @@ -1182,13 +345,12 @@ ClockConvertlocaltoutcObjCmd( int created = 0; int status; - fields.tzName = NULL; /* * Check params and convert time. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); return TCL_ERROR; } dict = objv[1]; @@ -1201,10 +363,10 @@ ClockConvertlocaltoutcObjCmd( "found in dictionary", -1)); return TCL_ERROR; } - if ((TclGetWideIntFromObj(interp, secondsObj, + if ((Tcl_GetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) - || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) { + || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { return TCL_ERROR; } @@ -1238,11 +400,12 @@ ClockConvertlocaltoutcObjCmd( * formatting a date, and populates a dictionary with them. * * Usage: - * ::tcl::clock::GetDateFields seconds timezone changeover + * ::tcl::clock::GetDateFields seconds tzdata changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. - * timezone - Time zone in which time is to be expressed. + * tzdata - Time zone data of the time zone in which time is to be + * expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * @@ -1271,17 +434,15 @@ ClockGetdatefieldsObjCmd( Tcl_Obj *const *literals = data->literals; int changeover; - fields.tzName = NULL; - /* * Check params. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); return TCL_ERROR; } - if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK + if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) { return TCL_ERROR; } @@ -1296,14 +457,28 @@ ClockGetdatefieldsObjCmd( return TCL_ERROR; } - /* Extract fields */ + /* + * Convert UTC time to local. + */ - if (ClockGetDateFields(clientData, interp, &fields, objv[2], - changeover) != TCL_OK) { + if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { return TCL_ERROR; } - /* Make dict of fields */ + /* + * Extract Julian day. + */ + + fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH) + / SECONDS_PER_DAY); + + /* + * Convert to Julian or Gregorian calendar. + */ + + GetGregorianEraYearDay(&fields, changeover); + GetMonthDay(&fields); + GetYearWeekDay(&fields, changeover); dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS], @@ -1342,58 +517,6 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- * - * ClockGetDateFields -- - * - * Converts given UTC time (seconds in a TclDateFields structure) - * to local time and determines the values that clock routines will - * use in scanning or formatting a date. - * - * Results: - * Date-time values are stored in structure "fields". - * Returns a standard Tcl result. - * - *---------------------------------------------------------------------- - */ - -int -ClockGetDateFields( - ClientData clientData, /* Client data of the interpreter */ - Tcl_Interp *interp, /* Tcl interpreter */ - TclDateFields *fields, /* Pointer to result fields, where - * fields->seconds contains date to extract */ - Tcl_Obj *timezoneObj, /* Time zone object or NULL for gmt */ - int changeover) /* Julian Day Number */ -{ - /* - * Convert UTC time to local. - */ - - if (ConvertUTCToLocal(clientData, interp, fields, timezoneObj, - changeover) != TCL_OK) { - return TCL_ERROR; - } - - /* - * Extract Julian day. - */ - - fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH) - / SECONDS_PER_DAY); - - /* - * Convert to Julian or Gregorian calendar. - */ - - GetGregorianEraYearDay(fields, changeover); - GetMonthDay(fields); - GetYearWeekDay(fields, changeover); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * ClockGetjuliandayfromerayearmonthdayObjCmd -- * * Tcl command that converts a time from era-year-month-day to a Julian @@ -1468,8 +591,6 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( int status; int era = 0; - fields.tzName = NULL; - /* * Check params. */ @@ -1554,8 +675,6 @@ ClockGetjuliandayfromerayearweekdayObjCmd( int status; int era = 0; - fields.tzName = NULL; - /* * Check params. */ @@ -1623,70 +742,18 @@ ClockGetjuliandayfromerayearweekdayObjCmd( static int ConvertLocalToUTC( - ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *timezoneObj, /* Time zone */ + Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - ClockClientData *dataPtr = clientData; - Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ - Tcl_WideInt seconds; - - /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ - if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) { - fields->seconds = fields->localSeconds; - fields->tzOffset = 0; - return TCL_OK; - } - - /* - * Check cacheable conversion could be used - * (last-period Local2UTC cache within the same TZ) - */ - seconds = fields->localSeconds - dataPtr->Local2UTC.tzOffset; - if ( timezoneObj == dataPtr->Local2UTC.timezoneObj - && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds - || ( seconds >= dataPtr->Local2UTC.rangesVal[0] - && seconds < dataPtr->Local2UTC.rangesVal[1]) - ) - && changeover == dataPtr->Local2UTC.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - fields->tzOffset = dataPtr->Local2UTC.tzOffset; - fields->seconds = seconds; - return TCL_OK; - } - - /* - * Check cacheable back-conversion could be used - * (last-period UTC2Local cache within the same TZ) - */ - seconds = fields->localSeconds - dataPtr->UTC2Local.tzOffset; - if ( timezoneObj == dataPtr->UTC2Local.timezoneObj - && ( seconds == dataPtr->UTC2Local.seconds - || ( seconds >= dataPtr->UTC2Local.rangesVal[0] - && seconds < dataPtr->UTC2Local.rangesVal[1]) - ) - && changeover == dataPtr->UTC2Local.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - fields->tzOffset = dataPtr->UTC2Local.tzOffset; - fields->seconds = seconds; - return TCL_OK; - } /* * Unpack the tz data. */ - tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if (tzdata == NULL) { - return TCL_ERROR; - } - if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -1697,26 +764,10 @@ ConvertLocalToUTC( */ if (rowc == 0) { - dataPtr->Local2UTC.rangesVal[0] = 0; - dataPtr->Local2UTC.rangesVal[1] = 0; - - if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { - return TCL_ERROR; - }; + return ConvertLocalToUTCUsingC(interp, fields, changeover); } else { - if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, - dataPtr->Local2UTC.rangesVal) != TCL_OK) { - return TCL_ERROR; - }; + return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); } - - /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->Local2UTC.timezoneObj, timezoneObj); - dataPtr->Local2UTC.localSeconds = fields->localSeconds; - dataPtr->Local2UTC.changeover = changeover; - dataPtr->Local2UTC.tzOffset = fields->tzOffset; - - return TCL_OK; } /* @@ -1742,8 +793,7 @@ ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ int rowc, /* Number of points at which time changes */ - Tcl_Obj *const rowv[], /* Points at which time changes */ - Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ + Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; int cellc; @@ -1767,8 +817,7 @@ ConvertLocalToUTCUsingTable( fields->tzOffset = 0; fields->seconds = fields->localSeconds; while (!found) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv, - rangesVal); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if ((row == NULL) || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK @@ -1793,41 +842,6 @@ ConvertLocalToUTCUsingTable( } fields->tzOffset = have[i]; fields->seconds = fields->localSeconds - fields->tzOffset; - -#if 0 - /* currently unused, test purposes only */ - /* - * Convert back from UTC, if local times are different - wrong local time - * (local time seems to be in between DST-hole). - */ - if (fields->tzOffset) { - - int corrOffset; - Tcl_WideInt backCompVal; - /* check DST-hole interval contains UTC time */ - TclGetWideIntFromObj(NULL, cellv[0], &backCompVal); - if ( fields->seconds >= backCompVal - fields->tzOffset - && fields->seconds <= backCompVal + fields->tzOffset - ) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); - if (row == NULL || - TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || - TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) { - return TCL_ERROR; - } - if (fields->localSeconds != fields->seconds + corrOffset) { - Tcl_Panic("wrong local time %ld by LocalToUTC conversion," - " local time seems to be in between DST-hole", - fields->localSeconds); - /* correcting offset * / - fields->tzOffset -= corrOffset; - fields->seconds += fields->tzOffset; - */ - } - } - } -#endif - return TCL_OK; } @@ -1929,61 +943,20 @@ ConvertLocalToUTCUsingC( *---------------------------------------------------------------------- */ -MODULE_SCOPE int +static int ConvertUTCToLocal( - ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *timezoneObj, /* Time zone */ + Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - ClockClientData *dataPtr = clientData; - Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ - /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ - if (timezoneObj == dataPtr->GMTSetupTimeZone - && dataPtr->GMTSetupTimeZone != NULL - && dataPtr->GMTSetupTZData != NULL - ) { - fields->localSeconds = fields->seconds; - fields->tzOffset = 0; - if ( TclListObjGetElements(interp, dataPtr->GMTSetupTZData, &rowc, &rowv) != TCL_OK - || Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) { - return TCL_ERROR; - } - Tcl_IncrRefCount(fields->tzName); - return TCL_OK; - } - - /* - * Check cacheable conversion could be used - * (last-period UTC2Local cache within the same TZ) - */ - if ( timezoneObj == dataPtr->UTC2Local.timezoneObj - && ( fields->seconds == dataPtr->UTC2Local.seconds - || ( fields->seconds >= dataPtr->UTC2Local.rangesVal[0] - && fields->seconds < dataPtr->UTC2Local.rangesVal[1]) - ) - && changeover == dataPtr->UTC2Local.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - Tcl_SetObjRef(fields->tzName, dataPtr->UTC2Local.tzName); - fields->tzOffset = dataPtr->UTC2Local.tzOffset; - fields->localSeconds = fields->seconds + fields->tzOffset; - return TCL_OK; - } - /* * Unpack the tz data. */ - tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if (tzdata == NULL) { - return TCL_ERROR; - } - if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -1994,26 +967,10 @@ ConvertUTCToLocal( */ if (rowc == 0) { - dataPtr->UTC2Local.rangesVal[0] = 0; - dataPtr->UTC2Local.rangesVal[1] = 0; - - if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { - return TCL_ERROR; - } + return ConvertUTCToLocalUsingC(interp, fields, changeover); } else { - if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, - dataPtr->UTC2Local.rangesVal) != TCL_OK) { - return TCL_ERROR; - } + return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); } - - /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->UTC2Local.timezoneObj, timezoneObj); - dataPtr->UTC2Local.seconds = fields->seconds; - dataPtr->UTC2Local.changeover = changeover; - dataPtr->UTC2Local.tzOffset = fields->tzOffset; - Tcl_SetObjRef(dataPtr->UTC2Local.tzName, fields->tzName); - return TCL_OK; } /* @@ -2040,8 +997,7 @@ ConvertUTCToLocalUsingTable( TclDateFields *fields, /* Fields of the date */ int rowc, /* Number of rows in the conversion table * (>= 1) */ - Tcl_Obj *const rowv[], /* Rows of the conversion table */ - Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ + Tcl_Obj *const rowv[]) /* Rows of the conversion table */ { Tcl_Obj *row; /* Row containing the current information */ int cellc; /* Count of cells in the row (must be 4) */ @@ -2051,7 +1007,7 @@ ConvertUTCToLocalUsingTable( * Look up the nearest transition time. */ - row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if (row == NULL || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -2062,7 +1018,8 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - Tcl_SetObjRef(fields->tzName, cellv[3]); + fields->tzName = cellv[3]; + Tcl_IncrRefCount(fields->tzName); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -2155,7 +1112,8 @@ ConvertUTCToLocalUsingC( if (diff > 0) { sprintf(buffer+5, "%02d", diff); } - Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); + fields->tzName = Tcl_NewStringObj(buffer, -1); + Tcl_IncrRefCount(fields->tzName); return TCL_OK; } @@ -2173,25 +1131,24 @@ ConvertUTCToLocalUsingC( *---------------------------------------------------------------------- */ -MODULE_SCOPE Tcl_Obj * +static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ int rowc, /* Number of rows of tzdata */ - Tcl_Obj *const *rowv, /* Rows in tzdata */ - Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ + Tcl_Obj *const *rowv) /* Rows in tzdata */ { - int l = 0; + int l; int u; Tcl_Obj *compObj; - Tcl_WideInt compVal, fromVal = tick, toVal = tick; + Tcl_WideInt compVal; /* * Examine the first row to make sure we're in bounds. */ if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK - || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } @@ -2201,36 +1158,28 @@ LookupLastTransition( */ if (tick < compVal) { - goto done; + return rowv[0]; } /* * Binary-search to find the transition. */ + l = 0; u = rowc-1; while (l < u) { int m = (l + u + 1) / 2; if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK || - TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } if (tick >= compVal) { l = m; - fromVal = compVal; } else { u = m-1; - toVal = compVal; } } - -done: - - if (rangesVal) { - rangesVal[0] = fromVal; - rangesVal[1] = toVal; - } return rowv[l]; } @@ -2261,8 +1210,6 @@ GetYearWeekDay( TclDateFields temp; int dayOfFiscalYear; - temp.tzName = NULL; - /* * Find the given date, minus three days, plus one year. That date's * iso8601 year is an upper bound on the ISO8601 year of the given date. @@ -2469,7 +1416,7 @@ GetMonthDay( *---------------------------------------------------------------------- */ -MODULE_SCOPE void +static void GetJulianDayFromEraYearWeekDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Julian Day Number of the Gregorian @@ -2479,8 +1426,6 @@ GetJulianDayFromEraYearWeekDay( * given year */ TclDateFields firstWeek; - firstWeek.tzName = NULL; - /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ @@ -2522,7 +1467,7 @@ GetJulianDayFromEraYearWeekDay( *---------------------------------------------------------------------- */ -MODULE_SCOPE void +static void GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ @@ -2576,9 +1521,9 @@ GetJulianDayFromEraYearMonthDay( * See above bug for details. The casts are necessary. */ if (ym1 >= 0) - ym1o4 = ym1 / 4; + ym1o4 = ym1 / 4; else { - ym1o4 = - (int) (((unsigned int) -ym1) / 4); + ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif if (ym1 % 4 < 0) { @@ -2618,61 +1563,6 @@ GetJulianDayFromEraYearMonthDay( /* *---------------------------------------------------------------------- * - * GetJulianDayFromEraYearDay -- - * - * Given era, year, and dayOfYear (in TclDateFields), and the - * Gregorian transition date, computes the Julian Day Number. - * - * Results: - * None. - * - * Side effects: - * Stores day number in 'julianDay' - * - *---------------------------------------------------------------------- - */ - - -MODULE_SCOPE void -GetJulianDayFromEraYearDay( - TclDateFields *fields, /* Date to convert */ - int changeover) /* Gregorian transition date as a Julian Day */ -{ - int year, ym1; - - /* Get absolute year number from the civil year */ - if (fields->era == BCE) { - year = 1 - fields->year; - } else { - year = fields->year; - } - - ym1 = year - 1; - - /* Try the Gregorian calendar first. */ - fields->gregorian = 1; - fields->julianDay = - 1721425 - + fields->dayOfYear - + ( 365 * ym1 ) - + ( ym1 / 4 ) - - ( ym1 / 100 ) - + ( ym1 / 400 ); - - /* If the date is before the Gregorian change, use the Julian calendar. */ - - if ( fields->julianDay < changeover ) { - fields->gregorian = 0; - fields->julianDay = - 1721423 - + fields->dayOfYear - + ( 365 * ym1 ) - + ( ym1 / 4 ); - } -} -/* - *---------------------------------------------------------------------- - * * IsGregorianLeapYear -- * * Tests whether a given year is a leap year, in either Julian or @@ -2684,14 +1574,16 @@ GetJulianDayFromEraYearDay( *---------------------------------------------------------------------- */ -MODULE_SCOPE int +static int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { - int year = fields->year; + int year; if (fields->era == BCE) { - year = 1 - year; + year = 1 - fields->year; + } else { + year = fields->year; } if (year%4 != 0) { return 0; @@ -2865,7 +1757,7 @@ ClockClicksObjCmd( } break; default: - Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?"); + Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); return TCL_ERROR; } @@ -2882,7 +1774,8 @@ ClockClicksObjCmd( #endif break; case CLICKS_MICROS: - clicks = TclpGetMicroseconds(); + Tcl_GetTime(&now); + clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec; break; } @@ -2918,7 +1811,7 @@ ClockMillisecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds"); + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); @@ -2952,1043 +1845,134 @@ ClockMicrosecondsObjCmd( int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { + Tcl_Time now; + if (objc != 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds"); + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( + ((Tcl_WideInt) now.sec * 1000000) + now.usec)); return TCL_OK; } -static inline void -ClockInitFmtScnArgs( - ClientData clientData, - Tcl_Interp *interp, - ClockFmtScnCmdArgs *opts) -{ - memset(opts, 0, sizeof(*opts)); - opts->clientData = clientData; - opts->interp = interp; -} - /* *----------------------------------------------------------------------------- * - * ClockParseFmtScnArgs -- + * ClockParseformatargsObjCmd -- * - * Parses the arguments for [clock scan] and [clock format]. + * Parses the arguments for [clock format]. * * Results: - * Returns a standard Tcl result, and stores parsed options - * (format, the locale, timezone and base) in structure "opts". + * Returns a standard Tcl result, whose value is a four-element list + * comprising the time format, the locale, and the timezone. + * + * This function exists because the loop that parses the [clock format] + * options is a known performance "hot spot", and is implemented in an effort + * to speed that particular code up. * *----------------------------------------------------------------------------- */ -#define CLC_FMT_ARGS (0) -#define CLC_SCN_ARGS (1 << 0) -#define CLC_ADD_ARGS (1 << 1) - static int -ClockParseFmtScnArgs( - register - ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ - TclDateFields *date, /* Extracted date-time corresponding base - * (by scan or add) resp. clockval (by format) */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[], /* Parameter vector */ - int flags /* Flags, differentiates between format, scan, add */ -) { - Tcl_Interp *interp = opts->interp; - ClockClientData *dataPtr = opts->clientData; +ClockParseformatargsObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter vector */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **litPtr = dataPtr->literals; + Tcl_Obj *results[3]; /* Format, locale and timezone */ +#define formatObj results[0] +#define localeObj results[1] +#define timezoneObj results[2] int gmtFlag = 0; - static const char *const options[] = { + static const char *const options[] = { /* Command line options expected */ "-format", "-gmt", "-locale", - "-timezone", "-base", NULL - }; + "-timezone", NULL }; enum optionInd { - CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE, - CLC_ARGS_TIMEZONE, CLC_ARGS_BASE + CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, + CLOCK_FORMAT_TIMEZONE }; int optionIndex; /* Index of an option. */ int saw = 0; /* Flag == 1 if option was seen already. */ + Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int i; - Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ - /* clock value (as current base) */ - if ( !(flags & (CLC_SCN_ARGS)) ) { - opts->baseObj = objv[1]; - saw |= (1 << CLC_ARGS_BASE); + /* + * Args consist of a time followed by keyword-value pairs. + */ + + if (objc < 2 || (objc % 2) != 0) { + Tcl_WrongNumArgs(interp, 0, objv, + "clock format clockval ?-format string? " + "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; } /* * Extract values for the keywords. */ + formatObj = litPtr[LIT__DEFAULT_FORMAT]; + localeObj = litPtr[LIT_C]; + timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { - /* bypass integers (offsets) by "clock add" */ - if (flags & CLC_ADD_ARGS) { - Tcl_WideInt num; - if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) { - continue; - } - } - /* get option */ - if (Tcl_GetIndexFromObj(interp, objv[i], options, - "option", 0, &optionIndex) != TCL_OK) { - goto badOption; - } - /* if already specified */ - if (saw & (1 << optionIndex)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": doubly present", - TclGetString(objv[i])) - ); - goto badOption; + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[i]), NULL); + return TCL_ERROR; } switch (optionIndex) { - case CLC_ARGS_FORMAT: - if (flags & CLC_ADD_ARGS) { - goto badOptionMsg; - } - opts->formatObj = objv[i+1]; + case CLOCK_FORMAT_FORMAT: + formatObj = objv[i+1]; break; - case CLC_ARGS_GMT: + case CLOCK_FORMAT_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ return TCL_ERROR; } break; - case CLC_ARGS_LOCALE: - opts->localeObj = objv[i+1]; - break; - case CLC_ARGS_TIMEZONE: - opts->timezoneObj = objv[i+1]; + case CLOCK_FORMAT_LOCALE: + localeObj = objv[i+1]; break; - case CLC_ARGS_BASE: - if ( !(flags & (CLC_SCN_ARGS)) ) { - goto badOptionMsg; - } - opts->baseObj = objv[i+1]; + case CLOCK_FORMAT_TIMEZONE: + timezoneObj = objv[i+1]; break; } - saw |= (1 << optionIndex); + saw |= 1 << optionIndex; } /* * Check options. */ - if ((saw & (1 << CLC_ARGS_GMT)) - && (saw & (1 << CLC_ARGS_TIMEZONE))) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); - return TCL_ERROR; - } - if (gmtFlag) { - opts->timezoneObj = dataPtr->literals[LIT_GMT]; - } - - /* If time zone not specified use system time zone */ - - if ( opts->timezoneObj == NULL - || TclGetString(opts->timezoneObj) == NULL - || opts->timezoneObj->length == 0 - ) { - opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp); - if (opts->timezoneObj == NULL) { - return TCL_ERROR; - } - } - - /* Setup timezone (normalize object if needed and load TZ on demand) */ - - opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj); - if (opts->timezoneObj == NULL) { - return TCL_ERROR; - } - - /* Base (by scan or add) or clock value (by format) */ - - if (opts->baseObj != NULL) { - register Tcl_Obj *baseObj = opts->baseObj; - /* bypass integer recognition if looks like option "-now" */ - if ( - (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') || - TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK - ) { - - /* we accept "-now" as current date-time */ - static const char *const nowOpts[] = { - "-now", NULL - }; - int idx; - if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now", - TCL_EXACT, &idx) == TCL_OK - ) { - goto baseNow; - } - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - Tcl_GetString(baseObj))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); - i = 1; - goto badOption; - } - /* - * seconds could be an unsigned number that overflowed. Make sure - * that it isn't. - */ - - if (baseObj->typePtr == &tclBignumType) { - Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); - return TCL_ERROR; - } - - } else { - -baseNow: - { - Tcl_Time now; - Tcl_GetTime(&now); - baseVal = (Tcl_WideInt) now.sec; - } - } - - /* - * Extract year, month and day from the base time for the parser to use as - * defaults - */ - - /* check base fields already cached (by TZ, last-second cache) */ - if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj - && dataPtr->lastBase.Date.seconds == baseVal) { - memcpy(date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); - } else { - /* extact fields from base */ - date->seconds = baseVal; - if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ - return TCL_ERROR; - } - /* cache last base */ - memcpy(&dataPtr->lastBase.Date, date, ClockCacheableDateFieldsSize); - Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); - } - - return TCL_OK; - -badOptionMsg: - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": unexpected for command \"%s\"", - TclGetString(objv[i]), TclGetString(objv[0])) - ); - -badOption: - - Tcl_SetErrorCode(interp, "CLOCK", "badOption", - i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); - - return TCL_ERROR; -} - -/*---------------------------------------------------------------------- - * - * ClockFormatObjCmd -- , clock format -- - * - * This function is invoked to process the Tcl "clock format" command. - * - * Formats a count of seconds since the Posix Epoch as a time of day. - * - * The 'clock format' command formats times of day for output. Refer - * to the user documentation to see what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -ClockFormatObjCmd( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter values */ -{ - ClockClientData *dataPtr = clientData; - - int ret; - ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - DateFormat dateFmt; /* Common structure used for formatting */ - - /* even number of arguments */ - if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock format clockval|-now " - "?-format string? " - "?-gmt boolean? " - "?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { return TCL_ERROR; } - - memset(&dateFmt, 0, sizeof(dateFmt)); - - /* - * Extract values for the keywords. - */ - - ClockInitFmtScnArgs(clientData, interp, &opts); - ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv, - CLC_FMT_ARGS); - if (ret != TCL_OK) { - goto done; - } - - /* Default format */ - if (opts.formatObj == NULL) { - opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT]; - } - - /* Use compiled version of Format - */ - - ret = ClockFormat(&dateFmt, &opts); - -done: - - Tcl_UnsetObjRef(dateFmt.date.tzName); - - if (ret != TCL_OK) { - return ret; - } - - return TCL_OK; -} - -/*---------------------------------------------------------------------- - * - * ClockScanObjCmd -- , clock scan -- - * - * This function is invoked to process the Tcl "clock scan" command. - * - * Inputs a count of seconds since the Posix Epoch as a time of day. - * - * The 'clock scan' command scans times of day on input. Refer to the - * user documentation to see what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -ClockScanObjCmd( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter values */ -{ - int ret; - ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - DateInfo yy; /* Common structure used for parsing */ - DateInfo *info = &yy; - - /* even number of arguments */ - if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock scan string " - "?-base seconds? " - "?-format string? " - "?-gmt boolean? " - "?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + if ((saw & (1 << CLOCK_FORMAT_GMT)) + && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { + Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } - - ClockInitDateInfo(&yy); - - /* - * Extract values for the keywords. - */ - - ClockInitFmtScnArgs(clientData, interp, &opts); - ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, - CLC_SCN_ARGS); - if (ret != TCL_OK) { - goto done; - } - - /* seconds are in localSeconds (relative base date), so reset time here */ - yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; - - /* If free scan */ - if (opts.formatObj == NULL) { - /* Use compiled version of FreeScan - */ - - /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ - if (opts.localeObj != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); - return TCL_ERROR; - } - ret = ClockFreeScan(&yy, objv[1], &opts); - } - else { - /* Use compiled version of Scan - */ - - ret = ClockScan(&yy, objv[1], &opts); - } - - /* Convert date info structure into UTC seconds */ - - if (ret == TCL_OK) { - ret = ClockScanCommit(clientData, &yy, &opts); - } - -done: - - Tcl_UnsetObjRef(yy.date.tzName); - - if (ret != TCL_OK) { - return ret; - } - - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); - return TCL_OK; -} - -/*---------------------------------------------------------------------- - * - * ClockScanCommit -- - * - * Converts date info structure into UTC seconds. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -ClockScanCommit( - ClientData clientData, /* Client data containing literal pool */ - register DateInfo *info, /* Clock scan info structure */ - register - ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */ -{ - /* If needed assemble julianDay using year, month, etc. */ - if (info->flags & CLF_ASSEMBLE_JULIANDAY) { - if ((info->flags & CLF_ISO8601)) { - GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - } - else - if (!(info->flags & CLF_DAYOFYEAR)) { - GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); - } else { - GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); - } - } - - /* some overflow checks, if not extended */ - if (!(opts->flags & CLF_EXTENDED)) { - if (yydate.julianDay > 5373484) { - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "requested date too large to represent", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); - return TCL_ERROR; - } - } - - /* Local seconds to UTC (stored in yydate.seconds) */ - - if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY)) { - yydate.localSeconds = - -210866803200L - + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) - + ( yySeconds % SECONDS_PER_DAY ); - } - - if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) { - if (ConvertLocalToUTC(clientData, opts->interp, &yydate, opts->timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { - return TCL_ERROR; - } - } - - /* Increment UTC seconds with relative time */ - - yydate.seconds += yyRelSeconds; - - return TCL_OK; -} - -/*---------------------------------------------------------------------- - * - * ClockFreeScan -- - * - * Used by ClockScanObjCmd for free scanning without format. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -ClockFreeScan( - register - DateInfo *info, /* Date fields used for parsing & converting - * simultaneously a yy-parse structure of the - * TclClockFreeScan */ - Tcl_Obj *strObj, /* String containing the time to scan */ - ClockFmtScnCmdArgs *opts) /* Command options */ -{ - Tcl_Interp *interp = opts->interp; - ClockClientData *dataPtr = opts->clientData; - - int ret = TCL_ERROR; - - /* - * Parse the date. The parser will fill a structure "info" with date, - * time, time zone, relative month/day/seconds, relative weekday, ordinal - * month. - * Notice that many yy-defines point to values in the "info" or "date" - * structure, e. g. yySeconds -> info->date.secondOfDay or - * yySeconds -> info->date.month (same as yydate.month) - */ - yyInput = Tcl_GetString(strObj); - - if (TclClockFreeScan(interp, info) != TCL_OK) { - Tcl_Obj *msg = Tcl_NewObj(); - Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s", - Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp))); - Tcl_SetObjResult(interp, msg); - goto done; - } - - /* - * If the caller supplied a date in the string, update the date with - * the value. If the caller didn't specify a time with the date, default to - * midnight. - */ - - if (yyHaveDate) { - if (yyYear < 100) { - if (yyYear >= dataPtr->yearOfCenturySwitch) { - yyYear -= 100; - } - yyYear += dataPtr->currentYearCentury; - } - yydate.era = CE; - if (yyHaveTime == 0) { - yyHaveTime = -1; - } - info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; - } - - /* - * If the caller supplied a time zone in the string, make it into a time - * zone indicator of +-hhmm and setup this time zone. - */ - - if (yyHaveZone) { - Tcl_Obj *tzObjStor = NULL; - int minEast = -yyTimezone; - int dstFlag = 1 - yyDSTmode; - tzObjStor = ClockFormatNumericTimeZone( - 60 * minEast + 3600 * dstFlag); - Tcl_IncrRefCount(tzObjStor); - - opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor); - - Tcl_DecrRefCount(tzObjStor); - if (opts->timezoneObj == NULL) { - goto done; - } - - // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); - - info->flags |= CLF_ASSEMBLE_SECONDS; - } - - /* - * Assemble date, time, zone into seconds-from-epoch - */ - - if (yyHaveTime == -1) { - yySeconds = 0; - info->flags |= CLF_ASSEMBLE_SECONDS; - } - else - if (yyHaveTime) { - yySeconds = ToSeconds(yyHour, yyMinutes, - yySeconds, yyMeridian); - info->flags |= CLF_ASSEMBLE_SECONDS; - } - else - if ( (yyHaveDay && !yyHaveDate) - || yyHaveOrdinalMonth - || ( yyHaveRel - && ( yyRelMonth != 0 - || yyRelDay != 0 ) ) - ) { - yySeconds = 0; - info->flags |= CLF_ASSEMBLE_SECONDS; - } - else { - yySeconds = yydate.localSeconds % SECONDS_PER_DAY; - } - - /* - * Do relative times - */ - - ret = ClockCalcRelTime(info, opts); - - /* Free scanning completed - date ready */ - -done: - - return ret; -} - -/*---------------------------------------------------------------------- - * - * ClockCalcRelTime -- - * - * Used for calculating of relative times. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -int -ClockCalcRelTime( - register - DateInfo *info, /* Date fields used for converting */ - ClockFmtScnCmdArgs *opts) /* Command options */ -{ - /* - * Because some calculations require in-between conversion of the - * julian day, we can repeat this processing multiple times - */ -repeat_rel: - - if (yyHaveRel) { - - /* - * Relative conversion normally possible in UTC time only, because - * of possible wrong local time increment if ignores in-between DST-hole. - * (see test-cases clock-34.53, clock-34.54). - * So increment date in julianDay, but time inside day in UTC (seconds). - */ - - /* add months (or years in months) */ - - if (yyRelMonth != 0) { - int m, h; - - /* if needed extract year, month, etc. again */ - if (info->flags & CLF_ASSEMBLE_DATE) { - GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); - GetMonthDay(&yydate); - GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_ASSEMBLE_DATE; - } - - /* add the requisite number of months */ - yyMonth += yyRelMonth - 1; - yyYear += yyMonth / 12; - m = yyMonth % 12; - yyMonth = m + 1; - - /* if the day doesn't exist in the current month, repair it */ - h = hath[IsGregorianLeapYear(&yydate)][m]; - if (yyDay > h) { - yyDay = h; - } - - /* on demand (lazy) assemble julianDay using new year, month, etc. */ - info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; - - yyRelMonth = 0; - } - - /* add days (or other parts aligned to days) */ - if (yyRelDay) { - - /* assemble julianDay using new year, month, etc. */ - if (info->flags & CLF_ASSEMBLE_JULIANDAY) { - GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_ASSEMBLE_JULIANDAY; - } - yydate.julianDay += yyRelDay; - - /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ - info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; - - yyRelDay = 0; - } - - /* relative time (seconds), if exceeds current date, do the day conversion and - * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */ - if (yyRelSeconds) { - int newSecs = yySeconds + yyRelSeconds; - - /* if seconds increment outside of current date, increment day */ - if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) { - - yyRelDay += newSecs / SECONDS_PER_DAY; - yySeconds = 0; - yyRelSeconds = newSecs % SECONDS_PER_DAY; - - goto repeat_rel; - } - } - - yyHaveRel = 0; - } - - /* - * Do relative (ordinal) month - */ - - if (yyHaveOrdinalMonth) { - int monthDiff; - - /* if needed extract year, month, etc. again */ - if (info->flags & CLF_ASSEMBLE_DATE) { - GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); - GetMonthDay(&yydate); - GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_ASSEMBLE_DATE; - } - - if (yyMonthOrdinalIncr > 0) { - monthDiff = yyMonthOrdinal - yyMonth; - if (monthDiff <= 0) { - monthDiff += 12; - } - yyMonthOrdinalIncr--; - } else { - monthDiff = yyMonth - yyMonthOrdinal; - if (monthDiff >= 0) { - monthDiff -= 12; - } - yyMonthOrdinalIncr++; - } - - /* process it further via relative times */ - yyHaveRel++; - yyYear += yyMonthOrdinalIncr; - yyRelMonth += monthDiff; - yyHaveOrdinalMonth = 0; - - info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; - - goto repeat_rel; + if (gmtFlag) { + timezoneObj = litPtr[LIT_GMT]; } /* - * Do relative weekday + * Return options as a list. */ - if (yyHaveDay && !yyHaveDate) { - - /* if needed assemble julianDay now */ - if (info->flags & CLF_ASSEMBLE_JULIANDAY) { - GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_ASSEMBLE_JULIANDAY; - } - - yydate.era = CE; - yydate.julianDay = WeekdayOnOrBefore(yyDayNumber, yydate.julianDay + 6) - + 7 * yyDayOrdinal; - if (yyDayOrdinal > 0) { - yydate.julianDay -= 7; - } - info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; - } - + Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); return TCL_OK; -} - -/*---------------------------------------------------------------------- - * - * ClockWeekdaysOffs -- - * - * Get offset in days for the number of week days corresponding the - * given day of week (skipping Saturdays and Sundays). - * - * - * Results: - * Returns a day increment adjusted the given weekdays - * - *---------------------------------------------------------------------- - */ - -static inline int -ClockWeekdaysOffs( - register int dayOfWeek, - register int offs) -{ - register int weeks, resDayOfWeek; - - /* offset in days */ - weeks = offs / 5; - offs = offs % 5; - /* compiler fix for negative offs - wrap (0, -1) -> (-1, 4) */ - if (offs < 0) { - weeks--; - offs = 5 + offs; - } - offs += 7 * weeks; - - /* resulting day of week */ - { - register int day = (offs % 7); - /* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */ - if (day < 0) { - day = 7 + day; - } - resDayOfWeek = dayOfWeek + day; - } - - /* adjust if we start from a weekend */ - if (dayOfWeek > 5) { - int adj = 5 - dayOfWeek; - offs += adj; - resDayOfWeek += adj; - } - - /* adjust if we end up on a weekend */ - if (resDayOfWeek > 5) { - offs += 2; - } - - return offs; -} - - - -/*---------------------------------------------------------------------- - * - * ClockAddObjCmd -- , clock add -- - * - * Adds an offset to a given time. - * - * Refer to the user documentation to see what it exactly does. - * - * Syntax: - * clock add clockval ?count unit?... ?-option value? - * - * Parameters: - * clockval -- Starting time value - * count -- Amount of a unit of time to add - * unit -- Unit of time to add, must be one of: - * years year months month weeks week - * days day hours hour minutes minute - * seconds second - * - * Options: - * -gmt BOOLEAN - * Flag synonymous with '-timezone :GMT' - * -timezone ZONE - * Name of the time zone in which calculations are to be done. - * -locale NAME - * Name of the locale in which calculations are to be done. - * Used to determine the Gregorian change date. - * - * Results: - * Returns a standard Tcl result with the given time adjusted - * by the given offset(s) in order. - * - * Notes: - * It is possible that adding a number of months or years will adjust the - * day of the month as well. For instance, the time at one month after - * 31 January is either 28 or 29 February, because February has fewer - * than 31 days. - * - *---------------------------------------------------------------------- - */ - -int -ClockAddObjCmd( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter values */ -{ - ClockClientData *dataPtr = clientData; - int ret; - ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - DateInfo yy; /* Common structure used for parsing */ - DateInfo *info = &yy; - - /* add "week" to units also (because otherwise ambiguous) */ - static const char *const units[] = { - "years", "months", "week", "weeks", - "days", "weekdays", - "hours", "minutes", "seconds", - NULL - }; - enum unitInd { - CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, - CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, - CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS - }; - int unitIndex; /* Index of an option. */ - int i; - Tcl_WideInt offs; - - /* even number of arguments */ - if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock add clockval|-now ?number units?..." - "?-gmt boolean? " - "?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); - return TCL_ERROR; - } - - ClockInitDateInfo(&yy); - - /* - * Extract values for the keywords. - */ - - ClockInitFmtScnArgs(clientData, interp, &opts); - ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, - CLC_ADD_ARGS); - if (ret != TCL_OK) { - goto done; - } - - /* time together as seconds of the day */ - yySeconds = yydate.localSeconds % SECONDS_PER_DAY; - /* seconds are in localSeconds (relative base date), so reset time here */ - yyHour = 0; yyMinutes = 0; yyMeridian = MER24; - - ret = TCL_ERROR; - - /* - * Find each offset and process date increment - */ - - for (i = 2; i < objc; i+=2) { - /* bypass not integers (options, allready processed above) */ - if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) { - continue; - } - if (objv[i]->typePtr == &tclBignumType) { - Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); - goto done; - } - /* get unit */ - if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, - &unitIndex) != TCL_OK) { - goto done; - } - - /* nothing to do if zero quantity */ - if (!offs) { - continue; - } - - /* if in-between conversion needed (already have relative date/time), - * correct date info, because the date may be changed, - * so refresh it now */ - - if ( yyHaveRel - && ( unitIndex == CLC_ADD_WEEKDAYS - /* some months can be shorter as another */ - || yyRelMonth || yyRelDay - /* day changed */ - || yySeconds + yyRelSeconds > SECONDS_PER_DAY - || yySeconds + yyRelSeconds < 0 - ) - ) { - if (ClockCalcRelTime(info, &opts) != TCL_OK) { - goto done; - } - } - - /* process increment by offset + unit */ - yyHaveRel++; - switch (unitIndex) { - case CLC_ADD_YEARS: - yyRelMonth += offs * 12; - break; - case CLC_ADD_MONTHS: - yyRelMonth += offs; - break; - case CLC_ADD_WEEK: - case CLC_ADD_WEEKS: - yyRelDay += offs * 7; - break; - case CLC_ADD_DAYS: - yyRelDay += offs; - break; - case CLC_ADD_WEEKDAYS: - /* add number of week days (skipping Saturdays and Sundays) - * to a relative days value. */ - offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs); - yyRelDay += offs; - break; - case CLC_ADD_HOURS: - yyRelSeconds += offs * 60 * 60; - break; - case CLC_ADD_MINUTES: - yyRelSeconds += offs * 60; - break; - case CLC_ADD_SECONDS: - yyRelSeconds += offs; - break; - } - } - - /* - * Do relative times (if not yet already processed interim): - */ - - if (yyHaveRel) { - if (ClockCalcRelTime(info, &opts) != TCL_OK) { - goto done; - } - } - - /* Convert date info structure into UTC seconds */ - - ret = ClockScanCommit(clientData, &yy, &opts); - -done: - - Tcl_UnsetObjRef(yy.date.tzName); - - if (ret != TCL_OK) { - return ret; - } - - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); - return TCL_OK; +#undef timezoneObj +#undef localeObj +#undef formatObj } /*---------------------------------------------------------------------- @@ -4019,7 +2003,7 @@ ClockSecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds"); + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); @@ -4030,7 +2014,7 @@ ClockSecondsObjCmd( /* *---------------------------------------------------------------------- * - * TzsetGetEpoch --, TzsetIfNecessary -- + * TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ * environment variable has changed. @@ -4044,37 +2028,15 @@ ClockSecondsObjCmd( *---------------------------------------------------------------------- */ -static unsigned long -TzsetGetEpoch(void) +static void +TzsetIfNecessary(void) { - static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by - * clockMutex. */ - static long tzLastRefresh = 0; /* Used for latency before next refresh */ - static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */ - static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, - that TZ changed via TCL */ - - const char *tzIsNow; /* Current value of TZ */ + static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by + * clockMutex. */ + const char *tzIsNow; /* Current value of TZ */ - /* - * Prevent performance regression on some platforms by resolving of system time zone: - * small latency for check whether environment was changed (once per second) - * no latency if environment was chaned with tcl-env (compare both epoch values) - */ - Tcl_Time now; - Tcl_GetTime(&now); - if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { - return tzWasEpoch; - } - tzEnvEpoch = TclEnvEpoch; - tzLastRefresh = now.sec; - - /* check in lock */ Tcl_MutexLock(&clockMutex); - tzIsNow = getenv("TCL_TZ"); - if (tzIsNow == NULL) { - tzIsNow = getenv("TZ"); - } + tzIsNow = getenv("TZ"); if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); @@ -4083,22 +2045,42 @@ TzsetGetEpoch(void) } tzWas = ckalloc(strlen(tzIsNow) + 1); strcpy(tzWas, tzIsNow); - tzWasEpoch++; } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); if (tzWas != INT2PTR(-1)) ckfree(tzWas); tzWas = NULL; - tzWasEpoch++; } Tcl_MutexUnlock(&clockMutex); - - return tzWasEpoch; } + +/* + *---------------------------------------------------------------------- + * + * ClockDeleteCmdProc -- + * + * Remove a reference to the clock client data, and clean up memory + * when it's all gone. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ static void -TzsetIfNecessary(void) +ClockDeleteCmdProc( + ClientData clientData) /* Opaque pointer to the client data */ { - TzsetGetEpoch(); + ClockClientData *data = clientData; + int i; + + if (data->refCount-- <= 1) { + for (i = 0; i < LIT__END; ++i) { + Tcl_DecrRefCount(data->literals[i]); + } + ckfree(data->literals); + ckfree(data); + } } /* |