Tcl Source Code

1 January 1970, 00:00 UTC.  Note that the count of seconds does not
include any leap seconds; seconds are counted as if each UTC day has
exactly 86400 seconds.  Tcl responds to leap seconds by speeding or
slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
\fI\-now\fR
Instead of \fItimeVal\fR a non-integer option \fI\-now\fR can be used as
replacement for today, which is simply interpolated to the runt-time as value
of \fBclock seconds\fR. For example:
.sp
\fBclock format -now -f %a; # current day of the week\fR
.sp
\fBclock add -now 1 month; # next month\fR
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
Used in conjunction with \fIcount\fR to identify an interval of time,
for example, \fI3 seconds\fR or \fI1 year\fR.
.SS "OPTIONS"
.TP

string of the same meaning in the locale, to indicate whether \fB%Y\fR refers
to years before or after Year 1 of the Common Era.  On input, accepts
the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the
abbreviation appropriate to the current locale, and uses it to fix
whether \fB%Y\fR refers to years before or after Year 1 of the
Common Era.
.TP
\fB%Es\fR
This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses
or formats local seconds (not the posix seconds).
Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines 
a point in time), it overrides all other input formats.
.TP
\fB%Ex\fR
On output, produces a locale-dependent representation of the date
in the locale's alternative calendar.  On input, matches
whatever \fB%Ex\fR produces.  The locale's alternative calendar need not
be the Gregorian calendar.
.TP
\fB%EX\fR

that \fB%Y\fR does not yield a year appropriate for use with the ISO8601
week number \fB%V\fR; programs should use \fB%G\fR for that purpose.
.TP
\fB%z\fR
On output, produces the current time zone, expressed in hours and
minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a
time zone specifier (see \fBTIME ZONES\fR below) that will be used to
determine the time zone (this token is optionally applicable on input, 
so the value is not mandatory and can be missing in input).
.TP
\fB%Z\fR
On output, produces the current time zone's name, possibly
translated to the given locale. On input, accepts a time zone
specifier (see \fBTIME ZONES\fR below) that will be used to determine the
time zone (token is also like \fB%z\fR optionally applicable on input).
This option should, in general, be used on input only when
parsing RFC822 dates. Other uses are fraught with ambiguity; for
instance, the string \fBBST\fR may represent British Summer Time or
Brazilian Standard Time. It is recommended that date/time strings for
use by computers use numeric time zones instead.
.TP
\fB%%\fR
On output, produces a literal

Using that time as the base, day-of-week specifications are added.
Next, relative specifications are used.  If a date or day is
specified, and no absolute or relative time is given, midnight is
used.  Finally, a correction is applied so that the correct hour of
the day is produced after allowing for daylight savings time
differences and the correct date is given when going from the end
of a long month to a short month.
.PP
The precedence of the applying of single tokens resp. which sequence will be
used by calculating of the time is complex, e. g. heavily dependent on the
precision of type of the token.
.sp
In example below the second date-string contains "next January", therefore
it results in next year but in January. And third date-string besides "January"
contains also additionally "Fri", so it results in the nearest Friday.
Thus both win before "385 days" resp. make it more precise, because of higher 
precision of this token types.
.CS
% clock format [clock scan "5 years 18 months 385 days" -base 0 -gmt 1] -gmt 1
Thu Jul 21 00:00:00 GMT 1977
% clock format [clock scan "5 years 18 months 385 days next January" -base 0 -gmt 1] -gmt 1
Sat Jan 21 00:00:00 GMT 1978
% clock format [clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1] -gmt 1
Fri Jan 27 00:00:00 GMT 1978
.CE
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
clock, date, time
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:

