⟦462a1486c⟧

TextFile

package body Transport_Stream is

    Buffer_Size : constant := 2 ** 10;

    Null_Socket_Id : constant Transport_Defs.Socket_Id :=
       Transport_Defs.Null_Socket_Id;

    subtype Data_Count is Natural range 0 .. Buffer_Size;

    subtype Data_Index is Data_Count range 0 .. Data_Count'Last - 1;

    type Buffer_Type is
        record
            First : Data_Index;
            Count : Data_Count;
            Data : Byte_Defs.Byte_String (Data_Index'First .. Data_Index'Last);
        end record;

    type Pool_Type (Network_Length : Natural;
                    Remote_Host_Length : Natural;
                    Remote_Socket_Length : Natural;
                    Local_Socket_Length : Natural) is
        record
            Next : Pool_List;
            Idle : Stream_List;
            Network : Transport_Defs.Network_Name (1 .. Network_Length);
            Remote_Host : Transport_Defs.Host_Id (1 .. Remote_Host_Length);
            Remote_Socket : Transport_Defs.Socket_Id
                               (1 .. Remote_Socket_Length);
            Local_Socket : Transport_Defs.Socket_Id (1 .. Local_Socket_Length);
        end record;

    type Stream_Type is
        record
            Next : Stream_List := null;
            Pool : Pool_Id := null;
            Unique : Unique_Id := Null_Unique_Id;
            Referenced : Boolean := False;
            Connection : Transport.Connection_Id;
            Transmit, Receive : Buffer_Type;
        end record;

    function Is_Null (Stream : Stream_Id) return Boolean is
    begin
        return Stream.Stream = null or else
                  Stream.Unique /= Stream.Stream.Unique;
    end Is_Null;

    procedure Check_Non_Null (Stream : Stream_Id) is
    begin
        if Is_Null (Stream) then
            raise Not_Connected;
        end if;
    end Check_Non_Null;

    procedure Initialize (Buffer : out Buffer_Type) is
    begin
        Buffer.First := Buffer.Data'First;
        Buffer.Count := 0;
    end Initialize;

    function Equals (X, Y : Transport_Defs.Network_Name) return Boolean is
    begin
        return Transport_Defs."=" (Transport_Defs.Normalize (X),
                                   Transport_Defs.Normalize (Y));
    end Equals;

    function Equals (X, Y : Transport_Defs.Host_Id) return Boolean is
    begin
        return Transport_Defs."=" (Transport_Defs.Normalize (X),
                                   Transport_Defs.Normalize (Y));
    end Equals;

    function Equals (X, Y : Transport_Defs.Socket_Id) return Boolean is
    begin
        return Transport_Defs."=" (Transport_Defs.Normalize (X),
                                   Transport_Defs.Normalize (Y));
    end Equals;

    task Worker is

        entry Create (Pool : out Pool_Id;
                      Network : Transport_Defs.Network_Name;
                      Remote_Host : Transport_Defs.Host_Id;
                      Remote_Socket : Transport_Defs.Socket_Id;
                      Local_Socket : Transport_Defs.Socket_Id);

        entry Allocate (Stream : out Stream_Id);

        entry Allocate (Stream : out Stream_Id; Pool : Pool_Id);

        entry Allocate (Stream : out Stream_Id;
                        Network : Transport_Defs.Network_Name;
                        Remote_Host : Transport_Defs.Host_Id;
                        Remote_Socket : Transport_Defs.Socket_Id);

        entry Deallocate (Stream : Stream_Id);

        entry Disconnect (Stream : Stream_Id);

        entry Scavenge (Pool : Pool_Id := null);

        entry Destroy (Pool : Pool_Id := null);

        entry Finalize;

    end Worker;

    function Create (Network : Transport_Defs.Network_Name;
                     Remote_Host : Transport_Defs.Host_Id;
                     Remote_Socket : Transport_Defs.Socket_Id;
                     Local_Socket : Transport_Defs.Socket_Id :=
                        Transport_Defs.Null_Socket_Id) return Pool_Id is
        Pool : Pool_Id;
    begin
        Worker.Create (Pool, Network, Remote_Host, Remote_Socket, Local_Socket);
        return Pool;
    end Create;

    procedure Scavenge (Pool : Pool_Id) is
    begin
        Worker.Scavenge (Pool);
    end Scavenge;

    procedure Scavenge is
    begin
        Worker.Scavenge;
    end Scavenge;

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

    task Scavenger is
        entry Finalize;
    end Scavenger;

    task body Scavenger is
    begin
        loop
            select
                accept Finalize;
                exit;
            or
                terminate;
            end select;
            Scavenge;
        end loop;
    end Scavenger;

    procedure Finalize is
    begin
        begin
            Worker.Finalize;
        exception
            when Tasking_Error =>
                null;
        end;

        begin
            Scavenger.Finalize;
        exception
            when Tasking_Error =>
                null;
        end;
    end Finalize;

    procedure Allocate (Stream : out Stream_Id;
                        Connection : Transport.Connection_Id) is
        The_Stream : Stream_Id;
    begin
        Worker.Allocate (The_Stream);
        The_Stream.Stream.Connection := Connection;
        Stream := The_Stream;
    exception
        when Tasking_Error =>
            raise Not_Connected;
    end Allocate;

    procedure Check_Ok (Status : Transport_Defs.Status_Code) is
    begin
        case Status is
            when Transport_Defs.Ok =>
                null;
            when others =>
                raise Not_Connected;
        end case;
    end Check_Ok;

    procedure Get_Connected (Stream : Stream_Id;
                             Is_New : out Boolean;
                             Network : Transport_Defs.Network_Name;
                             Host : Transport_Defs.Host_Id;
                             Socket : Transport_Defs.Socket_Id) is
        Connection : Transport.Connection_Id renames Stream.Stream.Connection;
        Status : Transport_Defs.Status_Code;
    begin
        Check_Non_Null (Stream);

        if Transport.Is_Connected (Connection) then
            Is_New := False;
        else
            Is_New := True;
            Initialize (Stream.Stream.Transmit);
            Initialize (Stream.Stream.Receive);

            if Transport.Is_Open (Connection) then
                Transport.Disconnect (Connection);
            else
                Transport.Close (Connection);
                Transport.Open (Connection, Status, Network);
                Check_Ok (Status);
            end if;

            Transport.Connect (Connection, Status, Host, Socket);
            Check_Ok (Status);
        end if;
    end Get_Connected;

    procedure Allocate (Stream : out Stream_Id;
                        Pool : Pool_Id;
                        Is_New : out Boolean) is
        The_Stream : Stream_Id;
    begin
        Worker.Allocate (The_Stream, Pool);
        Stream := The_Stream;
        Get_Connected (The_Stream, Is_New, Pool.Network,
                       Pool.Remote_Host, Pool.Remote_Socket);
    exception
        when Not_Connected | Tasking_Error =>
            Disconnect (The_Stream);
            raise Not_Connected;
    end Allocate;

    procedure Allocate (Stream : out Stream_Id;
                        Is_New : out Boolean;
                        Network : Transport_Defs.Network_Name;
                        Host : Transport_Defs.Host_Id;
                        Socket : Transport_Defs.Socket_Id) is
        The_Stream : Stream_Id;
    begin
        Worker.Allocate (The_Stream, Network, Host, Socket);
        Stream := The_Stream;
        Get_Connected (The_Stream, Is_New, Network, Host, Socket);
    exception
        when Not_Connected | Tasking_Error =>
            Disconnect (The_Stream);
            raise Not_Connected;
    end Allocate;

    procedure Deallocate (Stream : Stream_Id) is
    begin
        if not Is_Null (Stream) then
            Worker.Deallocate (Stream);
        end if;
    exception
        when Tasking_Error =>
            Disconnect (Stream);
    end Deallocate;

    function Connection (Stream : Stream_Id) return Transport.Connection_Id is
    begin
        Check_Non_Null (Stream);
        return Stream.Stream.Connection;
    end Connection;

    function Unique (Stream : Stream_Id) return Unique_Id is
    begin
        return Stream.Unique;
    end Unique;

    procedure Disconnect (Stream : Stream_Id) is
    begin
        if not Is_Null (Stream) then
            Worker.Disconnect (Stream);
        end if;
    exception
        when Tasking_Error =>
            Stream.Stream.Unique := Null_Unique_Id;
            Transport.Close (Stream.Stream.Connection);
    end Disconnect;

    procedure Check (Status : Transport_Defs.Status_Code) is
    begin
        case Status is
            when Transport_Defs.Ok | Transport_Defs.Timed_Out =>
                null;
            when others =>
                raise Not_Connected;
        end case;
    end Check;

    procedure Transmit (Connection : Transport.Connection_Id;
                        Data : Byte_Defs.Byte_String;
                        More : Boolean := False) is
        Status : Transport_Defs.Status_Code;
        Count : Natural;
        Total : Natural := 0;
    begin
        loop
            Transport.Transmit (Connection, Status,
                                Data (Data'First + Total .. Data'Last), Count,
                                More => More);
            Total := Total + Count;
            exit when Total >= Data'Length;
            Check (Status);
        end loop;
    end Transmit;

    procedure Receive (Connection : Transport.Connection_Id;
                       Data : out Byte_Defs.Byte_String) is
        Status : Transport_Defs.Status_Code;
        Count : Natural;
        Total : Natural := 0;
    begin
        loop
            Transport.Receive (Connection, Status,
                               Data (Data'First + Total .. Data'Last), Count);
            Total := Total + Count;
            exit when Total >= Data'Length;
            Check (Status);
        end loop;
    end Receive;

    procedure Transmit (Into : Stream_Id; Data : Byte_Defs.Byte_String) is
    begin
        Check_Non_Null (Into);

        if Data'Length > 0 then
            declare
                Buf : Buffer_Type renames Into.Stream.Transmit;
                Connection : Transport.Connection_Id
                    renames Into.Stream.Connection;
            begin
                pragma Assert (Buf.First = Data_Index'First);

                if Buf.Count + Data'Length < Data_Count'Last then
                    Buf.Data (Buf.First + Buf.Count ..
                                 Buf.First + Buf.Count + Data'Length - 1) :=
                       Data;
                    Buf.Count := Buf.Count + Data'Length;
                else
                    Transmit (Connection,
                              Buf.Data (Buf.First ..
                                           Buf.First + Buf.Count - 1));
                    Transmit (Connection, Data);
                    Buf.Count := 0;
                end if;
            end;
        end if;
    exception
        when Not_Connected =>
            Disconnect (Into);
            raise;
    end Transmit;

    procedure Receive (From : Stream_Id; Data : out Byte_Defs.Byte_String) is
    begin
        Check_Non_Null (From);

        if Data'Length > 0 then
            -- If its <= 0, then we're done.  Receiving 0 bytes is easy.
            declare
                Buf : Buffer_Type renames From.Stream.Receive;
                Connection : Transport.Connection_Id
                    renames From.Stream.Connection;
                Status : Transport_Defs.Status_Code;
            begin
                if Buf.Count = 0 then
                    -- nothing at all in the buffer.
                    pragma Assert (Buf.First = Buf.Data'First);

                    if Data'Length >= Buf.Data'Length then
                        -- bypass the buffer: receive right into Data.
                        Receive (Connection, Data);
                        return;
                    else
                        -- wait for some data (any data) to arrive.
                        loop
                            Transport.Receive (Connection, Status,
                                               Buf.Data, Buf.Count);
                            exit when Buf.Count > 0;
                            Check (Status);
                        end loop;
                    end if;
                end if;

                pragma Assert (Buf.First + Buf.Count - 1 <= Data_Index'Last);

                if Buf.Count >= Data'Length then
                    -- All the data we need are in the buffer.
                    Data := Buf.Data (Buf.First .. Buf.First + Data'Length - 1);
                    Buf.Count := Buf.Count - Data'Length;

                    if Buf.Count = 0 then
                        Buf.First := Data_Index'First;
                    else
                        Buf.First := Buf.First + Data'Length;
                    end if;
                else
                    -- Clean out the buffer:
                    Data (Data'First .. Data'First + Buf.Count - 1) :=
                       Buf.Data (Buf.First .. Buf.First + Buf.Count - 1);
                    -- Receive the rest of the data straight into Data:
                    Receive (Connection,
                             Data (Data'First + Buf.Count .. Data'Last));
                    Buf.First := Buf.Data'First;
                    Buf.Count := 0;
                end if;
            end;
        end if;
    exception
        when Not_Connected =>
            Disconnect (From);
            raise;
    end Receive;

    procedure Flush_Transmit_Buffer (Stream : Stream_Id) is
    begin
        Check_Non_Null (Stream);

        declare
            Buf : Buffer_Type renames Stream.Stream.Transmit;
        begin
            Transmit (Stream.Stream.Connection,
                      Buf.Data (Buf.Data'First ..
                                   Buf.Data'First + Buf.Count - 1),
                      More => False);
            Buf.Count := 0;
        end;
    exception
        when Not_Connected =>
            Disconnect (Stream);
            raise;
    end Flush_Transmit_Buffer;

    function Flush_Receive_Buffer (Stream : Stream_Id)
                                  return Byte_Defs.Byte_String is
    begin
        Check_Non_Null (Stream);

        declare
            Buf : Buffer_Type renames Stream.Stream.Receive;
            Answer : constant Byte_Defs.Byte_String :=
               Buf.Data (Buf.First .. Buf.First + Buf.Count - 1);
        begin
            Buf.First := Buf.Data'First;
            Buf.Count := 0;
            return Answer;
        end;
    exception
        when Not_Connected =>
            Disconnect (Stream);
            raise;
    end Flush_Receive_Buffer;

    task body Worker is separate;
end Transport_Stream;
DataMuseum.dk

Rational R1000/400 Tapes

⟦462a1486c⟧ TextFile

Derivation

TextFile
