diff options
Diffstat (limited to 'generic/tclClock.c')
| -rw-r--r-- | generic/tclClock.c | 1402 |
1 files changed, 1211 insertions, 191 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 71dec02..3dc93fa 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclClock.c,v 1.42 2005/11/01 15:30:52 dkf Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.43 2005/11/29 22:50:58 kennykb Exp $ */ #include "tclInt.h" @@ -26,6 +26,92 @@ #endif /* + * Constants + */ + +#define JULIAN_SEC_POSIX_EPOCH ((Tcl_WideInt) 210866803200) +#define SECONDS_PER_DAY 86400 +#define FOUR_CENTURIES 146097 /* days */ +#define JDAY_1_JAN_1_CE_JULIAN 1721424 +#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 +#define ONE_CENTURY_GREGORIAN 36524 /* days */ +#define FOUR_YEARS 1461 /* days */ +#define ONE_YEAR 365 /* days */ + +/* + * Table of the days in each month, leap and common years + */ + +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] + */ + +typedef enum ClockLiteral { + LIT_BCE, LIT_CE, + LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, + LIT_ERA, LIT_GREGORIAN, + LIT_ISO8601WEEK, LIT_ISO8601YEAR, + LIT_JULIANDAY, LIT_LOCALSECONDS, + LIT_MONTH, + LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, + LIT_YEAR, + LIT__END +} ClockLiteral; +static const char *const literals[] = { + "BCE", "CE", + "dayOfMonth", "dayOfWeek", "dayOfYear", + "era", "gregorian", + "iso8601Week", "iso8601Year", + "julianDay", "localSeconds", + "month", + "seconds", "tzName", "tzOffset", + "year" +}; + +/* + * Structure containing the client data for [clock] + */ + +typedef struct ClockClientData { + int refCount; /* Number of live references */ + Tcl_Obj** literals; /* Pool of object literals */ +} ClockClientData; + +/* + * Structure containing the fields used in [clock format] and [clock scan] + */ + +typedef struct TclDateFields { + Tcl_WideInt seconds; /* Time expressed in seconds from the + * Posix epoch */ + Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds + * from the Posix epoch */ + int tzOffset; /* Time zone offset in seconds east of + * Greenwich */ + Tcl_Obj* tzName; /* Time zone name */ + int julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ + +} TclDateFields; + +/* * Thread specific data block holding a 'struct tm' for the 'gmtime' and * 'localtime' library calls. */ @@ -43,312 +129,1216 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ +static int ConvertUTCToLocal(Tcl_Interp*, + TclDateFields*, Tcl_Obj*, int); +static int ConvertUTCToLocalUsingTable(Tcl_Interp*, + TclDateFields*, int, Tcl_Obj *CONST[]); +static int ConvertUTCToLocalUsingC(Tcl_Interp*, + TclDateFields*, int); +static int ConvertLocalToUTC(Tcl_Interp*, + TclDateFields*, Tcl_Obj*, int); +static int ConvertLocalToUTCUsingTable(Tcl_Interp*, + TclDateFields*, int, Tcl_Obj *CONST[]); +static int ConvertLocalToUTCUsingC(Tcl_Interp*, + TclDateFields*, int); +static Tcl_Obj* LookupLastTransition(Tcl_Interp*, Tcl_WideInt, + int, Tcl_Obj *CONST *); +static void GetYearWeekDay(TclDateFields*, int); +static void GetGregorianEraYearDay(TclDateFields*, int); +static void GetMonthDay(TclDateFields*); +static void GetJulianDayFromEraYearWeekDay(TclDateFields*, int); +static void GetJulianDayFromEraYearMonthDay(TclDateFields*, int); +static int IsGregorianLeapYear(TclDateFields*); +static int WeekdayOnOrBefore(int, int); +static int ClockClicksObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int ClockConvertlocaltoutcObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int ClockGetdatefieldsObjCmd( + 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 struct tm * ThreadSafeLocalTime(CONST time_t *); static void TzsetIfNecessary(void); +static void ClockDeleteCmdProc(ClientData); + /* *---------------------------------------------------------------------- * - * TclClockGetenvObjCmd -- + * TclClockInit -- * - * Tcl command that reads an environment variable from the system + * Registers the 'clock' subcommands with the Tcl interpreter + * and initializes its client data (which consists mostly of + * constant Tcl_Obj's that it is too much trouble to keep + * recreating). + * + * Results: + * None. + * + * Side effects: + * Installs the commands and creates the client data + * + *---------------------------------------------------------------------- + */ + +void +TclClockInit( + Tcl_Interp* interp /* Tcl interpreter */ +) { + int i; + + /* Create the client data */ + + ClockClientData *data = + (ClockClientData*) ckalloc(sizeof(ClockClientData)); + data->refCount = 0; + + /* + * Create the literal pool + */ + data->literals = (Tcl_Obj**) ckalloc(LIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < LIT__END; ++i) { + data->literals[i] = Tcl_NewStringObj(literals[i], -1); + Tcl_IncrRefCount(data->literals[i]); + } + + /* Install the commands */ + + Tcl_CreateObjCommand(interp, "::tcl::clock::clicks", + ClockClicksObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::getenv", + ClockGetenvObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::microseconds", + ClockMicrosecondsObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::milliseconds", + ClockMillisecondsObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::seconds", + ClockSecondsObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::Oldscan", + TclClockOldscanObjCmd, (ClientData) NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::clock::ConvertLocalToUTC", + ClockConvertlocaltoutcObjCmd, (ClientData) data, + ClockDeleteCmdProc); + Tcl_CreateObjCommand(interp, "::tcl::clock::GetDateFields", + ClockGetdatefieldsObjCmd,(ClientData) data, + ClockDeleteCmdProc); + ++data->refCount; + +} + +/* + *---------------------------------------------------------------------- + * + * ClockConvertlocaltoutcObjCmd -- + * + * Tcl command that converts a UTC time to a local time by + * whatever means is available. * * Usage: - * ::tcl::clock::getEnv NAME + * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover * * Parameters: - * NAME - Name of the environment variable desired + * dict - Dictionary containing a 'localSeconds' entry. + * tzdata - Time zone data + * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: - * Returns a standard Tcl result. Returns an error if the - * variable does not exist, with a message left in the interpreter. - * Returns TCL_OK and the value of the variable if the variable - * does exist, + * Returns a standard Tcl result. + * + * Side effects: + * On success, sets the interpreter result to the given dictionary + * augmented with a 'seconds' field giving the UTC time. On failure, + * leaves an error message in the interpreter result. * *---------------------------------------------------------------------- */ -int -TclClockGetenvObjCmd( - ClientData clientData, - Tcl_Interp* interp, - int objc, - Tcl_Obj *CONST objv[]) -{ +static int +ClockConvertlocaltoutcObjCmd( + ClientData clientData, /* Client data */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST * objv /* Parameter vector */ +) { + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + Tcl_Obj* secondsObj; + Tcl_Obj* dict; + int changeover; + TclDateFields fields; + int created = 0; + int status; - CONST char* varName; - CONST char* varValue; + /* Check params and convert time */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); return TCL_ERROR; } - varName = Tcl_GetStringFromObj(objv[1], NULL); - varValue = getenv(varName); - if (varValue == NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("variable not found", -1)); + dict = objv[1]; + if ((Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS], &secondsObj) + != TCL_OK) + || (Tcl_GetWideIntFromObj(interp, secondsObj, &(fields.localSeconds)) + != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &changeover) != TCL_OK) + || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { return TCL_ERROR; - } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); - return TCL_OK; } + + /* + * Copy-on-write; set the 'seconds' field in the dictionary and + * place the modified dictionary in the interpreter result. + */ + + if (Tcl_IsShared(dict)) { + dict = Tcl_DuplicateObj(dict); + created = 1; + Tcl_IncrRefCount(dict); + } + status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS], + Tcl_NewWideIntObj(fields.seconds)); + if (status == TCL_OK) { + Tcl_SetObjResult(interp, dict); + } + if (created) { + Tcl_DecrRefCount(dict); + } + return status; } /* - *------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * TclClockLocaltimeObjCmd -- + * ClockGetdatefieldsObjCmd -- * - * Tcl command that extracts local time using the C library to do - * it. + * Tcl command that determines the values that [clock format] will + * use in formatting a date, and populates a dictionary with them. * * Usage: - * ::tcl::clock::Localtime <tick> + * ::tcl::clock::GetDateFields seconds tzdata changeover * * Parameters: - * <tick> -- A count of seconds from the Posix epoch. + * seconds - Time expressed in seconds from the Posix epoch. + * tzdata - Time zone data of the time zone in which time is to + * be expressed. + * changeover - Julian Day Number at which the current locale adopted + * the Gregorian calendar * * Results: + * Returns a dictonary populated with the fields: + * seconds - Seconds from the Posix epoch + * localSeconds - Nominal seconds from the Posix epoch in + * the local time zone. + * tzOffset - Time zone offset in seconds east of Greenwich + * tzName - Time zone name + * julianDay - Julian Day Number in the local time zone + * + *---------------------------------------------------------------------- + */ + +int +ClockGetdatefieldsObjCmd( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST *objv /* Parameter vector */ +) { + TclDateFields fields; + Tcl_Obj* dict; + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + int changeover; - * Returns a standard Tcl result. The object result is a Tcl - * list containing the year, month, day, hour, minute, and second - * fields of the local time. It may return an error if the - * argument exceeds the arithmetic range representable by - * 'time_t'. + /* Check params */ + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[3], &changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Convert UTC time to local */ + + if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Extract Julian day */ + + fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH) + / SECONDS_PER_DAY); + + /* Convert to Julian or Gregorian calendar */ + + GetGregorianEraYearDay(&fields, changeover); + GetMonthDay(&fields); + GetYearWeekDay(&fields, changeover); + + dict = Tcl_NewDictObj(); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_LOCALSECONDS], + Tcl_NewWideIntObj(fields.localSeconds)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_SECONDS], + Tcl_NewWideIntObj(fields.seconds)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_TZNAME], + fields.tzName); + Tcl_DecrRefCount(fields.tzName); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_TZOFFSET], + Tcl_NewIntObj(fields.tzOffset)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_JULIANDAY], + Tcl_NewWideIntObj(fields.julianDay)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_GREGORIAN], + Tcl_NewIntObj(fields.gregorian)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_ERA], + literals[fields.era ? LIT_BCE : LIT_CE]); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_YEAR], + Tcl_NewIntObj(fields.year)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_DAYOFYEAR], + Tcl_NewIntObj(fields.dayOfYear)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_MONTH], + Tcl_NewIntObj(fields.month)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_DAYOFMONTH], + Tcl_NewIntObj(fields.dayOfMonth)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_ISO8601YEAR], + Tcl_NewIntObj(fields.iso8601Year)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_ISO8601WEEK], + Tcl_NewIntObj(fields.iso8601Week)); + Tcl_DictObjPut((Tcl_Interp*) NULL, dict, literals[LIT_DAYOFWEEK], + Tcl_NewIntObj(fields.dayOfWeek)); + Tcl_SetObjResult(interp, dict); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- * - * Side effects: - * None. + * ConvertLocalToUTC -- + * + * Converts a time (in a TclDateFields structure) from the + * local wall clock to UTC. + * + * Results: + * Returns a standard Tcl result. * - * This function is used as a call of last resort if the current time - * zone cannot be determined from environment variables TZ or TCL_TZ. - * It attempts to use the 'localtime' library function to extract the - * time and return it that way. This method suffers from Y2038 problems - * on most platforms. It also provides no portable way to get the - * name of the time zone. + * Side effects: + * Populates the 'seconds' field if successful; stores an error + * message in the interpreter result on failure. * - *------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -int -TclClockLocaltimeObjCmd( - ClientData clientData, /* Unused */ +static int +ConvertLocalToUTC( Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj* CONST* objv) /* Parameter vector */ -{ - Tcl_WideInt tick; /* Time to convert */ - time_t tock; - struct tm* timeVal; /* Time after conversion */ + TclDateFields* fields, /* Fields of the time */ + Tcl_Obj* tzdata, /* Time zone data */ + int changeover /* Julian Day of the Gregorian transition */ +) { + int rowc; /* Number of rows in tzdata */ + Tcl_Obj** rowv; /* Pointers to the rows */ - Tcl_Obj* returnVec[ 6 ]; + /* unpack the tz data */ + + if (Tcl_ListObjGetElements(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) { + return ConvertLocalToUTCUsingC(interp, fields, changeover); + } else { + return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConvertLocalToUTCUsingTable -- + * + * Converts a time (in a TclDateFields structure) from local time + * in a given time zone to UTC. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * Stores an error message in the interpreter if an error occurs; + * if successful, stores the 'seconds' field in 'fields. + * + *---------------------------------------------------------------------- + */ +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_Obj* row; + int cellc; + Tcl_Obj** cellv; + int have[8]; + int nHave = 0; + int i; + int found; /* - * Check args + * Perform an initial lookup assuming that local == UTC, and locate + * the last time conversion prior to that time. Get the offset from + * that row, and look up again. Continue until we find an offset + * that we found before. This definition, rather than "the same offset" + * ensures that we don't enter an endless loop, as would otherwise happen + * when trying to convert a non-existent time such as 02:30 during + * the US Spring Daylight Saving Time transition. */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "seconds"); + found = 0; + fields->tzOffset = 0; + fields->seconds = fields->localSeconds; + while (!found) { + row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + if ((row == NULL) + || (Tcl_ListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK) + || (Tcl_GetIntFromObj(interp, cellv[1], &(fields->tzOffset)) + != TCL_OK)) { + return TCL_ERROR; + } + found = 0; + for (i = 0; !found && i < nHave; ++i) { + if (have[i] == fields->tzOffset) { + found = 1; + break; + } + } + if (!found) { + if (nHave == 8) { + Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); + } + have[nHave] = fields->tzOffset; + ++nHave; + } + fields->seconds = fields->localSeconds - fields->tzOffset; + } + fields->tzOffset = have[i]; + fields->seconds = fields->localSeconds - fields->tzOffset; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ConvertLocalToUTCUsingC -- + * + * Converts a time from local wall clock to UTC when the local + * time zone cannot be determined. Uses 'mktime' to do the job. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * Stores an error message in the interpreter if an error occurs; + * if successful, stores the 'seconds' field in 'fields. + * + *---------------------------------------------------------------------- + */ + +static int +ConvertLocalToUTCUsingC( + Tcl_Interp* interp, /* Tcl interpreter */ + TclDateFields* fields, /* Time to convert, with 'seconds' filled in */ + int changeover /* Julian Day of the Gregorian transition */ +) { + struct tm timeVal; + int localErrno; + + /* Convert the given time to a date */ + + fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH) + / SECONDS_PER_DAY); + GetGregorianEraYearDay(fields, changeover); + GetMonthDay(fields); + + /* Convert the date/time to a 'struct tm' */ + + timeVal.tm_year = fields->year - 1900; + timeVal.tm_mon = fields->month - 1; + timeVal.tm_mday = fields->dayOfMonth; + timeVal.tm_hour = (int)((fields->localSeconds / 3600) % 24); + timeVal.tm_min = (int)((fields->localSeconds / 60) % 60); + timeVal.tm_sec = (int)(fields->localSeconds % 60); + timeVal.tm_isdst = -1; + timeVal.tm_wday = -1; + timeVal.tm_yday = -1; + + /* + * Get local time. It is rumored that mktime is not thread safe + * on some platforms, so seize a mutex before attempting this. + */ + + TzsetIfNecessary(); + Tcl_MutexLock(&clockMutex); + errno = 0; + fields->seconds = (Tcl_WideInt) mktime(&timeVal); + localErrno = errno; + Tcl_MutexUnlock(&clockMutex); + + /* If conversion fails, report an error */ + + if (localErrno != 0 + || (fields->seconds == -1 && timeVal.tm_yday == -1)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj( "time value too large/small to " + "represent", -1)); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[1], &tick) != TCL_OK) { + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ConvertUTCToLocal -- + * + * Converts a time (in a TclDateFields structure) from UTC to + * local time. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * Populates the 'tzName' and 'tzOffset' fields. + * + *---------------------------------------------------------------------- + */ + +static int +ConvertUTCToLocal( + Tcl_Interp* interp, /* Tcl interpreter */ + TclDateFields* fields, /* Fields of the time */ + Tcl_Obj* tzdata, /* Time zone data */ + int changeover /* Julian Day of the Gregorian transition */ +) { + int rowc; /* Number of rows in tzdata */ + Tcl_Obj** rowv; /* Pointers to the rows */ + + /* unpack the tz data */ + + if (Tcl_ListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } - /* - * Convert the time, checking for overflow + /* + * Special case: If the time zone is :localtime, the tzdata will be empty. + * Use 'localtime' to convert the time to local */ - tock = (time_t) tick; - if ((Tcl_WideInt) tock != tick) { + if (rowc == 0) { + return ConvertUTCToLocalUsingC(interp, fields, changeover); + } else { + return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); + } + +} + +/* + *---------------------------------------------------------------------- + * + * ConvertUTCToLocalUsingTable -- + * + * Converts UTC to local time, given a table of transition points + * + * Results: + * Returns a standard Tcl result + * + * Side effects: + * On success, fills fields->tzName, fields->tzOffset and + * fields->localSeconds. On failure, places an error message in + * the interpreter result. + * + *---------------------------------------------------------------------- + */ + +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_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); + if (row == NULL + || (Tcl_ListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK) + || (Tcl_GetIntFromObj(interp, cellv[1], &(fields->tzOffset)) + != TCL_OK)) { + return TCL_ERROR; + } + + /* Convert the time */ + + fields->tzName = cellv[3]; + Tcl_IncrRefCount(fields->tzName); + fields->localSeconds = fields->seconds + fields->tzOffset; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ConvertUTCToLocalUsingC -- + * + * Converts UTC to localtime in cases where the local time zone is + * not determinable, using the C 'localtime' function to do it. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * On success, fills fields->tzName, fields->tzOffset and + * fields->localSeconds. On failure, places an error message in + * the interpreter result. + * + *---------------------------------------------------------------------- + */ + +static int +ConvertUTCToLocalUsingC( + Tcl_Interp* interp, /* Tcl interpreter */ + TclDateFields* fields, /* Time to convert, with 'seconds' filled in */ + int changeover /* Julian Day of the Gregorian transition */ +) { + + time_t tock; + struct tm* timeVal; /* Time after conversion */ + int diff; /* Time zone diff local-Greenwich */ + char buffer[8]; /* Buffer for time zone name */ + + /* Use 'localtime' to determine local year, month, day, time of day. */ + + tock = (time_t) fields->seconds; + if ((Tcl_WideInt) tock != fields->seconds) { Tcl_AppendResult(interp, - "number too large to represent as a Posix time", NULL); + "number too large to represent as a Posix time", + NULL); Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } TzsetIfNecessary(); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { - Tcl_AppendResult(interp, "localtime failed (clock value may be too ", - "large/small to represent)", NULL); + Tcl_AppendResult(interp, + "localtime failed (clock value may be too ", + "large/small to represent)", NULL); Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); return TCL_ERROR; } - /* - * Package the results. - */ + /* Fill in the date in 'fields' and use it to derive Julian Day */ + + fields->era = CE; + fields->year = timeVal->tm_year + 1900; + fields->month = timeVal->tm_mon + 1; + fields->dayOfMonth = timeVal->tm_mday; + GetJulianDayFromEraYearMonthDay(fields, changeover); - returnVec[0] = Tcl_NewIntObj(timeVal->tm_year + 1900); - returnVec[1] = Tcl_NewIntObj(timeVal->tm_mon + 1); - returnVec[2] = Tcl_NewIntObj(timeVal->tm_mday); - returnVec[3] = Tcl_NewIntObj(timeVal->tm_hour); - returnVec[4] = Tcl_NewIntObj(timeVal->tm_min); - returnVec[5] = Tcl_NewIntObj(timeVal->tm_sec); - Tcl_SetObjResult(interp, Tcl_NewListObj(6, returnVec)); + /* Convert that value to seconds */ + + fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24 + + timeVal->tm_hour) * 60 + + timeVal->tm_min) * 60 + + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH; + + /* Determine a time zone offset and name; just use +hhmm for the name */ + + diff = (int) (fields->localSeconds - fields->seconds); + fields->tzOffset = diff; + if (diff < 0) { + *buffer = '-'; + diff = -diff; + } else { + *buffer = '+'; + } + sprintf(buffer+1, "%02d", diff / 3600); + diff %= 3600; + sprintf(buffer+3, "%02d", diff / 60); + diff %= 60; + if (diff > 0) { + sprintf(buffer+5, "%02d", diff); + } + fields->tzName = Tcl_NewStringObj(buffer, -1); + Tcl_IncrRefCount(fields->tzName); return TCL_OK; } /* *---------------------------------------------------------------------- * - * ThreadSafeLocalTime -- + * LookupLastTransition -- * - * Wrapper around the 'localtime' library function to make it thread - * safe. + * Given a UTC time and a tzdata array, looks up the last + * transition on or before the given time. * * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. + * Returns a pointer to the row, or NULL if an error occurs. * *---------------------------------------------------------------------- */ -static struct tm * -ThreadSafeLocalTime( - CONST time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ +static Tcl_Obj* +LookupLastTransition( + Tcl_Interp* interp, /* Interpreter for error messages */ + Tcl_WideInt tick, /* Time from the epoch */ + int rowc, /* Number of rows of tzdata */ + Tcl_Obj *CONST * rowv) /* Rows in tzdata */ { - /* - * Get a thread-local buffer to hold the returned time. - */ + int l; + int u; + Tcl_Obj* compObj; + Tcl_WideInt compVal; - struct tm *tmPtr = (struct tm *) - Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm)); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, tmPtr); -#else - struct tm *sysTmPtr; + /* Examine the first row to make sure we're in bounds */ - Tcl_MutexLock(&clockMutex); - sysTmPtr = localtime(timePtr); - if (sysTmPtr == NULL) { - Tcl_MutexUnlock(&clockMutex); + if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK + || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; - } else { - memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&clockMutex); } -#endif - return tmPtr; + /* + * Bizarre case - first row doesn't begin at MIN_WIDE_INT. + * Return it anyway. + */ + if (tick < compVal) { + return rowv[0]; + } + + /* + * Binary-search to find the transition. + */ + + l = 0; + u = rowc-1; + while (l < u) { + int m = (l + u + 1) / 2; + if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK + || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + return NULL; + } + if (tick >= compVal) { + l = m; + } else { + u = m-1; + } + } + return rowv[l]; + } /* *---------------------------------------------------------------------- * - * TclClockMktimeObjCmd -- + * GetYearWeekDay -- * - * Determine seconds from the epoch, given the fields of a local time. + * Given a date with Julian Calendar Day, compute the year, week, + * and day in the ISO8601 calendar. * - * Usage: - * mktime <year> <month> <day> <hour> <minute> <second> + * Results: + * None. * - * Parameters: - * year -- Calendar year - * month -- Calendar month - * day -- Calendar day - * hour -- Hour of day (00-23) - * minute -- Minute of hour - * second -- Second of minute + * Side effects: + * Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in + * the date fields. + * + *---------------------------------------------------------------------- + */ + +static void +GetYearWeekDay( + TclDateFields* fields, /* Date to convert, must have 'julianDay' */ + int changeover /* Julian Day Number of the Gregorian + * transition */ +) { + TclDateFields temp; + int dayOfFiscalYear; + + /* + * 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; + GetGregorianEraYearDay(&temp, changeover); + if (temp.era == BCE) { + temp.iso8601Year = temp.year - 1; + } else { + temp.iso8601Year = temp.year + 1; + } + temp.iso8601Week = 1; + temp.dayOfWeek = 1; + GetJulianDayFromEraYearWeekDay(&temp, changeover); + + /* + * temp.julianDay is now the start of an ISO8601 year, either the + * one corresponding to the given date, or the one after. If we guessed + * high, move one year earlier + */ + + if (fields->julianDay < temp.julianDay) { + if (temp.era == BCE) { + temp.iso8601Year += 1; + } else { + temp.iso8601Year -= 1; + } + GetJulianDayFromEraYearWeekDay(&temp, changeover); + } + + fields->iso8601Year = temp.iso8601Year; + dayOfFiscalYear = fields->julianDay - temp.julianDay; + fields->iso8601Week = (dayOfFiscalYear / 7) + 1; + fields->dayOfWeek = (dayOfFiscalYear + 1) % 7; + if (fields->dayOfWeek < 1) { + fields->dayOfWeek += 7; + } +} + +/* + *---------------------------------------------------------------------- + * + * GetGregorianEraYearDay -- + * + * Given a Julian Day Number, extracts the year and day of the + * year and puts them into TclDateFields, along with the era + * (BCE or CE) and a flag indicating whether the date is Gregorian + * or Julian. * * Results: - * Returns the given local time. + * None. * - * Errors: - * Returns an error if the 'mktime' function does not exist in the C - * library, or if the given time cannot be converted. + * Side effects: + * Stores 'era', 'gregorian', 'year', and 'dayOfYear'. + * + *---------------------------------------------------------------------- + */ + +static void +GetGregorianEraYearDay( + TclDateFields* fields, /* Date fields containing 'julianDay' */ + int changeover /* Gregorian transition date */ +) { + int jday = fields->julianDay; + int day; + int year; + int n; + + if (jday >= changeover) { + + /* Gregorian calendar */ + + fields->gregorian = 1; + year = 1; + + /* + * n = Number of 400-year cycles since 1 January, 1 CE in the + * proleptic Gregorian calendar. day = remaining days. + */ + + day = jday - JDAY_1_JAN_1_CE_GREGORIAN; + n = day / FOUR_CENTURIES; + day %= FOUR_CENTURIES; + year += 400 * n; + + /* + * n = number of centuries since the start of (year); + * day = remaining days + */ + + n = day / ONE_CENTURY_GREGORIAN; + day %= ONE_CENTURY_GREGORIAN; + if (n > 3) { + /* 31 December in the last year of a 400-year cycle */ + n = 3; + day += ONE_CENTURY_GREGORIAN; + } + year += 100 * n; + + } else { + + /* Julian calendar */ + + fields->gregorian = 0; + year = 1; + day = jday - JDAY_1_JAN_1_CE_JULIAN; + + } + + /* n = number of 4-year cycles; days = remaining days */ + + n = day / FOUR_YEARS; + day %= 1461; + year += 4 * n; + + /* n = number of years; days = remaining days */ + + n = day / ONE_YEAR; + day %= ONE_YEAR; + if (n > 3) { + /* 31 December of a leap year */ + n = 3; + day += 365; + } + year += n; + + /* store era/year/day back into fields */ + + if (year < 0) { + fields->era = BCE; + fields->year = 1 - year; + } else { + fields->era = CE; + fields->year = year; + } + fields->dayOfYear = day + 1; + +} + +/* + *---------------------------------------------------------------------- + * + * GetMonthDay -- + * + * Given a date as year and day-of-year, find month and day. + * + * Results: + * None. * * Side effects: + * Stores 'month' and 'dayOfMonth' in the 'fields' structure. + * + *---------------------------------------------------------------------- + */ + +static void +GetMonthDay( + TclDateFields* fields /* Date to convert */ +) { + int day = fields->dayOfYear; + int month; + const int* h = hath[IsGregorianLeapYear(fields)]; + for (month = 0; month < 12 && day > h[month]; ++month) { + day -= h[month]; + } + fields->month = month+1; + fields->dayOfMonth = day; +} + +/* + *---------------------------------------------------------------------- + * + * GetJulianDayFromEraYearWeekDay -- + * + * Given a TclDateFields structure containing era, ISO8601 year, + * ISO8601 week, and day of week, computes the Julian Day Number. + * + * Results: * None. * + * Side effects: + * Stores 'julianDay' in the fields. + * *---------------------------------------------------------------------- */ -int -TclClockMktimeObjCmd( - ClientData clientData, /* Unused */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *CONST *objv) /* Parameter vector */ -{ -#ifndef HAVE_MKTIME - Tcl_AppendResult(interp, "cannot determine local time", NULL); - return TCL_ERROR; -#else +static void +GetJulianDayFromEraYearWeekDay( + TclDateFields* fields, /* Date to convert */ + int changeover /* Julian Day Number of the + * Gregorian transition */ +) { - int i; - struct tm toConvert; /* Time to be converted */ - time_t convertedTime; /* Time converted from mktime */ - int localErrno; + int firstMonday; /* Julian day number of week 1, day 1 + * in the given year */ - /* - * Convert parameters - */ + /* Find January 4 in the ISO8601 year, which will always be in week 1 */ - if (objc != 7) { - Tcl_WrongNumArgs(interp, 1, objv, "year month day hour minute second"); - return TCL_ERROR; + TclDateFields firstWeek; + firstWeek.era = fields->era; + firstWeek.year = fields->iso8601Year; + firstWeek.month = 1; + firstWeek.dayOfMonth = 4; + GetJulianDayFromEraYearMonthDay(&firstWeek, changeover); + + /* Find Monday of week 1. */ + + firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay); + + /* Advance to the given week and day */ + + fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1) + + fields->dayOfWeek - 1; + +} + +/* + *---------------------------------------------------------------------- + * + * GetJulianDayFromEraYearMonthDay -- + * + * Given era, year, month, and dayOfMonth (in TclDateFields), and + * the Gregorian transition date, computes the Julian Day Number. + * + * Results: + * None. + * + * Side effects: + * Stores day number in 'julianDay' + * + *---------------------------------------------------------------------- + */ + +static void +GetJulianDayFromEraYearMonthDay( + TclDateFields* fields, /* Date to convert */ + int changeover /* Gregorian transition date as a Julian Day */ +) { + int year; int ym1; + int month; int mm1; + + if (fields->era == BCE) { + year = 1 - fields->year; + } else { + year = fields->year; } - if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { - return TCL_ERROR; + + /* Reduce month modulo 12 */ + + month = fields->month; + mm1 = month - 1; + year += mm1 / 12; + month = (mm1 % 12) + 1; + ym1 = year - 1; + + /* Adjust the year after reducing the month */ + + fields->gregorian = 1; + if (year < 1) { + fields->era = BCE; + fields->year = 1-year; + } else { + fields->era = CE; + fields->year = year; } - toConvert.tm_year = i - 1900; - if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) { - return TCL_ERROR; + + /* Try an initial conversion in the Gregorian calendar */ + + fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1 + + fields->dayOfMonth + + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1] + + (ONE_YEAR * ym1) + + (ym1 / 4) + - (ym1 / 100) + + (ym1 / 400); + + /* + * If the resulting date is before the Gregorian changeover, convert + * in the Julian calendar instead. + */ + + if (fields->julianDay < changeover) { + fields->gregorian = 0; + fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1 + + fields->dayOfMonth + + daysInPriorMonths[year%4 == 0][month - 1] + + (365 * ym1) + + (ym1 / 4); } - toConvert.tm_mon = i - 1; - if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { - return TCL_ERROR; + +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +static int +IsGregorianLeapYear( + TclDateFields* fields /* Date to test */ +) { + int year; + if (fields->era == BCE) { + year = 1 - fields->year; + } else { + year = fields->year; } - toConvert.tm_mday = i; - if (Tcl_GetIntFromObj(interp, objv[4], &i) != TCL_OK) { - return TCL_ERROR; + if (year%4 != 0) { + return 0; + } else if (!(fields->gregorian)) { + return 1; + } else if (year%400 == 0) { + return 1; + } else if (year%100 == 0) { + return 0; + } else { + return 1; } - toConvert.tm_hour = i; - if (Tcl_GetIntFromObj(interp, objv[5], &i) != TCL_OK) { +} + +/* + *---------------------------------------------------------------------- + * + * WeekdayOnOrBefore -- + * + * Finds the Julian Day Number of a given day of the week that + * falls on or before a given date, expressed as Julian Day Number. + * + * Results: + * Returns the Julian Day Number + * + *---------------------------------------------------------------------- + */ + +static int +WeekdayOnOrBefore( + int dayOfWeek, /* Day of week; Sunday == 0 or 7 */ + int julianDay /* Reference date */ +) { + int k = (dayOfWeek + 6) % 7; + return julianDay - ((julianDay - k) % 7); +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetenvObjCmd -- + * + * Tcl command that reads an environment variable from the system + * + * Usage: + * ::tcl::clock::getEnv NAME + * + * Parameters: + * NAME - Name of the environment variable desired + * + * Results: + * Returns a standard Tcl result. Returns an error if the + * variable does not exist, with a message left in the interpreter. + * Returns TCL_OK and the value of the variable if the variable + * does exist, + * + *---------------------------------------------------------------------- + */ + +int +ClockGetenvObjCmd( + ClientData clientData, + Tcl_Interp* interp, + int objc, + Tcl_Obj *CONST objv[]) +{ + + CONST char* varName; + CONST char* varValue; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - toConvert.tm_min = i; - if (Tcl_GetIntFromObj(interp, objv[6], &i) != TCL_OK) { + varName = Tcl_GetStringFromObj(objv[1], NULL); + varValue = getenv(varName); + if (varValue == NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("variable not found", -1)); return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); + return TCL_OK; } - toConvert.tm_sec = i; - toConvert.tm_isdst = -1; - toConvert.tm_wday = -1; - toConvert.tm_yday = -1; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadSafeLocalTime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ +static struct tm * +ThreadSafeLocalTime( + CONST time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ /* - * Convert the time. It is rumored that mktime is not thread safe on some - * platforms. + * Get a thread-local buffer to hold the returned time. */ - TzsetIfNecessary(); - Tcl_MutexLock(&clockMutex); - errno = 0; - convertedTime = mktime(&toConvert); - localErrno = errno; - Tcl_MutexUnlock(&clockMutex); - - /* - * Return the converted time, or an error if conversion fails. - */ + struct tm *tmPtr = (struct tm *) + Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm)); +#ifdef HAVE_LOCALTIME_R + localtime_r(timePtr, tmPtr); +#else + struct tm *sysTmPtr; - if (localErrno != 0 || (convertedTime == -1 && toConvert.tm_yday == -1)) { - Tcl_AppendResult(interp, "time value too large/small to represent", - NULL); - return TCL_ERROR; + Tcl_MutexLock(&clockMutex); + sysTmPtr = localtime(timePtr); + if (sysTmPtr == NULL) { + Tcl_MutexUnlock(&clockMutex); + return NULL; + } else { + memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&clockMutex); } - - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) convertedTime)); - return TCL_OK; -#endif /* HAVE_MKTIME */ +#endif + return tmPtr; } /*---------------------------------------------------------------------- * - * TclClockClicksObjCmd -- + * ClockClicksObjCmd -- * * Returns a high-resolution counter. * @@ -365,7 +1355,7 @@ TclClockMktimeObjCmd( */ int -TclClockClicksObjCmd( +ClockClicksObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ @@ -416,7 +1406,7 @@ TclClockClicksObjCmd( /*---------------------------------------------------------------------- * - * TclClockMillisecondsObjCmd - + * ClockMillisecondsObjCmd - * * Returns a count of milliseconds since the epoch. * @@ -433,7 +1423,7 @@ TclClockClicksObjCmd( */ int -TclClockMillisecondsObjCmd( +ClockMillisecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ @@ -453,7 +1443,7 @@ TclClockMillisecondsObjCmd( /*---------------------------------------------------------------------- * - * TclClockMicrosecondsObjCmd - + * ClockMicrosecondsObjCmd - * * Returns a count of microseconds since the epoch. * @@ -470,7 +1460,7 @@ TclClockMillisecondsObjCmd( */ int -TclClockMicrosecondsObjCmd( +ClockMicrosecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ @@ -490,7 +1480,7 @@ TclClockMicrosecondsObjCmd( /*---------------------------------------------------------------------- * - * TclClockSecondsObjCmd - + * ClockSecondsObjCmd - * * Returns a count of microseconds since the epoch. * @@ -507,7 +1497,7 @@ TclClockMicrosecondsObjCmd( */ int -TclClockSecondsObjCmd( +ClockSecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ @@ -566,6 +1556,36 @@ TzsetIfNecessary(void) } /* + *---------------------------------------------------------------------- + * + * 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 = (ClockClientData*) clientData; + int i; + --(data->refCount); + if (data->refCount == 0) { + for (i = 0; i < LIT__END; ++i) { + Tcl_DecrRefCount(data->literals[i]); + } + ckfree((char*) (data->literals)); + ckfree((char*) data); + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |