DataMuseum.dk

top - download

    Length: 13282 (0x33e2)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

WITH Pragma_Assert;
WITH Text_Io;
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
                     Text_Io.Put_Line ("transport_stream: loop in");
                     Transport.Receive (Connection, Status,
                                        Buf.Data, Buf.Count, 0.2);
                     Text_Io.Put_Line ("transport_stream: loop out");
                     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;