DataMuseum.dk

top - metrics - download

    Length: 2113 (0x841)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;