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

⟦336983c95⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Action, seg_0525aa

Derivation

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

package body Action is

    Running_Out_Of_Action_Object : exception; --[uncatchable exception !!!]

    subtype Id_Range is Natural range 1 .. 1024;

    task Unique_Id is
        entry Get (Id : in out Natural);
        entry Abandon (Id : in Natural);
    end Unique_Id;


    task body Unique_Id is
        type Status is (Free, In_Use);
        Ids : array (Id_Range) of Status := (others => Free);

    begin
        loop
            select
                accept Get (Id : in out Natural) do
                    declare
                        Id : Natural := Ids'First;
                    begin
                        while Id in Ids'Range loop
                            exit when Ids (Id) = Free;
                            Id := Id + 1;
                        end loop;  
                        Ids (Id) := In_Use;
                        if Id = Ids'Last and Ids (Id) = In_Use then
                            raise Running_Out_Of_Action_Object;
                        end if;
                    end;
                end Get;
            or
                accept Abandon (Id : in Natural) do
                    Ids (Id) := Free;
                end Abandon;
            end select;
        end loop;
    end Unique_Id;


    function Start (Id : Identifier.Object) return Action.Object is
        I : Natural;
    begin  
        Unique_Id.Get (I);
        return Object'(I, Status => Open, Owner => Id);
    end Start;


    procedure Finish (Action : in out Standard.Action.Object;
                      Id : Identifier.Object) is
    begin
        Action.Status := Closed;  
        Unique_Id.Abandon (Action.Id);
    end Finish;


    function "=" (Left, Right : Action.Object) return Boolean is
    begin
        return Left.Id = Right.Id and Identifier."=" (Left.Owner, Right.Owner);
    end "=";


    function Is_Open (Action : Standard.Action.Object) return Boolean is
    begin
        return Action.Status = Open;
    end Is_Open;


    function Owner (Action : Standard.Action.Object) return Identifier.Object is
    begin
        return Action.Owner;
    end Owner;

end Action;

    nblk1=4
    nid=2
    hdr6=6
        [0x00] rec0=1f rec1=00 rec2=01 rec3=06a
        [0x01] rec0=23 rec1=00 rec2=03 rec3=090
        [0x02] rec0=0c rec1=00 rec2=04 rec3=000
        [0x03] rec0=02 rec1=1c rec2=20 rec3=642
    tail 0x2154baf0e87a0730f9f0a 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 00 00 07 80 04 65 63 74 3b 04 4f 70 65 6e 3b  ┆      ect; Open;┆