DataMuseum.dk

top - download

    Length: 5243 (0x147b)
    Types: TextFile
    Names: »B«

└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─ ⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦a5bbbb819⟧ 
                └─⟦this⟧ 
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦eec0a994f⟧ 
                └─⟦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 and then  
               Transport.Is_Connecting_Passive (Worker.Connection) then
                -- worker belongs to this pool, but isn't serving yet.
                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 Destroy (Pool : Pool_Id := null) do  
                    if Pool = null then  
                        Destroy_All;  
                    else  
                        Destroy_One (Pool);  
                    end if;  
                end Destroy;  
            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;