DataMuseum.dk

top - download

    Length: 4521 (0x11a9)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─ ⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦this⟧ 

TextFile

separate (Transport_Server)
task body Mutex is

    All_Pools : Pool_Id := null;

    subtype Worker_List is Worker_Id;

    Busy_List : Worker_List := null;
    Idle_List : Worker_List := null;

    Finisher : Worker_Id;

    procedure Do_Abort (Worker : Worker_Id) is
    begin
        begin
            abort Worker.Worker;
        exception
            when others =>
                null;
        end;
        Transport.Close (Worker.Connection);
    end Do_Abort;

    procedure Do_Abort_List (List : in out Worker_List) is
    begin
        while List /= null loop
            Do_Abort (List);
            List := List.Next;
        end loop;
    end Do_Abort_List;

    procedure Destroy_One (Pool : Pool_Id) is
        Worker : Worker_Id := Busy_List;
    begin
        Pool.Max_Servers := 0;
        while Worker /= null loop
            if Worker.Pool = Pool then
                Do_Abort (Worker);
            end if;
            Worker := Worker.Next;
        end loop;
    end Destroy_One;

    procedure Destroy_All is
        Pool : Pool_Id := All_Pools;
    begin
        while Pool /= null loop
            Destroy_One (Pool);
            Pool := Pool.Next;
        end loop;
    end Destroy_All;

    procedure Start_Worker (Pool : Pool_Id) is
        Worker : Worker_Id;
    begin
        if Pool.Servers < Pool.Max_Servers then
            if Idle_List = null then
                Worker := new Worker_Type;
            else
                Worker := Idle_List;
                Idle_List := Idle_List.Next;
            end if;
            Worker.Next := Busy_List;
            Worker.Pool := Pool;
            Worker.Worker.Start (Worker);
            Busy_List := Worker;
            Pool.Servers := Pool.Servers + 1;
        end if;
    end Start_Worker;

    procedure Finish_Worker (Worker : Worker_Id) is
        Pool : constant Pool_Id := Worker.Pool;
    begin
        -- extract Worker from Busy_List:
        if Busy_List = Worker then
            Busy_List := Busy_List.Next;
        else
            declare
                Prev : Worker_Id := Busy_List;
            begin
                while Prev.Next /= Worker loop
                    Prev := Prev.Next;
                end loop;
                Prev.Next := Prev.Next.Next;
            end;
        end if;

        Worker.Next := Idle_List;
        Worker.Pool := null;
        Transport.Close (Worker.Connection);
        Idle_List := Worker;
        Pool.Servers := Pool.Servers - 1;
        if Pool.Servers = 0 then
            Start_Worker (Pool);
        end if;
    end Finish_Worker;

begin
    loop
        begin
            select
                accept Create (Pool : out Pool_Id;
                               Network : Transport_Defs.Network_Name;
                               Local_Socket : Transport_Defs.Socket_Id;
                               Max_Servers : Natural) do
                    declare
                        New_Pool : Pool_Id :=
                           new Pool_Type (Network'Length, Local_Socket'Length);
                    begin
                        New_Pool.Network := Network;
                        New_Pool.Local_Socket := Local_Socket;
                        New_Pool.Max_Servers := Max_Servers;
                        New_Pool.Servers := 0;
                        New_Pool.Next := All_Pools;
                        Start_Worker (New_Pool);
                        All_Pools := New_Pool;
                        Pool := New_Pool;
                    end;
                end Create;
            or
                accept Set_Max_Servers (Pool : Pool_Id;
                                        Max_Servers : Natural) do
                    Pool.Max_Servers := Max_Servers;
                end Set_Max_Servers;
            or
                accept Start (Pool : Pool_Id) do
                    Start_Worker (Pool);
                end Start;
            or
                accept Finish (Worker : Worker_Id) do
                    Finisher := Worker;
                end Finish;
                Finish_Worker (Finisher);
            or
                accept Finalize (Abort_Servers : Boolean) do
                    if Abort_Servers then
                        Do_Abort_List (Busy_List);
                    end if;
                    Do_Abort_List (Idle_List);
                    Destroy_All;
                end Finalize;
                exit;
            end select;
        exception
            when others =>
                null;
        end;
    end loop;
end Mutex;