summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2005-11-30 19:34:10 (GMT)
committerKevin B Kenny <kennykb@acm.org>2005-11-30 19:34:10 (GMT)
commitf4014a57db9561af6d9540399afc14cb2ed64523 (patch)
tree0e1bba3208ab0c1827c032807c28b8ee50931987
parentcdd6051c36020fca89502380c47fe1369042135d (diff)
downloadtcl-f4014a57db9561af6d9540399afc14cb2ed64523.zip
tcl-f4014a57db9561af6d9540399afc14cb2ed64523.tar.gz
tcl-f4014a57db9561af6d9540399afc14cb2ed64523.tar.bz2
code rationalization - eliminate some duplication between Tcl and C
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclClock.c194
-rw-r--r--library/clock.tcl202
3 files changed, 221 insertions, 178 deletions
diff --git a/ChangeLog b/ChangeLog
index d0b971d..43d4764 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -26,6 +26,9 @@
JULIAN_SEC_POSIX_EPOCH. Also fixed a bug where [clock format]
would fail in the :localtime zone for times before the Posix
Epoch. Thanks to Miguel Sofer for pointing out all of these.
+ Also rationalized the code a little bit by moving parts of
+ [clock scan] into C, eliminating some code that was duplicated
+ in the C and Tcl layers.
2005-11-29 Kevin Kenny <kennykb@acm.org>
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 340a06c..a29de78 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.46 2005/11/30 15:39:37 kennykb Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.47 2005/11/30 19:34:13 kennykb Exp $
*/
#include "tclInt.h"
@@ -112,6 +112,7 @@ typedef struct TclDateFields {
int dayOfWeek; /* Day of the week */
} TclDateFields;
+static CONST char* eras[] = { "CE", "BCE", NULL };
/*
* Thread specific data block holding a 'struct tm' for the 'gmtime' and
@@ -161,6 +162,12 @@ static int ClockConvertlocaltoutcObjCmd(
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[]);
@@ -240,6 +247,16 @@ TclClockInit(
ClockGetdatefieldsObjCmd,(ClientData) data,
ClockDeleteCmdProc);
++data->refCount;
+ Tcl_CreateObjCommand(interp,
+ "::tcl::clock::GetJulianDayFromEraYearMonthDay",
+ ClockGetjuliandayfromerayearmonthdayObjCmd,(ClientData) data,
+ ClockDeleteCmdProc);
+ ++data->refCount;
+ Tcl_CreateObjCommand(interp,
+ "::tcl::clock::GetJulianDayFromEraYearWeekDay",
+ ClockGetjuliandayfromerayearweekdayObjCmd,(ClientData) data,
+ ClockDeleteCmdProc);
+ ++data->refCount;
}
@@ -432,6 +449,170 @@ ClockGetdatefieldsObjCmd(
/*
*----------------------------------------------------------------------
*
+ * ClockGetjuliandayfromerayearmonthdayObjCmd --
+ *
+ * Tcl command that converts a time from era-year-month-day to
+ * a Julian Day Number.
+ *
+ * Parameters:
+ * dict - Dictionary that contains 'era', 'year', 'month' and
+ * 'dayOfMonth' keys.
+ * changeover - Julian Day of changeover to the Gregorian calendar
+ *
+ * Results:
+ * Result is either TCL_OK, with the interpreter result being the
+ * dictionary augmented with a 'julianDay' key, or TCL_ERROR,
+ * with the result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearmonthdayObjCmd (
+ 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;
+ Tcl_Obj* fieldPtr;
+ int changeover;
+ int copied = 0;
+ int status;
+
+ /* Check params */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+ return TCL_ERROR;
+ }
+ dict = objv[1];
+ if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+ &(fields.era)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfMonth)) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Get Julian day */
+
+ GetJulianDayFromEraYearMonthDay(&fields, changeover);
+
+ /* Store Julian day in the dictionary - copy on write */
+
+ if (Tcl_IsShared(dict)) {
+ dict = Tcl_DuplicateObj(dict);
+ Tcl_IncrRefCount(dict);
+ copied = 1;
+ }
+ status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+ Tcl_NewIntObj(fields.julianDay));
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, dict);
+ }
+ if (copied) {
+ Tcl_DecrRefCount(dict);
+ }
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetjuliandayfromerayearweekdayObjCmd --
+ *
+ * Tcl command that converts a time from the ISO calendar to
+ * a Julian Day Number.
+ *
+ * Parameters:
+ * dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week'
+ * and 'dayOfWeek' keys.
+ * changeover - Julian Day of changeover to the Gregorian calendar
+ *
+ * Results:
+ * Result is either TCL_OK, with the interpreter result being the
+ * dictionary augmented with a 'julianDay' key, or TCL_ERROR,
+ * with the result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearweekdayObjCmd (
+ 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;
+ Tcl_Obj* fieldPtr;
+ int changeover;
+ int copied = 0;
+ int status;
+
+ /* Check params */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+ return TCL_ERROR;
+ }
+ dict = objv[1];
+ if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+ &(fields.era)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
+ &fieldPtr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Get Julian day */
+
+ GetJulianDayFromEraYearWeekDay(&fields, changeover);
+
+ /* Store Julian day in the dictionary - copy on write */
+
+ if (Tcl_IsShared(dict)) {
+ dict = Tcl_DuplicateObj(dict);
+ Tcl_IncrRefCount(dict);
+ copied = 1;
+ }
+ status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+ Tcl_NewIntObj(fields.julianDay));
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, dict);
+ }
+ if (copied) {
+ Tcl_DecrRefCount(dict);
+ }
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ConvertLocalToUTC --
*
* Converts a time (in a TclDateFields structure) from the
@@ -1137,6 +1318,7 @@ GetJulianDayFromEraYearMonthDay(
) {
int year; int ym1;
int month; int mm1;
+ int q; int r;
if (fields->era == BCE) {
year = 1 - fields->year;
@@ -1148,8 +1330,14 @@ GetJulianDayFromEraYearMonthDay(
month = fields->month;
mm1 = month - 1;
- year += mm1 / 12;
- month = (mm1 % 12) + 1;
+ q = mm1 / 12;
+ r = (mm1 % 12);
+ if (r < 0) {
+ r += 12;
+ q -= 1;
+ }
+ year += q;
+ month = r + 1;
ym1 = year - 1;
/* Adjust the year after reducing the month */
diff --git a/library/clock.tcl b/library/clock.tcl
index 6f6b1ed..279a3db 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: clock.tcl,v 1.21 2005/11/29 22:50:58 kennykb Exp $
+# RCS: @(#) $Id: clock.tcl,v 1.22 2005/11/30 19:34:13 kennykb Exp $
#
#----------------------------------------------------------------------
@@ -399,7 +399,8 @@ proc ::tcl::clock::Initialize {} {
dict set date era CE
dict set date year [expr { 100 * [dict get $date century]
+ [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
{ century yearOfCentury dayOfYear } 2 {
dict set date era CE
@@ -412,13 +413,15 @@ proc ::tcl::clock::Initialize {} {
dict set date iso8601Year \
[expr { 100 * [dict get $date iso8601Century]
+ [dict get $date iso8601YearOfCentury] }]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
{ yearOfCentury month dayOfMonth } 3 {
set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
dict set date era CE
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
{ yearOfCentury dayOfYear } 3 {
set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
@@ -430,13 +433,15 @@ proc ::tcl::clock::Initialize {} {
$date[set date {}] $baseTime \
iso8601YearOfCentury iso8601Year]
dict set date era CE
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
{ month dayOfMonth } 4 {
set date [AssignBaseYear $date[set date {}] \
$baseTime $timeZone]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
{ dayOfYear } 4 {
set date [AssignBaseYear $date[set date {}] \
@@ -446,19 +451,22 @@ proc ::tcl::clock::Initialize {} {
{ iso8601Week dayOfWeek } 4 {
set date [AssignBaseIso8601Year $date[set date {}] \
$baseTime $timeZone]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
{ dayOfMonth } 5 {
set date [AssignBaseMonth $date[set date {}] \
$baseTime $timeZone]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
{ dayOfWeek } 6 {
set date [AssignBaseWeek $date[set date {}] \
$baseTime $timeZone]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
{} 7 {
@@ -1313,7 +1321,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# Assemble date, time, zone into seconds-from-epoch
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2299161]
if { $parseTime ne {} } {
dict set date secondOfDay $parseTime
} elseif { [llength $parseWeekday] != 0
@@ -1870,6 +1878,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
append procBody "set date \[dict create\]" \n
append procBody {dict set date tzName $timeZone} \n
append procBody $postcode
+ append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
# Add code that gets Julian Day Number from the fields.
@@ -1906,7 +1915,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
::tcl::clock::SetupTimeZone $timeZone
set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
$TZData($timeZone) \
- [mc GREGORIAN_CHANGE_DATE]]
+ $changeover]
}
}
@@ -2525,11 +2534,7 @@ proc ::tcl::clock::FormatStarDate { date } {
# Determine whether the year is a leap year
- if { [dict get $date gregorian] } {
- set lp [IsGregorianLeapYear $date]
- } else {
- set lp [expr { [dict get $date year] % 4 == 0 }]
- }
+ set lp [IsGregorianLeapYear $date]
# Convert day of year to a fractional year
@@ -2577,6 +2582,7 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
# Build a tentative date from year and fraction.
set date [dict create \
+ gregorian 1 \
era CE \
year [expr { $year + $Roddenberry }] \
dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
@@ -2584,11 +2590,7 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
# Determine whether the given year is a leap year
- if { [dict get $date gregorian] } {
- set lp [IsGregorianLeapYear $date]
- } else {
- set lp [expr { [dict get $date year] % 4 == 0 }]
- }
+ set lp [IsGregorianLeapYear $date]
# Reconvert the fractional year according to whether the given
# year is a leap year
@@ -3878,158 +3880,6 @@ proc ::tcl::clock::GetLocaleEra { date } {
#----------------------------------------------------------------------
#
-# GetJulianDayFromEraYearWeekDay --
-#
-# Finds the Julian Day Number corresponding to the given era,
-# year, week and day.
-#
-# Parameters:
-# date -- A dictionary populated with fields whose keys are given
-# by the 'keys' parameter below, plus the 'era' field.
-# daysInFirstWeek -- (Optional) The minimum number of days in
-# the first week of the year. Default is 4.
-# firstDayOfWeek -- (Optional) The ordinal number of the first
-# day of the week. Default is 1 (Monday);
-# 0 (Sunday) is an alternative.
-# keys -- (Optional) Keys in the dictionary for looking up the
-# fiscal year, fiscal week, and day of week. The
-# default is { iso8601Year iso8601Week dayOfWeek }.
-#
-# Results:
-# Returns the dictionary augmented with a 'julianDay' field
-# that gives the Julian Day Number corresponding to the given
-# date.
-#
-# Bugs:
-# This code needs to be moved to the C layer.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetJulianDayFromEraYearWeekDay {
- date
- { daysInFirstWeek 4 }
- { firstDayOfWeek 1 }
- { keys { iso8601Year iso8601Week dayOfWeek } }
-} {
-
- foreach var { fiscalYear fiscalWeek dayOfWeek } key $keys {
- set $var [dict get $date $key]
- }
-
- # Find a day of the first week of the year.
-
- set date2 [dict create \
- era [dict get $date era] \
- year $fiscalYear \
- month 1 \
- dayOfMonth $daysInFirstWeek]
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]]
-
- # Find the Julian Day Number of the start of that week.
-
- set jd [WeekdayOnOrBefore $firstDayOfWeek [dict get $date2 julianDay]]
-
- # Add the required number of weeks and days
-
- dict set date julianDay \
- [expr { $jd
- + ( 7 * ( $fiscalWeek - 1 ) )
- + $dayOfWeek - $firstDayOfWeek }]
-
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
-# GetJulianDayFromEraYearMonthDay --
-#
-# Given a year, month and day on the Gregorian calendar, determines
-# the Julian Day Number beginning at noon on that date.
-#
-# Parameters:
-# date -- A dictionary in which the 'era', 'year', 'month', and
-# 'dayOfMonth' slots are populated. The calendar in use
-# is determined by the date itself relative to
-# [mc GREGORIAN_CHANGE_DATE] in the current locale.
-#
-# Results:
-# Returns the given dictionary augmented with a 'julianDay' key
-# whose value is the desired Julian Day Number, and a 'gregorian'
-# key that specifies whether the calendar is Gregorian (1) or
-# Julian (0).
-#
-# Side effects:
-# None.
-#
-# Bugs:
-# This code needs to be moved to the C layer.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } {
-
- variable DaysInPriorMonthsInCommonYear
- variable DaysInPriorMonthsInLeapYear
-
- # Get absolute year number from the civil year
-
- switch -exact -- [dict get $date era] {
- BCE {
- set year [expr { 1 - [dict get $date year] }]
- }
- CE {
- set year [dict get $date year]
- }
- }
-
- # If month is out of range, reduce modulo 12 and adjust year accordingly.
-
- set month [expr { [dict get $date month] - 1 }]
- incr year [expr { $month / 12 }]
- set month [expr { ( $month % 12 ) + 1 }]
- dict set date era CE; dict set date year $year; dict set date month $month
-
- set ym1 [expr { $year - 1 }]
-
- # Try the Gregorian calendar first.
-
- dict set date gregorian 1
- set jd [expr { 1721425
- + [dict get $date dayOfMonth]
- + ( [IsGregorianLeapYear $date] ?
- [lindex $DaysInPriorMonthsInLeapYear \
- [expr { $month - 1}]]
- : [lindex $DaysInPriorMonthsInCommonYear \
- [expr { $month - 1}]] )
- + ( 365 * $ym1 )
- + ( $ym1 / 4 )
- - ( $ym1 / 100 )
- + ( $ym1 / 400 ) }]
-
- # If the date is before the Gregorian change, use the Julian calendar.
-
- if { $jd < [mc GREGORIAN_CHANGE_DATE] } {
-
- dict set date gregorian 0
- set jd [expr { 1721423
- + [dict get $date dayOfMonth]
- + ( ( $year % 4 == 0 ) ?
- [lindex $DaysInPriorMonthsInLeapYear \
- [expr { $month - 1}]]
- : [lindex $DaysInPriorMonthsInCommonYear \
- [expr { $month - 1}]] )
- + ( 365 * $ym1 )
- + ( $ym1 / 4 ) }]
- }
-
- dict set date julianDay $jd
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
# GetJulianDayFromEraYearDay --
#
# Given a year, month and day on the Gregorian calendar, determines
@@ -4129,7 +3979,8 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } {
dict incr date2 month
dict set date2 dayOfMonth 7
}
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]]
+ set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
+ [mc GREGORIAN_CHANGE_DATE]]
set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
[dict get $date2 julianDay]]
dict set date julianDay [expr { $wd0 + 7 * $week }]
@@ -4490,7 +4341,8 @@ proc ::tcl::clock::AddMonths { months clockval timezone } {
# Reconvert to a number of seconds
set date [GetJulianDayFromEraYearMonthDay \
- $date[set date {}]]
+ $date[set date {}]\
+ $changeover]
dict set date localSeconds \
[expr { -210866803200
+ ( 86400 * wide([dict get $date julianDay]) )