'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Time-related execution resp. performance measurement of a script
.SH SYNOPSIS
\fBtimerate \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR
.BE
.SH DESCRIPTION
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified. 
.sp
It will then return a canonical tcl-list of the form
.PP
.CS
\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu
the average amount of time required per iteration, in microseconds (lindex $result 0)
.IP \(bu
the count how many times it was executed (lindex $result 2)
.IP \(bu
the estimated rate per second (lindex $result 4)
.IP \(bu
the estimated real execution time without measurement overhead (lindex $result 6)
.PP
Time is measured in elapsed time using heighest timer resolution as possible, not CPU time.
This command may be used to provide information as to how well the script or a tcl-command 
is performing and can help determine bottlenecks and fine-tune application performance.
.PP
\fI-calibrate\fR
.
To measure very fast scripts as exact as posible the calibration process
may be required.

This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead 
of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR.
It can take up to 10 seconds if parameter \fItime\fR is not specified.
.PP
\fI-overhead double\fR
.
This parameter used to supply the measurement overhead of single iteration 
(in microseconds) that should be ignored during whole evaluation process.
.PP
\fI-direct\fR
.
Causes direct execution per iteration (not compiled variant of evaluation used).
.PP
In opposition to \fBtime\fR the execution limited here by fixed time instead of 
repetition count.
Additionally the compiled variant of the script will be used during whole evaluation 
(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified.
Therefore it provides more precise results and prevents very long execution time 
by slow scripts resp. scripts with unknown speed.

.SH EXAMPLE
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate:
timerate -calibrate {}
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the 
overhead for operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate for overhead of variable operations:
set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring 
overhead of the rest, without measurement how fast it takes for a whole script:
.PP
.CS
# calibrate:
timerate -calibrate {}
# estimate overhead:
set tm 0
set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
# measure using esimated overhead:
set tm 0
timerate -overhead $ovh {
    clock format $tm -format %H
    incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
.CE
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
script, timerate, time
.\" Local Variables:
.\" mode: nroff
.\" End:

    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
    {"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},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*

/*
 * tclClock.c --
 *
 *	Contains the time and date related commands. This code is derived from
 *	the time and date facilities of TclX, by Mark Diekhans and Karl
 *	Lehenbauer.
 *
 * 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.
 */

#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
















/*
 * Table of the days in each month, leap and common years
 */

static const int hath[2][12] = {
    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
    {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
};
static const int daysInPriorMonths[2][13] = {
    {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365},
    {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}
};

/*
 * Enumeration of the string literals used in [clock]
 */
















CLOCK_LITERAL_ARRAY(Literals);



















/* 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_");




















static const char *const eras[] = { "CE", "BCE", NULL };

/*
 * Thread specific data block holding a 'struct tm' for the 'gmtime' and
 * 'localtime' library calls.
 */

static Tcl_ThreadDataKey tmKey;

/*
 * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
 * in the date parsing code.
 */

TCL_DECLARE_MUTEX(clockMutex)

/*
 * Function prototypes for local procedures in this file:
 */



static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[],
			    Tcl_WideInt rangesVal[2]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(ClientData clientData, Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *timezoneObj, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[],
			    Tcl_WideInt rangesVal[2]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
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 int		WeekdayOnOrBefore(int, int);
static int		ClockClicksObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
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[]);
static int		ClockGetjuliandayfromerayearmonthdayObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockGetjuliandayfromerayearweekdayObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockGetenvObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockMicrosecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockMillisecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockSecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockFormatObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockScanObjCmd(
			    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);

/*
 * Structure containing description of "native" clock commands to create.
 */

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
				 * will always have the ClockClientData sent
				 * to it, but may well ignore this data. */
    CompileProc *compileProc;	/* The compiler for the command. */
    ClientData clientData;	/* Any clientData to give the command (if NULL
    				 * a reference to ClockClientData will be sent) */
};

static const struct ClockCommand clockCommands[] = {
    {"add",		ClockAddObjCmd,		TclCompileBasicMin1ArgCmd, NULL},
    {"clicks",		ClockClicksObjCmd,	TclCompileClockClicksCmd,  NULL},
    {"format",		ClockFormatObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"getenv",		ClockGetenvObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"microseconds",	ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)},
    {"milliseconds",	ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)},
    {"scan",		ClockScanObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"seconds",		ClockSecondsObjCmd,	TclCompileClockReadingCmd, INT2PTR(3)},
    {"configure",	  ClockConfigureObjCmd,			NULL, NULL},
    {"Oldscan",		  TclClockOldscanObjCmd,		NULL, NULL},
    {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd,		NULL, NULL},
    {"GetDateFields",	  ClockGetdatefieldsObjCmd,		NULL, NULL},
    {"GetJulianDayFromEraYearMonthDay",
		ClockGetjuliandayfromerayearmonthdayObjCmd,	NULL, NULL},
    {"GetJulianDayFromEraYearWeekDay",
		ClockGetjuliandayfromerayearweekdayObjCmd,	NULL, NULL},

    {NULL, NULL, NULL, NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclClockInit --
 *

TclClockInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    const struct ClockCommand *clockCmdPtr;
    char cmdName[50];		/* Buffer large enough to hold the string
				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
				 * plus a terminating NUL. */
    Command         *cmdPtr;
    ClockClientData *data;
    int i;














    /*
     * Safe interps get [::clock] as alias to a master, so do not need their
     * own copies of the support routines.
     */

    if (Tcl_IsSafe(interp)) {
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1));
    }
    data->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.

     */

#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
    memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
    	ClientData clientData;

	strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
	if (!(clientData = clockCmdPtr->clientData)) {
	    clientData = data;
	    data->refCount++;
	}
	cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName, 
		clockCmdPtr->objCmdProc, clientData,
		clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc);
	cmdPtr->compileProc = clockCmdPtr->compileProc ? 
		clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConfigureClear --
 *
 *	Clean up cached resp. run-time storages used in clock commands.
 *
 *	Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear".
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ClockConfigureClear(
    ClockClientData *data)
{
    ClockFrmScnClearCaches();

    data->LastTZEpoch = 0;
    Tcl_UnsetObjRef(data->SystemTimeZone);
    Tcl_UnsetObjRef(data->SystemSetupTZData);
    Tcl_UnsetObjRef(data->GMTSetupTimeZone);
    Tcl_UnsetObjRef(data->GMTSetupTZData);
    Tcl_UnsetObjRef(data->AnySetupTimeZone);
    Tcl_UnsetObjRef(data->AnySetupTZData);
    Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone);
    Tcl_UnsetObjRef(data->LastSetupTimeZone);
    Tcl_UnsetObjRef(data->LastSetupTZData);

    Tcl_UnsetObjRef(data->CurrentLocale);
    Tcl_UnsetObjRef(data->CurrentLocaleDict);
    Tcl_UnsetObjRef(data->LastUnnormUsedLocale);
    Tcl_UnsetObjRef(data->LastUsedLocale);
    Tcl_UnsetObjRef(data->LastUsedLocaleDict);

    Tcl_UnsetObjRef(data->lastBase.timezoneObj);
    Tcl_UnsetObjRef(data->UTC2Local.timezoneObj);
    Tcl_UnsetObjRef(data->UTC2Local.tzName);
    Tcl_UnsetObjRef(data->Local2UTC.timezoneObj);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockDeleteCmdProc --
 *
 *	Remove a reference to the clock client data, and clean up memory
 *	when it's all gone.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	if (data->mcLiterals != NULL) {
	    for (i = 0; i < MCLIT__END; ++i) {
		Tcl_DecrRefCount(data->mcLiterals[i]);
	    }
	    data->mcLiterals = NULL;
	}
	if (data->mcLitIdxs != NULL) {
	    for (i = 0; i < MCLIT__END; ++i) {
		Tcl_DecrRefCount(data->mcLitIdxs[i]);
	    }
	    data->mcLitIdxs = NULL;
	}

	ClockConfigureClear(data);

	ckfree(data->literals);
	ckfree(data);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NormTimezoneObj --
 *
 *	Normalizes the timezone object (used for caching puposes).
 *
 *	If already cached time zone could be found, returns this
 *	object (last setup or last used, system (current) or gmt).
 *
 * Results:
 *	Normalized tcl object pointer.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
NormTimezoneObj(
    ClockClientData *dataPtr,  /* Client data containing literal pool */
    Tcl_Obj *timezoneObj)
{
    const char *tz;
    if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone
      && dataPtr->LastSetupTimeZone != NULL 
    ) {
	return dataPtr->LastSetupTimeZone;
    }
    if ( timezoneObj == dataPtr->LastSetupTimeZone
      || timezoneObj == dataPtr->literals[LIT_GMT]
      || timezoneObj == dataPtr->SystemTimeZone
      || timezoneObj == dataPtr->AnySetupTimeZone
    ) {
	return timezoneObj;
    }

    tz = TclGetString(timezoneObj);
    if (dataPtr->AnySetupTimeZone != NULL &&
	(timezoneObj == dataPtr->AnySetupTimeZone
	   || strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0
	)
    ) {
	timezoneObj = dataPtr->AnySetupTimeZone;
    }
    else
    if (dataPtr->SystemTimeZone != NULL &&
	(timezoneObj == dataPtr->SystemTimeZone
	   || strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0
	)
    ) {
	timezoneObj = dataPtr->SystemTimeZone;
    }
    else
    if (
	strcmp(tz, Literals[LIT_GMT]) == 0
    ) {
	timezoneObj = dataPtr->literals[LIT_GMT];
    }
    return timezoneObj;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetSystemLocale --
 *
 *	Returns system locale.
 *
 *	Executes ::tcl::clock::GetSystemLocale in given interpreter.
 *
 * Results:
 *	Returns system locale tcl object.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
ClockGetSystemLocale(
    ClockClientData *dataPtr,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) {
	return NULL;
    }

    return Tcl_GetObjResult(interp);
}
/*
 *----------------------------------------------------------------------
 *
 * ClockGetCurrentLocale --
 *
 *	Returns current locale.
 *
 *	Executes ::tcl::clock::mclocale in given interpreter.
 *
 * Results:
 *	Returns current locale tcl object.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
ClockGetCurrentLocale(
    ClockClientData *dataPtr,	/* Client data containing literal pool */
    Tcl_Interp *interp)		/* Tcl interpreter */
{   
    if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) {
	return NULL;
    }

    Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp));
    Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);

    return dataPtr->CurrentLocale;
}

