|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 19456 (0x4c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_00b2f2
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
WITH Pragma_Assert;
PACKAGE BODY Transport_Stream IS
Null_Socket_Id : CONSTANT Transport_Defs.Socket_Id :=
Transport_Defs.Null_Socket_Id;
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);
Pragma_Assert.Check (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);
Pragma_Assert.Check (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);
Pragma_Assert.Check (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;
nblk1=12
nid=0
hdr6=24
[0x00] rec0=23 rec1=00 rec2=01 rec3=008
[0x01] rec0=18 rec1=00 rec2=02 rec3=048
[0x02] rec0=21 rec1=00 rec2=03 rec3=02c
[0x03] rec0=2f rec1=00 rec2=04 rec3=062
[0x04] rec0=1e rec1=00 rec2=05 rec3=026
[0x05] rec0=01 rec1=00 rec2=12 rec3=024
[0x06] rec0=1d rec1=00 rec2=06 rec3=01c
[0x07] rec0=1e rec1=00 rec2=07 rec3=01e
[0x08] rec0=21 rec1=00 rec2=08 rec3=02c
[0x09] rec0=1f rec1=00 rec2=09 rec3=010
[0x0a] rec0=00 rec1=00 rec2=11 rec3=008
[0x0b] rec0=1b rec1=00 rec2=0a rec3=018
[0x0c] rec0=01 rec1=00 rec2=10 rec3=000
[0x0d] rec0=18 rec1=00 rec2=0b rec3=02c
[0x0e] rec0=01 rec1=00 rec2=0f rec3=016
[0x0f] rec0=18 rec1=00 rec2=0c rec3=00a
[0x10] rec0=1f rec1=00 rec2=0d rec3=016
[0x11] rec0=18 rec1=00 rec2=0e rec3=000
tail 0x21708296c81fa63b0805d 0x489e0066482863c01