From eac924b26e7181f5813720bf155fab400ab61ddd Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Wed, 6 Feb 2008 01:13:05 +0000 Subject: * generic/tclClock.c (ClockParseformatargsObjCmd): * library/clock.tcl (::tcl::clock::format): * tests/clock.test (clock-1.0, clock-1.4): Performance enhancements in [clock format] (moving the analysis of $args into C code, holding on to Tcl_Objs with resolved command names, [lassign] in place of [foreach], avoiding [namespace which] for command resolution). --- ChangeLog | 11 ++++ generic/tclClock.c | 140 +++++++++++++++++++++++++++++++++++++++++++-- library/clock.tcl | 162 +++++++++++++++++------------------------------------ tests/clock.test | 10 +++- 4 files changed, 204 insertions(+), 119 deletions(-) diff --git a/ChangeLog b/ChangeLog index 98cb68e..cf46635 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2008-02-06 Kevin B. Kenny + + * generic/tclClock.c (ClockParseformatargsObjCmd): + * library/clock.tcl (::tcl::clock::format): + * tests/clock.test (clock-1.0, clock-1.4): + Performance enhancements in [clock format] (moving + the analysis of $args into C code, holding on to + Tcl_Objs with resolved command names, [lassign] + in place of [foreach], avoiding [namespace which] + for command resolution). + 2008-02-04 Don Porter *** 8.5.1 TAGGED FOR RELEASE *** diff --git a/generic/tclClock.c b/generic/tclClock.c index 26a8662..dd006b4 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.63 2007/12/13 15:23:15 dgp Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.64 2008/02/06 01:13:07 kennykb Exp $ */ #include "tclInt.h" @@ -58,9 +58,13 @@ static const int daysInPriorMonths[2][13] = { */ typedef enum ClockLiteral { - LIT_BCE, LIT_CE, + LIT__NIL, + LIT__DEFAULT_FORMAT, + LIT_BCE, LIT_C, + LIT_CANNOT_USE_GMT_AND_TIMEZONE, + LIT_CE, LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, - LIT_ERA, LIT_GREGORIAN, + LIT_ERA, LIT_GMT, LIT_GREGORIAN, LIT_ISO8601WEEK, LIT_ISO8601YEAR, LIT_JULIANDAY, LIT_LOCALSECONDS, LIT_MONTH, @@ -69,9 +73,13 @@ typedef enum ClockLiteral { LIT__END } ClockLiteral; static const char *const literals[] = { - "BCE", "CE", + "", + "%a %b %d %H:%M:%S %Z %Y", + "BCE", "C", + "cannot use -gmt and -timezone in same call", + "CE", "dayOfMonth", "dayOfWeek", "dayOfYear", - "era", "gregorian", + "era", ":GMT", "gregorian", "iso8601Week", "iso8601Year", "julianDay", "localSeconds", "month", @@ -176,6 +184,9 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockParseformatargsObjCmd( + 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[]); @@ -209,6 +220,7 @@ static const struct ClockCommand clockCommands[] = { ClockGetjuliandayfromerayearmonthdayObjCmd }, { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, + { "ParseFormatArgs", ClockParseformatargsObjCmd }, { NULL, NULL } }; @@ -1779,6 +1791,124 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +/* + *----------------------------------------------------------------------------- + * + * ClockParseformatargsObjCmd -- + * + * Parses the arguments for [clock format]. + * + * Results: + * Returns a standard Tcl result, whose value is a four-element + * list comprising the time format, the locale, and the timezone. + * + * This function exists because the loop that parses the [clock format] + * options is a known performance "hot spot", and is implemented in an + * effort to speed that particular code up. + * + *----------------------------------------------------------------------------- + */ + +static int +ClockParseformatargsObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[] /* Parameter vector */ +) { + + ClockClientData* dataPtr = (ClockClientData*) clientData; + Tcl_Obj** litPtr = dataPtr->literals; + + /* Format, locale and timezone */ + + Tcl_Obj* results[3]; +#define formatObj results[0] +#define localeObj results[1] +#define timezoneObj results[2] + int gmtFlag = 0; + + /* Command line options expected */ + + const static char* options[] = { + "-format", "-gmt", "-locale", + "-timezone", NULL }; + enum optionInd { + CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, + CLOCK_FORMAT_TIMEZONE + }; + int optionIndex; /* Index of an option */ + int saw = 0; /* Flag == 1 if option was seen already */ + Tcl_WideInt clockVal; /* Clock value - just used to parse */ + int i; + + /* Args consist of a time followed by keyword-value pairs */ + + if (objc < 2 || (objc % 2) != 0) { + Tcl_WrongNumArgs(interp, 0, objv, + "clock format clockval ?-format string? " + "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + /* Extract values for the keywords */ + + formatObj = litPtr[LIT__DEFAULT_FORMAT]; + localeObj = litPtr[LIT_C]; + timezoneObj = litPtr[LIT__NIL]; + for (i = 2; i < objc; i+=2) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0, + &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badSwitch", + Tcl_GetString(objv[i]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case CLOCK_FORMAT_FORMAT: + formatObj = objv[i+1]; + break; + case CLOCK_FORMAT_GMT: + if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK) { + return TCL_ERROR; + } + break; + case CLOCK_FORMAT_LOCALE: + localeObj = objv[i+1]; + break; + case CLOCK_FORMAT_TIMEZONE: + timezoneObj = objv[i+1]; + break; + } + saw |= (1 << optionIndex); + } + + /* Check options */ + + if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { + return TCL_ERROR; + } + if ((saw & (1 << CLOCK_FORMAT_GMT)) + && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { + Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); + return TCL_ERROR; + } + if (gmtFlag) { + timezoneObj = litPtr[LIT_GMT]; + } + + /* Return options as a list */ + + Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); + return TCL_OK; + +#undef timezoneObj +#undef localeObj +#undef formatObj + +} + /*---------------------------------------------------------------------- * * ClockSecondsObjCmd - diff --git a/library/clock.tcl b/library/clock.tcl index e5c831b..79ffc3e 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.45 2007/12/13 15:26:03 dgp Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.46 2008/02/06 01:13:07 kennykb Exp $ # #---------------------------------------------------------------------- @@ -644,6 +644,9 @@ proc ::tcl::clock::Initialize {} { # comprising start time, UTC offset, # Daylight Saving Time indicator, and # time zone abbreviation. + variable FormatProc; # Array mapping format group + # and locale to the name of a procedure + # that renders the given format } ::tcl::clock::Initialize @@ -661,74 +664,11 @@ proc ::tcl::clock::Initialize {} { proc ::tcl::clock::format { args } { + variable FormatProc variable TZData - set format {} - - # Check the count of args - - if { [llength $args] < 1 || [llength $args] % 2 != 1 } { - set cmdName "clock format" - return -code error \ - -errorcode [list CLOCK wrongNumArgs] \ - "wrong \# args: should be\ - \"$cmdName clockval\ - ?-format string? ?-gmt boolean?\ - ?-locale LOCALE? ?-timezone ZONE?\"" - } - - # Set defaults + lassign [ParseFormatArgs {*}$args] format locale timezone set clockval [lindex $args 0] - set format {%a %b %d %H:%M:%S %Z %Y} - set gmt 0 - set locale C - set timezone {} - - # Pick up command line options. - - foreach { flag value } [lreplace $args 0 0] { - set saw($flag) {} - switch -exact -- $flag { - -f - -fo - -for - -form - -forma - -format { - set format $value - } - -g - -gm - -gmt { - set gmt $value - } - -l - -lo - -loc - -loca - -local - -locale { - set locale $value - } - -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { - set timezone $value - } - default { - return -code error \ - -errorcode [list CLOCK badSwitch $flag] \ - "bad switch \"$flag\",\ - must be -format, -gmt, -locale or -timezone" - } - } - } - - # Check options for validity - - if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { - return -code error \ - -errorcode [list CLOCK gmtWithTimezone] \ - "cannot use -gmt and -timezone in same call" - } - if { ![string is wide -strict $clockval] } { - return -code error \ - "expected integer but got \"$clockval\"" - } - if { ![string is boolean -strict $gmt] } { - return -code error \ - "expected boolean value but got \"$gmt\"" - } else { - if { $gmt } { - set timezone :GMT - } - } # Get the data for time changes in the given zone @@ -742,10 +682,19 @@ proc ::tcl::clock::format { args } { } } - # Format the result + # Build a procedure to format the result. Cache the built procedure's + # name in the 'FormatProc' array to avoid losing its internal + # representation, which contains the name resolution. + + set procName ::tcl::clock::formatproc'$format'$locale + if {[info exists FormatProc($procName)]} { + set procName $FormatProc($procName) + } else { + set FormatProc($procName) \ + [ParseClockFormatFormat $procName $format $locale] + } - set formatter [ParseClockFormatFormat $format $locale] - return [$formatter $clockval $timezone] + return [$procName $clockval $timezone] } @@ -764,10 +713,9 @@ proc ::tcl::clock::format { args } { # #---------------------------------------------------------------------- -proc ::tcl::clock::ParseClockFormatFormat {format locale} { +proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { - set procName [namespace current]::formatproc'$format'$locale - if {[namespace which $procName] != {}} { + if {[namespace which $procName] ne {}} { return $procName } @@ -1422,15 +1370,15 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { return -code error "unable to convert date-time string \"$string\"" } - foreach { parseDate parseTime parseZone parseRel - parseWeekday parseOrdinalMonth } $result break + lassign $result parseDate parseTime parseZone parseRel \ + parseWeekday parseOrdinalMonth # If the caller supplied a date in the string, update the 'date' dict # with the value. If the caller didn't specify a time with the date, # default to midnight. if { [llength $parseDate] > 0 } { - foreach { y m d } $parseDate break + lassign $parseDate y m d if { $y < 100 } { if { $y >= 39 } { incr y 1900 @@ -1454,7 +1402,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # a time zone indicator of +-hhmm. if { [llength $parseZone] > 0 } { - foreach { minEast dstFlag } $parseZone break + lassign $parseZone minEast dstFlag set timezone [FormatNumericTimeZone \ [expr { 60 * $minEast + 3600 * $dstFlag }]] SetupTimeZone $timezone @@ -1485,7 +1433,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # Do relative times if { [llength $parseRel] > 0 } { - foreach { relMonth relDay relSecond } $parseRel break + lassign $parseRel relMonth relDay relSecond set seconds [add $seconds \ $relMonth months $relDay days $relSecond seconds \ -timezone $timezone -locale $locale] @@ -1495,7 +1443,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseWeekday] > 0 } { - foreach {dayOrdinal dayOfWeek} $parseWeekday break + lassign $parseWeekday dayOrdinal dayOfWeek set date2 [GetDateFields $seconds $TZData($timezone) 2361222] dict set date2 era CE set jdwkday [WeekdayOnOrBefore $dayOfWeek \ @@ -1523,7 +1471,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseOrdinalMonth] > 0 } { - foreach {monthOrdinal monthNumber} $parseOrdinalMonth break + lassign $parseOrdinalMonth monthOrdinal monthNumber if { $monthOrdinal > 0 } { set monthDiff [expr { $monthNumber - [dict get $date month] }] if { $monthDiff <= 0 } { @@ -1647,7 +1595,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $full] $i incr i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet dayOfWeek [incr fieldCount] append postcode "dict set date dayOfWeek \[" \ @@ -1665,7 +1613,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $abr] $i dict set l [string tolower $full] $i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1764,7 +1712,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { p - P { # AM/PM indicator set l [list [string tolower [mc AM]] 0 \ [string tolower [mc PM]] 1] - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet amPmIndicator [incr fieldCount] append postcode "dict set date amPmIndicator \[" \ @@ -1890,10 +1838,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { C { # Locale-dependent era set d {} foreach triple [mc LOCALE_ERAS] { - foreach {t symbol year} $triple break + lassign $triple t symbol year dict set d [string tolower $symbol] $year } - foreach { regex lookup } [UniquePrefixRegexp $d] break + lassign [UniquePrefixRegexp $d] regex lookup append re (?: $regex ) } E { @@ -1904,7 +1852,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l c.e. CE dict set l b.c. BCE dict set l a.d. CE - foreach {regex lookup} [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet era [incr fieldCount] append postcode "dict set date era \["\ @@ -1914,8 +1862,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } y { # Locale-dependent year of the era - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex incr captureCount } @@ -1932,8 +1879,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { %O { switch -exact -- $c { d - e { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfMonth [incr fieldCount] append postcode "dict set date dayOfMonth \[" \ @@ -1942,8 +1888,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } H - k { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hour [incr fieldCount] append postcode "dict set date hour \[" \ @@ -1952,8 +1897,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } I - l { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hourAMPM [incr fieldCount] append postcode "dict set date hourAMPM \[" \ @@ -1962,8 +1906,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } m { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1972,8 +1915,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } M { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet minute [incr fieldCount] append postcode "dict set date minute \[" \ @@ -1982,8 +1924,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } S { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet second [incr fieldCount] append postcode "dict set date second \[" \ @@ -1992,8 +1933,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } u - w { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfWeek [incr fieldCount] append postcode "set dow \[dict get " [list $lookup] \ @@ -2010,8 +1950,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { } } y { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet yearOfCentury [incr fieldCount] append postcode {dict set date yearOfCentury } \[ \ @@ -3364,13 +3303,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { set tzname {} } if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } { - foreach { - bias stdBias dstBias - stdYear stdMonth stdDayOfWeek stdDayOfMonth - stdHour stdMinute stdSecond stdMillisec - dstYear dstMonth dstDayOfWeek dstDayOfMonth + lassign $data \ + bias stdBias dstBias \ + stdYear stdMonth stdDayOfWeek stdDayOfMonth \ + stdHour stdMinute stdSecond stdMillisec \ + dstYear dstMonth dstDayOfWeek dstDayOfMonth \ dstHour dstMinute dstSecond dstMillisec - } $data break set stdDelta [expr { $bias + $stdBias }] set dstDelta [expr { $bias + $dstBias }] if { $stdDelta <= 0 } { @@ -3647,7 +3585,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { return -code error "$fileName has times out of order" } set lastTime $t - foreach { gmtoff isDst abbrInd } [lindex $types $c] break + lassign [lindex $types $c] gmtoff isDst abbrInd set abbrev [dict get $abbrevs $abbrInd] lappend r [list $t $gmtoff $isDst $abbrev] } @@ -3664,7 +3602,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { if {[llength $posix] > 0} { set posixFields [ParsePosixTimeZone $posix] foreach tuple [ProcessPosixTimeZone $posixFields] { - foreach {t gmtoff isDst abbrev} $tuple break + lassign $tuple t gmtoff isDst abbrev if {$t > $lastTime} { lappend r $tuple } @@ -4692,6 +4630,7 @@ proc ::tcl::clock::mc { name } { proc ::tcl::clock::ClearCaches {} { + variable FormatProc variable LocaleNumeralCache variable McLoaded variable CachedSystemTimeZone @@ -4704,6 +4643,7 @@ proc ::tcl::clock::ClearCaches {} { rename $p {} } + catch {unset FormatProc} set LocaleNumeralCache {} set McLoaded {} catch {unset CachedSystemTimeZone} diff --git a/tests/clock.test b/tests/clock.test index b736cac..257b5bd 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -11,7 +11,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.test,v 1.81 2007/12/13 15:26:04 dgp Exp $ +# RCS: @(#) $Id: clock.test,v 1.82 2008/02/06 01:13:07 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -272,9 +272,13 @@ test clock-1.3 "clock format - empty val" { clock format 0 -gmt 1 -format "" } {} -test clock-1.4 "clock format - bad flag" { +test clock-1.4 "clock format - bad flag" {*}{ + -body { list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode -} {1 {bad switch "-oops", must be -format, -gmt, -locale or -timezone} {CLOCK badSwitch -oops}} + } + -match glob + -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}} +} test clock-1.5 "clock format - bad timezone" { list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode -- cgit v0.12