code rationalization - eliminate some duplication between Tcl and C

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]) )