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

⟦f72eea329⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Class_Server, seg_04b451, separate Generic_Fact_Base.Generic_Class

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.Generic_Class)

package body Generic_Class_Server is


    task Server is
        entry Delete (The_User_Object : Class.User_Object);
        entry Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Slot.Object);
        entry Update;
    end Server;

    type Delete_Messages is
        record
            What_Fact : Class.User_Object;
        end record;  
    type Change_Messages is
        record
            What_Fact : Class.User_Object;
            What_Slot : Slot_Names;
            The_Value : Slot.Object;
        end record;

    type Change_Messages_Table is
       array (1 .. Max_Change_Operations) of Change_Messages;


    type Delete_Messages_Table is
       array (1 .. Max_Delete_Operations) of Delete_Messages;


    task body Server is  
        The_Change_Msg_Table : Change_Messages_Table;
        The_Delete_Msg_Table : Delete_Messages_Table;
        Nbr_Change_Msg       : Natural := 0;
        Nbr_Delete_Msg       : Natural := 0;
    begin  
        loop
            select  
                accept Update do  -- bloque l'appelant

                    while (Nbr_Delete_Msg > 0) loop
                        Generic_Class.Delete
                           (The_Delete_Msg_Table (Nbr_Delete_Msg).What_Fact);
                        Nbr_Delete_Msg := Nbr_Delete_Msg - 1;
                    end loop;

                    while (Nbr_Change_Msg > 0) loop
                        Generic_Class.Change
                           (The_Change_Msg_Table (Nbr_Change_Msg).What_Fact,
                            The_Change_Msg_Table (Nbr_Change_Msg).What_Slot,
                            The_Change_Msg_Table (Nbr_Change_Msg).The_Value);
                        Nbr_Change_Msg := Nbr_Change_Msg - 1;
                    end loop;
                end Update;
            or
                accept Change (The_Fact : Class.User_Object;
                               The_Slot : Slot_Names;
                               To_Value : Slot.Object) do  
                    Nbr_Change_Msg := Nbr_Change_Msg + 1;
                    The_Change_Msg_Table (Nbr_Change_Msg).What_Fact := The_Fact;
                    The_Change_Msg_Table (Nbr_Change_Msg).What_Slot := The_Slot;
                    The_Change_Msg_Table (Nbr_Change_Msg).The_Value := To_Value;
                end Change;

            or
                accept Delete (The_User_Object : Class.User_Object) do
                    Nbr_Delete_Msg := Nbr_Delete_Msg + 1;
                    The_Delete_Msg_Table (Nbr_Delete_Msg).What_Fact :=
                       The_User_Object;
                end Delete;
            or
                terminate;

            end select;
        end loop;
    end Server;



    procedure Delete (The_User_Object : Class.User_Object) is
    begin
        Server.Delete (The_User_Object);
    exception
        when Constraint_Error =>
            raise Server_Storage_Capacity_Overflow;
    end Delete;


    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Slot.Object) is
    begin
        Server.Change (The_Fact, The_Slot, To_Value);  
    exception
        when Constraint_Error =>
            raise Server_Storage_Capacity_Overflow;
    end Change;


    procedure Update is
    begin
        Server.Update;
    end Update;


end Generic_Class_Server;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=24 rec1=00 rec2=01 rec3=04a
        [0x01] rec0=17 rec1=00 rec2=04 rec3=03c
        [0x02] rec0=00 rec1=00 rec2=05 rec3=018
        [0x03] rec0=1a rec1=00 rec2=03 rec3=050
        [0x04] rec0=19 rec1=00 rec2=02 rec3=000
    tail 0x2174ffbfe867d4c28b54e 0x42a00088462063c03