/*
 *----------------------------------------------------------------------
 *
 * NormLocaleObj --
 *
 *	Normalizes the locale object (used for caching puposes).
 *
 *	If already cached locale could be found, returns this
 *	object (current, system (OS) or last used locales).
 *
 * Results:
 *	Normalized tcl object pointer.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NormLocaleObj(
    ClockClientData *dataPtr,	/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj    *localeObj,
    Tcl_Obj   **mcDictObj)
{
    const char *loc;
    if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale
      || localeObj == dataPtr->literals[LIT_C] 
      || localeObj == dataPtr->literals[LIT_CURRENT]
    ) {
	if (dataPtr->CurrentLocale == NULL) {
	    ClockGetCurrentLocale(dataPtr, interp);
	}
	*mcDictObj = dataPtr->CurrentLocaleDict;
	return dataPtr->CurrentLocale;
    }
    if ( localeObj == dataPtr->LastUsedLocale
      || localeObj == dataPtr->LastUnnormUsedLocale
    ) {
	*mcDictObj = dataPtr->LastUsedLocaleDict;
	return dataPtr->LastUsedLocale;
    }

    loc = TclGetString(localeObj);
    if ( dataPtr->CurrentLocale != NULL
      && ( localeObj == dataPtr->CurrentLocale
       || (localeObj->length == dataPtr->CurrentLocale->length
	  && strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0
	)
      )
    ) {
	*mcDictObj = dataPtr->CurrentLocaleDict;
	localeObj = dataPtr->CurrentLocale;
    }
    else
    if ( dataPtr->LastUsedLocale != NULL
      && ( localeObj == dataPtr->LastUsedLocale
       || (localeObj->length == dataPtr->LastUsedLocale->length
	  && strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0
	)
      )
    ) {
	*mcDictObj = dataPtr->LastUsedLocaleDict;
	Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
	localeObj = dataPtr->LastUsedLocale;
    }
    else
    if (
	 (localeObj->length == 1 /* C */
	   && strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0)
      || (localeObj->length == 7 /* current */
	   && strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0)
    ) {
	if (dataPtr->CurrentLocale == NULL) {
	    ClockGetCurrentLocale(dataPtr, interp);
	}
	*mcDictObj = dataPtr->CurrentLocaleDict;
	localeObj = dataPtr->CurrentLocale;
    } 
    else 
    if (
	 (localeObj->length == 6 /* system */
	   && strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0)
    ) {
	Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
	localeObj = ClockGetSystemLocale(dataPtr, interp);
	Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj);
	*mcDictObj = NULL;
    } 
    else 
    {
	*mcDictObj = NULL;
    }
    return localeObj;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockMCDict --
 *
 *	Retrieves a localized storage dictionary object for the given 
 *	locale object.
 *
 *	This corresponds with call `::tcl::clock::mcget locale`.
 *	Cached representation stored in options (for further access).
 *
 * Results:
 *	Tcl-object contains smart reference to msgcat dictionary.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockMCDict(ClockFmtScnCmdArgs *opts)
{
    ClockClientData *dataPtr = opts->clientData;

    /* if dict not yet retrieved */
    if (opts->mcDictObj == NULL) {

	/* if locale was not yet used */
	if ( !(opts->flags & CLF_LOCALE_USED) ) {
	    
	    opts->localeObj = NormLocaleObj(opts->clientData, opts->interp,
		opts->localeObj, &opts->mcDictObj);
	    
	    if (opts->localeObj == NULL) {
		Tcl_SetResult(opts->interp,
		    "locale not specified and no default locale set", TCL_STATIC);
		Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL);
		return NULL;
	    }
	    opts->flags |= CLF_LOCALE_USED;

	    /* check locale literals already available (on demand creation) */
	    if (dataPtr->mcLiterals == NULL) {
		int i;
		dataPtr->mcLiterals = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
		for (i = 0; i < MCLIT__END; ++i) {
		    Tcl_InitObjRef(dataPtr->mcLiterals[i], 
			Tcl_NewStringObj(MsgCtLiterals[i], -1));
		}
	    }
	}

	if (opts->mcDictObj == NULL) {
	    Tcl_Obj *callargs[2];
	    /* get msgcat dictionary - ::tcl::clock::mcget locale */
	    callargs[0] = dataPtr->literals[LIT_MCGET];
	    callargs[1] = opts->localeObj;

	    if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) {
		return NULL;
	    }

	    opts->mcDictObj = Tcl_GetObjResult(opts->interp);
	    /* be sure that object reference not increases (dict changeable) */
	    if (opts->mcDictObj->refCount > 0) {
		/* smart reference (shared dict as object with no ref-counter) */
		opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj);
	    }
	    if ( opts->localeObj == dataPtr->CurrentLocale ) {
		Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj);
	    } else if ( opts->localeObj == dataPtr->LastUsedLocale ) {
		Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
	    } else {
		Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj);
		Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale);
		Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
	    }
	    Tcl_ResetResult(opts->interp);
	}
    }

    return opts->mcDictObj;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockMCGet --
 *
 *	Retrieves a msgcat value for the given literal integer mcKey
 *	from localized storage (corresponding given locale object)
 *	by mcLiterals[mcKey] (e. g. MONTHS_FULL).
 *
 * Results:
 *	Tcl-object contains localized value.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockMCGet(
    ClockFmtScnCmdArgs *opts, 
    int mcKey)
{
    ClockClientData *dataPtr = opts->clientData;

    Tcl_Obj *valObj = NULL;

    if (opts->mcDictObj == NULL) {
	ClockMCDict(opts);
	if (opts->mcDictObj == NULL)
	    return NULL;
    }

    Tcl_DictObjGet(opts->interp, opts->mcDictObj, 
	dataPtr->mcLiterals[mcKey], &valObj);

    return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */
}

/*
 *----------------------------------------------------------------------
 *
 * ClockMCGetIdx --
 *
 *	Retrieves an indexed msgcat value for the given literal integer mcKey
 *	from localized storage (corresponding given locale object)
 *	by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
 *
 * Results:
 *	Tcl-object contains localized indexed value.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockMCGetIdx(
    ClockFmtScnCmdArgs *opts, 
    int mcKey)
{
    ClockClientData *dataPtr = opts->clientData;

    Tcl_Obj *valObj = NULL;

    if (opts->mcDictObj == NULL) {
	ClockMCDict(opts);
	if (opts->mcDictObj == NULL)
	    return NULL;
    }

    /* try to get indices object */
    if (dataPtr->mcLitIdxs == NULL) {
	return NULL;
    }
    
    if (Tcl_DictObjGet(NULL, opts->mcDictObj, 
	dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK
    ) {
	return NULL;
    }

    return valObj;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockMCSetIdx --
 *
 *	Sets an indexed msgcat value for the given literal integer mcKey
 *	in localized storage (corresponding given locale object)
 *	by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
ClockMCSetIdx(
    ClockFmtScnCmdArgs *opts, 
    int mcKey, Tcl_Obj *valObj)
{
    ClockClientData *dataPtr = opts->clientData;

    if (opts->mcDictObj == NULL) {
	ClockMCDict(opts);
	if (opts->mcDictObj == NULL)
	    return TCL_ERROR;
    }

    /* if literal storage for indices not yet created */
    if (dataPtr->mcLitIdxs == NULL) {
	int i;
	dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
	for (i = 0; i < MCLIT__END; ++i) {
	    Tcl_InitObjRef(dataPtr->mcLitIdxs[i], 
		Tcl_NewStringObj(MsgCtLitIdxs[i], -1));
	}
    }

    return Tcl_DictObjPut(opts->interp, opts->mcDictObj, 
	    dataPtr->mcLitIdxs[mcKey], valObj);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConfigureObjCmd --
 *
 *	This function is invoked to process the Tcl "clock configure" command.
 *
 * Usage:
 *	::tcl::clock::configure ?-option ?value??
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ClockConfigureObjCmd(
    ClientData clientData,  /* Client data containing literal pool */
    Tcl_Interp *interp,	    /* Tcl interpreter */
    int objc,		    /* Parameter count */
    Tcl_Obj *const objv[])  /* Parameter vector */
{
    ClockClientData *dataPtr = clientData;
    
    static const char *const options[] = {
	"-system-tz",	  "-setup-tz",	  "-default-locale",
	"-clear",
	"-year-century",  "-century-switch",
	NULL
    };
    enum optionInd {
	CLOCK_SYSTEM_TZ,  CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE,
	CLOCK_CLEAR_CACHE,
	CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
	CLOCK_SETUP_GMT, CLOCK_SETUP_NOP
    };
    int optionIndex;		/* Index of an option. */
    int i;

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i++], options, 
	    "option", 0, &optionIndex) != TCL_OK) {
	    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
		    Tcl_GetString(objv[i-1]), NULL);
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case CLOCK_SYSTEM_TZ:
	if (1) {
	    /* validate current tz-epoch */
	    unsigned long lastTZEpoch = TzsetGetEpoch();
	    if (i < objc) {
		if (dataPtr->SystemTimeZone != objv[i]) {
		    Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i]);
		    Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);
		}
		dataPtr->LastTZEpoch = lastTZEpoch;
	    } 
	    if (i+1 >= objc && dataPtr->SystemTimeZone != NULL 
			 && dataPtr->LastTZEpoch == lastTZEpoch) {
		Tcl_SetObjResult(interp, dataPtr->SystemTimeZone);
	    }
	}
	break;
	case CLOCK_SETUP_TZ:
	    if (i < objc) {
		/* differentiate GMT and system zones, because used often */
		Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]);
		Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]);
		if (dataPtr->LastSetupTimeZone != timezoneObj) {
		    Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
		    Tcl_UnsetObjRef(dataPtr->LastSetupTZData);
		}
		if (timezoneObj == dataPtr->literals[LIT_GMT]) {
		    optionIndex = CLOCK_SETUP_GMT;
		} else if (timezoneObj == dataPtr->SystemTimeZone) {
		    optionIndex = CLOCK_SETUP_NOP;
		}
		switch (optionIndex) {
		case CLOCK_SETUP_GMT:
		    if (i < objc) {
			if (dataPtr->GMTSetupTimeZone != timezoneObj) {
			    Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj);
			    Tcl_UnsetObjRef(dataPtr->GMTSetupTZData);
			}
		    }
		break;
		case CLOCK_SETUP_TZ:
		    if (i < objc) {
			if (dataPtr->AnySetupTimeZone != timezoneObj) {
			    Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj);
			    Tcl_UnsetObjRef(dataPtr->AnySetupTZData);
			}
		    } 
		break;
		}
	    }
	    if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) {
		Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone);
	    }
	break;
	case CLOCK_CURRENT_LOCALE:
	    if (i < objc) {
		if (dataPtr->CurrentLocale != objv[i]) {
		    Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]);
		    Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
		}
	    }
	    if (i+1 >= objc && dataPtr->CurrentLocale != NULL) {
		Tcl_SetObjResult(interp, dataPtr->CurrentLocale);
	    }
	break;
	case CLOCK_YEAR_CENTURY:
	    if (i < objc) {
		int year;
		if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
		    return TCL_ERROR;
		}
		dataPtr->currentYearCentury = year;
		if (i+1 >= objc) {
		    Tcl_SetObjResult(interp, objv[i]);
		}
		continue;
	    }
	    if (i+1 >= objc) {
		Tcl_SetObjResult(interp, 
		    Tcl_NewIntObj(dataPtr->currentYearCentury));
	    }
	break;
	case CLOCK_CENTURY_SWITCH:
	    if (i < objc) {
		int year;
		if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
		    return TCL_ERROR;
		}
		dataPtr->yearOfCenturySwitch = year;
		Tcl_SetObjResult(interp, objv[i]);
		continue;
	    }
	    if (i+1 >= objc) {
		Tcl_SetObjResult(interp, 
		    Tcl_NewIntObj(dataPtr->yearOfCenturySwitch));
	    }
	break;
	case CLOCK_CLEAR_CACHE:
	    ClockConfigureClear(dataPtr);
	break;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetTZData --
 *
 *	Retrieves tzdata table for given normalized timezone.
 *
 * Results:
 *	Returns a tcl object with tzdata.
 *
 * Side effects:
 *	The tzdata can be cached in ClockClientData structure.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
