DataMuseum.dk

top - download

    Length: 4122 (0x101a)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─ ⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦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 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
        -- Ignore the Max_Servers parameter due to blocking I/O on target
        -- Mutex.Create (Answer, Network, Local_Socket, Max_Servers);

        Mutex.Create (Answer, Network, Local_Socket, 1);
        return Answer;
    end Create;

    procedure Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural) is
    begin
        --  Ignore Max_Servers parameter due to blocking I/O on the target
        --  Mutex.Set_Max_Servers (Pool, Max_Servers);
        Mutex.Set_Max_Servers (Pool, 1);
    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;