xref: /macosx-10.10.1/tcl-105/tcl/tcl/tools/tclZIC.tcl

#----------------------------------------------------------------------
#
# tclZIC.tcl --
#
#	Take the time zone data source files from Arthur Olson's
#	repository at elsie.nci.nih.gov, and prepare time zone
#	information files for Tcl.
#
# Usage:
#	tclsh tclZIC.tcl inputDir outputDir
#
# Parameters:
#	inputDir - Directory (e.g., tzdata2003e) where Olson's source
#		   files are to be found.
#	outputDir - Directory (e.g., ../library/tzdata) where
#		    the time zone information files are to be placed.
#
# Results:
#	May produce error messages on the standard error.  An exit
#	code of zero denotes success; any other exit code is failure.
#
# This program parses the timezone data in a means analogous to the
# 'zic' command, and produces Tcl time zone information files suitable
# for loading into the 'clock' namespace.
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny.	 All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tclZIC.tcl,v 1.9.4.1 2009/04/09 20:12:10 kennykb Exp $
#
#----------------------------------------------------------------------

package require Tcl 8.5

# Define the names of the Olson files that we need to load.
# We avoid the solar time files and the leap seconds.

set olsonFiles {
    africa antarctica asia australasia
    backward etcetera europe northamerica
    pacificnew southamerica systemv
}

# Define the year at which the DST information will stop.

set maxyear 2100

# Determine how big a wide integer is.

set MAXWIDE [expr {wide(1)}]
while 1 {
    set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}]
    if {$next < 0} {
	break
    }
    set MAXWIDE $next
}
set MINWIDE [expr {-$MAXWIDE-1}]

#----------------------------------------------------------------------
#
# loadFiles --
#
#	Loads the time zone files for each continent into memory
#
# Parameters:
#	dir - Directory where the time zone source files are found
#
# Results:
#	None.
#
# Side effects:
#	Calls 'loadZIC' for each continent's data file in turn.
#	Reports progress on stdout.
#
#----------------------------------------------------------------------

proc loadFiles {dir} {
    variable olsonFiles
    foreach file $olsonFiles {
	puts "loading: [file join $dir $file]"
	loadZIC [file join $dir $file]
    }
    return
}

#----------------------------------------------------------------------
#
# checkForwardRuleRefs --
#
#	Checks to make sure that all references to Daylight Saving
#	Time rules designate defined rules.
#
# Parameters:
#	None.
#
# Results:
#	None.
#
# Side effects:
#	Produces an error message and increases the error count if
#	any undefined rules are present.
#
#----------------------------------------------------------------------

proc checkForwardRuleRefs {} {
    variable forwardRuleRefs
    variable rules

    foreach {rule where} [array get forwardRuleRefs] {
	if {![info exists rules($rule)]} {
	    foreach {fileName lno} $where {
		puts stderr "$fileName:$lno:can't locate rule \"$rule\""
		incr errorCount
	    }
	}
    }
}

#----------------------------------------------------------------------
#
# loadZIC --
#
#	Load one continent's data into memory.
#
# Parameters:
#	fileName -- Name of the time zone source file.
#
# Results:
#	None.
#
# Side effects:
#	The global variable, 'errorCount' counts the number of errors.
#	The global array, 'links', contains a distillation of the
#	'Link' directives in the file. The keys are 'links to' and
#	the values are 'links from'.  The 'parseRule' and 'parseZone'
#	procedures are called to handle 'Rule' and 'Zone' directives.
#
#----------------------------------------------------------------------

