|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8192 (0x2000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Local_Time, seg_050958, separate Calendar
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with System;
use System;
with Errno;
with V_I_Time;
separate (Calendar)
package body Local_Time is
One_100_Usec : constant Duration := 0.000100;
type Unix_Time is
record
Sec : Integer; -- seconds since Jan. 1, 1970
Usec : Integer; -- and microseconds
end record;
subtype Time_Ptr is Address; --access unix_time;
type Timezone is
record
Minuteswest : Integer; -- of Greenwich
Dsttime : Integer; -- type of dst correction to apply
end record;
subtype Timezone_Ptr is Address; --access timezone;
type Tm is
record
Sec : Integer;
Min : Integer;
Hour : Integer;
Mday : Integer;
Mon : Integer;
Year : Integer;
Wday : Integer;
Yday : Integer;
Isdst : Integer;
end record;
type Tm_Ptr is access Tm;
pragma Local_Access (Tm_Ptr);
function Gettimeofday (Tp : Time_Ptr; Tzp : Timezone_Ptr) return Integer;
pragma Interface (C, Gettimeofday);
function Localtime (T : Time_Ptr) return Tm_Ptr;
pragma Interface (C, Localtime);
-- 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 the 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 model applies.
-------------------------------------------------------------------------
function Clock return Time is
Day : Day_T;
Sec : Duration;
begin
V_I_Time.Current_Time (Day, Sec);
return (Integer (Day), Sec);
end Clock;
procedure Initialize_Clock is
use Errno;
Tp : Unix_Time;
Tzp : Timezone;
Tm : Tm_Ptr;
Seconds : Integer;
Date : Time;
begin
loop
exit when Gettimeofday (Tp'Address, Tzp'Address) /= -1;
case Errno.Errno is
when Eintr =>
null; -- try try again
when Efault =>
raise Storage_Error;
when others =>
exit; -- shouldn't happen
end case;
end loop;
Tm := Localtime (Tp'Address);
Seconds := Tm.Sec + Tm.Min * 60 + Tm.Hour * 3600;
Date := Time_Of (Tm.Year + 1900, Tm.Mon + 1, Tm.Mday,
(Seconds * 10000 + Tp.Usec / 100) * One_100_Usec);
V_I_Time.Set_Time (Day_T (Date.Julian_Day), Date.Sec, Tp'Address);
exception
when Numeric_Error =>
raise Time_Error;
end Initialize_Clock;
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 Sunday_After;
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;
end Local_Time;
nblk1=7
nid=0
hdr6=e
[0x00] rec0=29 rec1=00 rec2=01 rec3=00c
[0x01] rec0=1d rec1=00 rec2=02 rec3=040
[0x02] rec0=10 rec1=00 rec2=03 rec3=04c
[0x03] rec0=1b rec1=00 rec2=04 rec3=01c
[0x04] rec0=1a rec1=00 rec2=05 rec3=070
[0x05] rec0=16 rec1=00 rec2=06 rec3=020
[0x06] rec0=11 rec1=00 rec2=07 rec3=000
tail 0x21757fcdc878e78966523 0x42a00088462060003