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

⟦1c4b217cf⟧ Ada Source

    Length: 21504 (0x5400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Slot, seg_026565, seg_026d20

Derivation

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

E3 Source Code



-------------------------------------------------------------------------------
with Text_Io;
with Wild_String;

package body Slot is

    ---------------------------------------------------------------------------
    function Make (The_Variable : Standard.String; With_Kind : Kind)
                  return Element is
        The_Element : Element;

    begin  
        The_Element.The_Name := Umps_Defs.Normalize (The_Variable);
        The_Element.The_Kind := With_Kind;
        The_Element.Empty    := True;  
        case (With_Kind) is
            when Integer =>
                The_Element.The_Value :=
                   Value'(Is_Kind_Of => Integer, Integer => 0);
            when String =>
                The_Element.The_Value :=
                   Value'(Is_Kind_Of => String,
                          String     => (others => Ascii.Nul));
            when Character =>
                The_Element.The_Value :=
                   Value'(Is_Kind_Of => Character, Character => Ascii.Nul);
            when Boolean =>
                The_Element.The_Value :=
                   Value'(Is_Kind_Of => Boolean, Boolean => False);
            when Void =>
                The_Element.The_Value :=
                   Value'(Is_Kind_Of => Void, Void => Ascii.Nul);
        end case;
        return The_Element;
    end Make;

    ---------------------------------------------------------------------------
    function Make (The_Variable : Standard.String;
                   With_Value   : Standard.Integer) return Element is
        The_Element : Element;

    begin
        The_Element.The_Name  := Umps_Defs.Normalize (The_Variable);
        The_Element.The_Kind  := Integer;
        The_Element.Empty     := False;
        The_Element.The_Value :=
           Value'(Is_Kind_Of => Integer, Integer => With_Value);
        return The_Element;
    end Make;

    --------------------------------------------------------------------------
    function Make (The_Variable : Standard.String; With_Value : Standard.String)
                  return Element is
        The_Element : Element;  
        A_String    : Umps_Defs.String;

    begin  
        The_Element.The_Name  := Umps_Defs.Normalize (The_Variable);
        A_String              := Umps_Defs.Normalize (With_Value);
        The_Element.The_Kind  := String;
        The_Element.Empty     := False;
        The_Element.The_Value := Value'
                                    (Is_Kind_Of => String, String => A_String);
        return The_Element;
    end Make;

    ---------------------------------------------------------------------------
    function Make (The_Variable : Standard.String;
                   With_Value   : Standard.Character) return Element is
        The_Element : Element;

    begin
        The_Element.The_Name  := Umps_Defs.Normalize (The_Variable);
        The_Element.The_Kind  := Character;
        The_Element.Empty     := False;
        The_Element.The_Value := Value'(Is_Kind_Of => Character,
                                        Character  => With_Value);
        return The_Element;
    end Make;

    ---------------------------------------------------------------------------
    function Make (The_Variable : Standard.String;
                   With_Value   : Standard.Boolean) return Element is
        The_Element : Element;

    begin
        The_Element.The_Name  := Umps_Defs.Normalize (The_Variable);
        The_Element.The_Kind  := Boolean;
        The_Element.Empty     := False;
        The_Element.The_Value :=
           Value'(Is_Kind_Of => Boolean, Boolean => With_Value);
        return The_Element;
    end Make;

    ---------------------------------------------------------------------------
    function Name_Of (The_Element : Element) return Standard.String is

    begin
        return Umps_Defs.Denormalize (The_Element.The_Name);
    end Name_Of;

    ---------------------------------------------------------------------------
    function Kind_Of (The_Element : Element) return Kind is

    begin
        return The_Element.The_Kind;
    end Kind_Of;

    ---------------------------------------------------------------------------
    function Is_Empty_Value (The_Element : Element) return Standard.Boolean is

    begin
        return The_Element.Empty;
    end Is_Empty_Value;

    ---------------------------------------------------------------------------
    function Value_Of (The_Element : Element)  
                      return Standard.String is

    begin
        if (Is_Empty_Value (The_Element)) then
            raise Empty_Value_Error;
        end if;  
        if (Kind_Of (The_Element) /= String) then
            raise Illegal_Access_Error;
        end if;
        return Umps_Defs.Denormalize (The_Element.The_Value.String);
    end Value_Of;

    ---------------------------------------------------------------------------
    function Value_Of (The_Element : Element) return Standard.Integer is

    begin
        if (Is_Empty_Value (The_Element)) then
            raise Empty_Value_Error;
        end if;
        if (Kind_Of (The_Element) /= Integer) then
            raise Illegal_Access_Error;
        end if;
        return The_Element.The_Value.Integer;
    end Value_Of;

    ---------------------------------------------------------------------------
    function Value_Of (The_Element : Element) return Standard.Character is

    begin
        if (Is_Empty_Value (The_Element)) then
            raise Empty_Value_Error;
        end if;
        if (Kind_Of (The_Element) /= Character) then
            raise Illegal_Access_Error;
        end if;
        return The_Element.The_Value.Character;
    end Value_Of;

    ---------------------------------------------------------------------------
    function Value_Of (The_Element : Element) return Standard.Boolean is

    begin
        if (Is_Empty_Value (The_Element)) then
            raise Empty_Value_Error;
        end if;
        if (Kind_Of (The_Element) /= Boolean) then
            raise Illegal_Access_Error;
        end if;
        return The_Element.The_Value.Boolean;
    end Value_Of;

    ---------------------------------------------------------------------------
    function Value_Part (The_Element : Element) return Value is

    begin
        return The_Element.The_Value;
    end Value_Part;

    ---------------------------------------------------------------------------
    function Image (The_Value : Value) return Standard.String is

    begin
        case The_Value.Is_Kind_Of is
            when String =>
                return Umps_Defs.Denormalize (The_Value.String);
            when Integer =>
                return Standard.Integer'Image (The_Value.Integer);
            when Character =>
                return "" & The_Value.Character;
            when Boolean =>
                return Standard.Boolean'Image (The_Value.Boolean);
            when Void =>
                return "";
        end case;
    end Image;

    ---------------------------------------------------------------------------
    function Image (The_Element : Element) return Standard.String is

    begin  
        if (Is_Empty_Value (The_Element)) then
            return Name_Of (The_Element) & Umps_Defs.Separator &
                      Kind'Image (Kind_Of (The_Element)) & Umps_Defs.Separator;
        else  
            return Name_Of (The_Element) & Umps_Defs.Separator &
                      Kind'Image (Kind_Of (The_Element)) &
                      Umps_Defs.Separator & Image (Value_Part (The_Element));
        end if;
    end Image;

    ---------------------------------------------------------------------------
    procedure Display (The_Element   : Element;
                       String_Before : Standard.String := "") is

    begin
        Text_Io.Put_Line (String_Before & "The_Element => " &
                          Name_Of (The_Element));
        Text_Io.Put_Line (String_Before & "         Kind => " &
                          Kind'Image (Kind_Of (The_Element)));

        if (Is_Empty_Value (The_Element)) then
            Text_Io.Put_Line (String_Before & "         Value => <empty>");
        else
            Text_Io.Put_Line (String_Before & "         Value => " &
                              Image (Value_Part (The_Element)));
        end if;
    end Display;

    ---------------------------------------------------------------------------
    function Is_Part_Equal (Left, Right : Value) return Standard.Boolean is

    begin
        case Left.Is_Kind_Of is
            when String =>
                return Umps_Defs.Denormalize (Left.String) =
                          Umps_Defs.Denormalize (Right.String);
            when Integer =>
                return Left.Integer = Right.Integer;
            when Character =>
                return Left.Character = Right.Character;
            when Boolean =>
                return Left.Boolean = Right.Boolean;
            when Void =>
                return True;
        end case;

    end Is_Part_Equal;

    ---------------------------------------------------------------------------
    function Is_Equal (Left, Right : Element) return Standard.Boolean is

    begin  
        if (Field = On_None) then
            return True;
        end if;
        if (Umps_Defs.Denormalize (Left.The_Name) /=
            Umps_Defs.Denormalize (Right.The_Name)) then
            return False;
        elsif (Field = On_Name) then
            return True;
        end if;

        if (Kind_Of (Left) /= Kind_Of (Right)) then
            return False;
        elsif (Field = On_Kind) then
            return True;
        end if;

        if (Is_Empty_Value (Left) /= Is_Empty_Value (Right)) then
            return False;
        elsif (Is_Empty_Value (Left)) then
            return True;
        end if;

        return Is_Part_Equal (Value_Part (Left), Value_Part (Right));
    end Is_Equal;

    ---------------------------------------------------------------------------
    function Is_Part_Less (Left, Right : Value) return Standard.Boolean is

    begin
        case Left.Is_Kind_Of is
            when String =>
                return Umps_Defs.Denormalize (Left.String) <
                          Umps_Defs.Denormalize (Right.String);
            when Integer =>
                return Left.Integer < Right.Integer;
            when Character =>
                return Left.Character < Right.Character;
            when Boolean =>
                return Left.Boolean < Right.Boolean;
            when Void =>
                return False;
        end case;

    end Is_Part_Less;

    ---------------------------------------------------------------------------
    function Is_Less (Left, Right : Element) return Standard.Boolean is

    begin  
        if (Field = On_None) then
            return False;
        end if;
        if (Umps_Defs.Denormalize (Left.The_Name) >
            Umps_Defs.Denormalize (Right.The_Name)) then
            return False;
        elsif (Field = On_Name) then
            return True;
        end if;

        if (Kind_Of (Left) > Kind_Of (Right)) then
            return False;
        elsif (Field = On_Kind) then
            return True;
        end if;

        if (Is_Empty_Value (Left) or else Is_Empty_Value (Right)) then
            return False;
        end if;

        return Is_Part_Less (Value_Part (Left), Value_Part (Right));
    end Is_Less;

    ---------------------------------------------------------------------------
    function Is_Part_Most (Left, Right : Value) return Standard.Boolean is

    begin
        case Left.Is_Kind_Of is
            when String =>
                return Umps_Defs.Denormalize (Left.String) >
                          Umps_Defs.Denormalize (Right.String);
            when Integer =>
                return Left.Integer > Right.Integer;
            when Character =>
                return Left.Character > Right.Character;
            when Boolean =>
                return Left.Boolean > Right.Boolean;
            when Void =>
                return False;
        end case;

    end Is_Part_Most;

    ---------------------------------------------------------------------------
    function Is_Most (Left, Right : Element) return Standard.Boolean is

    begin  
        if (Field = On_None) then
            return False;
        end if;
        if (Umps_Defs.Denormalize (Left.The_Name) <
            Umps_Defs.Denormalize (Right.The_Name)) then
            return False;
        elsif (Field = On_Name) then
            return True;
        end if;

        if (Kind_Of (Left) < Kind_Of (Right)) then
            return False;
        elsif (Field = On_Kind) then
            return True;
        end if;

        if (Is_Empty_Value (Left) or else Is_Empty_Value (Right)) then
            return False;
        end if;

        return Is_Part_Most (Value_Part (Left), Value_Part (Right));
    end Is_Most;
end Slot;

E3 Meta Data

    nblk1=14
    nid=f
    hdr6=20
        [0x00] rec0=1b rec1=00 rec2=01 rec3=046
        [0x01] rec0=19 rec1=00 rec2=10 rec3=07a
        [0x02] rec0=00 rec1=00 rec2=12 rec3=002
        [0x03] rec0=18 rec1=00 rec2=02 rec3=014
        [0x04] rec0=19 rec1=00 rec2=0b rec3=008
        [0x05] rec0=1e rec1=00 rec2=13 rec3=032
        [0x06] rec0=01 rec1=00 rec2=14 rec3=038
        [0x07] rec0=1d rec1=00 rec2=06 rec3=032
        [0x08] rec0=1c rec1=00 rec2=07 rec3=01a
        [0x09] rec0=19 rec1=00 rec2=0c rec3=028
        [0x0a] rec0=17 rec1=00 rec2=08 rec3=01e
        [0x0b] rec0=1f rec1=00 rec2=11 rec3=032
        [0x0c] rec0=1d rec1=00 rec2=05 rec3=016
        [0x0d] rec0=20 rec1=00 rec2=0d rec3=00e
        [0x0e] rec0=1c rec1=00 rec2=09 rec3=054
        [0x0f] rec0=0d rec1=00 rec2=0e rec3=000
        [0x10] rec0=07 rec1=00 rec2=0a rec3=000
        [0x11] rec0=21 rec1=00 rec2=0a rec3=018
        [0x12] rec0=02 rec1=00 rec2=0b rec3=000
        [0x13] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21520436a83aa67909582 0x42a00088462063c03
Free Block Chain:
  0xf: 0000  00 0a 01 02 80 07 6e 20 54 72 75 65 3b 07 00 0f  ┆      n True;   ┆
  0xa: 0000  00 04 00 a6 80 09 68 74 29 29 20 74 68 65 6e 09  ┆      ht)) then ┆
  0x4: 0000  00 03 00 4c 80 2a 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ┆   L *----------┆
  0x3: 0000  00 00 00 1a 00 17 20 20 20 20 2d 2d 2d 2d 2d 2d  ┆          ------┆