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

⟦ea34cacbd⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Working_Memory, seg_02bad3, 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 Working_Memory is

    Last_Frame : Object := 0;

    type Frames is array (Object range <>) of Frame;

    Content : Frames (1 .. Object (Max_Frame_Count)) := (others => Null_Frame);

    function Image (Of_Class : Class_Name) return String
        renames Constant_String.Image;


    function "=" (Left, Right : Class_Name) return Boolean
        renames Constant_String."=";

    function Make (The_Class : Class_Name; The_Slots : Slots) return Frame is
    begin
        return Frame'(Size  => The_Slots'Length,
                      Class => The_Class,
                      Value => The_Slots);
    end Make;

    function Last return Object is
    begin
        return Last_Frame;
    end Last;

    procedure Make_Empty is
    begin
        Content := (others => Null_Frame);
    end Make_Empty;

    function Get (The_Fact : Object) return Frame is
    begin
        return Content (The_Fact);
    end Get;

    function Get (The_Fact : Object; Slot : Slot_Names) return Integer is
    begin  
        return Content (The_Fact).Value (Slot);
    end Get;


    procedure Add (The_Fact : Frame) is
    begin
        for I in Content'Range loop
            if Content (I) = Null_Frame then
                Content (I) := The_Fact;
                if I > Last_Frame then
                    Last_Frame := I;
                end if;
                return;
            end if;
        end loop;
        raise Overflow;
    end Add;


    procedure Delete (The_Fact : Object) is
    begin
        Content (The_Fact) := Null_Frame;
        if Last_Frame = The_Fact then  
            Last_Frame := Last_Frame - 1;
            for I in reverse 1 .. Last_Frame loop
                exit when Content (I) /= Null_Frame;
                Last_Frame := I;
            end loop;
        end if;
    end Delete;


    procedure Change (The_Fact : Object; Value : Frame) is
    begin
        Content (The_Fact) := Value;
    end Change;


    procedure Change (The_Fact : Object;
                      The_Slot : Slot_Names;
                      To_Value : Integer) is  
    begin
        Content (The_Fact).Value (The_Slot) := To_Value;
    end Change;

    function Match (The_Fact_Class, The_Filter_Class : Class_Name)
                   return Boolean is  
        Result : Boolean;
    begin
        Result := The_Fact_Class /= Null_Class_Name and then
                     The_Fact_Class = The_Filter_Class;
        return Result;
    end Match;

    function Match (The_Slots : Slots; Against : Patterns) return Boolean is
    begin
        for I in The_Slots'Range loop  
            if not Condition_Match (The_Slots (I), Against (I)) then  
                return False;
            end if;
        end loop;
        return True;
    end Match;


    function Match (The_Element : Object; Against : Query) return Boolean is
    begin
        return Match (Content (The_Element).Class, Against.Class) and then
                  Match (Content (The_Element).Value, Against.Value);
    end Match;



    procedure Put (The_Slots : Slots;
                   Where     : Output_Stream.Object :=
                      Output_Stream.Standard_Output) is
        First : Boolean := True;
        use Output_Stream;
    begin
        for I in The_Slots'Range loop
            if not First then
                Put (", ", Where);
                if I mod 2 /= 0 then
                    New_Line (Where);
                end if;
            else
                First := False;
            end if;
            Put ("Slot" & Slot_Names'Image (I) & " =>", Where);
            Put (Integer'Image (The_Slots (I)), Where);
        end loop;
    end Put;


    procedure Put (The_Frame : Frame; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Frame /= Null_Frame then
            Put_Line (Image (The_Frame.Class) & "'(", Where);
            Indent_Right (Where);
            Put (The_Slots => The_Frame.Value, Where => Where);
            Indent_Left (Where);
            Put_Line (")", Where);
        end if;
    end Put;


    procedure Put (The_Fact : Object; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Fact /= Null_Object then  
            Put (Content (The_Fact), Where);
        else
            Put ("No name", Where);
        end if;
    end Put;


    procedure Put (Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        Put_Line ("Working_Memory'(", Where);
        Indent_Right (Where);
        for Object in Content'Range loop  
            Put (Content (Object), Where);
        end loop;
        Indent_Left (Where);
        Put_Line (")", Where);
    end Put;


end Working_Memory;

    nblk1=7
    nid=4
    hdr6=c
        [0x00] rec0=25 rec1=00 rec2=01 rec3=042
        [0x01] rec0=0b rec1=00 rec2=05 rec3=016
        [0x02] rec0=23 rec1=00 rec2=06 rec3=010
        [0x03] rec0=20 rec1=00 rec2=07 rec3=032
        [0x04] rec0=1c rec1=00 rec2=02 rec3=040
        [0x05] rec0=1f rec1=00 rec2=03 rec3=000
        [0x06] rec0=0f rec1=c4 rec2=00 rec3=002
    tail 0x21523da3c83ef71946d61 0x42a00088462063c03
Free Block Chain:
  0x4: 0000  00 00 03 fc 80 13 41 67 61 69 6e 73 74 20 28 49  ┆      Against (I┆