DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦820fd8bb9⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Transport_Server, seg_0009d7

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

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;  

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=23 rec1=00 rec2=01 rec3=034
        [0x01] rec0=1a rec1=00 rec2=02 rec3=04a
        [0x02] rec0=21 rec1=00 rec2=03 rec3=00c
        [0x03] rec0=21 rec1=00 rec2=04 rec3=020
        [0x04] rec0=0f rec1=00 rec2=05 rec3=000
    tail 0x207001b967bac64c1aaf1 0x42a00088462060003