proc loadZIC {fileName} {
    variable errorCount
    variable links

    # Suck the text into memory.

    set f [open $fileName r]
    set data [read $f]
    close $f

    # Break the input into lines, and count line numbers.

    set lno 0
    foreach line [split $data \n] {
	incr lno

	# Break a line of input into words.

	regsub {\s*(\#.*)?$} $line {} line
	if {$line eq ""} {
	    continue
	}
	set words {}
	if {[regexp {^\s} $line]} {
	    # Detect continuations of a zone and flag the list appropriately
	    lappend words ""
	}
	lappend words {*}[regexp -all -inline {\S+} $line]

	# Switch on the directive

	switch -exact -- [lindex $words 0] {
	    Rule {
		parseRule $fileName $lno $words
	    }
	    Link {
		set links([lindex $words 2]) [lindex $words 1]
	    }
	    Zone {
		set lastZone [lindex $words 1]
		set until [parseZone $fileName $lno \
			$lastZone [lrange $words 2 end] "minimum"]
	    }
	    {} {
		set i 0
		foreach word $words {
		    if {[lindex $words $i] ne ""} {
			break
		    }
		    incr i
		}
		set words [lrange $words $i end]
		set until [parseZone $fileName $lno $lastZone $words $until]
	    }
	    default {
		incr errorCount
		puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\""
	    }
	}
    }

    return
}

#----------------------------------------------------------------------
#
# parseRule --
#
#	Parses a Rule directive in an Olson file.
#
# Parameters:
#	fileName -- Name of the file being parsed.
#	lno - Line number within the file
#	words - The line itself, broken into words.
#
# Results:
#	None.
#
# Side effects:
#	The rule is analyzed and added to the 'rules' array.
#	Errors are reported and counted.
#
#----------------------------------------------------------------------

proc parseRule {fileName lno words} {
    variable rules
    variable errorCount

    # Break out the columns

    lassign $words  Rule name from to type in on at save letter

    # Handle the 'only' keyword

    if {$to eq "only"} {
	set to $from
    }

    # Process the start year

    if {![string is integer $from]} {
	if {![string equal -length [string length $from] $from "minimum"]} {
	    puts stderr "$fileName:$lno:FROM field \"$from\" not an integer."
	    incr errorCount
	    return
	} else {
	    set from "minimum"
	}
    }

    # Process the end year

    if {![string is integer $to]} {
	if {![string equal -length [string length $to] $to "maximum"]} {
	    puts stderr "$fileName:$lno:TO field \"$to\" not an integer."
	    incr errorCount
	    return
	} else {
	    set to "maximum"
	}
    }

    # Process the type of year in which the rule applies

    if {$type ne "-"} {
	puts stderr "$fileName:$lno:year types are not yet supported."
	incr errorCount
	return
    }

    # Process the month in which the rule starts

    if {[catch {lookupMonth $in} in]} {
	puts stderr "$fileName:$lno:$in"
	incr errorCount
	return
    }

    # Process the day of the month on which the rule starts

    if {[catch {parseON $on} on]} {
	puts stderr "$fileName:$lno:$on"
	incr errorCount
	return
    }

    # Process the time of day on which the rule starts

    if {[catch {parseTOD $at} at]} {
	puts stderr "$fileName:$lno:$at"
	incr errorCount
	return
    }

    # Process the DST adder

    if {[catch {parseOffsetTime $save} save]} {
	puts stderr "$fileName:$lno:$save"
	incr errorCount
	return
    }

    # Process the letter to use for summer time

    if {$letter eq "-"} {
	set letter ""
    }

    # Accumulate all the data.

    lappend rules($name) $from $to $type $in $on $at $save $letter
    return

}

#----------------------------------------------------------------------
#
# parseON --
#
#	Parse a specification for a day of the month
#
# Parameters:
#	on - the ON field from a line in an Olson file.
#
# Results:
#	Returns a partial Tcl command.	When the year and number of the
#	month are appended, the command will return the Julian Day Number
#	of the desired date.
#
# Side effects:
#	None.
#
# The specification can be:
#	- a simple number, which designates a constant date.
#	- The name of a weekday, followed by >= or <=, followed by a number.
#	    This designates the nearest occurrence of the given weekday on
#	    or before (on or after) the given day of the month.
#	- The word 'last' followed by a weekday name with no intervening
#	  space.  This designates the last occurrence of the given weekday
#	  in the month.
#
#----------------------------------------------------------------------

proc parseON {on} {
    if {![regexp -expanded {
	^(?:
	  # first possibility - simple number - field 1
	  ([[:digit:]]+)
	|
	  # second possibility - weekday >= (or <=) number
	  # field 2 - weekday
	  ([[:alpha:]]+)
	  # field 3 - direction
	  ([<>]=)
	  # field 4 - number
	  ([[:digit:]]+)
	|
	  # third possibility - lastWeekday - field 5
	  last([[:alpha:]]+)
	)$
    } $on -> dom1 wday2 dir2 num2 wday3]} then {
	error "can't parse ON field \"$on\""
    }
    if {$dom1 ne ""} {
	return [list onDayOfMonth $dom1]
    } elseif {$wday2 ne ""} {
	set wday2 [lookupDayOfWeek $wday2]
	return [list onWeekdayInMonth $wday2 $dir2 $num2]
    } elseif {$wday3 ne ""} {
	set wday3 [lookupDayOfWeek $wday3]
	return [list onLastWeekdayInMonth $wday3]
    } else {
	error "in parseOn \"$on\": can't happen"
    }
}

#----------------------------------------------------------------------
#
# onDayOfMonth --
#
#	Find a given day of a given month
#
# Parameters:
#	day - Day of the month
#	year - Gregorian year
#	month - Number of the month (1-12)
#
# Results:
#	Returns the Julian Day Number of the desired day.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc onDayOfMonth {day year month} {
    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
	    [dict create era CE year $year month $month dayOfMonth $day] \
		 2361222]
    return [dict get $date julianDay]
}

