DataMuseum.dk

top - metrics - download

    Length: 4344 (0x10f8)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

package body Managed_Pool_Generic is

    task Worker is
        entry Open (Object : out Object_Id);
        entry Close (Object : Object_Id);
        entry Init_Open (Iter : in out Iterator);
        entry Init_Closed (Iter : in out Iterator);
    end Worker;

    function Is_Open (Object : Object_Id) return Boolean is
    begin
        return Object.Unique = Object.Value.Hidden.Unique;
    exception
        when others =>
            return False;
    end Is_Open;

    task body Worker is

        Open_List : Object_Pointer := null;
        Closed_List : Object_Pointer := null;

        Generator : Unique_Id := Null_Unique_Id;

        procedure Do_Open (Object : out Object_Id) is
            Value : Object_Pointer;
        begin
            if Closed_List = null then
                Value := new Object_Record;
                On_Allocate (Value.Object);
            else
                Value := Closed_List;
                Closed_List := Closed_List.Hidden.Next;
            end if;
            Generator := Generator + 1;
            Object := (Generator, Value);
            Value.Hidden := (Generator, Open_List);
            Open_List := Value;
            On_Open (Value.Object);
        end Do_Open;

        procedure Do_Close (Object : Object_Id) is
            Value : Object_Pointer;
            Cursor : Object_Pointer;
        begin
            if Is_Open (Object) then
                Value := Object.Value;
                -- remove the object from the open_list:
                if Open_List = Value then
                    Open_List := Open_List.Hidden.Next;
                else
                    Cursor := Open_List;
                    while Cursor.Hidden.Next /= Value loop
                        Cursor := Cursor.Hidden.Next;
                    end loop;
                    Cursor.Hidden.Next := Value.Hidden.Next;
                end if;
                Value.Hidden := (Null_Unique_Id, Closed_List);
                Closed_List := Value;
                On_Close (Value.Object);
            end if;
        end Do_Close;

    begin
        loop
            begin
                loop
                    select
                        accept Open (Object : out Object_Id) do
                            Do_Open (Object);
                        end Open;
                    or
                        accept Close (Object : Object_Id) do
                            Do_Close (Object);
                        end Close;
                    or
                        accept Init_Open (Iter : in out Iterator) do
                            Iter := Iterator (Open_List);
                        end Init_Open;
                    or
                        accept Init_Closed (Iter : in out Iterator) do
                            Iter := Iterator (Closed_List);
                        end Init_Closed;
                    or
                        terminate;
                    end select;
                end loop;
            exception
                when others =>
                    null;
            end;
        end loop;
    end Worker;

    procedure Open (Object : out Object_Id) is
    begin
        Worker.Open (Object);
    end Open;

    procedure Close (Object : Object_Id) is
    begin
        Worker.Close (Object);
    end Close;

    function Unique (Object : Object_Id) return Unique_Id is
    begin
        return Object.Unique;
    end Unique;

    function Value (Object : Object_Id) return Object_Pointer is
    begin
        if Is_Open (Object) then
            return Object.Value;
        else
            raise Not_Open;
        end if;
    end Value;

    procedure Init_Open (Iter : in out Iterator) is
    begin
        Worker.Init_Open (Iter);
    end Init_Open;

    procedure Init_Closed (Iter : in out Iterator) is
    begin
        Worker.Init_Closed (Iter);
    end Init_Closed;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter := Iterator (Iter.Hidden.Next);
    exception
        when others =>
            null;
    end Next;

    function Value (Iter : Iterator) return Object_Pointer is
    begin
        return Object_Pointer (Iter);
    end Value;

    function Done (Iter : Iterator) return Boolean is
    begin
        return Iter = null or else Iter.Hidden.Unique = Null_Unique_Id;
    end Done;

end Managed_Pool_Generic;