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

⟦4ac39cd92⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bal, seg_05568e

Derivation

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

package body Bal is

    package List_Of_Rm is new List_Generic (Element => Message.Tmessage);
    -- liste des messages a envoyer : Messages To Send

    package List_Of_Mts is new List_Generic (Element => Tmess_To_Send);
    -- liste des messages recus : Received Messages

    task Received_M is
        entry Put (M : in Message.Tmessage);  
        entry Get (M : out Message.Tmessage);
        entry Empty (Back : out Boolean);
    end Received_M;


    task M_To_Send is
        entry Put (M : in Tmess_To_Send);
        entry Get (M : out Tmess_To_Send);
        entry Empty (Back : out Boolean);
    end M_To_Send;

    procedure Put_Rm (M : in Message.Tmessage) is
    begin
        Received_M.Put (M);
    end Put_Rm;

    procedure Get_Rm (M : out Message.Tmessage) is
    begin
        Received_M.Get (M);
    end Get_Rm;

    function Is_Empty_Rm return Boolean is
        Back : Boolean;
    begin
        Received_M.Empty (Back);
        return Back;
    end Is_Empty_Rm;

    procedure Put_Mts (M : in Tmess_To_Send) is
    begin
        M_To_Send.Put (M);
    end Put_Mts;

    procedure Get_Mts (M : out Tmess_To_Send) is
    begin
        M_To_Send.Get (M);
    end Get_Mts;

    function Is_Empty_Mts return Boolean is
        Back : Boolean;
    begin
        M_To_Send.Empty (Back);
        return Back;
    end Is_Empty_Mts;

    -- rajoute un message a envoyer a la liste RM
    procedure Add_Rm (L : in out List_Of_Rm.List; M : in Message.Tmessage) is  
    begin
        L := List_Of_Rm.Make (M, L);
    end Add_Rm;

    -- retire de la liste le premier message de celle-ci
    procedure Remove_Rm (L : in out List_Of_Rm.List;
                         M : out Message.Tmessage) is  
    begin
        M := List_Of_Rm.First (L);
        L := List_Of_Rm.Rest (L);

    end Remove_Rm;

    task body Received_M is  
        L : List_Of_Rm.List;  
    begin
        loop
            select
                accept Put (M : in Message.Tmessage) do
                    Add_Rm (L, M);
                end Put;  
            or
                accept Get (M : out Message.Tmessage) do  
                    Remove_Rm (L, M);  
                end Get;
            or
                accept Empty (Back : out Boolean) do
                    Back := List_Of_Rm.Is_Empty (L);
                end Empty;
            end select;
        end loop;
    end Received_M;


    -- rajoute un message a envoyer a la liste MTS
    procedure Add_Mts (L : in out List_Of_Mts.List; M : in Tmess_To_Send) is
    begin
        L := List_Of_Mts.Make (M, L);
    end Add_Mts;

    -- liste des messages recus : Received Messages
    procedure Remove_Mts (L : in out List_Of_Mts.List; M : out Tmess_To_Send) is  
    begin
        M := List_Of_Mts.First (L);
        L := List_Of_Mts.Rest (L);

    end Remove_Mts;

    task body M_To_Send is  
        L : List_Of_Mts.List;
    begin
        loop
            select
                accept Put (M : in Tmess_To_Send) do
                    Add_Mts (L, M);
                end Put;  
            or
                accept Get (M : out Tmess_To_Send) do
                    Remove_Mts (L, M);
                end Get;
            or
                accept Empty (Back : out Boolean) do
                    Back := List_Of_Mts.Is_Empty (L);
                end Empty;
            end select;
        end loop;
    end M_To_Send;

end Bal;

    nblk1=5
    nid=2
    hdr6=8
        [0x00] rec0=24 rec1=00 rec2=01 rec3=040
        [0x01] rec0=27 rec1=00 rec2=03 rec3=00c
        [0x02] rec0=20 rec1=00 rec2=05 rec3=034
        [0x03] rec0=15 rec1=00 rec2=04 rec3=000
        [0x04] rec0=10 rec1=00 rec2=02 rec3=000
    tail 0x2175faaae87bd51955df1 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 00 01 f4 80 30 20 20 20 20 20 20 20 20 20 20  ┆     0          ┆