DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦8628b157b⟧ Ada Source

    Length: 21504 (0x5400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, function Time_Value, seg_00eb15, separate Time_Utilities

Derivation

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

E3 Source Code



separate (Time_Utilities)
function Time_Value (S : String) return Time is
    -- accepts all of the formats output by value
    -- algorithm consists of parsing for a series of numbers
    -- and assigning them to positions in the date according
    -- to heuristics about size and position.
    -- recognizes unique prefixes of month names


    Pm_Detected    : Boolean := False;
    Month_Position : Integer := 0;

    function Value (Month  : Positive;
                    Day    : Natural;
                    Year   : Natural;
                    Hour   : Natural;
                    Minute : Natural;
                    Second : Natural) return Time is
        Result : Time;
    begin
        if Year < 100 then
            Result.Year := Years (Integer'(1900 + Year));
        else
            Result.Year := Years (Year);
        end if;

        Result.Month := Months'Val (Month - 1);
        Result.Day   := Days (Day);

        Result.Minute := Minutes (Minute);
        Result.Second := Seconds (Second);

        case Hour is
            when 0 =>
                Result.Sun_Position := Am;
                Result.Hour         := 12;
            when 12 =>
                Result.Sun_Position := Pm;
                Result.Hour         := 12;
            when others =>
                if Hour > 12 then
                    Result.Sun_Position := Pm;
                    Result.Hour         := Hours (Hour - 12);
                else
                    if Pm_Detected then
                        Result.Sun_Position := Pm;
                    else
                        Result.Sun_Position := Am;
                    end if;

                    Result.Hour := Hours (Hour);
                end if;
        end case;

        return Result;
    end Value;

    function This_Year return Natural is
    begin
        return Natural (Get_Time.Year);
    end This_Year;

    function Value (Number : Number_Array) return Time is
        Now : Time;
    begin
        case Number'Length is
            when 6 =>
                case Month_Position is
                    when 1 =>
                        -- May 1, 1985 at 00:00:00
                        return Value (Number (1), Number (2), Number (3),
                                      Number (4), Number (5), Number (6));
                    when 2 =>
                        -- 1-May-85 at 00:00:00
                        return Value (Number (2), Number (1), Number (3),
                                      Number (4), Number (5), Number (6));
                    when 4 =>
                        -- 00:00:00 May 1, 1985
                        return Value (Number (4), Number (5), Number (6),
                                      Number (1), Number (2), Number (3));
                    when 5 =>
                        -- 00:00:00 1-May-85
                        return Value (Number (5), Number (4), Number (6),
                                      Number (1), Number (2), Number (3));
                    when 0 =>
                        -- no alphabetic year given
                        if Number (1) > 23 then
                            -- 85/5/1 00:00:00
                            return Value (Number (2), Number (3), Number (1),
                                          Number (4), Number (5), Number (6));
                        else
                            -- 5/1/85 00:00:00
                            return Value (Number (1), Number (2), Number (3),
                                          Number (4), Number (5), Number (6));
                        end if;
                    when others =>
                        raise Constraint_Error;
                end case;
            when 5 =>
                case Month_Position is
                    when 1 =>
                        -- May 1, 1985 at 00:00
                        return Value (Number (1), Number (2), Number (3),
                                      Number (4), Number (5), 0);
                    when 2 =>
                        -- 1-May-85 at 00:00
                        return Value (Number (2), Number (1), Number (3),
                                      Number (4), Number (5), 0);
                    when 3 =>
                        -- 00:00 May 1, 1985
                        return Value (Number (3), Number (4), Number (5),
                                      Number (1), Number (2), 0);
                    when 5 =>
                        -- 00:00:00 1-May
                        return Value (Number (5), Number (4),
                                      Natural (Get_Time.Year), Number (1),
                                      Number (2), Number (3));
                    when 0 =>
                        -- no alphabetic year given
                        if Number (1) > 23 then
                            -- 85/5/1 00:00
                            return Value (Number (2), Number (3), Number (1),
                                          Number (4), Number (5), 0);
                        elsif Number (3) > 23 then
                            -- 5/1/85 00:00
                            return Value (Number (1), Number (2), Number (3),
                                          Number (4), Number (5), 0);
                        else
                            -- 5/1 00:00:00
                            return Value (Number (1), Number (2),
                                          Natural (Get_Time.Year), Number (3),
                                          Number (4), Number (5));
                        end if;
                    when others =>
                        raise Constraint_Error;
                end case;
            when 4 =>
                case Month_Position is
                    when 0 | 1 =>
                        -- 5/1 00:00
                        -- May 1 00:00
                        return Value (Number (1), Number (2),
                                      Natural (Get_Time.Year),
                                      Number (3), Number (4), 0);
                    when 2 =>
                        -- 1-May 00:00
                        return Value (Number (2), Number (1),
                                      Natural (Get_Time.Year),
                                      Number (3), Number (4), 0);
                    when others =>
                        raise Constraint_Error;
                end case;
            when 3 =>
                Now := Get_Time;

                case Month_Position is
                    when 0 =>
                        if Number (1) > 23 then
                            -- 85/5/1
                            Pm_Detected := Now.Sun_Position = Pm;
                            return Value (Number (2), Number (3),
                                          Number (1), Natural (Now.Hour),
                                          Natural (Now.Minute),
                                          Natural (Now.Second));
                        elsif Number (3) > 59 then
                            -- 5/1/85
                            Pm_Detected := Now.Sun_Position = Pm;
                            return Value (Number (1), Number (2),
                                          Number (3), Natural (Now.Hour),
                                          Natural (Now.Minute),
                                          Natural (Now.Second));
                        else
                            -- 00:00:00
                            return Value (Natural (Months'Pos (Now.Month) + 1),
                                          Natural (Now.Day), Natural (Now.Year),
                                          Number (1), Number (2), Number (3));
                        end if;
                    when 1 =>
                        -- May 1, 1985
                        Pm_Detected := Now.Sun_Position = Pm;
                        return Value (Number (1), Number (2), Number (3),
                                      Natural (Now.Hour), Natural (Now.Minute),
                                      Natural (Now.Second));

                    when 2 =>
                        -- 1-May-85
                        Pm_Detected := Now.Sun_Position = Pm;
                        return Value (Number (2), Number (1), Number (3),
                                      Natural (Now.Hour), Natural (Now.Minute),
                                      Natural (Now.Second));

                    when others =>
                        raise Constraint_Error;
                end case;
            when 2 =>
                Now := Get_Time;

                case Month_Position is
                    when 0 =>
                        -- 00:00
                        return Value (Natural (Months'Pos (Now.Month) + 1),
                                      Natural (Now.Day), Natural (Now.Year),
                                      Number (1), Number (2), 0);
                    when 1 =>
                        -- May 1
                        Pm_Detected := Now.Sun_Position = Pm;
                        return Value (Number (1), Number (2),
                                      Natural (Now.Year), Natural (Now.Hour),
                                      Natural (Now.Minute),
                                      Natural (Now.Second));

                    when 2 =>
                        -- 1-May
                        Pm_Detected := Now.Sun_Position = Pm;
                        return Value (Number (2), Number (1),
                                      Natural (Now.Year), Natural (Now.Hour),
                                      Natural (Now.Minute),
                                      Natural (Now.Second));

                    when others =>
                        raise Constraint_Error;
                end case;
            when others =>
                raise Constraint_Error;
        end case;
    end Value;

    procedure Find_Number (S        :     String;
                           First    :     Positive;
                           Position : out Positive;
                           Success  : out Boolean) is
    begin
        for I in First .. S'Last loop
            if Is_Numeric (S (I)) then
                Success  := True;
                Position := I;
                return;
            end if;
        end loop;

        Position := First;
        Success  := False;
    end Find_Number;

    procedure Find_Non_Number
                 (S : String; First : Positive; Position : out Positive) is
    begin
        for I in First .. S'Last loop
            if not Is_Numeric (S (I)) then
                Position := I;
                return;
            end if;
        end loop;

        Position := S'Last + 1;
    end Find_Non_Number;

    procedure Find_Alphabetic (S        :     String;
                               First    :     Positive;
                               Position : out Positive;
                               Success  : out Boolean) is
    begin
        for I in First .. S'Last loop
            exit when Is_Numeric (S (I));

            if Is_Alphabetic (S (I)) then
                Success  := True;
                Position := I;
                return;
            end if;
        end loop;

        Position := First;
        Success  := False;
    end Find_Alphabetic;

    procedure Find_Non_Alphabetic
                 (S : String; First : Positive; Position : out Positive) is
    begin
        for I in First .. S'Last loop
            if not Is_Alphabetic (S (I)) then
                Position := I;
                return;
            end if;
        end loop;

        Position := S'Last + 1;
    end Find_Non_Alphabetic;

    procedure Get_Number (S       :        String;
                          First   : in out Positive;
                          Result  : out    Natural;
                          Success : out    Boolean) is
        Found : Boolean;
        Start : Positive;
    begin
        Find_Number (S, First, Start, Found);

        if not Found then
            Success := False;
            Result  := 0;
            return;
        end if;

        Find_Non_Number (S, Start, First);
        Success := True;
        Result  := Natural'Value (S (Start .. First - 1));
    end Get_Number;


    procedure Get_Month (S       :        String;
                         First   : in out Positive;
                         Result  : out    Natural;
                         Success : out    Boolean) is
        Found  : Boolean;
        Start  : Natural;
        Stop   : Natural;
        Prefix : Boolean;
        M      : Months;
    begin
        Find_Alphabetic (S, First, Start, Found);
       if Found then
            Find_Non_Alphabetic (S, Start, Stop);
            Unique_Prefix (S (Start .. Stop - 1), M, Prefix, Found);

            if Found then
                Result  := Months'Pos (M) + 1;
                First   := Stop;
                Success := True;
                return;
            end if;
        end if;

        Success := False;
        Result  := 0;
    exception
        when others =>
            Result  := 0;
            Success := False;
    end Get_Month;

    function Get_Number_Array (S : String) return Number_Array is
        Result  : Number_Array (1 .. 6);
        First   : Positive := S'First;
        Success : Boolean;
        I       : Integer  := Result'First;
    begin
        Pm_Detected :=
           String_Utilities.Locate ("PM", S, Ignore_Case => True) /= 0;

        while I <= Result'Last loop
            if Month_Position = 0 and then First <= S'Last and then
               not Is_Numeric (S (First)) then
                Get_Month (S, First, Result (I), Success);

                if Success then
                    Month_Position := I;
                    I              := I + 1;
                    exit when I > Result'Last;
                end if;
            end if;

            Get_Number (S, First, Result (I), Success);

            if not Success then
                return Result (1 .. I - 1);
            end if;

            I := I + 1;
        end loop;

        return Result;
    end Get_Number_Array;
begin
    return Value (Get_Number_Array (String_Utilities.Strip (S)));
end Time_Value;

E3 Meta Data

    nblk1=14
    nid=0
    hdr6=28
        [0x00] rec0=1f rec1=00 rec2=01 rec3=028
        [0x01] rec0=00 rec1=00 rec2=14 rec3=00a
        [0x02] rec0=21 rec1=00 rec2=02 rec3=02c
        [0x03] rec0=00 rec1=00 rec2=13 rec3=030
        [0x04] rec0=15 rec1=00 rec2=03 rec3=012
        [0x05] rec0=13 rec1=00 rec2=04 rec3=084
        [0x06] rec0=13 rec1=00 rec2=05 rec3=03a
        [0x07] rec0=14 rec1=00 rec2=06 rec3=024
        [0x08] rec0=15 rec1=00 rec2=07 rec3=020
        [0x09] rec0=11 rec1=00 rec2=08 rec3=048
        [0x0a] rec0=16 rec1=00 rec2=09 rec3=058
        [0x0b] rec0=14 rec1=00 rec2=0a rec3=02a
        [0x0c] rec0=22 rec1=00 rec2=0b rec3=02a
        [0x0d] rec0=00 rec1=00 rec2=12 rec3=004
        [0x0e] rec0=22 rec1=00 rec2=0c rec3=02a
        [0x0f] rec0=00 rec1=00 rec2=11 rec3=004
        [0x10] rec0=1f rec1=00 rec2=0d rec3=05a
        [0x11] rec0=02 rec1=00 rec2=10 rec3=002
        [0x12] rec0=1f rec1=00 rec2=0e rec3=034
        [0x13] rec0=18 rec1=00 rec2=0f rec3=000
    tail 0x2170b5cf08225429bba72 0x42a00088462063203