ClockGetTZData(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *timezoneObj)	/* Name of the timezone */
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj **literals = dataPtr->literals;
    Tcl_Obj *ret, **out = NULL;

    /* if cached (if already setup this one) */
    if ( dataPtr->LastSetupTZData != NULL
      && ( timezoneObj == dataPtr->LastSetupTimeZone
	|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
      )
    ) {
	return dataPtr->LastSetupTZData;
    }

    /* differentiate GMT and system zones, because used often */
    /* simple caching, because almost used the tz-data of last timezone
     */
    if (timezoneObj == dataPtr->SystemTimeZone) {
	if (dataPtr->SystemSetupTZData != NULL) {
	    return dataPtr->SystemSetupTZData;
	}
	out = &dataPtr->SystemSetupTZData;
    }
    else 
    if (timezoneObj == dataPtr->GMTSetupTimeZone) {
	if (dataPtr->GMTSetupTZData != NULL) {
	    return dataPtr->GMTSetupTZData;
	}
	out = &dataPtr->GMTSetupTZData;
    }
    else
    if (timezoneObj == dataPtr->AnySetupTimeZone) {
	if (dataPtr->AnySetupTZData != NULL) {
	    return dataPtr->AnySetupTZData;
	}
	out = &dataPtr->AnySetupTZData;
    }

    ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
	timezoneObj, TCL_LEAVE_ERR_MSG);

    /* cache using corresponding slot and as last used */
    if (out != NULL) {
	Tcl_SetObjRef(*out, ret);
    }
    Tcl_SetObjRef(dataPtr->LastSetupTZData, ret);
    if (dataPtr->LastSetupTimeZone != timezoneObj) {
	Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
	Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone);
    }
    return ret;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetSystemTimeZone --
 *
 *	Returns system (current) timezone.
 *
 *	If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone
 *	in given interpreter and caches its result.
 *
 * Results:
 *	Returns normalized timezone object.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
ClockGetSystemTimeZone(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj **literals;

    /* if known (cached and same epoch) - return now */
    if (dataPtr->SystemTimeZone != NULL 
	  && dataPtr->LastTZEpoch == TzsetGetEpoch()) {
	return dataPtr->SystemTimeZone;
    }

    Tcl_UnsetObjRef(dataPtr->SystemTimeZone);
    Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);

    literals = dataPtr->literals;

    if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
	return NULL;
    }
    if (dataPtr->SystemTimeZone == NULL) {
	Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp));
    }
    return dataPtr->SystemTimeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockSetupTimeZone --
 *
 *	Sets up the timezone. Loads tzdata, etc.
 *
 * Results:
 *	Returns normalized timezone object.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockSetupTimeZone(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *timezoneObj)
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj **literals = dataPtr->literals;
    Tcl_Obj *callargs[2];

    /* if cached (if already setup this one) */
    if ( dataPtr->LastSetupTimeZone != NULL
      && ( timezoneObj == dataPtr->LastSetupTimeZone
	|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
      )
    ) {
	return dataPtr->LastSetupTimeZone;
    }

    /* differentiate GMT and system zones, because used often and already set */
    timezoneObj = NormTimezoneObj(dataPtr, timezoneObj);
    if (   timezoneObj == dataPtr->GMTSetupTimeZone
	|| timezoneObj == dataPtr->SystemTimeZone
	|| timezoneObj == dataPtr->AnySetupTimeZone
    ) {
	return timezoneObj;
    }

    callargs[0] = literals[LIT_SETUPTIMEZONE];
    callargs[1] = timezoneObj;

    if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
	return dataPtr->LastSetupTimeZone;
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockFormatNumericTimeZone --
 *
 *	Formats a time zone as +hhmmss
 *
 * Parameters:
 *	z - Time zone in seconds east of Greenwich
 *
 * Results:
 *	Returns the time zone object (formatted in a numeric form)
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj * 
ClockFormatNumericTimeZone(int z) {
    char sign = '+';
    int h, m;
    if ( z < 0 ) {
	z = -z;
	sign = '-';
    }
    h = z / 3600;
    z %= 3600;
    m = z / 60;
    z %= 60;
    if (z != 0) {
	return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z);
    }
    return Tcl_ObjPrintf("%c%02d%02d", sign, h, m);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConvertlocaltoutcObjCmd --
 *
 *	Tcl command that converts a UTC time to a local time by whatever means
 *	is available.
 *
 * Usage:
 *	::tcl::clock::ConvertUTCToLocal dictionary timezone changeover
 *
 * Parameters:
 *	dict - Dictionary containing a 'localSeconds' entry.
 *	timezone - Time zone
 *	changeover - Julian Day of the adoption of the Gregorian calendar.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	On success, sets the interpreter result to the given dictionary

    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    fields.tzName = NULL;
    /*
     * Check params and convert time.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
	    &secondsObj)!= TCL_OK) {
	return TCL_ERROR;
    }
    if (secondsObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
		"found in dictionary", -1));
	return TCL_ERROR;
    }
    if ((TclGetWideIntFromObj(interp, secondsObj,
	    &fields.localSeconds) != TCL_OK)
	|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
	|| ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) {
	return TCL_ERROR;
    }

    /*
     * Copy-on-write; set the 'seconds' field in the dictionary and place the
     * modified dictionary in the interpreter result.
     */

 *
 * ClockGetdatefieldsObjCmd --
 *
 *	Tcl command that determines the values that [clock format] will use in
 *	formatting a date, and populates a dictionary with them.
 *
 * Usage:
 *	::tcl::clock::GetDateFields seconds timezone changeover
 *
 * Parameters:
 *	seconds - Time expressed in seconds from the Posix epoch.
 *	timezone - Time zone in which time is to be expressed.

 *	changeover - Julian Day Number at which the current locale adopted
 *		     the Gregorian calendar
 *
 * Results:
 *	Returns a dictonary populated with the fields:
 *		seconds - Seconds from the Posix epoch
 *		localSeconds - Nominal seconds from the Posix epoch in the