#----------------------------------------------------------------------
#
# onWeekdayInMonth --
#
#	Find the weekday falling on or after (on or before) a
#	given day of the month
#
# Parameters:
#	dayOfWeek - Day of the week (Monday=1, Sunday=7)
#	relation - <= for the weekday on or before a given date, >= for
#		   the weekday on or after the given date.
#	dayOfMonth - Day of the month
#	year - Gregorian year
#	month - Number of the month (1-12)
#
# Results:
#	Returns the Juloan Day Number of the desired day.
#
# Side effects:
#	None.
#
# onWeekdayInMonth is used to compute Daylight Saving Time rules
# like 'Sun>=1' (for the nearest Sunday on or after the first of the month)
# or "Mon<=4' (for the Monday on or before the fourth of the month).
#
#----------------------------------------------------------------------

proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} {
    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \
	    era CE year $year month $month dayOfMonth $dayOfMonth] 2361222]
    switch -exact -- $relation {
	<= {
	    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
		    [dict get $date julianDay]]
	}
	>= {
	    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
		    [expr {[dict get $date julianDay] + 6}]]
	}
    }
}

#----------------------------------------------------------------------
#
# onLastWeekdayInMonth --
#
#	Find the last instance of a given weekday in a month.
#
# Parameters:
#	dayOfWeek - Weekday to find (Monday=1, Sunday=7)
#	year - Gregorian year
#	month - Month (1-12)
#
# Results:
#	Returns the Julian Day number of the last instance of
#	the given weekday in the given month
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc onLastWeekdayInMonth {dayOfWeek year month} {
    incr month
    # Find day 0 of the following month, which is the last day of
    # the current month.  Yes, it works to ask for day 0 of month 13!
    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \
	    era CE year $year month $month dayOfMonth 0] 2361222]
    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
	    [dict get $date julianDay]]
}

#----------------------------------------------------------------------
#
# parseTOD --
#
#	Parses the specification of a time of day in an Olson file.
#
# Parameters:
#	tod - Time of day, which may be followed by 'w', 's', 'u', 'g'
#	      or 'z'.  'w' (or no letter) designates a wall clock time,
#	      's' designates Standard Time in the given zone, and
#	      'u', 'g', and 'z' all designate UTC.
#
# Results:
#	Returns a two element list containing a count of seconds from
#	midnight and the letter that followed the time.
#
# Side effects:
#	Reports and counts an error if the time cannot be parsed.
#
#----------------------------------------------------------------------

proc parseTOD {tod} {
    if {![regexp -expanded {
	^
	([[:digit:]]{1,2})		# field 1 - hour
	(?:
	    :([[:digit:]]{2})		# field 2 - minute
	    (?:
		:([[:digit:]]{2})	# field 3 - second
	    )?
	)?
	(?:
	    ([wsugz])			# field 4 - type indicator
	)?
    } $tod -> hour minute second ind]} then {
	puts stderr "$fileName:$lno:can't parse time field \"$tod\""
	incr errorCount
    }
    scan $hour %d hour
    if {$minute ne ""} {
	scan $minute %d minute
    } else {
	set minute 0
    }
    if {$second ne ""} {
	scan $second %d second
    } else {
	set second 0
    }
    if {$ind eq ""} {
	set ind w
    }
    return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind]
}

#----------------------------------------------------------------------
#
# parseOffsetTime --
#
#	Parses the specification of an offset time in an Olson file.
#
# Parameters:
#	offset - Offset time as [+-]hh:mm:ss
#
# Results:
#	Returns the offset time as a count of seconds.
#
# Side effects:
#	Reports and counts an error if the time cannot be parsed.
#
#----------------------------------------------------------------------

