DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦16ba2cfaa⟧ TextFile

    Length: 18425 (0x47f9)
    Types: TextFile
    Names: »B«

Derivation

└─⟦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 Machine; -- JMK 10/27/86

package body Transport_Stream is

    Buffer_Size : constant := 2 ** 10;

    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;  
            User_Id : Integer := 0;  
            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 Start;  
        entry Stop;  
        entry Finalize;  
    end Scavenger;

    task body Scavenger is  
        Running : Boolean := True;  
    begin  
        loop  
            if Running then  
                select  
                    accept Start do  
                        Running := True;  
                    end Start;  
                or  
                    accept Stop do  
                        Running := False;  
                    end Stop;  
                or  
                    accept Finalize;  
                    exit;  
                or  
                    delay 30.0;  
                    Scavenge;  
                end select;  
            else  
                select  
                    accept Start do  
                        Running := True;  
                    end Start;  
                or  
                    accept Stop do  
                        Running := False;  
                    end Stop;  
                or  
                    accept Finalize;  
                    exit;  
                or  
                    terminate;  
                end select;  
            end if;  
        end loop;  
    end Scavenger;

    procedure Finalize is  
    begin
        -- JMK 10/24/86 Not useful for shared elaboration.
        null;
        -- 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;  
        Retries : constant Natural := 2;    -- JMK 5/7/87
        Backoff : constant Duration := 5.0; -- JMK 5/7/87
    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);  
            Stream.Stream.User_Id := 0; -- JMK 10/24/86
            if Transport.Is_Open (Connection) then  
                Transport.Disconnect (Connection);  
            else  
                Transport.Close (Connection);  
                Transport.Open (Connection, Status, Network);  
                Check_Ok (Status);  
            end if;  
            for Retry in 0 .. Retries loop
                -- JMK 5/7/87  If the remote machine refuses the connection,
                -- perhaps that is because it is in the process of starting
                -- a server task or job.  Give it a little time to do this.
                Transport.Connect (Connection, Status, Host, Socket);  
                exit when Transport_Defs."/="  
                             (Status, Transport_Defs.Connection_Refused);  
                delay Backoff;  
            end loop;  
            Check_Ok (Status);  
        end if;  
        Transport.Set_Owner -- JMK 10/27/86
           (Connection, Machine.Get_Job_Id (Machine.Get_Task_Id));  
    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 Disconnect_Now (Stream : Stream_Id) is
        -- JMK 2/13/87
    begin  
        if not Is_Null (Stream) then  
            Worker.Disconnect (Stream);  
        end if;  
    exception  
        when others =>  
            Stream.Stream.Unique := Null_Unique_Id;  
            Transport.Disconnect (Stream.Stream.Connection); -- JMK 2/13/87
            Transport.Close (Stream.Stream.Connection);  
    end Disconnect_Now;

    procedure Disconnect (Stream : Stream_Id) is  
    begin  
        begin  
            Flush_Transmit_Buffer (Stream); -- JMK 2/13/87
        exception  
            when others =>  
                null;  
        end;  
        Disconnect_Now (Stream);  
    end Disconnect;

    procedure Deallocate (Stream : Stream_Id) is  
    begin  
        begin  
            Flush_Transmit_Buffer (Stream); -- JMK 2/13/87
        exception  
            when others =>  
                null;  
        end;  
        if not Is_Null (Stream) then  
            Worker.Deallocate (Stream);  
        end if;  
    exception  
        when Tasking_Error =>  
            Disconnect_Now (Stream); -- JMK 2/13/87
    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 Set_User_Id (Stream : Stream_Id; User_Id : Integer := 0) is  
    begin  
        Check_Non_Null (Stream);  
        Stream.Stream.User_Id := User_Id;  
    end Set_User_Id;

    function Get_User_Id (Stream : Stream_Id) return Integer is  
    begin  
        Check_Non_Null (Stream);  
        return Stream.Stream.User_Id;  
    end Get_User_Id;

    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_Now (Stream); -- JMK 2/13/87
            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;