|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 15013 (0x3aa5)
Types: TextFile
Names: »B«
└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
└─⟦bb34fe6e2⟧ »DATA«
└─⟦15d8b76c6⟧
└─⟦this⟧
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;