proc parseOffsetTime {offset} {
    if {![regexp -expanded {
	^
	([-+])?				# field 1 - signum
	([[:digit:]]{1,2})		# field 2 - hour
	(?:
	    :([[:digit:]]{2})		# field 3 - minute
	    (?:
		:([[:digit:]]{2})	# field 4 - second
	    )?
	)?
    } $offset -> signum hour minute second]} then {
	puts stderr "$fileName:$lno:can't parse offset time \"$offset\""
	incr errorCount
    }
    append signum 1
    scan $hour %d hour
    if {$minute ne ""} {
	scan $minute %d minute
    } else {
	set minute 0
    }
    if {$second ne ""} {
	scan $second %d second
    } else {
	set second 0
    }
    return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}]

}

#----------------------------------------------------------------------
#
# lookupMonth -
#	Looks up a month by name
#
# Parameters:
#	month - Name of a month.
#
# Results:
#	Returns the number of the month.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc lookupMonth {month} {
    set indx [lsearch -regexp {
	{} January February March April May June
	July August September October November December
    } ${month}.*]
    if {$indx < 1} {
	error "unknown month name \"$month\""
    }
    return $indx
}

#----------------------------------------------------------------------
#
# lookupDayOfWeek --
#
#	Looks up the name of a weekday.
#
# Parameters:
#	wday - Weekday name (or a unique prefix).
#
# Results:
#	Returns the weekday number (Monday=1, Sunday=7)
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc lookupDayOfWeek {wday} {
    set indx [lsearch -regexp {
	{} Monday Tuesday Wednesday Thursday Friday Saturday Sunday
    } ${wday}.*]
    if {$indx < 1} {
	error "unknown weekday name \"$wday\""
    }
    return $indx
}

#----------------------------------------------------------------------
#
# parseZone --
#
#	Parses a Zone directive in an Olson file
#
# Parameters:
#	fileName -- Name of the file being parsed.
#	lno -- Line number within the file.
#	zone -- Name of the time zone
#	words -- Remaining words on the line.
#	start -- 'Until' time from the previous line if this is a
#		 continuation line, or 'minimum' if this is the first line.
#
# Results:
#	Returns the 'until' field of the current line
#
# Side effects:
#	Stores a row in the 'zones' array describing the current zone.
#	The row consists of a start time (year month day tod), a Standard
#	Time offset from Greenwich, a Daylight Saving Time offset from
#	Standard Time, and a format for printing the time zone.
#
#	The start time is the result of an earlier call to 'parseUntil'
#	or else the keyword 'minimum'.	The GMT offset is the
#	result of a call to 'parseOffsetTime'.	The Daylight Saving
#	Time offset is represented as a partial Tcl command. To the
#	command will be appended a start time (seconds from epoch)
#	the current offset of Standard Time from Greenwich, the current
#	offset of Daylight Saving Time from Greenwich, the default
#	offset from this line, the name pattern from this line,
#	the 'until' field from this line, and a variable name where points
#	are to be stored.  This command is implemented by the 'applyNoRule',
#	'applyDSTOffset' and 'applyRules' procedures.
#
#----------------------------------------------------------------------

proc parseZone {fileName lno zone words start} {
    variable zones
    variable rules
    variable errorCount
    variable forwardRuleRefs

    lassign $words gmtoff save format
    if {[catch {parseOffsetTime $gmtoff} gmtoff]} {
	puts stderr "$fileName:$lno:$gmtoff"
	incr errorCount
	return
    }
    if {[info exists rules($save)]} {
	set save [list applyRules $save]
    } elseif {$save eq "-"} {
	set save [list applyNoRule]
    } elseif {[catch {parseOffsetTime $save} save2]} {
	lappend forwardRuleRefs($save) $fileName $lno
	set save [list applyRules $save]
    } else {
	set save [list applyDSTOffset $save2]
    }
    lappend zones($zone) $start $gmtoff $save $format
    if {[llength $words] >= 4} {
	return [parseUntil [lrange $words 3 end]]
    } else {
	return {}
    }
}

#----------------------------------------------------------------------
#
# parseUntil --
#
#	Parses the 'UNTIL' part of a 'Zone' directive.
#
# Parameters:
#	words - The 'UNTIL' part of the directie.
#
# Results:
#	Returns a list comprising the year, the month, the day, and
#	the time of day. Time of day is represented as the result of
#	'parseTOD'.
#
#----------------------------------------------------------------------

