DataMuseum.dk

top - download

    Length: 5209 (0x1459)
    Types: TextFile
    Notes: R1k Text-file segment

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦94df3b682⟧ 
            └─⟦this⟧ 

TextFile

separate( calendar )
package body local_time is

    type tm is record
        seconds:    day_duration;
        day:        day_number;
        month:      month_number;
        year:       year_number;
    end record;


    -------------------------------------------------
    -- Table of common Daylight Savings varieties. --
    -------------------------------------------------

    type months is (jan, feb, mar, apr, may, jun, jul, aug, sep, oct, nov, dec);

    type hemispheres is (northern, southern);
    this_hemisphere: hemispheres;

    type dst_rec    is record
        yr_in_effect:         year_number;
        change_month1:        months;
        change_sunday_after1: day_number;
        change_month2:        months;
        change_sunday_after2: day_number;
        seconds:              time_float;
    end record;


    ---------------------------------------------------------------------------
    -- ATTENTION:                                                            --
    -- The following tables and constants need to be adjusted when the VADS  --
    -- is installed at a site not in the PACIFIC time zone. For the U.S. the --
    -- dst table is correct everywhere that daylight savings applies.  The   --
    -- only changes, then, are to the zone names and to  hours_west_of_GMT.  --
    -- For example, in the Eastern time zone, "EDT", "EST", and 5 should do  --
    -- the trick.  In Indiana, where no daylight savings applies, then these --
    -- tables can be ignored, and the daylight_savings funtion can return    --
    -- 0.0 in all cases.                                                     --
    --                                                                       --
    -- If these tables are not adjusted, no disaster will occur.  Dates are  --
    -- normalized to GMT (Grenwich Meridian Time) to provide uniformity on   --
    -- geographically interconnected machines.  If these tables are not      --
    -- changed, then dates cannot be directly transfered (correctly) among   --
    -- these machines.                                                       --
    ---------------------------------------------------------------------------

    -----------------------------------------------------------------------
    -- dst (daylight savings time) for the PACIFIC time zone of the U.S. --
    -----------------------------------------------------------------------
    dst_zone_name: constant string := "PDT";
    non_dst_zone_name: constant string := "PST";
    hours_west_of_GMT: constant := 8;
    dst_entries : constant := 3;
    ------------------------------------------------------------------
    -- valid for most of the U.S.; Indiana has no DST, for example. --
    ------------------------------------------------------------------
    dst_table: constant array(1..dst_entries) of dst_rec := (
        (1974, jan, 6, nov, 24, 3600.0),
        (1975, mar, 1, oct, 25, 3600.0),
        (1976, apr, 24, oct, 25, 3600.0) );

    ------------------------------------------------------
    -- End of material to change, if the above daylight --
    -- savings time model applies.                      --
    ------------------------------------------------------

	function clock return time is
		day: integer;
		sec: duration;

		procedure ts_current_time(day: out integer; sec: out duration);
			pragma interface(ADA, ts_current_time);
			pragma interface_name(ts_current_time, "TS_CURRENT_TIME");
	begin
		ts_current_time(day, sec);
		return (day, sec);
    exception
    when numeric_error =>
        raise time_error;
    end;

    function sunday_after(y: year_number; m: months; d: day_number)
    return integer is
        jday: integer := julian_day_of(y, months'pos(m)+1, d);
    begin
        -- the 0th julian day was a monday.
        return ((jday / 7) * 7) + 6;
    end;

    function daylight_savings(year, julian_day: integer) return time_float is
        change1, change2: integer;
    begin
        for i in reverse 1..dst_entries loop
            if year >= dst_table(i).yr_in_effect then
                change1 := sunday_after(year, dst_table(i).change_month1,
                    dst_table(i).change_sunday_after1);
                change2 := sunday_after(year, dst_table(i).change_month2,
                    dst_table(i).change_sunday_after2);
                if julian_day >= change1 and then julian_day < change2 then
                    if this_hemisphere = northern then
                        return dst_table(i).seconds;
                    else
                        return 0.0;
                    end if;
                else
                    if this_hemisphere = northern then
                        return 0.0;
                    else
                        return dst_table(i).seconds;
                    end if;
                end if;
            end if;
        end loop;
        return 0.0;    -- date was before dst went into effect
    end daylight_savings;

begin
    this_hemisphere := northern;
    seconds_from_gmt := time_float(hours_west_of_GMT) * 3600.0;

	-- Initialize clock to some arbitrary time
	set_clock(time_of(year => 1987, month => 10, day => 15, seconds => 0.0));
end