{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover");
	return TCL_ERROR;
    }
    if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (objv[1]->typePtr == &tclBignumType) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /* Extract fields */



    if (ClockGetDateFields(clientData, interp, &fields, objv[2], 
	  changeover) != TCL_OK) {
	return TCL_ERROR;
    }




    /* Make dict of fields */











    dict = Tcl_NewDictObj();
    Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
	    Tcl_NewWideIntObj(fields.localSeconds));
    Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);

	    Tcl_NewIntObj(fields.iso8601Year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
	    Tcl_NewIntObj(fields.iso8601Week));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
	    Tcl_NewIntObj(fields.dayOfWeek));
    Tcl_SetObjResult(interp, dict);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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_Obj *dict;
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");

    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;

 *	in the interpreter result on failure.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTC(
    ClientData clientData,	/* Client data of the interpreter */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *timezoneObj,	/* Time zone */
    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;
    }

    /*
     * Special case: If the time zone is :localtime, the tzdata will be empty.
     * Use 'mktime' to convert the time to local
     */

    if (rowc == 0) {
	dataPtr->Local2UTC.rangesVal[0] = 0;
	dataPtr->Local2UTC.rangesVal[1] = 0;

	if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) {
	    return TCL_ERROR;
	};
    } else {
	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;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingTable --
 *

 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[],	/* Points at which time changes */
    Tcl_WideInt rangesVal[2])	/* Return bounds for time period */
{
    Tcl_Obj *row;
    int cellc;
    Tcl_Obj **cellv;
    int have[8];
    int nHave = 0;
    int i;

     * Saving Time transition.
     */

    found = 0;
    fields->tzOffset = 0;
    fields->seconds = fields->localSeconds;
    while (!found) {
	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) {
	    return TCL_ERROR;
	}

	    }
	    have[nHave++] = fields->tzOffset;
	}
	fields->seconds = fields->localSeconds - fields->tzOffset;
    }
    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;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingC --

 *
 * Side effects:
 *	Populates the 'tzName' and 'tzOffset' fields.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
ConvertUTCToLocal(
    ClientData clientData,	/* Client data of the interpreter */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *timezoneObj,	/* Time zone */
    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;
    }

    /*
     * Special case: If the time zone is :localtime, the tzdata will be empty.
     * Use 'localtime' to convert the time to local
     */

    if (rowc == 0) {
	dataPtr->UTC2Local.rangesVal[0] = 0;
	dataPtr->UTC2Local.rangesVal[1] = 0;

	if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	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;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocalUsingTable --
 *

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    int rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[],	/* Rows of the conversion table */
    Tcl_WideInt rangesVal[2])	/* Return bounds for time period */
{
    Tcl_Obj *row;		/* Row containing the current information */
    int cellc;			/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    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) {
	return TCL_ERROR;
    }

    /*
     * Convert the time.
     */

    Tcl_SetObjRef(fields->tzName, cellv[3]);

    fields->localSeconds = fields->seconds + fields->tzOffset;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    sprintf(buffer+1, "%02d", diff / 3600);
    diff %= 3600;
    sprintf(buffer+3, "%02d", diff / 60);
    diff %= 60;
    if (diff > 0) {
	sprintf(buffer+5, "%02d", diff);
    }
    Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1));

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LookupLastTransition --
 *
 *	Given a UTC time and a tzdata array, looks up the last transition on
 *	or before the given time.
 *
 * Results:
 *	Returns a pointer to the row, or NULL if an error occurs.
 *
 *----------------------------------------------------------------------
 */

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_WideInt rangesVal[2])	/* Return bounds for time period */
{
    int l = 0;
    int u;
    Tcl_Obj *compObj;
    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
	    || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
     * anyway.
     */

    if (tick < compVal) {
	goto done;
    }

    /*
     * Binary-search to find the transition.
     */


    u = rowc-1;
    while (l < u) {
	int m = (l + u + 1) / 2;

	if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
		TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	    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];
}

/*
 *----------------------------------------------------------------------
 *
 * GetYearWeekDay --

GetYearWeekDay(
    TclDateFields *fields,	/* Date to convert, must have 'julianDay' */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    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.
     */

    temp.julianDay = fields->julianDay - 3;

 *
 * Side effects:
 *	Stores 'julianDay' in the fields.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE void
GetJulianDayFromEraYearWeekDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    int firstMonday;		/* Julian day number of week 1, day 1 in the
				 * given year */
    TclDateFields firstWeek;

    firstWeek.tzName = NULL;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    firstWeek.era = fields->era;
    firstWeek.year = fields->iso8601Year;

 *
 * Side effects:
 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE void
GetJulianDayFromEraYearMonthDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;

    if (fields->era == BCE) {

    ym1o4 = ym1 / 4;
#else
    /*
     * Have to make sure quotient is truncated towards 0 when negative.
     * See above bug for details. The casts are necessary.
     */
    if (ym1 >= 0)
	ym1o4 = ym1 / 4;
    else {
	ym1o4 = - (int) (((unsigned int) -ym1) / 4);
    }
#endif
    if (ym1 % 4 < 0) {
	ym1o4--;
    }
    ym1o100 = ym1 / 100;
    if (ym1 % 100 < 0) {

		+ ym1o4;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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
 *	Gregorian calendar.
 *
 * Results:
 *	Returns 1 for a leap year, 0 otherwise.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    int year = fields->year;

    if (fields->era == BCE) {
	year = 1 - year;


    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {
	return 1;

    case 2:
	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	break;
    default:
	Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?");
	return TCL_ERROR;
    }

    switch (index) {
    case CLICKS_MILLIS:
	Tcl_GetTime(&now);
	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
	break;
    case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
#endif
	break;
    case CLICKS_MICROS:

	clicks = TclpGetMicroseconds();
	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
    return TCL_OK;
}


    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds");
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
	    now.sec * 1000 + now.usec / 1000));
    return TCL_OK;
}

int
ClockMicrosecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{


    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds");
	return TCL_ERROR;
    }

    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;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseFmtScnArgs --
 *
 *	Parses the arguments for [clock scan] and [clock format].
 *
 * Results:
 *	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
ClockParseFmtScnArgs(
    register
    ClockFmtScnCmdArgs *opts,	/* Result vector: format, locale, timezone... */
    TclDateFields      *date,	/* Extracted date-time corresponding base 
				 * (by scan or add) resp. clockval (by format) */
    int objc,		    /* Parameter count */
    Tcl_Obj *const objv[],	/* Parameter vector */
    int		flags		/* Flags, differentiates between format, scan, add */
) {
    Tcl_Interp	    *interp =  opts->interp;
    ClockClientData *dataPtr = opts->clientData;
    int gmtFlag = 0;
    static const char *const options[] = {
	"-format",	"-gmt",		"-locale",
	"-timezone",	"-base",	NULL
    };
    enum optionInd {
	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. */

    int i;
    Tcl_WideInt baseVal;	/* Base time, expressed in seconds from the Epoch */


    /* clock value (as current base) */

    if ( !(flags & (CLC_SCN_ARGS)) ) {

	opts->baseObj = objv[1];




	saw |= (1 << CLC_ARGS_BASE);
    }

    /*
     * Extract values for the keywords.
     */




    for (i = 2; i < objc; i+=2) {
	/* bypass integers (offsets) by "clock add" */
	if (flags & CLC_ADD_ARGS) {
	    Tcl_WideInt num;
	    if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) {
		continue;
	    }
	}
	/* get option */
	if (Tcl_GetIndexFromObj(interp, objv[i], options, 
	    "option", 0, &optionIndex) != TCL_OK) {
	    goto badOption;
	}
	/* if already specified */
	if (saw & (1 << optionIndex)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad option \"%s\": doubly present", 
		TclGetString(objv[i]))

	    );
	    goto badOption;
	}
	switch (optionIndex) {
	case CLC_ARGS_FORMAT:
	    if (flags & CLC_ADD_ARGS) {
		goto badOptionMsg;
	    }
	    opts->formatObj = objv[i+1];
	    break;
	case CLC_ARGS_GMT:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
		return TCL_ERROR;
	    }
	    break;
	case CLC_ARGS_LOCALE:
	    opts->localeObj = objv[i+1];
	    break;
	case CLC_ARGS_TIMEZONE:
	    opts->timezoneObj = objv[i+1];
	    break;
	case CLC_ARGS_BASE:
	    if ( !(flags & (CLC_SCN_ARGS)) ) {
		goto badOptionMsg;
	    }
	    opts->baseObj = objv[i+1];
	    break;
	}
	saw |= (1 << optionIndex);
    }

    /*
     * Check options.
     */




    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) {
	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;
    }

    /*
     * Do relative times
     */

    ret = ClockCalcRelTime(info, opts);

    /* Free scanning completed - date ready */

done:

    return ret;
}

/*----------------------------------------------------------------------
 *
 * ClockCalcRelTime --
 *
 *	Used for calculating of relative times.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
ClockCalcRelTime(
    register
    DateInfo	       *info,	/* Date fields used for converting */
    ClockFmtScnCmdArgs *opts)	/* Command options */
{
    /*
     * Because some calculations require in-between conversion of the
     * julian day, we can repeat this processing multiple times 
     */
repeat_rel:

    if (yyHaveRel) {

	/* 
	 * Relative conversion normally possible in UTC time only, because
	 * of possible wrong local time increment if ignores in-between DST-hole.
	 * (see test-cases clock-34.53, clock-34.54).
	 * So increment date in julianDay, but time inside day in UTC (seconds).
	 */

	/* add months (or years in months) */

	if (yyRelMonth != 0) {
	    int m, h;

	    /* if needed extract year, month, etc. again */
	    if (info->flags & CLF_ASSEMBLE_DATE) {
		GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
		GetMonthDay(&yydate);
		GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
		info->flags &= ~CLF_ASSEMBLE_DATE;
	    }

	    /* add the requisite number of months */
	    yyMonth += yyRelMonth - 1;
	    yyYear += yyMonth / 12;
	    m = yyMonth % 12;
	    yyMonth = m + 1;

	    /* if the day doesn't exist in the current month, repair it */
	    h = hath[IsGregorianLeapYear(&yydate)][m];
	    if (yyDay > h) {
		yyDay = h;
	    }

	    /* on demand (lazy) assemble julianDay using new year, month, etc. */
	    info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;

	    yyRelMonth = 0;
	}

	/* add days (or other parts aligned to days) */
	if (yyRelDay) {

	    /* assemble julianDay using new year, month, etc. */
	    if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
		GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
		info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
	    }
	    yydate.julianDay += yyRelDay;
	    
	    /* julianDay was changed, on demand (lazy) extract year, month, etc. again */
	    info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;

	    yyRelDay = 0;
	}

	/* relative time (seconds), if exceeds current date, do the day conversion and
	 * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */
	if (yyRelSeconds) {
	    int newSecs = yySeconds + yyRelSeconds;
	       
	    /* if seconds increment outside of current date, increment day */
	    if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) {
		
		yyRelDay += newSecs / SECONDS_PER_DAY;
		yySeconds = 0;		    
		yyRelSeconds = newSecs % SECONDS_PER_DAY;

		goto repeat_rel;
	    }
	}

	yyHaveRel = 0;
    }

    /*
     * Do relative (ordinal) month
     */

    if (yyHaveOrdinalMonth) {
	int monthDiff;

	/* if needed extract year, month, etc. again */
	if (info->flags & CLF_ASSEMBLE_DATE) {
	    GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
	    GetMonthDay(&yydate);
	    GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
	    info->flags &= ~CLF_ASSEMBLE_DATE;
	}

	if (yyMonthOrdinalIncr > 0) {
	    monthDiff = yyMonthOrdinal - yyMonth;
	    if (monthDiff <= 0) {
		monthDiff += 12;
	    }
	    yyMonthOrdinalIncr--;
	} else {
	    monthDiff = yyMonth - yyMonthOrdinal;
	    if (monthDiff >= 0) {
		monthDiff -= 12;
	    }
	    yyMonthOrdinalIncr++;
	}

	/* process it further via relative times */
	yyHaveRel++;
	yyYear += yyMonthOrdinalIncr;
	yyRelMonth += monthDiff;
	yyHaveOrdinalMonth = 0;

	info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;

	goto repeat_rel;
    }

    /*
     * 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;
    }

    /* 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;
}

/*----------------------------------------------------------------------
 *
 * ClockSecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.

    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds");
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TzsetGetEpoch --, TzsetIfNecessary --
 *
 *	Calls the tzset() library function if the contents of the TZ
 *	environment variable has changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls tzset.
 *
 *----------------------------------------------------------------------
 */