proc parseUntil {words} {
    variable firstYear

    if {[llength $words] >= 1} {
	set year [lindex $words 0]
	if {![string is integer $year]} {
	    error "can't parse UNTIL field \"$words\""
	}
	if {![info exists firstYear] || $year < $firstYear} {
	    set firstYear $year
	}
    } else {
	set year "maximum"
    }
    if {[llength $words] >= 2} {
	set month [lookupMonth [lindex $words 1]]
    } else {
	set month 1
    }
    if {[llength $words] >= 3} {
	set day [parseON [lindex $words 2]]
    } else {
	set day {onDayOfMonth 1}
    }
    if {[llength $words] >= 4} {
	set tod [parseTOD [lindex $words 3]]
    } else {
	set tod {0 w}
    }
    return [list $year $month $day $tod]
}

#----------------------------------------------------------------------
#
# applyNoRule --
#
#	Generates time zone data for a zone without Daylight Saving
#	Time.
#
# Parameters:
#	year - Year in which the rule applies
#	startSecs - Time at which the rule starts.
#	stdGMTOffset - Offset from Greenwich prior to the start of the
#		       rule
#	DSTOffset - Offset of Daylight from Standard prior to the
#		    start of the rule.
#	nextGMTOffset - Offset from Greenwich when the rule is in effect.
#	namePattern - Name of the timezone.
#	until - Time at which the rule expires.
#	pointsVar - Name of a variable in callers scope that receives
#		    transition times
#
# Results:
#	Returns a two element list comprising 'nextGMTOffset' and
#	0 - the zero indicates that Daylight Saving Time is not
#	in effect.
#
# Side effects:
#	Appends a row to the 'points' variable comprising the start time,
#	the offset from GMT, a zero (indicating that DST is not in effect),
#	and the name of the time zone.
#
#----------------------------------------------------------------------

proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset
		  namePattern until pointsVar} {
    upvar 1 $pointsVar points
    lappend points $startSecs $nextGMTOffset 0 \
	    [convertNamePattern $namePattern -]
    return [list $nextGMTOffset 0]
}

#----------------------------------------------------------------------
#
# applyDSTOffset --
#
#	Generates time zone data for a zone with permanent Daylight
#	Saving Time.
#
# Parameters:
#	nextDSTOffset - Offset of Daylight from Standard while the
#			rule is in effect.
#	year - Year in which the rule applies
#	startSecs - Time at which the rule starts.
#	stdGMTOffset - Offset from Greenwich prior to the start of the
#		       rule
#	DSTOffset - Offset of Daylight from Standard prior to the
#		    start of the rule.
#	nextGMTOffset - Offset from Greenwich when the rule is in effect.
#	namePattern - Name of the timezone.
#	until - Time at which the rule expires.
#	pointsVar - Name of a variable in callers scope that receives
#		    transition times
#
# Results:
#	Returns a two element list comprising 'nextGMTOffset' and
#	'nextDSTOffset'.
#
# Side effects:
#	Appends a row to the 'points' variable comprising the start time,
#	the offset from GMT, a one (indicating that DST is in effect),
#	and the name of the time zone.
#
#----------------------------------------------------------------------

proc applyDSTOffset {nextDSTOffset year startSecs
		     stdGMTOffset DSTOffset nextGMTOffset
		     namePattern until pointsVar} {
    upvar 1 $pointsVar points
    lappend points \
	    $startSecs \
	    [expr {$nextGMTOffset + $nextDSTOffset}] \
	    1 \
	    [convertNamePattern $namePattern S]
    return [list $nextGMTOffset $nextDSTOffset]
}

#----------------------------------------------------------------------
#
# applyRules --
#
#	Applies a rule set to a time zone for a given range of time
#
# Parameters:
#	ruleSet - Name of the rule set to apply
#	year - Starting year for the rules
#	startSecs - Time at which the rules begin to apply
#	stdGMTOffset - Offset from Greenwich prior to the start of the
#		       rules.
#	DSTOffset - Offset of Daylight from Standard prior to the
#		    start of the rules.
#	nextGMTOffset - Offset from Greenwich when the rules are in effect.
#	namePattern - Name pattern for the time zone.
#	until - Time at which the rule set expires.
#	pointsVar - Name of a variable in callers scope that receives
#		    transition times
#
# Results:
#	Returns a two element list comprising the offset from GMT
#	to Standard and the offset from Standard to Daylight (if DST
#	is in effect) at the end of the period in which the rules apply
#
# Side effects:
#	Appends one or more rows to the 'points' variable, each of which
#	comprises a transition time, the offset from GMT that is
#	in effect after the transition, a flag for whether DST is in
#	effect, and the name of the time zone.
#
#----------------------------------------------------------------------

proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset
		 namePattern until pointsVar} {
    variable done
    variable rules
    variable maxyear

    upvar 1 $pointsVar points

    # Extract the rules that apply to the current year, and the number
    # of rules (now or in future) that will end at a specific year.
    # Ignore rules entirely in the past.

    lassign [divideRules $ruleSet $year] currentRules nSunsetRules

    # If the first transition is later than $startSecs, and $stdGMTOffset is
    # different from $nextGMTOffset, we will need an initial record like:
    #	 lappend points $startSecs $stdGMTOffset 0 \
    #			[convertNamePattern $namePattern -]

    set didTransitionIn false

    # Determine the letter to use in Standard Time

    set prevLetter ""
    foreach {
	fromYear toYear yearType monthIn daySpecOn timeAt save letter
    } $rules($ruleSet) {
	if {$save == 0} {
	    set prevLetter $letter
	    break
	}
    }

    # Walk through each year in turn. This loop will break when
    #	 (a) the 'until' time is passed
    # or (b) the 'until' time is empty and all remaining rules extend to
    #	     the end of time

    set stdGMTOffset $nextGMTOffset

    # convert "until" to seconds from epoch in current time zone

    if {$until ne ""} {
	lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay
	lappend untilDaySpec $untilYear $untilMonth
	set untilJCD [eval $untilDaySpec]
	set untilBaseSecs [expr {
		wide(86400) * wide($untilJCD) - 210866803200 }]
	set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \
		$DSTOffset {*}$untilTimeOfDay]
    }

    set origStartSecs $startSecs

    while {($until ne "" && $startSecs < $untilSecs)
	    || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} {
	set remainingRules $currentRules
	while {[llength $remainingRules] > 0} {

	    # Find the rule with the earliest start time from among the
	    # active rules that haven't yet been processed.

	    lassign [findEarliestRule $remainingRules $year \
		    $stdGMTOffset $DSTOffset] earliestSecs earliestIndex

	    set endi [expr {$earliestIndex + 7}]
	    set rule [lrange $remainingRules $earliestIndex $endi]
	    lassign $rule fromYear toYear \
		    yearType monthIn daySpecOn timeAt save letter

	    # Test if the rule is in effect.

	    if {
		$earliestSecs > $startSecs &&
		($until eq "" || $earliestSecs < $untilSecs)
	    } then {
		# Test if the initial transition has been done.
		# If not, do it now.

		if {!$didTransitionIn && $earliestSecs > $origStartSecs} {
		    set nm [convertNamePattern $namePattern $prevLetter]
		    lappend points \
			    $origStartSecs \
			    [expr {$stdGMTOffset + $DSTOffset}] \
			    0 \
			    $nm
		    set didTransitionIn true
		}

		# Add a row to 'points' for the rule

		set nm [convertNamePattern $namePattern $letter]
		lappend points \
			$earliestSecs \
			[expr {$stdGMTOffset + $save}] \
			[expr {$save != 0}] \
			$nm
	    }

	    # Remove the rule just applied from the queue

	    set remainingRules [lreplace \
		    $remainingRules[set remainingRules {}] \
		    $earliestIndex $endi]

	    # Update current DST offset and time zone letter

	    set DSTOffset $save
	    set prevLetter $letter

	    # Reconvert the 'until' time in the current zone.

	    if {$until ne ""} {
		set untilSecs [convertTimeOfDay $untilBaseSecs \
			$stdGMTOffset $DSTOffset {*}$untilTimeOfDay]
	    }
	}

	# Advance to the next year

	incr year
	set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
		[dict create era CE year $year month 1 dayOfMonth 1] 2361222]
	set startSecs [expr {
	    [dict get $date julianDay] * wide(86400) - 210866803200
		- $stdGMTOffset - $DSTOffset
	}]

	# Get rules in effect in the new year.

	lassign [divideRules $ruleSet $year] currentRules nSunsetRules
    }

    return [list $stdGMTOffset $DSTOffset]
}

