summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2017-05-10 12:28:46 (GMT)
committersebres <sebres@users.sourceforge.net>2017-05-10 12:28:46 (GMT)
commitfb3c424b5605a3c21de5c3ea3c72a7530a34de1d (patch)
treeb2f7992afa76a26e513ab92ab8e7b65f9faf8593 /generic
parent87313fd6795a5c95c6788ed3b8d3443bdf3740a2 (diff)
parent2c44e4887289d6b17deac377da76d117c1adc051 (diff)
downloadtcl-fb3c424b5605a3c21de5c3ea3c72a7530a34de1d.zip
tcl-fb3c424b5605a3c21de5c3ea3c72a7530a34de1d.tar.gz
tcl-fb3c424b5605a3c21de5c3ea3c72a7530a34de1d.tar.bz2
[interim-merge-commit] back-ported branch sebres-clock-speedup (from trunk to 8.6): tcl-clock functionality rewritten in C.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclClock.c2506
-rw-r--r--generic/tclDate.c558
-rw-r--r--generic/tclDictObj.c99
-rw-r--r--generic/tclEnv.c9
-rw-r--r--generic/tclGetDate.y196
-rw-r--r--generic/tclInt.h8
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 */
/*