DataMuseum.dk

top - download

    Length: 4214 (0x1076)
    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

with Transport_Server_Proc;

package body Transport_Server is

    type Pool_Type (Network_Length, Local_Socket_Length : Natural) is  
        record
            Servers : Natural := 0;  
            Max_Servers : Natural;  
            Network : Transport_Defs.Network_Name (1 .. Network_Length);  
            Local_Socket :  
               Transport_Defs.Socket_Id (1 .. Local_Socket_Length);  
            Next : Pool_Id;  
        end record;

    Pool_Is_Destroyed : exception;

    type Worker_Type;  
    type Worker_Id is access Worker_Type;

    task type Worker_Task is  
        entry Start (Id : Worker_Id);  
    end Worker_Task;

    type Worker_Type is  
        record
            Worker : Worker_Task;  
            Connection : Transport.Connection_Id;  
            Pool : Pool_Id;  
            Next : Worker_Id;  
        end record;

    task Mutex is  
        entry Create (Pool : out Pool_Id;  
                      Network : Transport_Defs.Network_Name;  
                      Local_Socket : Transport_Defs.Socket_Id;  
                      Max_Servers : Natural);  
        entry Destroy (Pool : Pool_Id := null);  
        entry Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural);  
        entry Start (Pool : Pool_Id);  
        entry Finish (Worker : Worker_Id);  
        entry Finalize (Abort_Servers : Boolean);  
    end Mutex;

    Min_Backoff : constant Duration := 0.1;  
    Max_Backoff : constant Duration := 5 * 60.0;

    procedure Do_Backoff (Backoff : in out Duration) is  
    begin  
        delay Backoff;  
        Backoff := 2 * Backoff;  
        if Backoff > Max_Backoff then  
            Backoff := Max_Backoff;  
        end if;  
    end Do_Backoff;

    task body Mutex is separate;

    function Create (Network : Transport_Defs.Network_Name;  
                     Local_Socket : Transport_Defs.Socket_Id;  
                     Max_Servers : Natural := Natural'Last) return Pool_Id is  
        Answer : Pool_Id;  
    begin  
        Mutex.Create (Answer, Network, Local_Socket, Max_Servers);  
        return Answer;  
    end Create;

    procedure Destroy (Pool : Pool_Id) is  
    begin  
        Mutex.Destroy (Pool);  
    end Destroy;

    procedure Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural) is  
    begin  
        Mutex.Set_Max_Servers (Pool, Max_Servers);  
    end Set_Max_Servers;

    function Network (Pool : Pool_Id) return Transport_Defs.Network_Name is  
    begin  
        return Pool.Network;  
    end Network;

    function Local_Socket (Pool : Pool_Id) return Transport_Defs.Socket_Id is  
    begin  
        return Pool.Local_Socket;  
    end Local_Socket;

    function Max_Servers (Pool : Pool_Id) return Natural is  
    begin  
        return Pool.Max_Servers;  
    end Max_Servers;

    function Servers (Pool : Pool_Id) return Natural is  
    begin  
        return Pool.Servers;  
    end Servers;

    procedure Finalize (Abort_Servers : Boolean := False) is  
    begin
        -- Mutex.Finalize (Abort_Servers); JMK 10/25/86 not for native code
        null;  
    end Finalize;

    procedure Serve (Pool : in out Pool_Id;  
                     Connection : Transport.Connection_Id) is  
    begin  
        if Pool.Max_Servers <= 0 then  
            raise Pool_Is_Destroyed;  
        end if;  
        Mutex.Start (Pool);  
        Serve (Connection);  
        if Pool.Max_Servers <= 0 then  
            raise Pool_Is_Destroyed;  
        end if;  
    end Serve;

    procedure Work is new Transport_Server_Proc (Pool_Id, Serve);

    task body Worker_Task is  
        Id : Worker_Id;  
    begin  
        loop  
            select  
                accept Start (Id : Worker_Id) do  
                    Worker_Task.Id := Start.Id;  
                end Start;  
            or  
                terminate;  
            end select;  
            begin  
                Work (Id.Pool, Id.Connection,  
                      Id.Pool.Network, Id.Pool.Local_Socket);  
            exception  
                when Pool_Is_Destroyed =>  
                    null;  
            end;  
            Mutex.Finish (Id);  
        end loop;  
    end Worker_Task;

end Transport_Server;