|
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 - downloadIndex: ┃ B T ┃
Length: 18425 (0x47f9)
Types: TextFile
Names: »B«
└─⟦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⟧
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;