#----------------------------------------------------------------------
#
# divideRules --
#	Determine what Daylight Saving Time rules may be in effect in
#	a given year.
#
# Parameters:
#	ruleSet - Set of rules from 'parseRule'
#	year - Year to test
#
# Results:
#	Returns a two element list comprising the subset of 'ruleSet'
#	that is in effect in the given year, and the count of rules
#	that expire in the future (as opposed to those that expire in
#	the past or not at all). If this count is zero, the rules do
#	not change in future years.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc divideRules {ruleSet year} {
    variable rules

    set currentRules {}
    set nSunsetRules 0

    foreach {
	fromYear toYear yearType monthIn daySpecOn timeAt save letter
    } $rules($ruleSet) {
	if {$toYear ne "maximum" && $year > $toYear} {
	    # ignore - rule is in the past
	} else {
	    if {$fromYear eq "minimum" || $fromYear <= $year} {
		lappend currentRules $fromYear $toYear $yearType $monthIn \
			$daySpecOn $timeAt $save $letter
	    }
	    if {$toYear ne "maximum"} {
		incr nSunsetRules
	    }
	}
    }

    return [list $currentRules $nSunsetRules]

}

#----------------------------------------------------------------------
#
# findEarliestRule --
#
#	Find the rule in a rule set that has the earliest start time.
#
# Parameters:
#	remainingRules -- Rules to search
#	year - Year being processed.
#	stdGMTOffset - Current offset of standard time from GMT
#	DSTOffset - Current offset of daylight time from standard,
#		    if daylight time is in effect.
#
# Results:
#	Returns the index in remainingRules of the next rule to
#	go into effect.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} {
    set earliest $::MAXWIDE
    set i 0
    foreach {
	fromYear toYear yearType monthIn daySpecOn timeAt save letter
    } $remainingRules {
	lappend daySpecOn $year $monthIn
	set dayIn [eval $daySpecOn]
	set secs [expr {wide(86400) * wide($dayIn) - 210866803200}]
	set secs [convertTimeOfDay $secs \
		$stdGMTOffset $DSTOffset {*}$timeAt]
	if {$secs < $earliest} {
	    set earliest $secs
	    set earliestIdx $i
	}
	incr i 8
    }

    return [list $earliest $earliestIdx]
}

#----------------------------------------------------------------------
#
# convertNamePattern --
#
#	Converts a name pattern to the name of the time zone.
#
# Parameters:
#	pattern - Patthern to convert
#	flag - Daylight Time flag. An empty string denotes Standard
#	       Time, anything else is Daylight Time.
#
# Results;
#	Returns the name of the time zone.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc convertNamePattern {pattern flag} {
    if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} {
	if {$flag ne ""} {
	    set pattern $daylight
	} else {
	    set pattern $standard
	}
    }
    return [string map [list %s $flag] $pattern]
}

#----------------------------------------------------------------------
#
# convertTimeOfDay --
#
#	Takes a time of day specifier from 'parseAt' and converts
#	to seconds from the Epoch,
#
# Parameters:
#	seconds -- Time at which the GMT day starts, in seconds
#		   from the Posix epoch
#	stdGMTOffset - Offset of Standard Time from Greenwich
#	DSTOffset - Offset of Daylight Time from standard.
#	timeOfDay - Time of day to convert, in seconds from midnight
#	flag - Flag indicating whether the time is Greenwich, Standard
#	       or wall-clock. (g, s, or w)
#
# Results:
#	Returns the time of day in seconds from the Posix epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} {
    incr seconds $timeOfDay
    switch -exact $flag {
	g - u - z {
	}
	w {
	    incr seconds [expr {-$stdGMTOffset}]
	    incr seconds [expr {-$DSTOffset}]
	}
	s {
	    incr seconds [expr {-$stdGMTOffset}]
	}
    }
    return $seconds
}

