diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclClock.c | 2506 | ||||
| -rw-r--r-- | generic/tclDate.c | 558 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 99 | ||||
| -rw-r--r-- | generic/tclEnv.c | 9 | ||||
| -rw-r--r-- | generic/tclGetDate.y | 196 | ||||
| -rw-r--r-- | generic/tclInt.h | 8 |
6 files changed, 2691 insertions, 685 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index a24b126..8e176b6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -8,12 +8,15 @@ * 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" /* * Windows has mktime. The configurators do not check. @@ -24,21 +27,6 @@ #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 */ @@ -55,70 +43,13 @@ static const int daysInPriorMonths[2][13] = { * Enumeration of the string literals used in [clock] */ -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 { - int refCount; /* Number of live references. */ - Tcl_Obj **literals; /* Pool of object literals. */ -} ClockClientData; +CLOCK_LITERAL_ARRAY(Literals); -/* - * Structure containing the fields used in [clock format] and [clock scan] - */ +/* 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_"); -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 }; /* @@ -139,26 +70,23 @@ 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[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt rangesVal[2]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); -static int ConvertLocalToUTC(Tcl_Interp *, - TclDateFields *, Tcl_Obj *, int); +static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, + TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt rangesVal[2]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); -static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - int, Tcl_Obj *const *); +static int ClockConfigureObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); 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, @@ -166,6 +94,10 @@ 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[]); @@ -184,13 +116,28 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockParseformatargsObjCmd( +static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockSecondsObjCmd( +static int ClockFormatObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockScanObjCmd( + 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( 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); @@ -209,6 +156,9 @@ struct ClockCommand { static const struct ClockCommand clockCommands[] = { { "getenv", ClockGetenvObjCmd }, + { "format", ClockFormatObjCmd }, + { "scan", ClockScanObjCmd }, + { "configure", ClockConfigureObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, { "GetDateFields", ClockGetdatefieldsObjCmd }, @@ -216,7 +166,6 @@ static const struct ClockCommand clockCommands[] = { ClockGetjuliandayfromerayearmonthdayObjCmd }, { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, - { "ParseFormatArgs", ClockParseformatargsObjCmd }, { NULL, NULL } }; @@ -279,9 +228,33 @@ TclClockInit( data->refCount = 0; data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { - data->literals[i] = Tcl_NewStringObj(literals[i], -1); - Tcl_IncrRefCount(data->literals[i]); + Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); } + 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. @@ -305,17 +278,881 @@ TclClockInit( /* *---------------------------------------------------------------------- * + * 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; + } + + Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp)); + Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict); + + 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_SetResult(opts->interp, + "locale not specified and no default locale set", TCL_STATIC); + 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); +} + +/* + *---------------------------------------------------------------------- + * * ClockConvertlocaltoutcObjCmd -- * * Tcl command that converts a UTC time to a local time by whatever means * is available. * * Usage: - * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover + * ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover * * Parameters: * dict - Dictionary containing a 'localSeconds' entry. - * tzdata - Time zone data + * timezone - Time zone * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: @@ -345,12 +1182,13 @@ ClockConvertlocaltoutcObjCmd( int created = 0; int status; + fields.tzName = NULL; /* * Check params and convert time. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover"); return TCL_ERROR; } dict = objv[1]; @@ -363,10 +1201,10 @@ ClockConvertlocaltoutcObjCmd( "found in dictionary", -1)); return TCL_ERROR; } - if ((Tcl_GetWideIntFromObj(interp, secondsObj, + if ((TclGetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) - || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { + || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) { return TCL_ERROR; } @@ -400,12 +1238,11 @@ ClockConvertlocaltoutcObjCmd( * formatting a date, and populates a dictionary with them. * * Usage: - * ::tcl::clock::GetDateFields seconds tzdata changeover + * ::tcl::clock::GetDateFields seconds timezone changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. - * tzdata - Time zone data of the time zone in which time is to be - * expressed. + * timezone - Time zone in which time is to be expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * @@ -434,15 +1271,17 @@ ClockGetdatefieldsObjCmd( Tcl_Obj *const *literals = data->literals; int changeover; + fields.tzName = NULL; + /* * Check params. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover"); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK + if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) { return TCL_ERROR; } @@ -457,28 +1296,14 @@ ClockGetdatefieldsObjCmd( return TCL_ERROR; } - /* - * Convert UTC time to local. - */ + /* Extract fields */ - if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { + if (ClockGetDateFields(clientData, interp, &fields, objv[2], + 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); + /* Make dict of fields */ dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS], @@ -517,6 +1342,58 @@ 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 @@ -591,6 +1468,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( int status; int era = 0; + fields.tzName = NULL; + /* * Check params. */ @@ -675,6 +1554,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd( int status; int era = 0; + fields.tzName = NULL; + /* * Check params. */ @@ -742,18 +1623,70 @@ ClockGetjuliandayfromerayearweekdayObjCmd( static int ConvertLocalToUTC( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ 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; } @@ -764,10 +1697,26 @@ ConvertLocalToUTC( */ if (rowc == 0) { - return ConvertLocalToUTCUsingC(interp, fields, changeover); + dataPtr->Local2UTC.rangesVal[0] = 0; + dataPtr->Local2UTC.rangesVal[1] = 0; + + if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + }; } else { - return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); + if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, + dataPtr->Local2UTC.rangesVal) != TCL_OK) { + return TCL_ERROR; + }; } + + /* 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; } /* @@ -793,7 +1742,8 @@ 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_Obj *const rowv[], /* Points at which time changes */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { Tcl_Obj *row; int cellc; @@ -817,7 +1767,8 @@ ConvertLocalToUTCUsingTable( fields->tzOffset = 0; fields->seconds = fields->localSeconds; while (!found) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, + rangesVal); if ((row == NULL) || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK @@ -842,6 +1793,41 @@ 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; } @@ -943,20 +1929,61 @@ ConvertLocalToUTCUsingC( *---------------------------------------------------------------------- */ -static int +MODULE_SCOPE int ConvertUTCToLocal( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ 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; } @@ -967,10 +1994,26 @@ ConvertUTCToLocal( */ if (rowc == 0) { - return ConvertUTCToLocalUsingC(interp, fields, changeover); + dataPtr->UTC2Local.rangesVal[0] = 0; + dataPtr->UTC2Local.rangesVal[1] = 0; + + if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + } } else { - return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); + if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, + dataPtr->UTC2Local.rangesVal) != TCL_OK) { + return TCL_ERROR; + } } + + /* 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; } /* @@ -997,7 +2040,8 @@ 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_Obj *const rowv[], /* Rows of the conversion table */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { Tcl_Obj *row; /* Row containing the current information */ int cellc; /* Count of cells in the row (must be 4) */ @@ -1007,7 +2051,7 @@ ConvertUTCToLocalUsingTable( * Look up the nearest transition time. */ - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal); if (row == NULL || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -1018,8 +2062,7 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - fields->tzName = cellv[3]; - Tcl_IncrRefCount(fields->tzName); + Tcl_SetObjRef(fields->tzName, cellv[3]); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -1112,8 +2155,7 @@ ConvertUTCToLocalUsingC( if (diff > 0) { sprintf(buffer+5, "%02d", diff); } - fields->tzName = Tcl_NewStringObj(buffer, -1); - Tcl_IncrRefCount(fields->tzName); + Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); return TCL_OK; } @@ -1131,24 +2173,25 @@ ConvertUTCToLocalUsingC( *---------------------------------------------------------------------- */ -static Tcl_Obj * +MODULE_SCOPE 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_Obj *const *rowv, /* Rows in tzdata */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { - int l; + int l = 0; int u; Tcl_Obj *compObj; - Tcl_WideInt compVal; + Tcl_WideInt compVal, fromVal = tick, toVal = tick; /* * Examine the first row to make sure we're in bounds. */ if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK - || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } @@ -1158,28 +2201,36 @@ LookupLastTransition( */ if (tick < compVal) { - return rowv[0]; + goto done; } /* * 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 || - Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + TclGetWideIntFromObj(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]; } @@ -1210,6 +2261,8 @@ 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. @@ -1416,7 +2469,7 @@ GetMonthDay( *---------------------------------------------------------------------- */ -static void +MODULE_SCOPE void GetJulianDayFromEraYearWeekDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Julian Day Number of the Gregorian @@ -1426,6 +2479,8 @@ GetJulianDayFromEraYearWeekDay( * given year */ TclDateFields firstWeek; + firstWeek.tzName = NULL; + /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ @@ -1467,7 +2522,7 @@ GetJulianDayFromEraYearWeekDay( *---------------------------------------------------------------------- */ -static void +MODULE_SCOPE void GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ @@ -1563,6 +2618,61 @@ 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 @@ -1574,16 +2684,14 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ -static int +MODULE_SCOPE int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { - int year; + int year = fields->year; if (fields->era == BCE) { - year = 1 - fields->year; - } else { - year = fields->year; + year = 1 - year; } if (year%4 != 0) { return 0; @@ -1852,122 +2960,1030 @@ ClockMicrosecondsObjCmd( 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; +} + /* *----------------------------------------------------------------------------- * - * ClockParseformatargsObjCmd -- + * ClockParseFmtScnArgs -- * - * Parses the arguments for [clock format]. + * Parses the arguments for [clock scan] and [clock format]. * * Results: - * 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. + * Returns a standard Tcl result, and stores parsed options + * (format, the locale, timezone and base) in structure "opts". * *----------------------------------------------------------------------------- */ +#define CLC_FMT_ARGS (0) +#define CLC_SCN_ARGS (1 << 0) +#define CLC_ADD_ARGS (1 << 1) + static int -ClockParseformatargsObjCmd( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ +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 */ -{ - 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] + Tcl_Obj *const objv[], /* Parameter vector */ + int flags /* Flags, differentiates between format, scan, add */ +) { + Tcl_Interp *interp = opts->interp; + ClockClientData *dataPtr = opts->clientData; int gmtFlag = 0; - static const char *const options[] = { /* Command line options expected */ + static const char *const options[] = { "-format", "-gmt", "-locale", - "-timezone", NULL }; + "-timezone", "-base", NULL + }; enum optionInd { - CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, - CLOCK_FORMAT_TIMEZONE + CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE, + CLC_ARGS_TIMEZONE, CLC_ARGS_BASE }; 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 */ - /* - * 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; + /* clock value (as current base) */ + if ( !(flags & (CLC_SCN_ARGS)) ) { + opts->baseObj = objv[1]; + saw |= (1 << CLC_ARGS_BASE); } /* * 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) { - 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; + /* 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; } switch (optionIndex) { - case CLOCK_FORMAT_FORMAT: - formatObj = objv[i+1]; + case CLC_ARGS_FORMAT: + if (flags & CLC_ADD_ARGS) { + goto badOptionMsg; + } + opts->formatObj = objv[i+1]; break; - case CLOCK_FORMAT_GMT: + case CLC_ARGS_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ return TCL_ERROR; } break; - case CLOCK_FORMAT_LOCALE: - localeObj = objv[i+1]; + case CLC_ARGS_LOCALE: + opts->localeObj = objv[i+1]; break; - case CLOCK_FORMAT_TIMEZONE: - timezoneObj = objv[i+1]; + case CLC_ARGS_TIMEZONE: + opts->timezoneObj = objv[i+1]; break; + case CLC_ARGS_BASE: + if ( !(flags & (CLC_SCN_ARGS)) ) { + goto badOptionMsg; } - saw |= 1 << optionIndex; + opts->baseObj = objv[i+1]; + break; + } + saw |= (1 << optionIndex); } /* * Check options. */ - if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { - return TCL_ERROR; - } - if ((saw & (1 << CLOCK_FORMAT_GMT)) - && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { - Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + if ((saw & (1 << CLC_ARGS_GMT)) + && (saw & (1 << CLC_ARGS_TIMEZONE))) { + Tcl_SetResult(interp, "cannot use -gmt and -timezone in same call", TCL_STATIC); Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } if (gmtFlag) { - timezoneObj = litPtr[LIT_GMT]; + 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) { + if (TclGetWideIntFromObj(NULL, opts->baseObj, &baseVal) != TCL_OK) { + + /* we accept "-now" as current date-time */ + const char *const nowOpts[] = { + "-now", NULL + }; + int idx; + if (Tcl_GetIndexFromObj(NULL, opts->baseObj, nowOpts, "seconds or -now", + TCL_EXACT, &idx) == TCL_OK + ) { + goto baseNow; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(opts->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 (opts->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, 1, objv, "clockval|-now " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + 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, 1, objv, "string " + "?-base seconds? " + "?-format string? " + "?-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_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_SetResult(interp, + "legacy [clock scan] does not support -locale", TCL_STATIC); + 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; } /* - * Return options as a list. + * Do relative times */ - Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); + 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; + } + + /* + * Do relative weekday + */ + + 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; + } + return TCL_OK; +} -#undef timezoneObj -#undef localeObj -#undef formatObj + +/*---------------------------------------------------------------------- + * + * 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, 1, objv, "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; } /*---------------------------------------------------------------------- @@ -2009,7 +4025,7 @@ ClockSecondsObjCmd( /* *---------------------------------------------------------------------- * - * TzsetIfNecessary -- + * TzsetGetEpoch --, TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ * environment variable has changed. @@ -2023,15 +4039,37 @@ ClockSecondsObjCmd( *---------------------------------------------------------------------- */ -static void -TzsetIfNecessary(void) +static unsigned long +TzsetGetEpoch(void) { static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ + static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */ + static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling, + that TZ changed via TCL */ + 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"); + } if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); @@ -2040,43 +4078,21 @@ TzsetIfNecessary(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); -} - -/* - *---------------------------------------------------------------------- - * - * 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 */ + return tzWasEpoch; +} + static void +TzsetIfNecessary(void) { - ClockClientData *data = clientData; - int i; - - data->refCount--; - if (data->refCount == 0) { - for (i = 0; i < LIT__END; ++i) { - Tcl_DecrRefCount(data->literals[i]); - } - ckfree(data->literals); - ckfree(data); - } + TzsetGetEpoch(); } /* diff --git a/generic/tclDate.c b/generic/tclDate.c index e4dd000..64cb804 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1,24 +1,22 @@ -/* A Bison parser, made by GNU Bison 2.3. */ +/* A Bison parser, made by GNU Bison 2.4.2. */ /* Skeleton implementation for Bison's Yacc-like parsers in C - - Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 - Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or modify + + Copyright (C) 1984, 1989-1990, 2000-2006, 2009-2010 Free Software + Foundation, Inc. + + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - + You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. */ + along with this program. If not, see <http://www.gnu.org/licenses/>. */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work @@ -29,7 +27,7 @@ special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. - + This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ @@ -47,7 +45,7 @@ #define YYBISON 1 /* Bison version. */ -#define YYBISON_VERSION "2.3" +#define YYBISON_VERSION "2.4.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" @@ -55,65 +53,24 @@ /* Pure parsers. */ #define YYPURE 1 +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + /* Using locations. */ #define YYLSP_NEEDED 1 /* Substitute the variable and function names. */ -#define yyparse TclDateparse -#define yylex TclDatelex -#define yyerror TclDateerror -#define yylval TclDatelval -#define yychar TclDatechar -#define yydebug TclDatedebug -#define yynerrs TclDatenerrs -#define yylloc TclDatelloc - -/* Tokens. */ -#ifndef YYTOKENTYPE -# define YYTOKENTYPE - /* Put the tokens into the symbol table, so that GDB and other debuggers - know about them. */ - enum yytokentype { - tAGO = 258, - tDAY = 259, - tDAYZONE = 260, - tID = 261, - tMERIDIAN = 262, - tMONTH = 263, - tMONTH_UNIT = 264, - tSTARDATE = 265, - tSEC_UNIT = 266, - tSNUMBER = 267, - tUNUMBER = 268, - tZONE = 269, - tEPOCH = 270, - tDST = 271, - tISOBASE = 272, - tDAY_UNIT = 273, - tNEXT = 274 - }; -#endif -/* Tokens. */ -#define tAGO 258 -#define tDAY 259 -#define tDAYZONE 260 -#define tID 261 -#define tMERIDIAN 262 -#define tMONTH 263 -#define tMONTH_UNIT 264 -#define tSTARDATE 265 -#define tSEC_UNIT 266 -#define tSNUMBER 267 -#define tUNUMBER 268 -#define tZONE 269 -#define tEPOCH 270 -#define tDST 271 -#define tISOBASE 272 -#define tDAY_UNIT 273 -#define tNEXT 274 - - - +#define yyparse TclDateparse +#define yylex TclDatelex +#define yyerror TclDateerror +#define yylval TclDatelval +#define yychar TclDatechar +#define yydebug TclDatedebug +#define yynerrs TclDatenerrs +#define yylloc TclDatelloc /* Copy the first part of user declarations. */ @@ -129,6 +86,7 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * */ #include "tclInt.h" @@ -146,73 +104,11 @@ * parsed fields will be returned. */ -typedef struct DateInfo { - - Tcl_Obj* messages; /* Error messages */ - const char* separatrix; /* String separating messages */ - - time_t dateYear; - time_t dateMonth; - time_t dateDay; - int dateHaveDate; - - time_t dateHour; - time_t dateMinutes; - time_t dateSeconds; - int dateMeridian; - int dateHaveTime; - - time_t dateTimezone; - int dateDSTmode; - int dateHaveZone; - - time_t dateRelMonth; - time_t dateRelDay; - time_t dateRelSeconds; - int dateHaveRel; - - time_t dateMonthOrdinal; - int dateHaveOrdinalMonth; - - time_t dateDayOrdinal; - time_t dateDayNumber; - int dateHaveDay; - - const char *dateStart; - const char *dateInput; - time_t *dateRelPointer; - - int dateDigitCount; -} DateInfo; +#include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) -#define yyDSTmode (info->dateDSTmode) -#define yyDayOrdinal (info->dateDayOrdinal) -#define yyDayNumber (info->dateDayNumber) -#define yyMonthOrdinal (info->dateMonthOrdinal) -#define yyHaveDate (info->dateHaveDate) -#define yyHaveDay (info->dateHaveDay) -#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) -#define yyHaveRel (info->dateHaveRel) -#define yyHaveTime (info->dateHaveTime) -#define yyHaveZone (info->dateHaveZone) -#define yyTimezone (info->dateTimezone) -#define yyDay (info->dateDay) -#define yyMonth (info->dateMonth) -#define yyYear (info->dateYear) -#define yyHour (info->dateHour) -#define yyMinutes (info->dateMinutes) -#define yySeconds (info->dateSeconds) -#define yyMeridian (info->dateMeridian) -#define yyRelMonth (info->dateRelMonth) -#define yyRelDay (info->dateRelDay) -#define yyRelSeconds (info->dateRelSeconds) -#define yyRelPointer (info->dateRelPointer) -#define yyInput (info->dateInput) -#define yyDigitCount (info->dateDigitCount) - #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 @@ -246,13 +142,6 @@ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; @@ -274,19 +163,49 @@ typedef enum _MERIDIAN { # define YYTOKEN_TABLE 0 #endif + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + tAGO = 258, + tDAY = 259, + tDAYZONE = 260, + tID = 261, + tMERIDIAN = 262, + tMONTH = 263, + tMONTH_UNIT = 264, + tSTARDATE = 265, + tSEC_UNIT = 266, + tSNUMBER = 267, + tUNUMBER = 268, + tZONE = 269, + tEPOCH = 270, + tDST = 271, + tISOBASE = 272, + tDAY_UNIT = 273, + tNEXT = 274 + }; +#endif + + + #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED typedef union YYSTYPE - { + + time_t Number; enum _MERIDIAN Meridian; -} -/* Line 187 of yacc.c. */ - YYSTYPE; + + +} YYSTYPE; +# define YYSTYPE_IS_TRIVIAL 1 # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 -# define YYSTYPE_IS_TRIVIAL 1 #endif #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED @@ -316,14 +235,10 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); -static time_t ToSeconds(time_t Hours, time_t Minutes, - time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); -/* Line 216 of yacc.c. */ - #ifdef short # undef short @@ -359,15 +274,21 @@ typedef short int yytype_int16; #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ -# else +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include <stddef.h> /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int # endif #endif #define YYSIZE_MAXIMUM ((YYSIZE_T) -1) #ifndef YY_ -# if YYENABLE_NLS +# if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include <libintl.h> /* INFRINGES ON USER NAME SPACE */ # define YY_(msgid) dgettext ("bison-runtime", msgid) @@ -392,14 +313,14 @@ typedef short int yytype_int16; #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static int -YYID (int i) +YYID (int yyi) #else static int -YYID (i) - int i; +YYID (yyi) + int yyi; #endif { - return i; + return yyi; } #endif @@ -481,9 +402,9 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */ /* A type that is properly aligned for any stack member. */ union yyalloc { - yytype_int16 yyss; - YYSTYPE yyvs; - YYLTYPE yyls; + yytype_int16 yyss_alloc; + YYSTYPE yyvs_alloc; + YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ @@ -518,12 +439,12 @@ union yyalloc elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ -# define YYSTACK_RELOCATE(Stack) \ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYSIZE_T yynewbytes; \ - YYCOPY (&yyptr->Stack, Stack, yysize); \ - Stack = &yyptr->Stack; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ @@ -624,12 +545,12 @@ static const yytype_int8 yyrhs[] = /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 225, 225, 226, 229, 232, 235, 238, 241, 244, - 247, 251, 256, 259, 265, 271, 279, 285, 296, 300, - 304, 310, 314, 318, 322, 326, 332, 336, 341, 346, - 351, 356, 360, 365, 369, 374, 381, 385, 391, 400, - 409, 419, 433, 438, 441, 444, 447, 450, 453, 458, - 461, 466, 470, 474, 480, 498, 501 + 0, 152, 152, 153, 156, 159, 162, 165, 168, 171, + 174, 178, 183, 186, 192, 198, 206, 212, 223, 227, + 231, 237, 241, 245, 249, 253, 259, 263, 268, 273, + 278, 283, 287, 292, 296, 301, 308, 312, 318, 327, + 336, 346, 360, 365, 368, 371, 374, 377, 380, 385, + 388, 393, 397, 401, 407, 425, 428 }; #endif @@ -783,9 +704,18 @@ static const yytype_uint8 yystos[] = /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. - Once GCC version 2 has supplanted version 1, this can go. */ + Once GCC version 2 has supplanted version 1, this can go. However, + YYFAIL appears to be in use. Nevertheless, it is formally deprecated + in Bison 2.4.2's NEWS entry, where a plan to phase it out is + discussed. */ #define YYFAIL goto yyerrlab +#if defined YYFAIL + /* This is here to suppress warnings from the GCC cpp's + -Wunused-macros. Normally we don't worry about that warning, but + some users do, and we want to make it easy for users to remove + YYFAIL uses, which will produce warnings from Bison 2.5. */ +#endif #define YYRECOVERING() (!!yyerrstatus) @@ -842,7 +772,7 @@ while (YYID (0)) we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT -# if YYLTYPE_IS_TRIVIAL +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL # define YY_LOCATION_PRINT(File, Loc) \ fprintf (File, "%d.%d-%d.%d", \ (Loc).first_line, (Loc).first_column, \ @@ -961,17 +891,20 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info) #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void -yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) +yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) #else static void -yy_stack_print (bottom, top) - yytype_int16 *bottom; - yytype_int16 *top; +yy_stack_print (yybottom, yytop) + yytype_int16 *yybottom; + yytype_int16 *yytop; #endif { YYFPRINTF (stderr, "Stack now"); - for (; bottom <= top; ++bottom) - YYFPRINTF (stderr, " %d", *bottom); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } YYFPRINTF (stderr, "\n"); } @@ -1007,11 +940,11 @@ yy_reduce_print (yyvsp, yylsp, yyrule, info) /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { - fprintf (stderr, " $%d = ", yyi + 1); + YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], &(yyvsp[(yyi + 1) - (yynrhs)]) , &(yylsp[(yyi + 1) - (yynrhs)]) , info); - fprintf (stderr, "\n"); + YYFPRINTF (stderr, "\n"); } } @@ -1295,10 +1228,8 @@ yydestruct (yymsg, yytype, yyvaluep, yylocationp, info) break; } } - /* Prevent warnings from -Wmissing-prototypes. */ - #ifdef YYPARSE_PARAM #if defined __STDC__ || defined __cplusplus int yyparse (void *YYPARSE_PARAM); @@ -1317,10 +1248,9 @@ int yyparse (); - -/*----------. -| yyparse. | -`----------*/ +/*-------------------------. +| yyparse or yypush_parse. | +`-------------------------*/ #ifdef YYPARSE_PARAM #if (defined __STDC__ || defined __C99__FUNC__ \ @@ -1344,88 +1274,97 @@ yyparse (info) #endif #endif { - /* The look-ahead symbol. */ +/* The lookahead symbol. */ int yychar; -/* The semantic value of the look-ahead symbol. */ +/* The semantic value of the lookahead symbol. */ YYSTYPE yylval; -/* Number of syntax errors so far. */ -int yynerrs; -/* Location data for the look-ahead symbol. */ +/* Location data for the lookahead symbol. */ YYLTYPE yylloc; - int yystate; - int yyn; - int yyresult; - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; - /* Look-ahead token as an internal (translated) token number. */ - int yytoken = 0; -#if YYERROR_VERBOSE - /* Buffer for error messages, and its allocated size. */ - char yymsgbuf[128]; - char *yymsg = yymsgbuf; - YYSIZE_T yymsg_alloc = sizeof yymsgbuf; -#endif + /* Number of syntax errors so far. */ + int yynerrs; - /* Three stacks and their tools: - `yyss': related to states, - `yyvs': related to semantic values, - `yyls': related to locations. + int yystate; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; - Refer to the stacks thru separate pointers, to allow yyoverflow - to reallocate them elsewhere. */ + /* The stacks and their tools: + `yyss': related to states. + `yyvs': related to semantic values. + `yyls': related to locations. - /* The state stack. */ - yytype_int16 yyssa[YYINITDEPTH]; - yytype_int16 *yyss = yyssa; - yytype_int16 *yyssp; + Refer to the stacks thru separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ - /* The semantic value stack. */ - YYSTYPE yyvsa[YYINITDEPTH]; - YYSTYPE *yyvs = yyvsa; - YYSTYPE *yyvsp; + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss; + yytype_int16 *yyssp; - /* The location stack. */ - YYLTYPE yylsa[YYINITDEPTH]; - YYLTYPE *yyls = yylsa; - YYLTYPE *yylsp; - /* The locations where the error started and ended. */ - YYLTYPE yyerror_range[2]; + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs; + YYSTYPE *yyvsp; -#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) + /* The location stack. */ + YYLTYPE yylsa[YYINITDEPTH]; + YYLTYPE *yyls; + YYLTYPE *yylsp; - YYSIZE_T yystacksize = YYINITDEPTH; + /* The locations where the error started and ended. */ + YYLTYPE yyerror_range[2]; + YYSIZE_T yystacksize; + + int yyn; + int yyresult; + /* Lookahead token as an internal (translated) token number. */ + int yytoken; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) + /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; + yytoken = 0; + yyss = yyssa; + yyvs = yyvsa; + yyls = yylsa; + yystacksize = YYINITDEPTH; + YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ + yychar = YYEMPTY; /* Cause a token to be read. */ /* Initialize stack pointers. Waste one element of value and location stack so that they stay on the same level as the state stack. The wasted elements are never initialized. */ - yyssp = yyss; yyvsp = yyvs; yylsp = yyls; -#if YYLTYPE_IS_TRIVIAL + +#if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Initialize the default location before parsing starts. */ yylloc.first_line = yylloc.last_line = 1; - yylloc.first_column = yylloc.last_column = 0; + yylloc.first_column = yylloc.last_column = 1; #endif goto yysetstate; @@ -1464,6 +1403,7 @@ YYLTYPE yylloc; &yyvs1, yysize * sizeof (*yyvsp), &yyls1, yysize * sizeof (*yylsp), &yystacksize); + yyls = yyls1; yyss = yyss1; yyvs = yyvs1; @@ -1485,9 +1425,9 @@ YYLTYPE yylloc; (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyexhaustedlab; - YYSTACK_RELOCATE (yyss); - YYSTACK_RELOCATE (yyvs); - YYSTACK_RELOCATE (yyls); + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); + YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); @@ -1508,6 +1448,9 @@ YYLTYPE yylloc; YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + if (yystate == YYFINAL) + YYACCEPT; + goto yybackup; /*-----------. @@ -1516,16 +1459,16 @@ YYLTYPE yylloc; yybackup: /* Do appropriate processing given the current state. Read a - look-ahead token if we need one and don't already have one. */ + lookahead token if we need one and don't already have one. */ - /* First try to decide what to do without reference to look-ahead token. */ + /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yyn == YYPACT_NINF) goto yydefault; - /* Not known => get a look-ahead token if don't already have one. */ + /* Not known => get a lookahead token if don't already have one. */ - /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */ + /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); @@ -1557,20 +1500,16 @@ yybackup: goto yyreduce; } - if (yyn == YYFINAL) - YYACCEPT; - /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; - /* Shift the look-ahead token. */ + /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - /* Discard the shifted token unless it is eof. */ - if (yychar != YYEOF) - yychar = YYEMPTY; + /* Discard the shifted token. */ + yychar = YYEMPTY; yystate = yyn; *++yyvsp = yylval; @@ -1878,16 +1817,16 @@ yyreduce: case 36: { - yyMonthOrdinal = 1; - yyMonth = (yyvsp[(2) - (2)].Number); + yyMonthOrdinalIncr = 1; + yyMonthOrdinal = (yyvsp[(2) - (2)].Number); ;} break; case 37: { - yyMonthOrdinal = (yyvsp[(2) - (3)].Number); - yyMonth = (yyvsp[(3) - (3)].Number); + yyMonthOrdinalIncr = (yyvsp[(2) - (3)].Number); + yyMonthOrdinal = (yyvsp[(3) - (3)].Number); ;} break; @@ -2062,7 +2001,6 @@ yyreduce: break; -/* Line 1267 of yacc.c. */ default: break; } @@ -2139,7 +2077,7 @@ yyerrlab: if (yyerrstatus == 3) { - /* If just tried and failed to reuse look-ahead token after an + /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= YYEOF) @@ -2156,7 +2094,7 @@ yyerrlab: } } - /* Else will try to reuse look-ahead token after shifting the error + /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; @@ -2214,14 +2152,11 @@ yyerrlab1: YY_STACK_PRINT (yyss, yyssp); } - if (yyn == YYFINAL) - YYACCEPT; - *++yyvsp = yylval; yyerror_range[1] = yylloc; /* Using YYLLOC is tempting, but would change the location of - the look-ahead. YYLOC is available though. */ + the lookahead. YYLOC is available though. */ YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2); *++yylsp = yyloc; @@ -2246,7 +2181,7 @@ yyabortlab: yyresult = 1; goto yyreturn; -#ifndef yyoverflow +#if !defined(yyoverflow) || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ @@ -2257,7 +2192,7 @@ yyexhaustedlab: #endif yyreturn: - if (yychar != YYEOF && yychar != YYEMPTY) + if (yychar != YYEMPTY) yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, info); /* Do not reclaim the symbols of the rule which action triggered @@ -2513,11 +2448,11 @@ TclDateerror( infoPtr->separatrix = "\n"; } -static time_t +MODULE_SCOPE int ToSeconds( - time_t Hours, - time_t Minutes, - time_t Seconds, + int Hours, + int Minutes, + int Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { @@ -2680,7 +2615,7 @@ TclDatelex( location->first_column = yyInput - info->dateStart; for ( ; ; ) { - while (TclIsSpaceProc(*yyInput)) { + while (isspace(UCHAR(*yyInput))) { yyInput++; } @@ -2740,65 +2675,36 @@ TclDatelex( } while (Count > 0); } } - + int -TclClockOldscanObjCmd( - ClientData clientData, /* Unused */ +TclClockFreeScan( Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Count of paraneters */ - Tcl_Obj *const *objv) /* Parameters */ + DateInfo *info) /* Input and result parameters */ { - Tcl_Obj *result, *resultElement; - int yr, mo, da; - DateInfo dateInfo; - DateInfo* info = &dateInfo; int status; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "stringToParse baseYear baseMonth baseDay" ); - return TCL_ERROR; - } - - yyInput = Tcl_GetString( objv[1] ); - dateInfo.dateStart = yyInput; - - yyHaveDate = 0; - if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { - return TCL_ERROR; - } - yyYear = yr; yyMonth = mo; yyDay = da; - - yyHaveTime = 0; - yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; - - yyHaveZone = 0; - yyTimezone = 0; yyDSTmode = DSTmaybe; - - yyHaveOrdinalMonth = 0; - yyMonthOrdinal = 0; - - yyHaveDay = 0; - yyDayOrdinal = 0; yyDayNumber = 0; + /* + * yyInput = stringToParse; + * + * ClockInitDateInfo(info) should be executed to pre-init info; + */ - yyHaveRel = 0; - yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; + yyDSTmode = DSTmaybe; - dateInfo.messages = Tcl_NewObj(); - dateInfo.separatrix = ""; - Tcl_IncrRefCount(dateInfo.messages); + info->messages = Tcl_NewObj(); + info->separatrix = ""; + Tcl_IncrRefCount(info->messages); - status = yyparse(&dateInfo); + info->dateStart = yyInput; + status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, dateInfo.messages); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_SetObjResult(interp, info->messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { @@ -2806,11 +2712,11 @@ TclClockOldscanObjCmd( "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, @@ -2843,6 +2749,40 @@ TclClockOldscanObjCmd( return TCL_ERROR; } + return TCL_OK; +} + +int +TclClockOldscanObjCmd( + ClientData clientData, /* Unused */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Count of paraneters */ + Tcl_Obj *const *objv) /* Parameters */ +{ + Tcl_Obj *result, *resultElement; + int yr, mo, da; + DateInfo dateInfo; + DateInfo* info = &dateInfo; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "stringToParse baseYear baseMonth baseDay" ); + return TCL_ERROR; + } + + yyInput = Tcl_GetString( objv[1] ); + + if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { + return TCL_ERROR; + } + yyYear = yr; yyMonth = mo; yyDay = da; + + if (TclClockFreeScan(interp, info) != TCL_OK) { + return TCL_ERROR; + } + result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { @@ -2894,9 +2834,9 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinalIncr)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj((int) yyMonthOrdinal)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 428173d..4088883 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -51,6 +51,8 @@ static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, @@ -98,6 +100,7 @@ static const EnsembleImplMap implementationMap[] = { {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, + {"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, @@ -1960,6 +1963,102 @@ DictSizeCmd( /* *---------------------------------------------------------------------- * + * Tcl_DictObjSmartRef -- + * + * This function returns new tcl-object with the smart reference to + * dictionary object. + * + * Object returned with this function is a smart reference (pointer), + * so new object of type tclDictType, that directly references given + * dictionary object (with internally increased refCount). + * + * The usage of such pointer objects allows to hold more as one + * reference to the same real dictionary object, allows to make a pointer + * to part of another dictionary, allows to change the dictionary without + * regarding of the "shared" state of the dictionary object. + * + * Prevents "called with shared object" exception if object is multiple + * referenced. + * + * Results: + * The newly create object (contains smart reference) is returned. + * The returned object has a ref count of 0. + * + * Side effects: + * Increases ref count of the referenced dictionary. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_DictObjSmartRef( + Tcl_Interp *interp, + Tcl_Obj *dictPtr) +{ + Tcl_Obj *result; + Dict *dict; + + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } + + dict = DICT(dictPtr); + + result = Tcl_NewObj(); + DICT(result) = dict; + dict->refCount++; + result->internalRep.twoPtrValue.ptr2 = NULL; + result->typePtr = &tclDictType; + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DictSmartRefCmd -- + * + * This function implements the "dict smartref" Tcl command. + * + * See description of Tcl_DictObjSmartRef for details. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictSmartRefCmd( + ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Tcl_Obj *result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); + return TCL_ERROR; + } + + result = Tcl_DictObjSmartRef(interp, objv[1]); + if (result == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, result); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * DictExistsCmd -- * * This function implements the "dict exists" Tcl command. See the user diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 66ddb57..0041a40 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -17,6 +17,11 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ + +/* MODULE_SCOPE */ +unsigned long TclEnvEpoch = 0; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + static struct { int cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment @@ -371,6 +376,7 @@ Tcl_PutEnv( value[0] = '\0'; TclSetEnv(name, value+1); } + TclEnvEpoch++; Tcl_DStringFree(&nameString); return 0; @@ -579,6 +585,7 @@ EnvTraceProc( if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); + TclEnvEpoch++; return NULL; } @@ -599,6 +606,7 @@ EnvTraceProc( value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); + TclEnvEpoch++; } /* @@ -622,6 +630,7 @@ EnvTraceProc( if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); + TclEnvEpoch++; } return NULL; } diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index da4c3fd..6d6a0d0 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -9,6 +9,7 @@ * * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 2015 Sergey G. Brester aka sebres. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -50,73 +51,11 @@ * parsed fields will be returned. */ -typedef struct DateInfo { - - Tcl_Obj* messages; /* Error messages */ - const char* separatrix; /* String separating messages */ - - time_t dateYear; - time_t dateMonth; - time_t dateDay; - int dateHaveDate; - - time_t dateHour; - time_t dateMinutes; - time_t dateSeconds; - int dateMeridian; - int dateHaveTime; - - time_t dateTimezone; - int dateDSTmode; - int dateHaveZone; - - time_t dateRelMonth; - time_t dateRelDay; - time_t dateRelSeconds; - int dateHaveRel; - - time_t dateMonthOrdinal; - int dateHaveOrdinalMonth; - - time_t dateDayOrdinal; - time_t dateDayNumber; - int dateHaveDay; - - const char *dateStart; - const char *dateInput; - time_t *dateRelPointer; - - int dateDigitCount; -} DateInfo; +#include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) -#define yyDSTmode (info->dateDSTmode) -#define yyDayOrdinal (info->dateDayOrdinal) -#define yyDayNumber (info->dateDayNumber) -#define yyMonthOrdinal (info->dateMonthOrdinal) -#define yyHaveDate (info->dateHaveDate) -#define yyHaveDay (info->dateHaveDay) -#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) -#define yyHaveRel (info->dateHaveRel) -#define yyHaveTime (info->dateHaveTime) -#define yyHaveZone (info->dateHaveZone) -#define yyTimezone (info->dateTimezone) -#define yyDay (info->dateDay) -#define yyMonth (info->dateMonth) -#define yyYear (info->dateYear) -#define yyHour (info->dateHour) -#define yyMinutes (info->dateMinutes) -#define yySeconds (info->dateSeconds) -#define yyMeridian (info->dateMeridian) -#define yyRelMonth (info->dateRelMonth) -#define yyRelDay (info->dateRelDay) -#define yyRelSeconds (info->dateRelSeconds) -#define yyRelPointer (info->dateRelPointer) -#define yyInput (info->dateInput) -#define yyDigitCount (info->dateDigitCount) - #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 @@ -150,14 +89,6 @@ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; - %} %union { @@ -176,8 +107,6 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); -static time_t ToSeconds(time_t Hours, time_t Minutes, - time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); %} @@ -377,12 +306,12 @@ date : tUNUMBER '/' tUNUMBER { ; ordMonth: tNEXT tMONTH { - yyMonthOrdinal = 1; - yyMonth = $2; + yyMonthOrdinalIncr = 1; + yyMonthOrdinal = $2; } | tNEXT tUNUMBER tMONTH { - yyMonthOrdinal = $2; - yyMonth = $3; + yyMonthOrdinalIncr = $2; + yyMonthOrdinal = $3; } ; @@ -730,11 +659,11 @@ TclDateerror( infoPtr->separatrix = "\n"; } -static time_t +MODULE_SCOPE int ToSeconds( - time_t Hours, - time_t Minutes, - time_t Seconds, + int Hours, + int Minutes, + int Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { @@ -957,65 +886,36 @@ TclDatelex( } while (Count > 0); } } - + int -TclClockOldscanObjCmd( - ClientData clientData, /* Unused */ +TclClockFreeScan( Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Count of paraneters */ - Tcl_Obj *const *objv) /* Parameters */ + DateInfo *info) /* Input and result parameters */ { - Tcl_Obj *result, *resultElement; - int yr, mo, da; - DateInfo dateInfo; - DateInfo* info = &dateInfo; int status; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "stringToParse baseYear baseMonth baseDay" ); - return TCL_ERROR; - } - - yyInput = Tcl_GetString( objv[1] ); - dateInfo.dateStart = yyInput; - - yyHaveDate = 0; - if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { - return TCL_ERROR; - } - yyYear = yr; yyMonth = mo; yyDay = da; - - yyHaveTime = 0; - yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; - - yyHaveZone = 0; - yyTimezone = 0; yyDSTmode = DSTmaybe; - - yyHaveOrdinalMonth = 0; - yyMonthOrdinal = 0; - - yyHaveDay = 0; - yyDayOrdinal = 0; yyDayNumber = 0; + /* + * yyInput = stringToParse; + * + * ClockInitDateInfo(info) should be executed to pre-init info; + */ - yyHaveRel = 0; - yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; + yyDSTmode = DSTmaybe; - dateInfo.messages = Tcl_NewObj(); - dateInfo.separatrix = ""; - Tcl_IncrRefCount(dateInfo.messages); + info->messages = Tcl_NewObj(); + info->separatrix = ""; + Tcl_IncrRefCount(info->messages); - status = yyparse(&dateInfo); + info->dateStart = yyInput; + status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, dateInfo.messages); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_SetObjResult(interp, info->messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { @@ -1023,11 +923,11 @@ TclClockOldscanObjCmd( "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, @@ -1060,6 +960,40 @@ TclClockOldscanObjCmd( return TCL_ERROR; } + return TCL_OK; +} + +int +TclClockOldscanObjCmd( + ClientData clientData, /* Unused */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Count of paraneters */ + Tcl_Obj *const *objv) /* Parameters */ +{ + Tcl_Obj *result, *resultElement; + int yr, mo, da; + DateInfo dateInfo; + DateInfo* info = &dateInfo; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "stringToParse baseYear baseMonth baseDay" ); + return TCL_ERROR; + } + + yyInput = Tcl_GetString( objv[1] ); + + if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { + return TCL_ERROR; + } + yyYear = yr; yyMonth = mo; yyDay = da; + + if (TclClockFreeScan(interp, info) != TCL_OK) { + return TCL_ERROR; + } + result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { @@ -1111,9 +1045,9 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinalIncr)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj((int) yyMonthOrdinal)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclInt.h b/generic/tclInt.h index b369f58..ea4c73e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2884,6 +2884,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); +MODULE_SCOPE Tcl_Obj * Tcl_DictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, @@ -4873,6 +4874,13 @@ typedef struct NRE_callback { #define Tcl_Free(ptr) TclpFree(ptr) #endif +/* + * Other externals. + */ + +MODULE_SCOPE unsigned long TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + #endif /* _TCLINT */ /* |