diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 1 | ||||
-rw-r--r-- | generic/tclClock.c | 2598 | ||||
-rw-r--r-- | generic/tclClockFmt.c | 3138 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 348 | ||||
-rw-r--r-- | generic/tclCompile.h | 19 | ||||
-rw-r--r-- | generic/tclDate.c | 558 | ||||
-rw-r--r-- | generic/tclDate.h | 512 | ||||
-rw-r--r-- | generic/tclDictObj.c | 117 | ||||
-rw-r--r-- | generic/tclEnsemble.c | 20 | ||||
-rw-r--r-- | generic/tclEnv.c | 9 | ||||
-rw-r--r-- | generic/tclGetDate.y | 196 | ||||
-rw-r--r-- | generic/tclInt.h | 23 | ||||
-rw-r--r-- | generic/tclStrIdxTree.c | 527 | ||||
-rw-r--r-- | generic/tclStrIdxTree.h | 169 |
14 files changed, 7490 insertions, 745 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0486383..4d392d0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -285,6 +285,7 @@ static const CmdInfo builtInCmds[] = { {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, diff --git a/generic/tclClock.c b/generic/tclClock.c index 02b2845..c980a27 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -8,12 +8,16 @@ * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include "tclStrIdxTree.h" +#include "tclDate.h" +#include "tclCompile.h" /* * Windows has mktime. The configurators do not check. @@ -24,21 +28,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 +44,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 +71,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 +95,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 +117,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); @@ -202,22 +150,32 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::<name>". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ + CompileProc *compileProc; /* The compiler for the command. */ + ClientData clientData; /* Any clientData to give the command (if NULL + * a reference to ClockClientData will be sent) */ }; static const struct ClockCommand clockCommands[] = { - { "getenv", ClockGetenvObjCmd }, - { "Oldscan", TclClockOldscanObjCmd }, - { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, - { "GetDateFields", ClockGetdatefieldsObjCmd }, - { "GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd }, - { "GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd }, - { "ParseFormatArgs", ClockParseformatargsObjCmd }, - { NULL, NULL } + {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, + {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, + {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, + {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, + {"configure", ClockConfigureObjCmd, NULL, NULL}, + {"Oldscan", TclClockOldscanObjCmd, NULL, NULL}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, + {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, + {NULL, NULL, NULL, NULL} }; /* @@ -246,22 +204,10 @@ TclClockInit( char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ + Command *cmdPtr; ClockClientData *data; int i; - /* Structure of the 'clock' ensemble */ - - static const EnsembleImplMap clockImplMap[] = { - {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0}, - {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, - {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, - {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - /* * Safe interps get [::clock] as alias to a master, so do not need their * own copies of the support routines. @@ -279,27 +225,918 @@ 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. - * TODO - Let Tcl_MakeEnsemble do this? */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { + ClientData clientData; + strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); - data->refCount++; - Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data, - ClockDeleteCmdProc); + if (!(clientData = clockCmdPtr->clientData)) { + clientData = data; + data->refCount++; + } + cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName, + clockCmdPtr->objCmdProc, clientData, + clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); + cmdPtr->compileProc = clockCmdPtr->compileProc ? + clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; + } +} + +/* + *---------------------------------------------------------------------- + * + * ClockConfigureClear -- + * + * Clean up cached resp. run-time storages used in clock commands. + * + * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear". + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockConfigureClear( + ClockClientData *data) +{ + ClockFrmScnClearCaches(); + + data->LastTZEpoch = 0; + Tcl_UnsetObjRef(data->SystemTimeZone); + Tcl_UnsetObjRef(data->SystemSetupTZData); + Tcl_UnsetObjRef(data->GMTSetupTimeZone); + Tcl_UnsetObjRef(data->GMTSetupTZData); + Tcl_UnsetObjRef(data->AnySetupTimeZone); + Tcl_UnsetObjRef(data->AnySetupTZData); + Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone); + Tcl_UnsetObjRef(data->LastSetupTimeZone); + Tcl_UnsetObjRef(data->LastSetupTZData); + + Tcl_UnsetObjRef(data->CurrentLocale); + Tcl_UnsetObjRef(data->CurrentLocaleDict); + Tcl_UnsetObjRef(data->LastUnnormUsedLocale); + Tcl_UnsetObjRef(data->LastUsedLocale); + Tcl_UnsetObjRef(data->LastUsedLocaleDict); + + Tcl_UnsetObjRef(data->lastBase.timezoneObj); + Tcl_UnsetObjRef(data->UTC2Local.timezoneObj); + Tcl_UnsetObjRef(data->UTC2Local.tzName); + Tcl_UnsetObjRef(data->Local2UTC.timezoneObj); +} + +/* + *---------------------------------------------------------------------- + * + * ClockDeleteCmdProc -- + * + * Remove a reference to the clock client data, and clean up memory + * when it's all gone. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ +static void +ClockDeleteCmdProc( + ClientData clientData) /* Opaque pointer to the client data */ +{ + ClockClientData *data = clientData; + int i; + + if (data->refCount-- <= 1) { + for (i = 0; i < LIT__END; ++i) { + Tcl_DecrRefCount(data->literals[i]); + } + if (data->mcLiterals != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLiterals[i]); + } + data->mcLiterals = NULL; + } + if (data->mcLitIdxs != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLitIdxs[i]); + } + data->mcLitIdxs = NULL; + } + + ClockConfigureClear(data); + + ckfree(data->literals); + ckfree(data); } +} + +/* + *---------------------------------------------------------------------- + * + * NormTimezoneObj -- + * + * Normalizes the timezone object (used for caching puposes). + * + * If already cached time zone could be found, returns this + * object (last setup or last used, system (current) or gmt). + * + * Results: + * Normalized tcl object pointer. + * + *---------------------------------------------------------------------- + */ - /* Make the clock ensemble */ +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; + } - TclMakeEnsemble(interp, "clock", clockImplMap); + 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); } /* @@ -311,11 +1148,11 @@ TclClockInit( * 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 */ @@ -1521,9 +2576,9 @@ GetJulianDayFromEraYearMonthDay( * See above bug for details. The casts are necessary. */ if (ym1 >= 0) - ym1o4 = ym1 / 4; + ym1o4 = ym1 / 4; else { - ym1o4 = - (int) (((unsigned int) -ym1) / 4); + ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif if (ym1 % 4 < 0) { @@ -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; @@ -1757,7 +2865,7 @@ ClockClicksObjCmd( } break; default: - Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); + Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?"); return TCL_ERROR; } @@ -1774,8 +2882,7 @@ ClockClicksObjCmd( #endif break; case CLICKS_MICROS: - Tcl_GetTime(&now); - clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec; + clicks = TclpGetMicroseconds(); break; } @@ -1811,7 +2918,7 @@ ClockMillisecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds"); return TCL_ERROR; } Tcl_GetTime(&now); @@ -1845,134 +2952,1043 @@ ClockMicrosecondsObjCmd( int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { - Tcl_Time now; - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds"); return TCL_ERROR; } - Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj( - ((Tcl_WideInt) now.sec * 1000000) + now.usec)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); 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 CLC_ARGS_TIMEZONE: + opts->timezoneObj = objv[i+1]; break; - case CLOCK_FORMAT_TIMEZONE: - timezoneObj = objv[i+1]; + case CLC_ARGS_BASE: + if ( !(flags & (CLC_SCN_ARGS)) ) { + goto badOptionMsg; + } + opts->baseObj = objv[i+1]; break; } - saw |= 1 << optionIndex; + 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) { + register Tcl_Obj *baseObj = opts->baseObj; + /* bypass integer recognition if looks like option "-now" */ + if ( + (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') || + TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK + ) { + + /* we accept "-now" as current date-time */ + static const char *const nowOpts[] = { + "-now", NULL + }; + int idx; + if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now", + TCL_EXACT, &idx) == TCL_OK + ) { + goto baseNow; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(baseObj))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + i = 1; + goto badOption; + } + /* + * seconds could be an unsigned number that overflowed. Make sure + * that it isn't. + */ + + if (baseObj->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + return TCL_ERROR; + } + + } else { + +baseNow: + { + Tcl_Time now; + Tcl_GetTime(&now); + baseVal = (Tcl_WideInt) now.sec; + } + } + + /* + * Extract year, month and day from the base time for the parser to use as + * defaults + */ + + /* check base fields already cached (by TZ, last-second cache) */ + if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj + && dataPtr->lastBase.Date.seconds == baseVal) { + memcpy(date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); + } else { + /* extact fields from base */ + date->seconds = baseVal; + if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ + return TCL_ERROR; + } + /* cache last base */ + memcpy(&dataPtr->lastBase.Date, date, ClockCacheableDateFieldsSize); + Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); + } + + return TCL_OK; + +badOptionMsg: + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": unexpected for command \"%s\"", + TclGetString(objv[i]), TclGetString(objv[0])) + ); + +badOption: + + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); + + return TCL_ERROR; +} + +/*---------------------------------------------------------------------- + * + * ClockFormatObjCmd -- , clock format -- + * + * This function is invoked to process the Tcl "clock format" command. + * + * Formats a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock format' command formats times of day for output. Refer + * to the user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ClockFormatObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = clientData; + + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateFormat dateFmt; /* Common structure used for formatting */ + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 0, NULL, "clock format clockval|-now " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + memset(&dateFmt, 0, sizeof(dateFmt)); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv, + CLC_FMT_ARGS); + if (ret != TCL_OK) { + goto done; + } + + /* Default format */ + if (opts.formatObj == NULL) { + opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT]; + } + + /* Use compiled version of Format - */ + + ret = ClockFormat(&dateFmt, &opts); + +done: + + Tcl_UnsetObjRef(dateFmt.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockScanObjCmd -- , clock scan -- + * + * This function is invoked to process the Tcl "clock scan" command. + * + * Inputs a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock scan' command scans times of day on input. Refer to the + * user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ClockScanObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 0, NULL, "clock scan string " + "?-base seconds? " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + 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; +} + + +/*---------------------------------------------------------------------- + * + * 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; + } -#undef timezoneObj -#undef localeObj -#undef formatObj + /* adjust if we end up on a weekend */ + if (resDayOfWeek > 5) { + offs += 2; + } + + return offs; +} + + + +/*---------------------------------------------------------------------- + * + * ClockAddObjCmd -- , clock add -- + * + * Adds an offset to a given time. + * + * Refer to the user documentation to see what it exactly does. + * + * Syntax: + * clock add clockval ?count unit?... ?-option value? + * + * Parameters: + * clockval -- Starting time value + * count -- Amount of a unit of time to add + * unit -- Unit of time to add, must be one of: + * years year months month weeks week + * days day hours hour minutes minute + * seconds second + * + * Options: + * -gmt BOOLEAN + * Flag synonymous with '-timezone :GMT' + * -timezone ZONE + * Name of the time zone in which calculations are to be done. + * -locale NAME + * Name of the locale in which calculations are to be done. + * Used to determine the Gregorian change date. + * + * Results: + * Returns a standard Tcl result with the given time adjusted + * by the given offset(s) in order. + * + * Notes: + * It is possible that adding a number of months or years will adjust the + * day of the month as well. For instance, the time at one month after + * 31 January is either 28 or 29 February, because February has fewer + * than 31 days. + * + *---------------------------------------------------------------------- + */ + +int +ClockAddObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = clientData; + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + /* add "week" to units also (because otherwise ambiguous) */ + static const char *const units[] = { + "years", "months", "week", "weeks", + "days", "weekdays", + "hours", "minutes", "seconds", + NULL + }; + enum unitInd { + CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, + CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, + CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS + }; + int unitIndex; /* Index of an option. */ + int i; + Tcl_WideInt offs; + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 0, NULL, "clock add clockval|-now ?number units?..." + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + ClockInitDateInfo(&yy); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, + CLC_ADD_ARGS); + if (ret != TCL_OK) { + goto done; + } + + /* time together as seconds of the day */ + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + /* seconds are in localSeconds (relative base date), so reset time here */ + yyHour = 0; yyMinutes = 0; yyMeridian = MER24; + + ret = TCL_ERROR; + + /* + * Find each offset and process date increment + */ + + for (i = 2; i < objc; i+=2) { + /* bypass not integers (options, allready processed above) */ + if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) { + continue; + } + if (objv[i]->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + goto done; + } + /* get unit */ + if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, + &unitIndex) != TCL_OK) { + goto done; + } + + /* nothing to do if zero quantity */ + if (!offs) { + continue; + } + + /* if in-between conversion needed (already have relative date/time), + * correct date info, because the date may be changed, + * so refresh it now */ + + if ( yyHaveRel + && ( unitIndex == CLC_ADD_WEEKDAYS + /* some months can be shorter as another */ + || yyRelMonth || yyRelDay + /* day changed */ + || yySeconds + yyRelSeconds > SECONDS_PER_DAY + || yySeconds + yyRelSeconds < 0 + ) + ) { + if (ClockCalcRelTime(info, &opts) != TCL_OK) { + goto done; + } + } + + /* process increment by offset + unit */ + yyHaveRel++; + switch (unitIndex) { + case CLC_ADD_YEARS: + yyRelMonth += offs * 12; + break; + case CLC_ADD_MONTHS: + yyRelMonth += offs; + break; + case CLC_ADD_WEEK: + case CLC_ADD_WEEKS: + yyRelDay += offs * 7; + break; + case CLC_ADD_DAYS: + yyRelDay += offs; + break; + case CLC_ADD_WEEKDAYS: + /* add number of week days (skipping Saturdays and Sundays) + * to a relative days value. */ + offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs); + yyRelDay += offs; + break; + case CLC_ADD_HOURS: + yyRelSeconds += offs * 60 * 60; + break; + case CLC_ADD_MINUTES: + yyRelSeconds += offs * 60; + break; + case CLC_ADD_SECONDS: + yyRelSeconds += offs; + break; + } + } + + /* + * Do relative times (if not yet already processed interim): + */ + + if (yyHaveRel) { + if (ClockCalcRelTime(info, &opts) != TCL_OK) { + goto done; + } + } + + /* Convert date info structure into UTC seconds */ + + ret = ClockScanCommit(clientData, &yy, &opts); + +done: + + Tcl_UnsetObjRef(yy.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); + return TCL_OK; } /*---------------------------------------------------------------------- @@ -2003,7 +4019,7 @@ ClockSecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds"); return TCL_ERROR; } Tcl_GetTime(&now); @@ -2014,7 +4030,7 @@ ClockSecondsObjCmd( /* *---------------------------------------------------------------------- * - * TzsetIfNecessary -- + * TzsetGetEpoch --, TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ * environment variable has changed. @@ -2028,15 +4044,37 @@ ClockSecondsObjCmd( *---------------------------------------------------------------------- */ -static void -TzsetIfNecessary(void) +static unsigned long +TzsetGetEpoch(void) { - static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by - * clockMutex. */ - const char *tzIsNow; /* Current value of TZ */ + 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("TZ"); + tzIsNow = getenv("TCL_TZ"); + if (tzIsNow == NULL) { + tzIsNow = getenv("TZ"); + } if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); @@ -2045,43 +4083,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/tclClockFmt.c b/generic/tclClockFmt.c new file mode 100644 index 0000000..d923ede --- /dev/null +++ b/generic/tclClockFmt.c @@ -0,0 +1,3138 @@ +/* + * tclClockFmt.c -- + * + * Contains the date format (and scan) routines. This code is back-ported + * from the time and date facilities of tclSE engine, by Serg G. Brester. + * + * 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" + +/* + * Miscellaneous forward declarations and functions used within this file + */ + +static void +ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr); +static int +ClockFmtObj_SetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void +ClockFmtObj_UpdateString(Tcl_Obj *objPtr); + + +TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ + +static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); + +static void ClockFrmScnFinalize(ClientData clientData); + +/* + * Clock scan and format facilities. + */ + +/* + *---------------------------------------------------------------------- + * + * _str2int -- , _str2wideInt -- + * + * Fast inline-convertion of string to signed int or wide int by given + * start/end. + * + * The given string should contain numbers chars only (because already + * pre-validated within parsing routines) + * + * Results: + * Returns a standard Tcl result. + * TCL_OK - by successful conversion, TCL_ERROR by (wide) int overflow + * + *---------------------------------------------------------------------- + */ + +static inline int +_str2int( + int *out, + register + const char *p, + const char *e, + int sign) +{ + register int val = 0, prev = 0; + if (sign >= 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + +static inline int +_str2wideInt( + Tcl_WideInt *out, + register + const char *p, + const char *e, + int sign) +{ + register Tcl_WideInt val = 0, prev = 0; + if (sign >= 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * _itoaw -- , _witoaw -- + * + * Fast inline-convertion of signed int or wide int to string, using + * given padding with specified padchar and width (or without padding). + * + * This is a very fast replacement for sprintf("%02d"). + * + * Results: + * Returns position in buffer after end of conversion result. + * + *---------------------------------------------------------------------- + */ + +static inline char * +_itoaw( + char *buf, + register int val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + while (width <= 9 && val >= wrange[width]) { + width++; + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + while (width <= 9 && val <= -wrange[width]) { + width++; + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + +static inline char * +_witoaw( + char *buf, + register Tcl_WideInt val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + if (val >= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 >= wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val >= wrange[width]) { + width++; + } + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + if (val <= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 <= -wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val <= -wrange[width]) { + width++; + } + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + +/* + * Global GC as LIFO for released scan/format object storages. + * + * Used to holds last released CLOCK_FMT_SCN_STORAGE_GC_SIZE formats + * (after last reference from Tcl-object will be removed). This is helpful + * to avoid continuous (re)creation and compiling by some dynamically resp. + * variable format objects, that could be often reused. + * + * As long as format storage is used resp. belongs to GC, it takes place in + * FmtScnHashTable also. + */ + +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + +static struct { + ClockFmtScnStorage *stackPtr; + ClockFmtScnStorage *stackBound; + unsigned int count; +} ClockFmtScnStorage_GC = {NULL, NULL, 0}; + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageGC_In -- + * + * Adds an format storage object to GC. + * + * If current GC is full (size larger as CLOCK_FMT_SCN_STORAGE_GC_SIZE) + * this removes last unused storage at begin of GC stack (LIFO). + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) +{ + /* add new entry */ + TclSpliceIn(entry, ClockFmtScnStorage_GC.stackPtr); + if (ClockFmtScnStorage_GC.stackBound == NULL) { + ClockFmtScnStorage_GC.stackBound = entry; + } + ClockFmtScnStorage_GC.count++; + + /* if GC ist full */ + if (ClockFmtScnStorage_GC.count > CLOCK_FMT_SCN_STORAGE_GC_SIZE) { + + /* GC stack is LIFO: delete first inserted entry */ + ClockFmtScnStorage *delEnt = ClockFmtScnStorage_GC.stackBound; + ClockFmtScnStorage_GC.stackBound = delEnt->prevPtr; + TclSpliceOut(delEnt, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + delEnt->prevPtr = delEnt->nextPtr = NULL; + /* remove it now */ + ClockFmtScnStorageDelete(delEnt); + } +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorage_GC_Out -- + * + * Restores (for reusing) given format storage object from GC. + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) +{ + TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + if (ClockFmtScnStorage_GC.stackBound == entry) { + ClockFmtScnStorage_GC.stackBound = entry->prevPtr; + } + entry->prevPtr = entry->nextPtr = NULL; +} + +#endif + + +/* + * Global format storage hash table of type ClockFmtScnStorageHashKeyType + * (contains list of scan/format object storages, shared across all threads). + * + * Used for fast searching by format string. + */ +static Tcl_HashTable FmtScnHashTable; +static int initialized = 0; + +/* + * Wrappers between pointers to hash entry and format storage object + */ +static inline Tcl_HashEntry * +HashEntry4FmtScn(ClockFmtScnStorage *fss) { + return (Tcl_HashEntry*)(fss + 1); +}; +static inline ClockFmtScnStorage * +FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) { + return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage)); +}; + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageAllocProc -- + * + * Allocate space for a hash entry containing format storage together + * with the string key. + * + * Results: + * The return value is a pointer to the created entry. + * + *---------------------------------------------------------------------- + */ + +static Tcl_HashEntry * +ClockFmtScnStorageAllocProc( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ +{ + ClockFmtScnStorage *fss; + + const char *string = (const char *) keyPtr; + Tcl_HashEntry *hPtr; + unsigned int size, + allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry); + + allocsize += (size = strlen(string) + 1); + if (size > sizeof(hPtr->key)) { + allocsize -= sizeof(hPtr->key); + } + + fss = ckalloc(allocsize); + + /* initialize */ + memset(fss, 0, sizeof(*fss)); + + hPtr = HashEntry4FmtScn(fss); + memcpy(&hPtr->key.string, string, size); + hPtr->clientData = 0; /* currently unused */ + + return hPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageFreeProc -- + * + * Free format storage object and space of given hash entry. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockFmtScnStorageFreeProc( + Tcl_HashEntry *hPtr) +{ + ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr); + + if (fss->scnTok != NULL) { + ckfree(fss->scnTok); + fss->scnTok = NULL; + fss->scnTokC = 0; + } + if (fss->fmtTok != NULL) { + ckfree(fss->fmtTok); + fss->fmtTok = NULL; + fss->fmtTokC = 0; + } + + ckfree(fss); +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageDelete -- + * + * Delete format storage object. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + /* + * This will delete a hash entry and call "ckfree" for storage self, if + * some additionally handling required, freeEntryProc can be used instead + */ + Tcl_DeleteHashEntry(hPtr); +} + + +/* + * Derivation of tclStringHashKeyType with another allocEntryProc + */ + +static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; + + +/* + * Type definition of clock-format tcl object type. + */ + +Tcl_ObjType ClockFmtObjType = { + "clock-format", /* name */ + ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ + ClockFmtObj_DupInternalRep, /* dupIntRepProc */ + ClockFmtObj_UpdateString, /* updateStringProc */ + ClockFmtObj_SetFromAny /* setFromAnyProc */ +}; + +#define ObjClockFmtScn(objPtr) \ + (*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1)) + +#define ObjLocFmtKey(objPtr) \ + (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2)) + +static void +ClockFmtObj_DupInternalRep(srcPtr, copyPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *copyPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr); + + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + fss->objRefCount++; + Tcl_MutexUnlock(&ClockFmtMutex); + } + + ObjClockFmtScn(copyPtr) = fss; + /* regards special case - format not localizable */ + if (ObjLocFmtKey(srcPtr) != srcPtr) { + Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr)); + } else { + ObjLocFmtKey(copyPtr) = copyPtr; + } + copyPtr->typePtr = &ClockFmtObjType; + + + /* if no format representation, dup string representation */ + if (fss == NULL) { + copyPtr->bytes = ckalloc(srcPtr->length + 1); + memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1); + copyPtr->length = srcPtr->length; + } +} + +static void +ClockFmtObj_FreeInternalRep(objPtr) + Tcl_Obj *objPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + /* decrement object reference count of format/scan storage */ + if (--fss->objRefCount <= 0) { + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* don't remove it right now (may be reusable), just add to GC */ + ClockFmtScnStorageGC_In(fss); + #else + /* remove storage (format representation) */ + ClockFmtScnStorageDelete(fss); + #endif + } + Tcl_MutexUnlock(&ClockFmtMutex); + } + ObjClockFmtScn(objPtr) = NULL; + if (ObjLocFmtKey(objPtr) != objPtr) { + Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); + } else { + ObjLocFmtKey(objPtr) = NULL; + } + objPtr->typePtr = NULL; +}; + +static int +ClockFmtObj_SetFromAny(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + /* validate string representation before free old internal represenation */ + (void)TclGetString(objPtr); + + /* free old internal represenation */ + if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) + objPtr->typePtr->freeIntRepProc(objPtr); + + /* initial state of format object */ + ObjClockFmtScn(objPtr) = NULL; + ObjLocFmtKey(objPtr) = NULL; + objPtr->typePtr = &ClockFmtObjType; + + return TCL_OK; +}; + +static void +ClockFmtObj_UpdateString(objPtr) + Tcl_Obj *objPtr; +{ + char *name = "UNKNOWN"; + int len; + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + + if (fss != NULL) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + name = hPtr->key.string; + } + len = strlen(name); + objPtr->length = len, + objPtr->bytes = ckalloc((size_t)++len); + if (objPtr->bytes) + memcpy(objPtr->bytes, name, len); +} + +/* + *---------------------------------------------------------------------- + * + * ClockFrmObjGetLocFmtKey -- + * + * Retrieves format key object used to search localized format. + * + * This is normally stored in second pointer of internal representation. + * If format object is not localizable, it is equal the given format + * pointer (special case to fast fallback by not-localizable formats). + * + * Results: + * Returns tcl object with key or format object if not localizable. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the key inside its internal representation. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj* +ClockFrmObjGetLocFmtKey( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + Tcl_Obj *keyObj; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + keyObj = ObjLocFmtKey(objPtr); + if (keyObj) { + return keyObj; + } + + keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr)); + Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj); + + return keyObj; +} + +/* + *---------------------------------------------------------------------- + * + * FindOrCreateFmtScnStorage -- + * + * Retrieves format storage for given string format. + * + * This will find the given format in the global storage hash table + * or create a format storage object on demaind and save the + * reference in the first pointer of internal representation of given + * object. + * + * Results: + * Returns scan/format storage pointer to ClockFmtScnStorage. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the format storage reference inside its internal representation. + * Increments objRefCount of the ClockFmtScnStorage reference. + * + *---------------------------------------------------------------------- + */ + +static ClockFmtScnStorage * +FindOrCreateFmtScnStorage( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + const char *strFmt = TclGetString(objPtr); + ClockFmtScnStorage *fss = NULL; + int new; + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&ClockFmtMutex); + + /* if not yet initialized */ + if (!initialized) { + /* initialize type */ + memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); + ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; + ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; + + /* initialize hash table */ + Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, + &ClockFmtScnStorageHashKeyType); + + initialized = 1; + Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL); + } + + /* get or create entry (and alocate storage) */ + hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); + if (hPtr != NULL) { + + fss = FmtScn4HashEntry(hPtr); + + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* unlink if it is currently in GC */ + if (new == 0 && fss->objRefCount == 0) { + ClockFmtScnStorage_GC_Out(fss); + } + #endif + + /* new reference, so increment in lock right now */ + fss->objRefCount++; + + ObjClockFmtScn(objPtr) = fss; + } + + Tcl_MutexUnlock(&ClockFmtMutex); + + if (fss == NULL && interp != NULL) { + Tcl_AppendResult(interp, "retrieve clock format failed \"", + strFmt ? strFmt : "", "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetClockFrmScnFromObj -- + * + * Returns a clock format/scan representation of (*objPtr), if possible. + * If something goes wrong, NULL is returned, and if interp is non-NULL, + * an error message is written there. + * + * Results: + * Valid representation of type ClockFmtScnStorage. + * + * Side effects: + * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr) + * and in global hash table, shared across all threads. + * + *---------------------------------------------------------------------- + */ + +ClockFmtScnStorage * +Tcl_GetClockFrmScnFromObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + ClockFmtScnStorage *fss; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + fss = ObjClockFmtScn(objPtr); + + if (fss == NULL) { + fss = FindOrCreateFmtScnStorage(interp, objPtr); + } + + return fss; +} +/* + *---------------------------------------------------------------------- + * + * ClockLocalizeFormat -- + * + * Wrap the format object in options to the localized format, + * corresponding given locale. + * + * This searches localized format in locale catalog, and if not yet + * exists, it executes ::tcl::clock::LocalizeFormat in given interpreter + * and caches its result in the locale catalog. + * + * Results: + * Localized format object. + * + * Side effects: + * Caches the localized format inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj * +ClockLocalizeFormat( + ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *valObj = NULL, *keyObj; + + keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); + + /* special case - format object is not localizable */ + if (keyObj == opts->formatObj) { + return opts->formatObj; + } + + /* prevents loss of key object if the format object (where key stored) + * becomes changed (loses its internal representation during evals) */ + Tcl_IncrRefCount(keyObj); + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + goto done; + } + + /* try to find in cache within locale mc-catalog */ + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + keyObj, &valObj) != TCL_OK) { + goto done; + } + + /* call LocalizeFormat locale format fmtkey */ + if (valObj == NULL) { + Tcl_Obj *callargs[4]; + callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; + callargs[1] = opts->localeObj; + callargs[2] = opts->formatObj; + callargs[3] = keyObj; + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + ) { + goto done; + } + + valObj = Tcl_GetObjResult(opts->interp); + + /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + keyObj, valObj) != TCL_OK + ) { + valObj = NULL; + goto done; + } + + Tcl_ResetResult(opts->interp); + + /* check special case - format object is not localizable */ + if (valObj == opts->formatObj) { + /* mark it as unlocalizable, by setting self as key (without refcount incr) */ + if (opts->formatObj->typePtr == &ClockFmtObjType) { + Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj)); + ObjLocFmtKey(opts->formatObj) = opts->formatObj; + } + } + } + +done: + + Tcl_UnsetObjRef(keyObj); + return (opts->formatObj = valObj); +} + +/* + *---------------------------------------------------------------------- + * + * FindTokenBegin -- + * + * Find begin of given scan token in string, corresponding token type. + * + * Results: + * Position of token inside string if found. Otherwise - end of string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static const char * +FindTokenBegin( + register const char *p, + register const char *end, + ClockScanToken *tok) +{ + char c; + if (p < end) { + /* next token a known token type */ + switch (tok->map->type) { + case CTOKT_DIGIT: + /* should match at least one digit */ + while (!isdigit(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_WORD: + c = *(tok->tokWord.start); + /* should match at least to the first char of this word */ + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_SPACE: + while (!isspace(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_CHAR: + c = *((char *)tok->map->data); + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + } + } + return p; +} + +/* + *---------------------------------------------------------------------- + * + * DetermineGreedySearchLen -- + * + * Determine min/max lengths as exact as possible (speed, greedy match). + * + * Results: + * None. Lengths are stored in *minLenPtr, *maxLenPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok, + int *minLenPtr, int *maxLenPtr) +{ + register int minLen = tok->map->minSize; + register int maxLen; + register const char *p = yyInput + minLen, + *end = info->dateEnd; + + /* if still tokens available, try to correct minimum length */ + if ((tok+1)->map) { + end -= tok->endDistance + yySpaceCount; + /* find position of next known token */ + p = FindTokenBegin(p, end, tok+1); + if (p < end) { + minLen = p - yyInput; + } + } + + /* max length to the end regarding distance to end (min-width of following tokens) */ + maxLen = end - yyInput; + /* several amendments */ + if (maxLen > tok->map->maxSize) { + maxLen = tok->map->maxSize; + }; + if (minLen < tok->map->minSize) { + minLen = tok->map->minSize; + } + if (minLen > maxLen) { + maxLen = minLen; + } + if (maxLen > info->dateEnd - yyInput) { + maxLen = info->dateEnd - yyInput; + } + + /* check digits rigth now */ + if (tok->map->type == CTOKT_DIGIT) { + p = yyInput; + end = p + maxLen; + if (end > info->dateEnd) { end = info->dateEnd; }; + while (isdigit(UCHAR(*p)) && p < end) { p++; }; + maxLen = p - yyInput; + } + + /* try to get max length more precise for greedy match, + * check the next ahead token available there */ + if (minLen < maxLen && tok->lookAhTok) { + ClockScanToken *laTok = tok + tok->lookAhTok + 1; + p = yyInput + maxLen; + /* regards all possible spaces here (because they are optional) */ + end = p + tok->lookAhMax + yySpaceCount + 1; + if (end > info->dateEnd) { + end = info->dateEnd; + } + p += tok->lookAhMin; + if (laTok->map && p < end) { + const char *f; + /* try to find laTok between [lookAhMin, lookAhMax] */ + while (minLen < maxLen) { + f = FindTokenBegin(p, end, laTok); + /* if found (not below lookAhMax) */ + if (f < end) { + break; + } + /* try again with fewer length */ + maxLen--; + p--; + end--; + } + } else if (p > end) { + maxLen -= (p - end); + if (maxLen < minLen) { + maxLen = minLen; + } + } + } + + *minLenPtr = minLen; + *maxLenPtr = maxLen; +} + +/* + *---------------------------------------------------------------------- + * + * ObjListSearch -- + * + * Find largest part of the input string from start regarding min and + * max lengths in the given list (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found, TCL_RETURN - not matched, TCL_ERROR in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + +static inline int +ObjListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int *val, + Tcl_Obj **lstv, int lstc, + int minLen, int maxLen) +{ + int i, l, lf = -1; + const char *s, *f, *sf; + /* search in list */ + for (i = 0; i < lstc; i++) { + s = TclGetString(lstv[i]); + l = lstv[i]->length; + + if ( l >= minLen + && (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput + ) { + l = f - yyInput; + if (l < minLen) { + continue; + } + /* found, try to find longest value (greedy search) */ + if (l < maxLen && minLen != maxLen) { + lf = i; + minLen = l + 1; + continue; + } + /* max possible - end of search */ + *val = i; + yyInput += l; + break; + } + } + + /* if found */ + if (i < lstc) { + return TCL_OK; + } + if (lf >= 0) { + *val = lf; + yyInput += minLen - 1; + return TCL_OK; + } + return TCL_RETURN; +} +#if 0 +/* currently unused */ + +static int +LocaleListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int mcKey, int *val, + int minLen, int maxLen) +{ + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + /* get msgcat value */ + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + return TCL_ERROR; + } + + /* is a list */ + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + } + + /* search in list */ + return ObjListSearch(opts, info, val, lstv, lstc, + minLen, maxLen); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * ClockMCGetListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * given literal index mcKey (and builds it on demand). + * + * Searches localized index in locale catalog, and if not yet exists, + * creates string indexed tree and stores it in the locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +static TclStrIdxTree * +ClockMCGetListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) { + goto done; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCGetMultiListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * multiple lists by literal indices mcKeys (and builds it on demand). + * + * Searches localized index in locale catalog for mcKey, and if not + * yet exists, creates string indexed tree and stores it in the + * locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +static TclStrIdxTree * +ClockMCGetMultiListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey, + int *mcKeys) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + while (*mcKeys) { + + valObj = ClockMCGet(opts, *mcKeys); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) { + goto done; + } + mcKeys++; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +/* + *---------------------------------------------------------------------- + * + * ClockStrIdxTreeSearch -- + * + * Find largest part of the input string from start regarding lengths + * in the given localized string indexed tree (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found and the index stored in *val, + * TCL_RETURN - not matched or ambigous, + * TCL_ERROR - in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + +static inline int +ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, TclStrIdxTree *idxTree, int *val, + int minLen, int maxLen) +{ + const char *f; + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(NULL, &foundItem, idxTree, + yyInput, yyInput + maxLen); + + if (f <= yyInput || (f - yyInput) < minLen) { + /* not found */ + return TCL_RETURN; + } + if (!foundItem->value) { + /* ambigous */ + return TCL_RETURN; + } + + *val = PTR2INT(foundItem->value); + + /* shift input pointer */ + yyInput = f; + + return TCL_OK; +} +#if 0 +/* currently unused */ + +static int +StaticListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, const char **lst, int *val) +{ + int len; + const char **s = lst; + while (*s != NULL) { + len = strlen(*s); + if ( len <= info->dateEnd - yyInput + && strncasecmp(yyInput, *s, len) == 0 + ) { + *val = (s - lst); + yyInput += len; + break; + } + s++; + } + if (*s != NULL) { + return TCL_OK; + } + return TCL_RETURN; +} +#endif + +static inline const char * +FindWordEnd( + ClockScanToken *tok, + register const char * p, const char * end) +{ + register const char *x = tok->tokWord.start; + const char *pfnd = p; + if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */ + if (*p == *x) { + return ++p; + } + } + /* multi-char word */ + x = TclUtfFindEqualNC(x, tok->tokWord.end, p, end, &pfnd); + if (x < tok->tokWord.end) { + /* no match -> error */ + return NULL; + } + return pfnd; +} + +static int +ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ +#if 0 +/* currently unused, test purposes only */ + static const char * months[] = { + /* full */ + "January", "February", "March", + "April", "May", "June", + "July", "August", "September", + "October", "November", "December", + /* abbr */ + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + NULL + }; + int val; + if (StaticListSearch(opts, info, months, &val) != TCL_OK) { + return TCL_RETURN; + } + yyMonth = (val % 12) + 1; + return TCL_OK; +#endif + + static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; + + int ret, val; + int minLen, maxLen; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + yyMonth = val; + return TCL_OK; + +} + +static int +ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0}; + + int ret, val; + int minLen, maxLen; + char curTok = *tok->tokWord.start; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* %u %w %Ou %Ow */ + if ( curTok != 'a' && curTok != 'A' + && ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data)) + ) { + + val = -1; + + if (PTR2INT(tok->map->data) == 0) { + if (*yyInput >= '0' && *yyInput <= '9') { + val = *yyInput - '0'; + } + } else { + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + --val; + } + + if (val != -1) { + if (val == 0) { + val = 7; + } + if (val > 7) { + Tcl_SetResult(opts->interp, "day of week is greater than 7", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); + return TCL_ERROR; + } + info->date.dayOfWeek = val; + yyInput++; + return TCL_OK; + } + + + return TCL_RETURN; + } + + /* %a %A */ + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_DAYS_OF_WEEK_COMB, dowKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + --val; + + if (val == 0) { + val = 7; + } + info->date.dayOfWeek = val; + return TCL_OK; + +} + +static int +ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + Tcl_Obj *amPmObj[2]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + amPmObj[0] = ClockMCGet(opts, MCLIT_AM); + amPmObj[1] = ClockMCGet(opts, MCLIT_PM); + + if (amPmObj[0] == NULL || amPmObj[1] == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, amPmObj, 2, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val == 0) { + yyMeridian = MERam; + } else { + yyMeridian = MERpm; + } + + return TCL_OK; +} + +static int +ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + ClockClientData *dataPtr = opts->clientData; + + int ret, val; + int minLen, maxLen; + Tcl_Obj *eraObj[6]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + eraObj[0] = ClockMCGet(opts, MCLIT_BCE); + eraObj[1] = ClockMCGet(opts, MCLIT_CE); + eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2]; + eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2]; + eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3]; + eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3]; + + if (eraObj[0] == NULL || eraObj[1] == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, eraObj, 6, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val & 1) { + yydate.era = CE; + } else { + yydate.era = BCE; + } + + return TCL_OK; +} + +static int +ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (tok->map->offs > 0) { + *(int *)(((char *)info) + tok->map->offs) = --val; + } + + return TCL_OK; +} + +static int +ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + int len = 0; + register const char *p = yyInput; + Tcl_Obj *tzObjStor = NULL; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* numeric timezone */ + if (*p == '+' || *p == '-') { + /* max chars in numeric zone = "+00:00:00" */ + #define MAX_ZONE_LEN 9 + char buf[MAX_ZONE_LEN + 1]; + char *bp = buf; + *bp++ = *p++; len++; + if (maxLen > MAX_ZONE_LEN) + maxLen = MAX_ZONE_LEN; + /* cumulate zone into buf without ':' */ + while (len + 1 < maxLen) { + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (len + 2 < maxLen) { + if (*p == ':') { + p++; len++; + } + } + } + *bp = '\0'; + + if (len < minLen) { + return TCL_RETURN; + } + #undef MAX_ZONE_LEN + + /* timezone */ + tzObjStor = Tcl_NewStringObj(buf, bp-buf); + } else { + /* legacy (alnum) timezone like CEST, etc. */ + if (maxLen > 4) + maxLen = 4; + while (len < maxLen) { + if ( (*p & 0x80) + || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p))) + ) { /* INTL: ISO only. */ + break; + } + p++; len++; + } + + if (len < minLen) { + return TCL_RETURN; + } + + /* timezone */ + tzObjStor = Tcl_NewStringObj(yyInput, p-yyInput); + + /* convert using dict */ + } + + /* try to apply new time zone */ + Tcl_IncrRefCount(tzObjStor); + + opts->timezoneObj = ClockSetupTimeZone(opts->clientData, opts->interp, + tzObjStor); + + Tcl_DecrRefCount(tzObjStor); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } + + yyInput += len; + + return TCL_OK; +} + +static int +ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + register const char *p = yyInput, *end; const char *s; + int year, fractYear, fractDayDiv, fractDay; + static const char *stardatePref = "stardate "; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + end = yyInput + maxLen; + + /* stardate string */ + p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s); + if (p >= end || p - yyInput < 9) { + return TCL_RETURN; + } + /* bypass spaces */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + if (p >= end) { + return TCL_RETURN; + } + /* currently positive stardate only */ + if (*p == '+') { p++; }; + s = p; + while (p < end && isdigit(UCHAR(*p))) { + p++; + } + if (p >= end || p - s < 4) { + return TCL_RETURN; + } + if ( _str2int(&year, s, p-3, 1) != TCL_OK + || _str2int(&fractYear, p-3, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + if (*p++ != '.') { + return TCL_RETURN; + } + s = p; + fractDayDiv = 1; + while (p < end && isdigit(UCHAR(*p))) { + fractDayDiv *= 10; + p++; + } + if ( _str2int(&fractDay, s, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + yyInput = p; + + /* Build a date from year and fraction. */ + + yydate.year = year + RODDENBERRY; + yydate.era = CE; + yydate.gregorian = 1; + + if (IsGregorianLeapYear(&yydate)) { + fractYear *= 366; + } else { + fractYear *= 365; + } + yydate.dayOfYear = fractYear / 1000 + 1; + if (fractYear % 1000 >= 500) { + yydate.dayOfYear++; + } + + GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + + yydate.localSeconds = + -210866803200L + + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + + ( SECONDS_PER_DAY * fractDay / fractDayDiv ); + + return TCL_OK; +} + +static const char *ScnSTokenMapIndex = + "dmbyYHMSpJjCgGVazUsntQ"; +static ClockScanTokenMap ScnSTokenMap[] = { + /* %d %e */ + {CTOKT_DIGIT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + NULL}, + /* %m %N */ + {CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), + NULL}, + /* %b %B %h */ + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0, + ClockScnToken_Month_Proc}, + /* %y */ + {CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), + NULL}, + /* %Y */ + {CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year), + NULL}, + /* %H %k %I %l */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), + NULL}, + /* %M */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes), + NULL}, + /* %S */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay), + NULL}, + /* %p %P */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_amPmInd_Proc, NULL}, + /* %J */ + {CTOKT_DIGIT, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + NULL}, + /* %j */ + {CTOKT_DIGIT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear), + NULL}, + /* %C */ + {CTOKT_DIGIT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), + NULL}, + /* %g */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year), + NULL}, + /* %G */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year), + NULL}, + /* %V */ + {CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), + NULL}, + /* %a %A %u %w */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_DayOfWeek_Proc, NULL}, + /* %z %Z */ + {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0xffff, 0, + ClockScnToken_TimeZone_Proc, NULL}, + /* %U %W */ + {CTOKT_DIGIT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */ + NULL}, + /* %s */ + {CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), + NULL}, + /* %n */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, + /* %t */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, + /* %Q */ + {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0, + ClockScnToken_StarDate_Proc, NULL}, +}; +static const char *ScnSTokenMapAliasIndex[2] = { + "eNBhkIlPAuwZW", + "dmbbHHHpaaazU" +}; + +static const char *ScnETokenMapIndex = + "Eys"; +static ClockScanTokenMap ScnETokenMap[] = { + /* %EE */ + {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ey */ + {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Es */ + {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + NULL}, +}; +static const char *ScnETokenMapAliasIndex[2] = { + "", + "" +}; + +static const char *ScnOTokenMapIndex = + "dmyHMSu"; +static ClockScanTokenMap ScnOTokenMap[] = { + /* %Od %Oe */ + {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.dayOfMonth), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.month), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CTOKT_PARSER, CLF_YEAR, 0, 0, 0xffff, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok %OI %Ol */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.hour), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.minutes), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.secondOfDay), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou Ow */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, +}; +static const char *ScnOTokenMapAliasIndex[2] = { + "ekIlw", + "dHHHu" +}; + +static const char *ScnSpecTokenMapIndex = + " "; +static ClockScanTokenMap ScnSpecTokenMap[] = { + {CTOKT_SPACE, 0, 0, 1, 1, 0, + NULL}, +}; + +static ClockScanTokenMap ScnWordTokenMap = { + CTOKT_WORD, 0, 0, 1, 1, 0, + NULL +}; + + +static inline unsigned int +EstimateTokenCount( + register const char *fmt, + register const char *end) +{ + register const char *p = fmt; + unsigned int tokcnt; + /* estimate token count by % char and format length */ + tokcnt = 0; + while (p <= end) { + if (*p++ == '%') { + tokcnt++; + p++; + } + } + p = fmt + tokcnt * 2; + if (p < end) { + if ((unsigned int)(end - p) < tokcnt) { + tokcnt += (end - p); + } else { + tokcnt += tokcnt; + } + } + return ++tokcnt; +} + +#define AllocTokenInChain(tok, chain, tokCnt) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + chain = ckrealloc((char *)(chain), \ + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ + if ((chain) == NULL) { goto done; }; \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ + memset(tok, 0, sizeof(*(tok))); + +/* + *---------------------------------------------------------------------- + */ +ClockFmtScnStorage * +ClockGetOrParseScanFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockScanToken *tok; + + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); + if (fss == NULL) { + return NULL; + } + + /* if first time scanning - tokenize format */ + if (fss->scnTok == NULL) { + unsigned int tokCnt; + register const char *p, *e, *cp; + + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); + + /* estimate token count by % char and format length */ + fss->scnTokC = EstimateTokenCount(p, e); + + fss->scnSpaceCount = 0; + + Tcl_MutexLock(&ClockFmtMutex); + + fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); + memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; + while (p < e) { + switch (*p) { + case '%': + if (1) { + ClockScanTokenMap * scnMap = ScnSTokenMap; + const char *mapIndex = ScnSTokenMapIndex, + **aliasIndex = ScnSTokenMapAliasIndex; + if (p+1 >= e) { + goto word_tok; + } + p++; + /* try to find modifier: */ + switch (*p) { + case '%': + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &ScnWordTokenMap; + tok->tokWord.start = p; + tok->tokWord.end = p+1; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + break; + case 'E': + scnMap = ScnETokenMap, + mapIndex = ScnETokenMapIndex, + aliasIndex = ScnETokenMapAliasIndex; + p++; + break; + case 'O': + scnMap = ScnOTokenMap, + mapIndex = ScnOTokenMapIndex, + aliasIndex = ScnOTokenMapAliasIndex; + p++; + break; + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(aliasIndex[0], *p); + if (!cp || *cp == '\0') { + p--; if (scnMap != ScnSTokenMap) p--; + goto word_tok; + } + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; if (scnMap != ScnSTokenMap) p--; + goto word_tok; + } + } + tok->map = &scnMap[cp - mapIndex]; + tok->tokWord.start = p; + + /* calculate look ahead value by standing together tokens */ + if (tok > fss->scnTok) { + ClockScanToken *prevTok = tok - 1; + + while (prevTok >= fss->scnTok) { + if (prevTok->map->type != tok->map->type) { + break; + } + prevTok->lookAhMin += tok->map->minSize; + prevTok->lookAhMax += tok->map->maxSize; + prevTok->lookAhTok++; + prevTok--; + } + } + + /* increase space count used in format */ + if ( tok->map->type == CTOKT_CHAR + && isspace(UCHAR(*((char *)tok->map->data))) + ) { + fss->scnSpaceCount++; + } + + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + } + break; + case ' ': + cp = strchr(ScnSpecTokenMapIndex, *p); + if (!cp || *cp == '\0') { + p--; + goto word_tok; + } + tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; + /* increase space count used in format */ + fss->scnSpaceCount++; + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + break; + default: +word_tok: + if (1) { + ClockScanToken *wordTok = tok; + if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { + wordTok = tok-1; + } + /* new word token */ + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &ScnWordTokenMap; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + } + if (isspace(UCHAR(*p))) { + fss->scnSpaceCount++; + } + p = TclUtfNext(p); + wordTok->tokWord.end = p; + } + break; + } + } + + /* calculate end distance value for each tokens */ + if (tok > fss->scnTok) { + unsigned int endDist = 0; + ClockScanToken *prevTok = tok-1; + + while (prevTok >= fss->scnTok) { + prevTok->endDistance = endDist; + if (prevTok->map->type != CTOKT_WORD) { + endDist += prevTok->map->minSize; + } else { + endDist += prevTok->tokWord.end - prevTok->tokWord.start; + } + prevTok--; + } + } + + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->scnTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->scnTok = tok; + } + } + fss->scnTokC = tokCnt; + +done: + Tcl_MutexUnlock(&ClockFmtMutex); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + */ +int +ClockScan( + register DateInfo *info, /* Date fields used for parsing & converting */ + Tcl_Obj *strObj, /* String containing the time to scan */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockClientData *dataPtr = opts->clientData; + ClockFmtScnStorage *fss; + ClockScanToken *tok; + ClockScanTokenMap *map; + register const char *p, *x, *end; + unsigned short int flags = 0; + int ret = TCL_ERROR; + + /* get localized format */ + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + + if ( !(fss = ClockGetOrParseScanFormat(opts->interp, opts->formatObj)) + || !(tok = fss->scnTok) + ) { + return TCL_ERROR; + } + + /* prepare parsing */ + + yyMeridian = MER24; + + p = TclGetString(strObj); + end = p + strObj->length; + /* in strict mode - bypass spaces at begin / end only (not between tokens) */ + if (opts->flags & CLF_STRICT) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } + } + yyInput = p; + /* look ahead to count spaces (bypass it by count length and distances) */ + x = end; + while (p < end) { + if (isspace(UCHAR(*p))) { + x = p++; + yySpaceCount++; + continue; + } + x = end; + p++; + } + /* ignore spaces at end */ + yySpaceCount -= (end - x); + end = x; + /* ignore mandatory spaces used in format */ + yySpaceCount -= fss->scnSpaceCount; + if (yySpaceCount < 0) { + yySpaceCount = 0; + } + info->dateStart = p = yyInput; + info->dateEnd = end; + + /* parse string */ + for (; tok->map != NULL; tok++) { + map = tok->map; + /* bypass spaces at begin of input before parsing each token */ + if ( !(opts->flags & CLF_STRICT) + && ( map->type != CTOKT_SPACE + && map->type != CTOKT_WORD + && map->type != CTOKT_CHAR ) + ) { + while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; + p++; + } + } + yyInput = p; + /* end of input string */ + if (p >= end) { + break; + } + switch (map->type) + { + case CTOKT_DIGIT: + if (1) { + int minLen, size; + int sign = 1; + if (map->flags & CLF_SIGNED) { + if (*p == '+') { yyInput = ++p; } + else + if (*p == '-') { yyInput = ++p; sign = -1; }; + } + + DetermineGreedySearchLen(opts, info, tok, &minLen, &size); + + if (size < map->minSize) { + /* missing input -> error */ + if ((map->flags & CLF_OPTIONAL)) { + continue; + } + goto not_match; + } + /* string 2 number, put number into info structure by offset */ + if (map->offs) { + p = yyInput; x = p + size; + if (!(map->flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { + if (_str2int((int *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } + flags = (flags & ~map->clearFlags) | map->flags; + } + } + break; + case CTOKT_PARSER: + switch (map->parser(opts, info, tok)) { + case TCL_OK: + break; + case TCL_RETURN: + if ((map->flags & CLF_OPTIONAL)) { + yyInput = p; + continue; + } + goto not_match; + break; + default: + goto done; + break; + }; + /* decrement count for possible spaces in match */ + while (p < yyInput) { + if (isspace(UCHAR(*p++))) { + yySpaceCount--; + } + } + p = yyInput; + flags = (flags & ~map->clearFlags) | map->flags; + break; + case CTOKT_SPACE: + /* at least one space */ + if (!isspace(UCHAR(*p))) { + /* unmatched -> error */ + goto not_match; + } + yySpaceCount--; + p++; + while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; + p++; + } + break; + case CTOKT_WORD: + x = FindWordEnd(tok, p, end); + if (!x) { + /* no match -> error */ + goto not_match; + } + p = x; + break; + case CTOKT_CHAR: + x = (char *)map->data; + if (*x != *p) { + /* no match -> error */ + goto not_match; + } + if (isspace(UCHAR(*x))) { + yySpaceCount--; + } + p++; + break; + } + } + /* check end was reached */ + if (p < end) { + /* something after last token - wrong format */ + goto not_match; + } + /* end of string, check only optional tokens at end, otherwise - not match */ + while (tok->map != NULL) { + if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) { + tok++; + if (tok->map == NULL) break; + } + if (!(tok->map->flags & CLF_OPTIONAL)) { + goto not_match; + } + tok++; + } + + /* + * Invalidate result + */ + + /* seconds token (%s) take precedence over all other tokens */ + if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) { + if (flags & CLF_DATE) { + + if (!(flags & CLF_JULIANDAY)) { + info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; + + /* dd precedence below ddd */ + switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { + case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* miss month: ddd over dd (without month) */ + flags &= ~CLF_DAYOFMONTH; + case (CLF_DAYOFYEAR): + /* ddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* both available: mmdd over ddd */ + flags &= ~CLF_DAYOFYEAR; + case (CLF_MONTH|CLF_DAYOFMONTH): + case (CLF_DAYOFMONTH): + /* mmdd / dd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + } + + /* YearWeekDay below YearMonthDay */ + if ( (flags & CLF_ISO8601) + && ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR) + || (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH) + ) + ) { + /* yy precedence below yyyy */ + if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) { + /* normally precedence of ISO is higher, but no century - so put it down */ + flags &= ~CLF_ISO8601; + } + else + /* yymmdd or yyddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + } + + if (!(flags & CLF_ISO8601)) { + if (yyYear < 100) { + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; + } + } + } else { + if (info->date.iso8601Year < 100) { + if (!(flags & CLF_ISO8601CENTURY)) { + if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) { + info->date.iso8601Year -= 100; + } + info->date.iso8601Year += dataPtr->currentYearCentury; + } else { + info->date.iso8601Year += info->dateCentury * 100; + } + } + } + } + } + + /* if no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC|CLF_POSIXSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yydate.localSeconds = 0; + } + + if (flags & CLF_TIME) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + } else + if (!(flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + } + } + + /* tell caller which flags were set */ + info->flags |= flags; + + ret = TCL_OK; + goto done; + +overflow: + + Tcl_SetResult(opts->interp, "requested date too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + goto done; + +not_match: + + Tcl_SetResult(opts->interp, "input string does not match supplied format", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); + +done: + + return ret; +} + +static inline int +FrmResultAllocate( + register DateFormat *dateFmt, + int len) +{ + int needed = dateFmt->output + len - dateFmt->resEnd; + if (needed >= 0) { /* >= 0 - regards NTS zero */ + int newsize = dateFmt->resEnd - dateFmt->resMem + + needed + MIN_FMT_RESULT_BLOCK_ALLOC; + char *newRes = ckrealloc(dateFmt->resMem, newsize); + if (newRes == NULL) { + return TCL_ERROR; + } + dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem); + dateFmt->resMem = newRes; + dateFmt->resEnd = newRes + newsize; + } + return TCL_OK; +} + +static int +ClockFmtToken_HourAMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + *val = ( ( ( *val % SECONDS_PER_DAY ) + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1; + return TCL_OK; +} + +static int +ClockFmtToken_AMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if ((*val % SECONDS_PER_DAY) < (SECONDS_PER_DAY / 2)) { + mcObj = ClockMCGet(opts, MCLIT_AM); + } else { + mcObj = ClockMCGet(opts, MCLIT_PM); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + if (*tok->tokWord.start == 'p') { + len = Tcl_UtfToUpper(dateFmt->output); + } + dateFmt->output += len; + + return TCL_OK; +} + +static int +ClockFmtToken_StarDate_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) + { + int fractYear; + /* Get day of year, zero based */ + int v = dateFmt->date.dayOfYear - 1; + + /* Convert day of year to a fractional year */ + if (IsGregorianLeapYear(&dateFmt->date)) { + fractYear = 1000 * v / 366; + } else { + fractYear = 1000 * v / 365; + } + + /* Put together the StarDate as "Stardate %02d%03d.%1d" */ + if (FrmResultAllocate(dateFmt, 30) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, "Stardate ", 9); + dateFmt->output += 9; + dateFmt->output = _itoaw(dateFmt->output, + dateFmt->date.year - RODDENBERRY, '0', 2); + dateFmt->output = _itoaw(dateFmt->output, + fractYear, '0', 3); + *dateFmt->output++ = '.'; + /* be sure positive after decimal point (note: clock-value can be negative) */ + v = dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ); + if (v < 0) v = 10 + v; + dateFmt->output = _itoaw(dateFmt->output, v, '0', 1); + + return TCL_OK; +} +static int +ClockFmtToken_WeekOfYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int dow = dateFmt->date.dayOfWeek; + if (*tok->tokWord.start == 'U') { + if (dow == 7) { + dow = 0; + } + dow++; + } + *val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7; + return TCL_OK; +} +static int +ClockFmtToken_TimeZone_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + if (*tok->tokWord.start == 'z') { + int z = dateFmt->date.tzOffset; + char sign = '+'; + if ( z < 0 ) { + z = -z; + sign = '-'; + } + if (FrmResultAllocate(dateFmt, 7) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = sign; + dateFmt->output = _itoaw(dateFmt->output, z / 3600, '0', 2); + z %= 3600; + dateFmt->output = _itoaw(dateFmt->output, z / 60, '0', 2); + z %= 60; + if (z != 0) { + dateFmt->output = _itoaw(dateFmt->output, z, '0', 2); + } + } else { + Tcl_Obj * objPtr; + const char *s; int len; + /* convert seconds to local seconds to obtain tzName object */ + if (ConvertUTCToLocal(opts->clientData, opts->interp, + &dateFmt->date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { + return TCL_ERROR; + }; + objPtr = dateFmt->date.tzName; + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERA_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if (dateFmt->date.era == BCE) { + mcObj = ClockMCGet(opts, MCLIT_BCE); + } else { + mcObj = ClockMCGet(opts, MCLIT_CE); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERAYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int rowc; + Tcl_Obj **rowv; + + if (dateFmt->localeEra == NULL) { + Tcl_Obj *mcObj = ClockMCGet(opts, MCLIT_LOCALE_ERAS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { + return TCL_ERROR; + } + if (rowc != 0) { + dateFmt->localeEra = LookupLastTransition(opts->interp, + dateFmt->date.localSeconds, rowc, rowv, NULL); + } + if (dateFmt->localeEra == NULL) { + dateFmt->localeEra = (Tcl_Obj*)1; + } + } + + /* if no LOCALE_ERAS in catalog or era not found */ + if (dateFmt->localeEra == (Tcl_Obj*)1) { + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + if (*tok->tokWord.start == 'C') { /* %EC */ + *val = dateFmt->date.year / 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } else { /* %Ey */ + *val = dateFmt->date.year % 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } + } else { + Tcl_Obj *objPtr; + const char *s; + int len; + if (*tok->tokWord.start == 'C') { /* %EC */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + } else { /* %Ey */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 2, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) { + return TCL_ERROR; + } + *val = dateFmt->date.year - *val; + /* if year in locale numerals */ + if (*val >= 0 && *val < 100) { + /* year as integer */ + Tcl_Obj * mcObj = ClockMCGet(opts, MCLIT_LOCALE_NUMERALS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + /* year as integer */ + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + return TCL_OK; + } + } + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + + +static const char *FmtSTokenMapIndex = + "demNbByYCHMSIklpaAuwUVzgGjJsntQ"; +static ClockFormatTokenMap FmtSTokenMap[] = { + /* %d */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %e */ + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %m */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %N */ + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %b %h */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_ABBREV}, + /* %B */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_FULL}, + /* %y */ + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, + /* %Y */ + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, + /* %C */ + {CFMTT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, + /* %H */ + {CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %M */ + {CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %S */ + {CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %I */ + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %k */ + {CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %l */ + {CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %p %P */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_AMPM_Proc, NULL}, + /* %a */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV}, + /* %A */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL}, + /* %u */ + {CFMTT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %w */ + {CFMTT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %U %W */ + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear), + ClockFmtToken_WeekOfYear_Proc, NULL}, + /* %V */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, + /* %z %Z */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_TimeZone_Proc, NULL}, + /* %g */ + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %G */ + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %j */ + {CFMTT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, + /* %J */ + {CFMTT_INT, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + /* %s */ + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + /* %n */ + {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, + /* %t */ + {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, + /* %Q */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_StarDate_Proc, NULL}, +}; +static const char *FmtSTokenMapAliasIndex[2] = { + "hPWZ", + "bpUz" +}; + +static const char *FmtETokenMapIndex = + "Eys"; +static ClockFormatTokenMap FmtETokenMap[] = { + /* %EE */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era), + ClockFmtToken_LocaleERA_Proc, NULL}, + /* %Ey %EC */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), + ClockFmtToken_LocaleERAYear_Proc, NULL}, + /* %Es */ + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL}, +}; +static const char *FmtETokenMapAliasIndex[2] = { + "C", + "y" +}; + +static const char *FmtOTokenMapIndex = + "dmyHIMSuw"; +static ClockFormatTokenMap FmtOTokenMap[] = { + /* %Od %Oe */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfMonth), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.year), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 3600, 24, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OI %Ol */ + {CFMTT_INT, NULL, 0, CLFMT_CALC | CLFMT_LOCALE_INDX, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 60, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ow */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, +}; +static const char *FmtOTokenMapAliasIndex[2] = { + "ekl", + "dHI" +}; + +static ClockFormatTokenMap FmtWordTokenMap = { + CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL +}; + +/* + *---------------------------------------------------------------------- + */ +ClockFmtScnStorage * +ClockGetOrParseFmtFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockFormatToken *tok; + + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); + if (fss == NULL) { + return NULL; + } + + /* if first time scanning - tokenize format */ + if (fss->fmtTok == NULL) { + unsigned int tokCnt; + register const char *p, *e, *cp; + + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); + + /* estimate token count by % char and format length */ + fss->fmtTokC = EstimateTokenCount(p, e); + + Tcl_MutexLock(&ClockFmtMutex); + + fss->fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC); + memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; + while (p < e) { + switch (*p) { + case '%': + if (1) { + ClockFormatTokenMap * fmtMap = FmtSTokenMap; + const char *mapIndex = FmtSTokenMapIndex, + **aliasIndex = FmtSTokenMapAliasIndex; + if (p+1 >= e) { + goto word_tok; + } + p++; + /* try to find modifier: */ + switch (*p) { + case '%': + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &FmtWordTokenMap; + tok->tokWord.start = p; + tok->tokWord.end = p+1; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + p++; + continue; + break; + case 'E': + fmtMap = FmtETokenMap, + mapIndex = FmtETokenMapIndex, + aliasIndex = FmtETokenMapAliasIndex; + p++; + break; + case 'O': + fmtMap = FmtOTokenMap, + mapIndex = FmtOTokenMapIndex, + aliasIndex = FmtOTokenMapAliasIndex; + p++; + break; + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(aliasIndex[0], *p); + if (!cp || *cp == '\0') { + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + } + tok->map = &fmtMap[cp - mapIndex]; + tok->tokWord.start = p; + /* next token */ + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + p++; + continue; + } + break; + default: +word_tok: + if (1) { + ClockFormatToken *wordTok = tok; + if (tok > fss->fmtTok && (tok-1)->map == &FmtWordTokenMap) { + wordTok = tok-1; + } + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &FmtWordTokenMap; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + } + p = TclUtfNext(p); + wordTok->tokWord.end = p; + } + break; + } + } + + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->fmtTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->fmtTok = tok; + } + } + fss->fmtTokC = tokCnt; + +done: + Tcl_MutexUnlock(&ClockFmtMutex); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + */ +int +ClockFormat( + register DateFormat *dateFmt, /* Date fields used for parsing & converting */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockFmtScnStorage *fss; + ClockFormatToken *tok; + ClockFormatTokenMap *map; + + /* get localized format */ + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + + if ( !(fss = ClockGetOrParseFmtFormat(opts->interp, opts->formatObj)) + || !(tok = fss->fmtTok) + ) { + return TCL_ERROR; + } + + /* prepare formatting */ + dateFmt->date.secondOfDay = (int)(dateFmt->date.localSeconds % SECONDS_PER_DAY); + if (dateFmt->date.secondOfDay < 0) { + dateFmt->date.secondOfDay += SECONDS_PER_DAY; + } + + /* result container object */ + dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); + if (dateFmt->resMem == NULL) { + return TCL_ERROR; + } + dateFmt->output = dateFmt->resMem; + dateFmt->resEnd = dateFmt->resMem + MIN_FMT_RESULT_BLOCK_ALLOC; + *dateFmt->output = '\0'; + + /* do format each token */ + for (; tok->map != NULL; tok++) { + map = tok->map; + switch (map->type) + { + case CFMTT_INT: + if (1) { + int val = (int)*(int *)(((char *)dateFmt) + map->offs); + if (map->fmtproc == NULL) { + if (map->flags & CLFMT_DECR) { + val--; + } + if (map->flags & CLFMT_INCR) { + val++; + } + if (map->divider) { + val /= map->divider; + } + if (map->divmod) { + val %= map->divmod; + } + } else { + if (map->fmtproc(opts, dateFmt, tok, &val) != TCL_OK) { + goto done; + } + /* if not calculate only (output inside fmtproc) */ + if (!(map->flags & CLFMT_CALC)) { + continue; + } + } + if (!(map->flags & CLFMT_LOCALE_INDX)) { + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { goto error; }; + if (map->width) { + dateFmt->output = _itoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } + } else { + const char *s; + Tcl_Obj * mcObj = ClockMCGet(opts, PTR2INT(map->data) /* mcKey */); + if (mcObj == NULL) { + goto error; + } + if ( Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK + || mcObj == NULL + ) { + goto error; + } + s = TclGetString(mcObj); + if (FrmResultAllocate(dateFmt, mcObj->length) != TCL_OK) { goto error; }; + memcpy(dateFmt->output, s, mcObj->length + 1); + dateFmt->output += mcObj->length; + } + } + break; + case CFMTT_WIDE: + if (1) { + Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs); + if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; }; + if (map->width) { + dateFmt->output = _witoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } + } + break; + case CTOKT_CHAR: + if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; }; + *dateFmt->output++ = *map->tostr; + break; + case CFMTT_PROC: + if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) { + goto error; + }; + break; + case CTOKT_WORD: + if (1) { + int len = tok->tokWord.end - tok->tokWord.start; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; }; + if (len == 1) { + *dateFmt->output++ = *tok->tokWord.start; + } else { + memcpy(dateFmt->output, tok->tokWord.start, len); + dateFmt->output += len; + } + } + break; + } + } + + goto done; + +error: + + ckfree(dateFmt->resMem); + dateFmt->resMem = NULL; + +done: + + if (dateFmt->resMem) { + Tcl_Obj * result = Tcl_NewObj(); + result->length = dateFmt->output - dateFmt->resMem; + result->bytes = NULL; + result->bytes = ckrealloc(dateFmt->resMem, result->length+1); + if (result->bytes == NULL) { + result->bytes = dateFmt->resMem; + } + result->bytes[result->length] = '\0'; + Tcl_SetObjResult(opts->interp, result); + return TCL_OK; + } + + return TCL_ERROR; +} + + +MODULE_SCOPE void +ClockFrmScnClearCaches(void) +{ + Tcl_MutexLock(&ClockFmtMutex); + /* clear caches ... */ + Tcl_MutexUnlock(&ClockFmtMutex); +} + +static void +ClockFrmScnFinalize( + ClientData clientData) /* Not used. */ +{ + Tcl_MutexLock(&ClockFmtMutex); +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* clear GC */ + ClockFmtScnStorage_GC.stackPtr = NULL; + ClockFmtScnStorage_GC.stackBound = NULL; + ClockFmtScnStorage_GC.count = 0; +#endif + if (initialized) { + Tcl_DeleteHashTable(&FmtScnHashTable); + initialized = 0; + } + Tcl_MutexUnlock(&ClockFmtMutex); + Tcl_MutexFinalize(&ClockFmtMutex); +} +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 885a0bc..8c2c026 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -17,6 +17,7 @@ */ #include "tclInt.h" +#include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" @@ -4146,7 +4147,7 @@ Tcl_TimeObjCmd( start = TclpGetWideClicks(); #endif while (i-- > 0) { - result = Tcl_EvalObjEx(interp, objPtr, 0); + result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); if (result != TCL_OK) { return result; } @@ -4186,6 +4187,351 @@ Tcl_TimeObjCmd( /* *---------------------------------------------------------------------- * + * Tcl_TimeRateObjCmd -- + * + * This object-based procedure is invoked to process the "timerate" Tcl + * command. + * This is similar to command "time", except the execution limited by + * given time (in milliseconds) instead of repetition count. + * + * Example: + * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]` + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_TimeRateObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + static + double measureOverhead = 0; /* global measure-overhead */ + double overhead = -1; /* given measure-overhead */ + register Tcl_Obj *objPtr; + register int result, i; + Tcl_Obj *calibrate = NULL, *direct = NULL; + Tcl_WideInt count = 0; /* Holds repetition count */ + Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; + /* Maximal running time (in milliseconds) */ + Tcl_WideInt threshold = 1; /* Current threshold for check time (faster + * repeat count without time check) */ + Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold + * additionally avoid divide to zero (never < 1) */ + register Tcl_WideInt start, middle, stop; +#ifndef TCL_WIDE_CLICKS + Tcl_Time now; +#endif + + static const char *const options[] = { + "-direct", "-overhead", "-calibrate", "--", NULL + }; + enum options { + TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST + }; + + NRE_callback *rootPtr; + ByteCode *codePtr = NULL; + + for (i = 1; i < objc - 1; i++) { + int index; + if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, + &index) != TCL_OK) { + break; + } + if (index == TMRT_LAST) { + i++; + break; + } + switch (index) { + case TMRT_EV_DIRECT: + direct = objv[i]; + break; + case TMRT_OVERHEAD: + if (++i >= objc - 1) { + goto usage; + } + if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) { + return TCL_ERROR; + } + break; + case TMRT_CALIBRATE: + calibrate = objv[i]; + break; + } + } + + if (i >= objc || i < objc-2) { +usage: + Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?"); + return TCL_ERROR; + } + objPtr = objv[i++]; + if (i < objc) { + result = TclGetWideIntFromObj(interp, objv[i], &maxms); + if (result != TCL_OK) { + return result; + } + } + + /* if calibrate */ + if (calibrate) { + + /* if no time specified for the calibration */ + if (maxms == -0x7FFFFFFFFFFFFFFFL) { + Tcl_Obj *clobjv[6]; + Tcl_WideInt maxCalTime = 5000; + double lastMeasureOverhead = measureOverhead; + + clobjv[0] = objv[0]; + i = 1; + if (direct) { + clobjv[i++] = direct; + } + clobjv[i++] = objPtr; + + /* reset last measurement overhead */ + measureOverhead = (double)0; + + /* self-call with 100 milliseconds to warm-up, + * before entering the calibration cycle */ + TclNewLongObj(clobjv[i], 100); + Tcl_IncrRefCount(clobjv[i]); + result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + Tcl_DecrRefCount(clobjv[i]); + if (result != TCL_OK) { + return result; + } + + i--; + clobjv[i++] = calibrate; + clobjv[i++] = objPtr; + + /* set last measurement overhead to max */ + measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + + /* calibration cycle until it'll be preciser */ + maxms = -1000; + do { + lastMeasureOverhead = measureOverhead; + TclNewLongObj(clobjv[i], (int)maxms); + Tcl_IncrRefCount(clobjv[i]); + result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + Tcl_DecrRefCount(clobjv[i]); + if (result != TCL_OK) { + return result; + } + maxCalTime += maxms; + /* increase maxms for preciser calibration */ + maxms -= (-maxms / 4); + /* as long as new value more as 0.05% better */ + } while ( (measureOverhead >= lastMeasureOverhead + || measureOverhead / lastMeasureOverhead <= 0.9995) + && maxCalTime > 0 + ); + + return result; + } + if (maxms == 0) { + /* reset last measurement overhead */ + measureOverhead = 0; + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + return TCL_OK; + } + + /* if time is negative - make current overhead more precise */ + if (maxms > 0) { + /* set last measurement overhead to max */ + measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + } else { + maxms = -maxms; + } + + } + + if (maxms == -0x7FFFFFFFFFFFFFFFL) { + maxms = 1000; + } + if (overhead == -1) { + overhead = measureOverhead; + } + + /* be sure that resetting of result will not smudge the further measurement */ + Tcl_ResetResult(interp); + + /* compile object */ + if (!direct) { + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } + codePtr = TclCompileObj(interp, objPtr, NULL, 0); + TclPreserveByteCode(codePtr); + } + + /* get start and stop time */ +#ifdef TCL_WIDE_CLICKS + start = middle = TclpGetWideClicks(); + /* time to stop execution (in wide clicks) */ + stop = start + (maxms * 1000 / TclpWideClickInMicrosec()); +#else + Tcl_GetTime(&now); + start = now.sec; start *= 1000000; start += now.usec; + middle = start; + /* time to stop execution (in microsecs) */ + stop = start + maxms * 1000; +#endif + + /* start measurement */ + while (1) { + /* eval single iteration */ + count++; + + if (!direct) { + /* precompiled */ + rootPtr = TOP_CB(interp); + result = TclNRExecuteByteCode(interp, codePtr); + result = TclNRRunCallbacks(interp, result, rootPtr); + } else { + /* eval */ + result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); + } + if (result != TCL_OK) { + goto done; + } + + /* don't check time up to threshold */ + if (--threshold > 0) continue; + + /* check stop time reached, estimate new threshold */ + #ifdef TCL_WIDE_CLICKS + middle = TclpGetWideClicks(); + #else + Tcl_GetTime(&now); + middle = now.sec; middle *= 1000000; middle += now.usec; + #endif + if (middle >= stop) { + break; + } + + /* don't calculate threshold by few iterations, because sometimes + * first iteration(s) can be too fast (cached, delayed clean up, etc) */ + if (count < 10) { + threshold = 1; continue; + } + + /* average iteration time in microsecs */ + threshold = (middle - start) / count; + if (threshold > maxIterTm) { + maxIterTm = threshold; + } + /* as relation between remaining time and time since last check */ + threshold = ((stop - middle) / maxIterTm) / 4; + if (threshold > 100000) { /* fix for too large threshold */ + threshold = 100000; + } + } + + { + Tcl_Obj *objarr[8], **objs = objarr; + Tcl_WideInt val; + const char *fmt; + + middle -= start; /* execution time in microsecs */ + + #ifdef TCL_WIDE_CLICKS + /* convert execution time in wide clicks to microsecs */ + middle *= TclpWideClickInMicrosec(); + #endif + + /* if not calibrate */ + if (!calibrate) { + /* minimize influence of measurement overhead */ + if (overhead > 0) { + /* estimate the time of overhead (microsecs) */ + Tcl_WideInt curOverhead = overhead * count; + if (middle > curOverhead) { + middle -= curOverhead; + } else { + middle = 1; + } + } + } else { + /* calibration - obtaining new measurement overhead */ + if (measureOverhead > (double)middle / count) { + measureOverhead = (double)middle / count; + } + objs[0] = Tcl_NewDoubleObj(measureOverhead); + TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ + objs += 2; + } + + val = middle / count; /* microsecs per iteration */ + if (val >= 1000000) { + objs[0] = Tcl_NewWideIntObj(val); + } else { + if (val < 10) { fmt = "%.6f"; } else + if (val < 100) { fmt = "%.4f"; } else + if (val < 1000) { fmt = "%.3f"; } else + if (val < 10000) { fmt = "%.2f"; } else + { fmt = "%.1f"; }; + objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count); + } + + objs[2] = Tcl_NewWideIntObj(count); /* iterations */ + + /* calculate speed as rate (count) per sec */ + if (!middle) middle++; /* +1 ms, just to avoid divide by zero */ + if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) { + val = (count * 1000000) / middle; + if (val < 100000) { + if (val < 100) { fmt = "%.3f"; } else + if (val < 1000) { fmt = "%.2f"; } else + { fmt = "%.1f"; }; + objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle); + } else { + objs[4] = Tcl_NewWideIntObj(val); + } + } else { + objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); + } + + /* estimated net execution time (in millisecs) */ + if (!calibrate) { + objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); + TclNewLiteralStringObj(objs[7], "nett-ms"); + } + + /* + * Construct the result as a list because many programs have always parsed + * as such (extracting the first element, typically). + */ + + TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */ + TclNewLiteralStringObj(objs[3], "#"); + TclNewLiteralStringObj(objs[5], "#/sec"); + Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); + } + +done: + + if (codePtr != NULL) { + TclReleaseByteCode(codePtr); + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_TryObjCmd, TclNRTryObjCmd -- * * This procedure is invoked to process the "try" Tcl command. See the diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c04fc0e..90edf07 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1159,6 +1159,25 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *isScalarPtr); + +static inline void +TclPreserveByteCode( + register ByteCode *codePtr) +{ + codePtr->refCount++; +} + +static inline void +TclReleaseByteCode( + register ByteCode *codePtr) +{ + if (codePtr->refCount-- > 1) { + return; + } + /* Just dropped to refcount==0. Clean up. */ + TclCleanupByteCode(codePtr); +} + MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); 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/tclDate.h b/generic/tclDate.h new file mode 100644 index 0000000..e614f9d --- /dev/null +++ b/generic/tclDate.h @@ -0,0 +1,512 @@ +/* + * tclDate.h -- + * + * This header file handles common usage of clock primitives + * between tclDate.c (yacc), tclClock.c and tclClockFmt.c. + * + * Copyright (c) 2014 Serg 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. + */ + +#ifndef _TCLCLOCK_H +#define _TCLCLOCK_H + +/* + * Constants + */ + +#define JULIAN_DAY_POSIX_EPOCH 2440588 +#define GREGORIAN_CHANGE_DATE 2361222 +#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 */ + +#define RODDENBERRY 1946 /* Another epoch (Hi, Jeff!) */ + + +#define CLF_OPTIONAL (1 << 0) /* token is non mandatory */ +#define CLF_POSIXSEC (1 << 1) +#define CLF_LOCALSEC (1 << 2) +#define CLF_JULIANDAY (1 << 3) +#define CLF_TIME (1 << 4) +#define CLF_CENTURY (1 << 6) +#define CLF_DAYOFMONTH (1 << 7) +#define CLF_DAYOFYEAR (1 << 8) +#define CLF_MONTH (1 << 9) +#define CLF_YEAR (1 << 10) +#define CLF_ISO8601YEAR (1 << 12) +#define CLF_ISO8601 (1 << 13) +#define CLF_ISO8601CENTURY (1 << 14) +#define CLF_SIGNED (1 << 15) +/* On demand (lazy) assemble flags */ +#define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */ +#define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ +#define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ + +#define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ + CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | CLF_ISO8601) + +/* + * Enumeration of the string literals used in [clock] + */ + +typedef enum ClockLiteral { + LIT__NIL, + LIT__DEFAULT_FORMAT, + LIT_SYSTEM, LIT_CURRENT, LIT_C, + LIT_BCE, 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_TZDATA, + LIT_GETSYSTEMTIMEZONE, + LIT_SETUPTIMEZONE, + LIT_MCGET, + LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE, + LIT_LOCALIZE_FORMAT, + LIT__END +} ClockLiteral; + +#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ + "", \ + "%a %b %d %H:%M:%S %Z %Y", \ + "system", "current", "C", \ + "BCE", "CE", \ + "dayOfMonth", "dayOfWeek", "dayOfYear", \ + "era", ":GMT", "gregorian", \ + "integer value too large to represent", \ + "iso8601Week", "iso8601Year", \ + "julianDay", "localSeconds", \ + "month", \ + "seconds", "tzName", "tzOffset", \ + "year", \ + "::tcl::clock::TZData", \ + "::tcl::clock::GetSystemTimeZone", \ + "::tcl::clock::SetupTimeZone", \ + "::tcl::clock::mcget", \ + "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ + "::tcl::clock::LocalizeFormat" \ +} + +/* + * Enumeration of the msgcat literals used in [clock] + */ + +typedef enum ClockMsgCtLiteral { + MCLIT__NIL, /* placeholder */ + MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB, + MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB, + MCLIT_AM, MCLIT_PM, + MCLIT_LOCALE_ERAS, + MCLIT_BCE, MCLIT_CE, + MCLIT_BCE2, MCLIT_CE2, + MCLIT_BCE3, MCLIT_CE3, + MCLIT_LOCALE_NUMERALS, + MCLIT__END +} ClockMsgCtLiteral; + +#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ + pref "", \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ + pref "AM", pref "PM", \ + pref "LOCALE_ERAS", \ + pref "BCE", pref "CE", \ + pref "b.c.e.", pref "c.e.", \ + pref "b.c.", pref "a.d.", \ + pref "LOCALE_NUMERALS", \ +} + +/* + * Structure containing the fields used in [clock format] and [clock scan] + */ + +typedef struct TclDateFields { + + /* Cacheable fields: */ + + 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 */ + 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 */ + int hour; /* Hours of day (in-between time only calculation) */ + int minutes; /* Minutes of day (in-between time only calculation) */ + int secondOfDay; /* Seconds of day (in-between time only calculation) */ + + /* Non cacheable fields: */ + + Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the + * time zone, if set the refCount is incremented */ +} TclDateFields; + +#define ClockCacheableDateFieldsSize \ + TclOffset(TclDateFields, tzName) + +/* + * Structure contains return parsed fields. + */ + +typedef struct DateInfo { + const char *dateStart; + const char *dateInput; + const char *dateEnd; + + TclDateFields date; + + int flags; + + int dateHaveDate; + + int dateMeridian; + int dateHaveTime; + + int dateTimezone; + int dateDSTmode; + int dateHaveZone; + + int dateRelMonth; + int dateRelDay; + int dateRelSeconds; + int dateHaveRel; + + int dateMonthOrdinalIncr; + int dateMonthOrdinal; + int dateHaveOrdinalMonth; + + int dateDayOrdinal; + int dateDayNumber; + int dateHaveDay; + + int *dateRelPointer; + + int dateSpaceCount; + int dateDigitCount; + + int dateCentury; + + Tcl_Obj* messages; /* Error messages */ + const char* separatrix; /* String separating messages */ +} DateInfo; + +#define yydate (info->date) /* Date fields used for converting */ + +#define yyDay (info->date.dayOfMonth) +#define yyMonth (info->date.month) +#define yyYear (info->date.year) + +#define yyHour (info->date.hour) +#define yyMinutes (info->date.minutes) +#define yySeconds (info->date.secondOfDay) + +#define yyDSTmode (info->dateDSTmode) +#define yyDayOrdinal (info->dateDayOrdinal) +#define yyDayNumber (info->dateDayNumber) +#define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr) +#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 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 yySpaceCount (info->dateSpaceCount) + +static inline void +ClockInitDateInfo(DateInfo *info) { + memset(info, 0, sizeof(DateInfo)); +} + +/* + * Structure containing the command arguments supplied to [clock format] and [clock scan] + */ + +#define CLF_EXTENDED (1 << 4) +#define CLF_STRICT (1 << 8) +#define CLF_LOCALE_USED (1 << 15) + +typedef struct ClockFmtScnCmdArgs { + ClientData clientData; /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp; /* Tcl interpreter */ + + Tcl_Obj *formatObj; /* Format */ + Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ + Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ + Tcl_Obj *baseObj; /* Base (scan and add) or clockValue (format) */ + int flags; /* Flags control scanning */ + + Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/ +} ClockFmtScnCmdArgs; + +/* + * Structure containing the client data for [clock] + */ + +typedef struct ClockClientData { + size_t refCount; /* Number of live references. */ + Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */ + Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */ + Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_, + * used for quick dictionary search */ + + /* Cache for current clock parameters, imparted via "configure" */ + unsigned long LastTZEpoch; + int currentYearCentury; + int yearOfCenturySwitch; + Tcl_Obj *SystemTimeZone; + Tcl_Obj *SystemSetupTZData; + Tcl_Obj *GMTSetupTimeZone; + Tcl_Obj *GMTSetupTZData; + Tcl_Obj *AnySetupTimeZone; + Tcl_Obj *AnySetupTZData; + Tcl_Obj *LastUnnormSetupTimeZone; + Tcl_Obj *LastSetupTimeZone; + Tcl_Obj *LastSetupTZData; + + Tcl_Obj *CurrentLocale; + Tcl_Obj *CurrentLocaleDict; + Tcl_Obj *LastUnnormUsedLocale; + Tcl_Obj *LastUsedLocale; + Tcl_Obj *LastUsedLocaleDict; + + /* Cache for last base (last-second fast convert if base/tz not changed) */ + struct { + Tcl_Obj *timezoneObj; + TclDateFields Date; + } lastBase; + /* Las-period cache for fast UTC2Local conversion */ + struct { + /* keys */ + Tcl_Obj *timezoneObj; + int changeover; + Tcl_WideInt seconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ + /* values */ + int tzOffset; + Tcl_Obj *tzName; + } UTC2Local; + /* Las-period cache for fast Local2UTC conversion */ + struct { + /* keys */ + Tcl_Obj *timezoneObj; + int changeover; + Tcl_WideInt localSeconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ + /* values */ + int tzOffset; + } Local2UTC; +} ClockClientData; + +#define ClockDefaultYearCentury 2000 +#define ClockDefaultCenturySwitch 38 + +/* + * Meridian: am, pm, or 24-hour style. + */ + +typedef enum _MERIDIAN { + MERam, MERpm, MER24 +} MERIDIAN; + +/* + * Clock scan and format facilities. + */ + +#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 + +#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2 + +typedef struct ClockScanToken ClockScanToken; + + +typedef int ClockScanTokenProc( + ClockFmtScnCmdArgs *opts, + DateInfo *info, + ClockScanToken *tok); + + +typedef enum _CLCKTOK_TYPE { + CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR, + CFMTT_INT, CFMTT_WIDE, CFMTT_PROC +} CLCKTOK_TYPE; + +typedef struct ClockScanTokenMap { + unsigned short int type; + unsigned short int flags; + unsigned short int clearFlags; + unsigned short int minSize; + unsigned short int maxSize; + unsigned short int offs; + ClockScanTokenProc *parser; + void *data; +} ClockScanTokenMap; + +typedef struct ClockScanToken { + ClockScanTokenMap *map; + struct { + const char *start; + const char *end; + } tokWord; + unsigned short int endDistance; + unsigned short int lookAhMin; + unsigned short int lookAhMax; + unsigned short int lookAhTok; +} ClockScanToken; + + +#define MIN_FMT_RESULT_BLOCK_ALLOC 200 + +typedef struct DateFormat { + char *resMem; + char *resEnd; + char *output; + + TclDateFields date; + + Tcl_Obj *localeEra; +} DateFormat; + +#define CLFMT_INCR (1 << 3) +#define CLFMT_DECR (1 << 4) +#define CLFMT_CALC (1 << 5) +#define CLFMT_LOCALE_INDX (1 << 8) + +typedef struct ClockFormatToken ClockFormatToken; + +typedef int ClockFormatTokenProc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val); + +typedef struct ClockFormatTokenMap { + unsigned short int type; + const char *tostr; + unsigned short int width; + unsigned short int flags; + unsigned short int divider; + unsigned short int divmod; + unsigned short int offs; + ClockFormatTokenProc *fmtproc; + void *data; +} ClockFormatTokenMap; +typedef struct ClockFormatToken { + ClockFormatTokenMap *map; + struct { + const char *start; + const char *end; + } tokWord; +} ClockFormatToken; + + +typedef struct ClockFmtScnStorage ClockFmtScnStorage; + +typedef struct ClockFmtScnStorage { + int objRefCount; /* Reference count shared across threads */ + ClockScanToken *scnTok; + unsigned int scnTokC; + unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */ + ClockFormatToken *fmtTok; + unsigned int fmtTokC; +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + ClockFmtScnStorage *nextPtr; + ClockFmtScnStorage *prevPtr; +#endif +#if 0 + +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, + * stored by offset +sizeof(self) */ +#endif +} ClockFmtScnStorage; + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE int ToSeconds(int Hours, int Minutes, + int Seconds, MERIDIAN Meridian); +MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); +MODULE_SCOPE void + GetJulianDayFromEraYearWeekDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearMonthDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, + TclDateFields *, Tcl_Obj *timezoneObj, int); +MODULE_SCOPE Tcl_Obj * + LookupLastTransition(Tcl_Interp *, Tcl_WideInt, + int, Tcl_Obj *const *, Tcl_WideInt rangesVal[2]); + +MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); + +/* tclClock.c module declarations */ + +MODULE_SCOPE Tcl_Obj * + ClockSetupTimeZone(ClientData clientData, + Tcl_Interp *interp, Tcl_Obj *timezoneObj); + +MODULE_SCOPE Tcl_Obj * + ClockMCDict(ClockFmtScnCmdArgs *opts); +MODULE_SCOPE Tcl_Obj * + ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE Tcl_Obj * + ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey, + Tcl_Obj *valObj); + +/* tclClockFmt.c module declarations */ + +MODULE_SCOPE Tcl_Obj* + ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, + Tcl_Obj *objPtr); + +MODULE_SCOPE ClockFmtScnStorage * + Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); +MODULE_SCOPE Tcl_Obj * + ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE int ClockScan(register DateInfo *info, + Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt, + ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE void ClockFrmScnClearCaches(void); + +#endif /* _TCLCLOCK_H */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 428173d..593f5a3 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 }, @@ -142,7 +145,7 @@ typedef struct Dict { * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ - int refcount; /* Reference counter (see above) */ + size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ @@ -392,7 +395,7 @@ DupDictInternalRep( newDict->epoch = 0; newDict->chain = NULL; - newDict->refcount = 1; + newDict->refCount = 1; /* * Store in the object. @@ -427,8 +430,7 @@ FreeDictInternalRep( { Dict *dict = DICT(dictPtr); - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } dictPtr->typePtr = NULL; @@ -713,7 +715,7 @@ SetDictFromAny( TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; @@ -1117,7 +1119,7 @@ Tcl_DictObjFirst( searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; - dict->refcount++; + dict->refCount++; if (keyPtrPtr != NULL) { *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); } @@ -1231,8 +1233,7 @@ Tcl_DictObjDone( if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } } @@ -1384,7 +1385,7 @@ Tcl_NewDictObj(void) InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1434,7 +1435,7 @@ Tcl_DbNewDictObj( InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1960,6 +1961,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/tclEnsemble.c b/generic/tclEnsemble.c index c1b0890..2480685 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -55,11 +55,12 @@ enum EnsSubcmds { }; static const char *const ensembleCreateOptions[] = { - "-command", "-map", "-parameters", "-prefixes", "-subcommands", - "-unknown", NULL + "-command", "-compile", "-map", "-parameters", "-prefixes", + "-subcommands", "-unknown", NULL }; enum EnsCreateOpts { - CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN + CRT_CMD, CRT_COMPILE, CRT_MAP, CRT_PARAM, CRT_PREFIX, + CRT_SUBCMDS, CRT_UNKNOWN }; static const char *const ensembleConfigOptions[] = { @@ -183,6 +184,7 @@ TclNamespaceEnsembleCmd( int permitPrefix = 1; Tcl_Obj *unknownObj = NULL; Tcl_Obj *paramObj = NULL; + int ensCompFlag = -1; /* * Check that we've got option-value pairs... [Bug 1558654] @@ -325,6 +327,12 @@ TclNamespaceEnsembleCmd( return TCL_ERROR; } continue; + case CRT_COMPILE: + if (Tcl_GetBooleanFromObj(interp, objv[1], + &ensCompFlag) != TCL_OK) { + return TCL_ERROR; + }; + continue; case CRT_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { @@ -350,6 +358,12 @@ TclNamespaceEnsembleCmd( Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); + /* + * Ensemble should be compiled if it has map (performance purposes) + */ + if (ensCompFlag > 0 && mapObj != NULL) { + Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE); + } /* * Tricky! Must ensure that the result is not shared (command delete 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 7b582c0..333a665 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, @@ -3151,10 +3152,22 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); + #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); +MODULE_SCOPE double TclpWideClickInMicrosec(void); +#else +# ifdef _WIN32 +# define TCL_WIDE_CLICKS 1 +MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); +MODULE_SCOPE double TclpWideClickInMicrosec(void); +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) +# endif #endif +MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); + MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); @@ -3424,6 +3437,9 @@ MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -4858,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 */ /* diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c new file mode 100644 index 0000000..291e481 --- /dev/null +++ b/generic/tclStrIdxTree.c @@ -0,0 +1,527 @@ +/* + * tclStrIdxTree.c -- + * + * Contains the routines for managing string index tries in Tcl. + * + * This code is back-ported from the tclSE engine, by Serg G. Brester. + * + * Copyright (c) 2016 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. + * + * ----------------------------------------------------------------------- + * + * String index tries are prepaired structures used for fast greedy search of the string + * (index) by unique string prefix as key. + * + * Index tree build for two lists together can be explained in the following datagram + * + * Lists: + * + * {Januar Februar Maerz April Mai Juni Juli August September Oktober November Dezember} + * {Jnr Fbr Mrz Apr Mai Jni Jli Agt Spt Okt Nvb Dzb} + * + * Index-Tree: + * + * j 0 * ... + * anuar 1 * + * u 0 * a 0 + * ni 6 * pril 4 + * li 7 * ugust 8 + * n 0 * gt 8 + * r 1 * s 9 + * i 6 * eptember 9 + * li 7 * pt 9 + * f 2 * oktober 10 + * ebruar 2 * n 11 + * br 2 * ovember 11 + * m 0 * vb 11 + * a 0 * d 12 + * erz 3 * ezember 12 + * i 5 * zb 12 + * rz 3 * + * ... + * + * Thereby value 0 shows pure group items (corresponding ambigous matches). + * But the group may have a value if it contains only same values + * (see for example group "f" above). + * + * StrIdxTree's are very fast, so: + * build of above-mentioned tree takes about 10 microseconds. + * search of string index in this tree takes fewer as 0.1 microseconds. + * + */ + +#include "tclInt.h" +#include "tclStrIdxTree.h" + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeSearch -- + * + * Find largest part of string "start" in indexed tree (case sensitive). + * + * Also used for building of string index tree. + * + * Results: + * Return position of UTF character in start after last equal character + * and found item (with parent). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE const char* +TclStrIdxTreeSearch( + TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */ + TclStrIdx **foundItem, /* Return value of found item */ + TclStrIdxTree *tree, /* Index tree will be browsed */ + const char *start, /* UTF string to find in tree */ + const char *end) /* End of string */ +{ + TclStrIdxTree *parent = tree, *prevParent = tree; + TclStrIdx *item = tree->firstPtr, *prevItem = NULL; + const char *s = start, *f, *cin, *cinf, *prevf; + int offs = 0; + + if (item == NULL) { + goto done; + } + + /* search in tree */ + do { + cinf = cin = TclGetString(item->key) + offs; + f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf); + /* if something was found */ + if (f > s) { + /* if whole string was found */ + if (f >= end) { + start = f; + goto done; + }; + /* set new offset and shift start string */ + offs += cinf - cin; + s = f; + /* if match item, go deeper as long as possible */ + if (offs >= item->length && item->childTree.firstPtr) { + /* save previuosly found item (if not ambigous) for + * possible fallback (few greedy match) */ + if (item->value != NULL) { + prevf = f; + prevItem = item; + prevParent = parent; + } + parent = &item->childTree; + item = item->childTree.firstPtr; + continue; + } + /* no children - return this item and current chars found */ + start = f; + goto done; + } + + item = item->nextPtr; + + } while (item != NULL); + + /* fallback (few greedy match) not ambigous (has a value) */ + if (prevItem != NULL) { + item = prevItem; + parent = prevParent; + start = prevf; + } + +done: + + if (foundParent) + *foundParent = parent; + if (foundItem) + *foundItem = item; + return start; +} + +MODULE_SCOPE void +TclStrIdxTreeFree( + TclStrIdx *tree) +{ + while (tree != NULL) { + TclStrIdx *t; + Tcl_DecrRefCount(tree->key); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreeFree(tree->childTree.firstPtr); + } + t = tree, tree = tree->nextPtr; + ckfree(t); + } +} + +/* + * Several bidirectional list primitives + */ +inline void +TclStrIdxTreeInsertBranch( + TclStrIdxTree *parent, + register TclStrIdx *item, + register TclStrIdx *child) +{ + if (parent->firstPtr == child) + parent->firstPtr = item; + if (parent->lastPtr == child) + parent->lastPtr = item; + if ( (item->nextPtr = child->nextPtr) ) { + item->nextPtr->prevPtr = item; + child->nextPtr = NULL; + } + if ( (item->prevPtr = child->prevPtr) ) { + item->prevPtr->nextPtr = item; + child->prevPtr = NULL; + } + item->childTree.firstPtr = child; + item->childTree.lastPtr = child; +} + +inline void +TclStrIdxTreeAppend( + register TclStrIdxTree *parent, + register TclStrIdx *item) +{ + if (parent->lastPtr != NULL) { + parent->lastPtr->nextPtr = item; + } + item->prevPtr = parent->lastPtr; + item->nextPtr = NULL; + parent->lastPtr = item; + if (parent->firstPtr == NULL) { + parent->firstPtr = item; + } +} + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeBuildFromList -- + * + * Build or extend string indexed tree from tcl list. + * If the values not given the values of built list are indices starts with 1. + * Value of 0 is thereby reserved to the ambigous values. + * + * Important: by multiple lists, optimal tree can be created only if list with + * larger strings used firstly. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TclStrIdxTreeBuildFromList( + TclStrIdxTree *idxTree, + int lstc, + Tcl_Obj **lstv, + ClientData *values) +{ + Tcl_Obj **lwrv; + int i, ret = TCL_ERROR; + ClientData val; + const char *s, *e, *f; + TclStrIdx *item; + + /* create lowercase reflection of the list keys */ + + lwrv = ckalloc(sizeof(Tcl_Obj*) * lstc); + if (lwrv == NULL) { + return TCL_ERROR; + } + for (i = 0; i < lstc; i++) { + lwrv[i] = Tcl_DuplicateObj(lstv[i]); + if (lwrv[i] == NULL) { + return TCL_ERROR; + } + Tcl_IncrRefCount(lwrv[i]); + lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i])); + } + + /* build index tree of the list keys */ + for (i = 0; i < lstc; i++) { + TclStrIdxTree *foundParent = idxTree; + e = s = TclGetString(lwrv[i]); + e += lwrv[i]->length; + val = values ? values[i] : INT2PTR(i+1); + + /* ignore empty keys (impossible to index it) */ + if (lwrv[i]->length == 0) continue; + + item = NULL; + if (idxTree->firstPtr != NULL) { + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(&foundParent, &foundItem, + idxTree, s, e); + /* if common prefix was found */ + if (f > s) { + /* ignore element if fulfilled or ambigous */ + if (f == e) { + continue; + } + /* if shortest key was found with the same value, + * just replace its current key with longest key */ + if ( foundItem->value == val + && foundItem->length < lwrv[i]->length + && foundItem->childTree.firstPtr == NULL + ) { + Tcl_SetObjRef(foundItem->key, lwrv[i]); + foundItem->length = lwrv[i]->length; + continue; + } + /* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) ) + * but don't split by fulfilled child of found item ( ii->iii->iiii ) */ + if (foundItem->length != (f - s)) { + /* first split found item (insert one between parent and found + new one) */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + Tcl_InitObjRef(item->key, foundItem->key); + item->length = f - s; + /* set value or mark as ambigous if not the same value of both */ + item->value = (foundItem->value == val) ? val : NULL; + /* insert group item between foundParent and foundItem */ + TclStrIdxTreeInsertBranch(foundParent, item, foundItem); + foundParent = &item->childTree; + } else { + /* the new item should be added as child of found item */ + foundParent = &foundItem->childTree; + } + } + } + /* append item at end of found parent */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + item->childTree.lastPtr = item->childTree.firstPtr = NULL; + Tcl_InitObjRef(item->key, lwrv[i]); + item->length = lwrv[i]->length; + item->value = val; + TclStrIdxTreeAppend(foundParent, item); + }; + + ret = TCL_OK; + +done: + + if (lwrv != NULL) { + for (i = 0; i < lstc; i++) { + Tcl_DecrRefCount(lwrv[i]); + } + ckfree(lwrv); + } + + if (ret != TCL_OK) { + if (idxTree->firstPtr != NULL) { + TclStrIdxTreeFree(idxTree->firstPtr); + } + } + + return ret; +} + + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr); +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr); + +Tcl_ObjType StrIdxTreeObjType = { + "str-idx-tree", /* name */ + StrIdxTreeObj_FreeIntRepProc, /* freeIntRepProc */ + StrIdxTreeObj_DupIntRepProc, /* dupIntRepProc */ + StrIdxTreeObj_UpdateStringProc, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +MODULE_SCOPE Tcl_Obj* +TclStrIdxTreeNewObj() +{ + Tcl_Obj *objPtr = Tcl_NewObj(); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &StrIdxTreeObjType; + /* return tree root in internal representation */ + return objPtr; +} + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) +{ + /* follow links (smart pointers) */ + if ( srcPtr->internalRep.twoPtrValue.ptr1 != NULL + && srcPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1; + } + /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ + Tcl_InitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1), + srcPtr); + copyPtr->internalRep.twoPtrValue.ptr2 = NULL; + copyPtr->typePtr = &StrIdxTreeObjType; +} + +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr) +{ + /* follow links (smart pointers) */ + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + /* is a link */ + Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1)); + } else { + /* is a tree */ + TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; + if (tree->firstPtr != NULL) { + TclStrIdxTreeFree(tree->firstPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + } + objPtr->typePtr = NULL; +}; + +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr) +{ + /* currently only dummy empty string possible */ + objPtr->length = 0; + objPtr->bytes = &tclEmptyString; +}; + +MODULE_SCOPE TclStrIdxTree * +TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) { + /* follow links (smart pointers) */ + if (objPtr->typePtr != &StrIdxTreeObjType) { + return NULL; + } + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1; + } + /* return tree root in internal representation */ + return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; +} + +/* + * Several debug primitives + */ +#if 0 +/* currently unused, debug resp. test purposes only */ + +void +TclStrIdxTreePrint( + Tcl_Interp *interp, + TclStrIdx *tree, + int offs) +{ + Tcl_Obj *obj[2]; + const char *s; + Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1)); + while (tree != NULL) { + s = TclGetString(tree->key) + offs; + Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d", + offs, "", tree->length - offs, s, tree->value)); + Tcl_PutsObjCmd(NULL, interp, 2, obj); + Tcl_UnsetObjRef(obj[1]); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length); + } + tree = tree->nextPtr; + } + Tcl_UnsetObjRef(obj[0]); +} + + +MODULE_SCOPE int +TclStrIdxTreeTestObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + const char *cs, *cin, *ret; + + static const char *const options[] = { + "index", "puts-index", "findequal", + NULL + }; + enum optionInd { + O_INDEX, O_PUTS_INDEX, O_FINDEQUAL + }; + int optionIndex; + + if (objc < 2) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], options, + "option", 0, &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[1]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case O_FINDEQUAL: + if (objc < 4) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + cs = TclGetString(objv[2]); + cin = TclGetString(objv[3]); + ret = TclUtfFindEqual( + cs, cs + objv[1]->length, cin, cin + objv[2]->length); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); + break; + case O_INDEX: + case O_PUTS_INDEX: + + if (1) { + Tcl_Obj **lstv; + int i, lstc; + TclStrIdxTree idxTree = {NULL, NULL}; + i = 1; + while (++i < objc) { + if (TclListObjGetElements(interp, objv[i], + &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + }; + TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv, NULL); + } + if (optionIndex == O_PUTS_INDEX) { + TclStrIdxTreePrint(interp, idxTree.firstPtr, 0); + } + TclStrIdxTreeFree(idxTree.firstPtr); + } + break; + } + + return TCL_OK; +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h new file mode 100644 index 0000000..9f26907 --- /dev/null +++ b/generic/tclStrIdxTree.h @@ -0,0 +1,169 @@ +/* + * tclStrIdxTree.h -- + * + * Declarations of string index tries and other primitives currently + * back-ported from tclSE. + * + * Copyright (c) 2016 Serg 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. + */ + +#ifndef _TCLSTRIDXTREE_H +#define _TCLSTRIDXTREE_H + + +/* + * Main structures declarations of index tree and entry + */ + +typedef struct TclStrIdxTree { + struct TclStrIdx *firstPtr; + struct TclStrIdx *lastPtr; +} TclStrIdxTree; + +typedef struct TclStrIdx { + struct TclStrIdxTree childTree; + struct TclStrIdx *nextPtr; + struct TclStrIdx *prevPtr; + Tcl_Obj *key; + int length; + ClientData value; +} TclStrIdx; + + +/* + *---------------------------------------------------------------------- + * + * TclUtfFindEqual, TclUtfFindEqualNC -- + * + * Find largest part of string cs in string cin (case sensitive and not). + * + * Results: + * Return position of UTF character in cs after last equal character. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline const char * +TclUtfFindEqual( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine) /* End of cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) break; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfFindEqualNC( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfFindEqualNCInLwr( + register const char *cs, /* UTF string (in anycase) to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string (in lowercase) will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfNext( + register const char *src) /* The current location in the string. */ +{ + if (((unsigned char) *(src)) < 0xC0) { + return ++src; + } else { + Tcl_UniChar ch; + return src + TclUtfToUniChar(src, &ch); + } +} + + +/* + * Primitives to safe set, reset and free references. + */ + +#define Tcl_UnsetObjRef(obj) \ + if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } +#define Tcl_InitObjRef(obj, val) \ + obj = val; if (obj) { Tcl_IncrRefCount(obj); } +#define Tcl_SetObjRef(obj, val) \ +if (1) { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + Tcl_InitObjRef(obj, nval); \ + if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ + } \ +} + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE const char* + TclStrIdxTreeSearch(TclStrIdxTree **foundParent, + TclStrIdx **foundItem, TclStrIdxTree *tree, + const char *start, const char *end); + +MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, + int lstc, Tcl_Obj **lstv, ClientData *values); + +MODULE_SCOPE Tcl_Obj* + TclStrIdxTreeNewObj(); + +MODULE_SCOPE TclStrIdxTree* + TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); + +#if 1 + +MODULE_SCOPE int TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *, + int, Tcl_Obj *const objv[]); +#endif + +#endif /* _TCLSTRIDXTREE_H */ |