#----------------------------------------------------------------------
#
# processTimeZone --
#
#	Generate the information about all time transitions in a
#	time zone.
#
# Parameters:
#	zoneName - Name of the time zone
#	zoneData - List containing the rows describing the time zone,
#		   obtained from 'parseZone.
#
# Results:
#	Returns a list of rows.	 Each row consists of a time in
#	seconds from the Posix epoch, an offset from GMT to local
#	that begins at that time, a flag indicating whether DST
#	is in effect after that time, and the printable name of the
#	timezone that goes into effect at that time.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc processTimeZone {zoneName zoneData} {
    set points {}
    set i 0
    foreach {startTime nextGMTOffset dstRule namePattern} $zoneData {
	incr i 4
	set until [lindex $zoneData $i]
	if {![info exists stdGMTOffset]} {
	    set stdGMTOffset $nextGMTOffset
	}
	if {![info exists DSTOffset]} {
	    set DSTOffset 0
	}
	if {$startTime eq "minimum"} {
	    set secs $::MINWIDE
	    set year 0
	} else {
	    lassign $startTime year month dayRule timeOfDay
	    lappend dayRule $year $month
	    set startDay [eval $dayRule]
	    set secs [expr {wide(86400) * wide($startDay) -210866803200}]
	    set secs [convertTimeOfDay $secs \
		    $stdGMTOffset $DSTOffset {*}$timeOfDay]
	}
	lappend dstRule \
		$year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \
		$namePattern $until points
	lassign [eval $dstRule] stdGMTOffset DSTOffset
    }
    return $points
}

#----------------------------------------------------------------------
#
# writeZones --
#
#	Writes all the time zone information files.
#
# Parameters:
#	outDir - Directory in which to store the files.
#
# Results:
#	None.
#
# Side effects:
#	Writes the time zone information files; traces what's happening
#	on the standard output.
#
#----------------------------------------------------------------------

proc writeZones {outDir} {
    variable zones

    # Walk the zones

    foreach zoneName [lsort -dictionary [array names zones]] {
	puts "calculating: $zoneName"
	set fileName [eval [list file join $outDir] [file split $zoneName]]

	# Create directories as needed

	set dirName [file dirname $fileName]
	if {![file exists $dirName]} {
	    puts "creating directory: $dirName"
	    file mkdir $dirName
	}

	# Generate data for a zone

	set data ""
	foreach {
	    time offset dst name
	} [processTimeZone $zoneName $zones($zoneName)] {
	    append data "\n    " [list [list $time $offset $dst $name]]
	}
	append data \n

	# Write the data to the information file

	set f [open $fileName w]
	fconfigure $f -translation lf
	puts $f "\# created by $::argv0 - do not edit"
	puts $f ""
	puts $f [list set TZData(:$zoneName) $data]
	close $f
    }

    return
}

#----------------------------------------------------------------------
#
# writeLinks --
#
#	Write files describing time zone synonyms (the Link directives
#	from the Olson files)
#
# Parameters:
#	outDir - Name of the directory where the output files go.
#
# Results:
#	None.
#
# Side effects:
#	Creates a file for each link.

proc writeLinks {outDir} {
    variable links

    # Walk the links

    foreach zoneName [lsort -dictionary [array names links]] {
	puts "creating link: $zoneName"
	set fileName [eval [list file join $outDir] [file split $zoneName]]

	# Create directories as needed

	set dirName [file dirname $fileName]
	if {![file exists $dirName]} {
	    puts "creating directory: $dirName"
	    file mkdir $dirName
	}

	# Create code for the synonym

	set linkTo $links($zoneName)
	set sourceCmd "\n    [list LoadTimeZoneFile $linkTo]\n"
	set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd]
	set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)"

	# Write the file

	set f [open $fileName w]
	fconfigure $f -translation lf
	puts $f "\# created by $::argv0 - do not edit"
	puts $f $ifCmd
	puts $f $setCmd
	close $f
    }

    return
}

#----------------------------------------------------------------------
#
# MAIN PROGRAM
#
#----------------------------------------------------------------------

puts "Compiling time zones -- [clock format [clock seconds] \
                                   -format {%x %X} -locale system]"

# Determine directories

lassign $argv inDir outDir

puts "Olson files in $inDir"
puts "Tcl files to be placed in $outDir"

# Initialize count of errors

set errorCount 0

# Parse the Olson files

loadFiles $inDir
if {$errorCount > 0} {
    exit 1
}

# Check that all riles appearing in Zone and Link lines actually exist

checkForwardRuleRefs
if {$errorCount > 0} {
    exit 1
}

# Write the time zone information files

writeZones $outDir
writeLinks $outDir
if {$errorCount > 0} {
    exit 1
}

# All done!

exit