static unsigned long
TzsetGetEpoch(void)
{
    static char* tzWas = INT2PTR(-1);	 /* Previous value of TZ, protected by
					  * clockMutex. */
    static long	 tzLastRefresh = 0;	 /* Used for latency before next refresh */
    static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */
    static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling, 
					    that TZ changed via TCL */
    
    const char *tzIsNow;		 /* Current value of TZ */
    
    /* 
     * Prevent performance regression on some platforms by resolving of system time zone:
     * small latency for check whether environment was changed (once per second)
     * no latency if environment was chaned with tcl-env (compare both epoch values)
     */
    Tcl_Time now;
    Tcl_GetTime(&now);
    if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
	return tzWasEpoch;
    }
    tzEnvEpoch = TclEnvEpoch;
    tzLastRefresh = now.sec;

    /* check in lock */
    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TCL_TZ");
    if (tzIsNow == NULL) {
	tzIsNow = getenv("TZ");
    }
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    ckfree(tzWas);
	}
	tzWas = ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
	tzWasEpoch++;
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
	tzWasEpoch++;
    }
    Tcl_MutexUnlock(&clockMutex);

    return tzWasEpoch;
}














static void
TzsetIfNecessary(void)

{


    TzsetGetEpoch();







}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * 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:
 */

 * Copyright (c) 2003-2009 Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;

    i = count;
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&start);
#else
    start = TclpGetWideClicks();
#endif
    while (i-- > 0) {
	result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&stop);
    totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6

    TclNewLiteralStringObj(objs[1], "microseconds");
    TclNewLiteralStringObj(objs[2], "per");
    TclNewLiteralStringObj(objs[3], "iteration");
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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

/* 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-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 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, 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
   under terms of your choice, so long as that work isn't itself a
   parser generator using the skeleton or a modified version thereof
   as a parser skeleton.  Alternatively, if you modify or redistribute
   the parser skeleton itself, you may (at your option) remove this
   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.  */

/* C LALR(1) parser skeleton written by Richard Stallman, by
   simplifying the original so-called "semantic" parser.  */

/* All symbols defined below should begin with yy or YY, to avoid
   infringing on user name space.  This should be done even for local
   variables, as they might otherwise be expanded by user macros.
   There are some unavoidable exceptions within include files to
   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output.  */
#define YYBISON 1

/* Bison version.  */
#define YYBISON_VERSION "2.4.2"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* 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
















































/* Copy the first part of user declarations.  */


/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

/*
 * Bison generates several labels that happen to be unused. MS Visual C++
 * doesn't like that, and complains. Tell it to shut up.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#endif /* _MSC_VER */

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */


#include "tclDate.h"





































#define YYMALLOC	ckalloc
#define YYFREE(x)	(ckfree((void*) (x)))


























#define EPOCH		1970
#define START_OF_TIME	1902
#define END_OF_TIME	2037

/*
 * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
 * Posix requires 1900.

 * Daylight-savings mode: on, off, or not yet known.
 */

typedef enum _DSTMODE {
    DSTon, DSToff, DSTmaybe
} DSTMODE;











/* Enabling traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif

/* Enabling verbose error messages.  */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif

/* Enabling the token table.  */
#ifndef YYTOKEN_TABLE
# 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;



} YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1

#endif

#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE
{
  int first_line;
  int first_column;

 */

static int		LookupWord(YYSTYPE* yylvalPtr, char *buff);
 static void		TclDateerror(YYLTYPE* location,
				     DateInfo* info, const char *s);
 static int		TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
				   DateInfo* info);


MODULE_SCOPE int	yyparse(DateInfo*);






#ifdef short
# undef short
#endif

#ifdef YYTYPE_UINT8
typedef YYTYPE_UINT8 yytype_uint8;

#else
typedef short int yytype_int16;
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__
# 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 defined YYENABLE_NLS && YYENABLE_NLS
#  if ENABLE_NLS
#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
#   define YY_(msgid) dgettext ("bison-runtime", msgid)
#  endif
# endif
# ifndef YY_
#  define YY_(msgid) msgid

/* Identity function, used to suppress warnings about constant conditions.  */
#ifndef lint
# define YYID(n) (n)
#else
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static int
YYID (int yyi)
#else
static int
YYID (yyi)
    int yyi;
#endif
{
  return yyi;
}
#endif

#if ! defined yyoverflow || YYERROR_VERBOSE

/* The parser invokes alloca or malloc; define the necessary symbols.  */