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

⟦a96286f4e⟧ Ada Source

    Length: 13312 (0x3400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Class, seg_03b94c, separate Generic_Fact_Base

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦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  
        for Slot_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=c
    nid=b
    hdr6=16
        [0x00] rec0=1e rec1=00 rec2=01 rec3=00c
        [0x01] rec0=1c rec1=00 rec2=05 rec3=000
        [0x02] rec0=1e rec1=00 rec2=02 rec3=040
        [0x03] rec0=1d rec1=00 rec2=06 rec3=01e
        [0x04] rec0=0c rec1=00 rec2=04 rec3=05e
        [0x05] rec0=1f rec1=00 rec2=08 rec3=002
        [0x06] rec0=1e rec1=00 rec2=0c rec3=040
        [0x07] rec0=1a rec1=00 rec2=07 rec3=038
        [0x08] rec0=1c rec1=00 rec2=09 rec3=07c
        [0x09] rec0=1c rec1=00 rec2=03 rec3=01e
        [0x0a] rec0=02 rec1=00 rec2=0a rec3=000
        [0x0b] rec0=02 rec1=00 rec2=0a rec3=000
    tail 0x21738b1b2851e7fe156dd 0x42a00088462063c03
Free Block Chain:
  0xb: 0000  00 00 00 39 80 0f 6a 65 63 74 73 20 28 52 65 73  ┆   9  jects (Res┆