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

⟦8cbc86a1c⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Class, seg_04b4c4, separate Generic_Fact_Base

Derivation

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

separate (Generic_Fact_Base)
package body Generic_Class is

    The_Class_Object : Class.Object;

    function Slot_Count return Natural is
        First : Natural := Slot_Names'Pos (Slot_Names'First);
        Last  : Natural := Slot_Names'Pos (Slot_Names'Last);
    begin
        return Last - First + 1;
    end Slot_Count;

    function As_Query_Slot_Name
                (Slot_Name : Slot_Names) return Query.Slot_Names is
    begin
        return Slot_Names'Pos (Slot_Name) -
                  Slot_Names'Pos (Slot_Names'First) + 1;
    end As_Query_Slot_Name;


    function As_Class_Slot_Name
                (Slot_Name : Slot_Names) return Class.Slot_Names is
    begin
        return Slot_Names'Pos (Slot_Name) -
                  Slot_Names'Pos (Slot_Names'First) + 1;
    end As_Class_Slot_Name;


    function As_Anonymous (What : Patterns) return Query.Patterns is
        Result : Query.Patterns (1 .. Slot_Count);
    begin  
        forSlot_Name in What'Range loop
            Result (As_Query_Slot_Name (Slot_Name)) := What (Slot_Name);
        end loop;
        return Result;
    end As_Anonymous;


    function As_Anonymous (What : Slots) return Class.Slots is
        Result : Class.Slots (1 .. Slot_Count);
    begin
        for Slot_Name in What'Range loop
            Result (As_Class_Slot_Name (Slot_Name)) := What (Slot_Name);
        end loop;
        return Result;
    end As_Anonymous;

    function Get_Slot_Names_Images return Class.Slot_Names_Images is
        Result : Class.Slot_Names_Images (1 .. Slot_Count);
    begin  
        for I in Slot_Names loop
            Result (As_Class_Slot_Name (I)) :=
               Constant_String.Value (Slot_Names'Image (I));
        end loop;
        return Result;
    end Get_Slot_Names_Images;

    function Class_Object return Class.Object is
    begin
        return The_Class_Object;
    end Class_Object;

    function Exist (What : Patterns) return Query.Object is
    begin
        return Query.Object'(Kind  => Query.Find,
                             Class => Class.Class_Name_Of (The_Class_Object),
                             Size  => Slot_Count,
                             Value => As_Anonymous (What));
    end Exist;


    function Not_Any (What : Patterns) return Query.Object is
    begin
        return Query.Object'(Kind  => Query.Check_No,
                             Class => Class.Class_Name_Of (The_Class_Object),
                             Size  => Slot_Count,
                             Value => As_Anonymous (What));
    end Not_Any;


    function Such_As (What : Patterns) return Predicate.Object is
    begin
        return Predicate.Collection (As_Anonymous (What));
    end Such_As;


    procedure Check_Class_Membership (For_Object : Class.User_Object) is
    begin
        if Class."/=" (Class.Class_Of (For_Object), The_Class_Object) then
            raise Illegal_Access;
        end if;
    end Check_Class_Membership;


    function Get (The_Fact : Class.User_Object) return Slots is
        Result : Slots;
    begin
        Check_Class_Membership (For_Object => The_Fact);
        for Slot in Slot_Names loop
            Result (Slot) := Class.Get (The_Object => The_Fact,
                                        The_Slot => As_Class_Slot_Name (Slot));
        end loop;
        return Result;
    end Get;


    function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
                 return Slot.Object is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        return Class.Get (The_Fact, The_Slot => As_Class_Slot_Name (The_Slot));
    end Get;


    function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
                 return Class.User_Object is
    begin
        return Class.As_User_Object (Get (The_Fact, The_Slot));
    end Get;


    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Integer is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Boolean is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Float is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Character is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Duration is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return String is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;


    procedure Add (The_Fact : Slots; Its_Reference : out Slot.Object) is
    begin
        Class.Add (To_Class      => The_Class_Object,
                   The_Instance  => As_Anonymous (The_Fact),
                   Its_Reference => Its_Reference);
    end Add;


    procedure Add (The_Fact : Slots) is  
        Unused_Slot : Slot.Object;
    begin
        Class.Add (To_Class      => The_Class_Object,
                   The_Instance  => As_Anonymous (The_Fact),
                   Its_Reference => Unused_Slot);
    end Add;


    procedure Delete (The_Fact : Class.User_Object) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Delete (The_Fact);
    end Delete;


    procedure Change (The_Fact : Class.User_Object; Value : Slots) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Change (The_Fact, To_Value => As_Anonymous (Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Slot.Object) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Change (The_Object => The_Fact,
                      The_Slot   => As_Class_Slot_Name (The_Slot),
                      To_Value   => To_Value);
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Integer) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Boolean) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Float) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Character) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Duration) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : String) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;


    procedure Generic_Put (The_Fact : Class.User_Object;
                           Where    : Output_Stream.Object) is
        First      : Boolean         := True;
        Class_Name : constant String :=
           Class_Names'Image (Class.Class_Name_Of (The_Class_Object));  
        use Output_Stream;

    begin
        Check_Class_Membership (For_Object => The_Fact);
        Put (Class_Name & "'(", Where);
        Indent_Right (Where);
        New_Line (Where);
        for I in Slot_Names loop
            if not First then
                Put_Line (", ", Where);
            else
                First := False;
            end if;
            Put (Slot_Names'Image (I) & " =>", Where);
            Put (Image (I, Get (The_Fact, The_Slot => I)), Where);
        end loop;
        Indent_Left (Where);
        Put_Line (")", Where);  
    end Generic_Put;

begin
    The_Class_Object := Class.Make (Name       => Class_Name,  
                                    Class_Size => Class_Size,
                                    Names      => Get_Slot_Names_Images);
    Working_Memory.Register (The_Class_Object);
end Generic_Class;

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=21 rec1=00 rec2=01 rec3=016
        [0x01] rec0=00 rec1=00 rec2=0b rec3=002
        [0x02] rec0=1f rec1=00 rec2=02 rec3=026
        [0x03] rec0=1b rec1=00 rec2=03 rec3=018
        [0x04] rec0=20 rec1=00 rec2=04 rec3=01a
        [0x05] rec0=1b rec1=00 rec2=05 rec3=072
        [0x06] rec0=22 rec1=00 rec2=06 rec3=026
        [0x07] rec0=19 rec1=00 rec2=07 rec3=04a
        [0x08] rec0=1c rec1=00 rec2=08 rec3=042
        [0x09] rec0=1d rec1=00 rec2=09 rec3=008
        [0x0a] rec0=08 rec1=00 rec2=0a rec3=000
    tail 0x217503660867e33c4ba94 0x42a00088462063c03