DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

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

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦74bdb9306⟧ Ada Source

    Length: 33792 (0x8400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_021828

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



WITH Byte_Defs;
WITH Socket_System_Interface;
WITH System;
WITH System_Interface;
WITH Transport_Defs;
WITH Unchecked_Conversion;
WITH Unix_Base_Types;
PACKAGE BODY Transport IS

   Unix_Error : CONSTANT Unix_Base_Types.Int := -1;


   TYPE Process_Kind IS (Nul, Server, Client);


   TYPE Socket_Status_Kind IS (Open, Connected, Not_Connected, Closed);
   -- For Servers:
   --   Open implies that the passive socket is Open, Bound and Listening.
   --   Connected means that the _accept call has completed and a
   --      connection with a remote (active) socket has been established.
   -- For Clients:
   --   Open implies that the local _socket call has completed successfully.
   --   Connected implies that the _connect call has completed successfully
   --      and that an active connection to the specified remote socket
   --      has been established.
   -- For both Servers and Clients:
   --   Not_Connected implies that the Connection is still open after a
   --      transmit or receive failure.  The socket should be Closed and then
   --      reopened.  You CANNOT simply reconnect a socket that is
   --      Not_Connected.
   --


   -- Private type completion
   TYPE Connection_Info IS
      RECORD
         Kind                    : Process_Kind        := Nul;
         Socket_Status           : Socket_Status_Kind  := Closed;
         Local_Socket_Descriptor : Unix_Base_Types.Int := Unix_Error;
         Tcp_Socket_Descriptor   : Unix_Base_Types.Int := Unix_Error;
         Local_Sockaddr_In       : Socket_System_Interface.Sockaddr_In;
         Remote_Sockaddr_In      : Socket_System_Interface.Sockaddr_In;
         Next                    : Connection_Id       := NULL;
      END RECORD;


   Free_List : Connection_Id := NULL;


   FUNCTION ">" (L, R : Byte_Defs.Byte) RETURN Boolean RENAMES Byte_Defs.">";

   FUNCTION "-" (L, R : Byte_Defs.Byte) RETURN Byte_Defs.Byte
       RENAMES Byte_Defs."-";


   FUNCTION "=" (Left  : Transport_Defs.Status_Code;
                 Right : Transport_Defs.Status_Code)  
                RETURN Boolean RENAMES Transport_Defs."=";


   FUNCTION "=" (Left  : Transport_Defs.Socket_Id;
                 Right : Transport_Defs.Socket_Id)  
                RETURN Boolean RENAMES Transport_Defs."=";


   FUNCTION To_Sockaddr_In IS  
      NEW Unchecked_Conversion (Source => Socket_System_Interface.Sockaddr,
                                Target => Socket_System_Interface.Sockaddr_In);


   FUNCTION To_Sockaddr IS  
      NEW Unchecked_Conversion (Source => Socket_System_Interface.Sockaddr_In,
                                Target => Socket_System_Interface.Sockaddr);


   FUNCTION To_Sockaddr_In_Ptr IS  
      NEW Unchecked_Conversion
             (Source => System.Address,
              Target => Socket_System_Interface.Sockaddr_In_Ptr);


   FUNCTION To_Sockaddr_Ptr IS  
      NEW Unchecked_Conversion
             (Source => System.Address,
              Target => Socket_System_Interface.Sockaddr_Ptr);


   FUNCTION To_Int_Ptr IS  
      NEW Unchecked_Conversion (Source => System.Address,
                                Target => Socket_System_Interface.Int_Ptr);


   FUNCTION Get RETURN Connection_Id IS SEPARATE;

   PROCEDURE Free (Connection : Connection_Id) IS SEPARATE;

   PROCEDURE Start_System_Call IS SEPARATE;

   FUNCTION Finish_System_Call RETURN Unix_Base_Types.Int IS SEPARATE;

   FUNCTION Convert_Errno (Errno : Unix_Base_Types.Int)
                          RETURN Transport_Defs.Status_Code IS SEPARATE;


   FUNCTION Byte_String_To_Integer (Bs : Byte_Defs.Byte_String)
                                   RETURN Unix_Base_Types.Int IS SEPARATE;


   PROCEDURE Open_Server (Connection   : OUT Transport.Connection_Id;
                          Status       : OUT Transport_Defs.Status_Code;
                          Network      : IN  Transport_Defs.Network_Name;
                          Local_Socket : IN  Transport_Defs.
                                               Socket_Id) IS SEPARATE;


   PROCEDURE Open_Client (Connection : OUT Transport.Connection_Id;
                          Status     : OUT Transport_Defs.Status_Code;
                          Network    : IN  Transport_Defs.
                                             Network_Name) IS SEPARATE;


   --
   -- Spec level routines
   --
   PROCEDURE Open (Connection   : OUT Transport.Connection_Id;
                   Status       : OUT Transport_Defs.Status_Code;
                   Network      :     Transport_Defs.Network_Name;
                   Local_Socket :     Transport_Defs.Socket_Id :=
                      Transport_Defs.Null_Socket_Id) IS

      -- IT IS ASSUMED THAT Server TASK WILL BE STARTED ON A KNOWN LOCAL
      -- SOCKET.  Client TASKS WON'T CARE WHAT LOCAL_SOCKET THEY START ON
      -- AND WILL CALL OPEN WITH Local_Socket =
      -- Transport_Defs.Null_Socket_Id.
      --
      Is_Server : CONSTANT Boolean :=
         Local_Socket /= Transport_Defs.Null_Socket_Id;

   BEGIN
      IF Is_Server THEN
         Open_Server (Connection   => Connection,
                      Status       => Status,
                      Network      => Network,
                      Local_Socket => Local_Socket);
      ELSE
         Open_Client (Connection => Connection,
                      Status     => Status,
                      Network    => Network);
      END IF;
   END Open;


   PROCEDURE Close (Connection : Transport.Connection_Id) IS
      Temp_Connect       : Transport.Connection_Id := Connection;
      System_Call_Result : Unix_Base_Types.Int;
   BEGIN

      IF Connection = Null_Connection_Id THEN
         RETURN;
      END IF;

      IF Temp_Connect.Socket_Status = Connected THEN
         Transport.Disconnect (Connection => Temp_Connect);
      END IF;


      IF Temp_Connect.Socket_Status = Open OR
         Temp_Connect.Socket_Status = Not_Connected THEN

         System_Call_Result :=  
            Socket_System_Interface.Shutdown
               (S => Temp_Connect.Local_Socket_Descriptor, How => 2);

         System_Call_Result :=  
            System_Interface.File_Io.Close
               (Fildes => Temp_Connect.Local_Socket_Descriptor);

         IF System_Call_Result < 0 THEN
            RAISE Program_Error;
         ELSE
            Temp_Connect.Local_Socket_Descriptor := Unix_Error;
            Temp_Connect.Socket_Status           := Closed;
         END IF;

      END IF;

   END Close;


   PROCEDURE Connect (Connection    :     Transport.Connection_Id;
                      Status        : OUT Transport_Defs.Status_Code;
                      Remote_Host   :     Transport_Defs.Host_Id;
                      Remote_Socket :     Transport_Defs.Socket_Id;
                      Max_Wait      :     Duration := Duration'Last) IS
      --
      Laddr_In : Socket_System_Interface.Sockaddr_In :=
         (Sin_Family => Socket_System_Interface.Af_Inet,
          Sin_Port => Unix_Base_Types.Ushort
                         (Byte_String_To_Integer
                             (Byte_Defs.Byte_String  
                                 (Transport_Defs.Normalize (Remote_Socket)))),  
          Sin_Addr => Unix_Base_Types.U_Long
                         (Byte_String_To_Integer
                             (Byte_Defs.Byte_String
                                 (Transport_Defs.Normalize (Remote_Host)))),
          Sin_Zero => (OTHERS => Ascii.Nul));

      Laddrlen : Unix_Base_Types.Int := Laddr_In'Size / System.Storage_Unit;

      Laddr_In_Ptr : Socket_System_Interface.Sockaddr_In_Ptr :=
         To_Sockaddr_In_Ptr (Laddr_In'Address);


      Temp_Connection    : Connection_Id := Connection;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int;


   BEGIN
      IF Temp_Connection = Null_Connection_Id OR ELSE
         Temp_Connection.Socket_Status /= Open THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      ELSIF Temp_Connection.Socket_Status = Not_Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Status := Transport_Defs.Ok;

      Start_System_Call;

      System_Call_Result := Socket_System_Interface.Connect
                               (S => Temp_Connection.Local_Socket_Descriptor,
                                Addr => Laddr_In_Ptr,
                                Addrlen => Laddrlen);

      Errno := Finish_System_Call;

      IF (System_Call_Result < 0) THEN
         Status := Convert_Errno (Errno => Errno);
         RETURN;
      END IF;

      Temp_Connection.Socket_Status     := Connected;
      Temp_Connection.Local_Sockaddr_In := Laddr_In;


   END Connect;


   --
   -- Form a passive connection.  This connection must be formed by a
   -- Server.  It waits for a remote connection from an active Client.
   --
   PROCEDURE Connect (Connection :     Transport.Connection_Id;
                      Status     : OUT Transport_Defs.Status_Code;
                      Max_Wait   :     Duration := Duration'Last) IS

      Temp_Connection : Connection_Id := Connection;

      Laddr : Socket_System_Interface.Sockaddr;

      Laddr_Ptr : Socket_System_Interface.Sockaddr_Ptr :=
         To_Sockaddr_Ptr (Laddr'Address);

      Laddrlen : Unix_Base_Types.Int :=
         Temp_Connection.Local_Sockaddr_In'Size / System.Storage_Unit;

      Laddrlen_Ptr : Socket_System_Interface.Int_Ptr :=
         To_Int_Ptr (Laddrlen'Address);

      Tcp_Connection : Unix_Base_Types.Int;
      Errno          : Unix_Base_Types.Int;

   BEGIN

      IF Temp_Connection = Null_Connection_Id OR ELSE
         Temp_Connection.Socket_Status = Closed THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      ELSIF Temp_Connection.Socket_Status = Not_Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Accept_Loop:
         LOOP
            Status := Transport_Defs.Ok;

            Start_System_Call;

            Tcp_Connection :=  
               Socket_System_Interface.Saccept
                  (S       => Temp_Connection.Local_Socket_Descriptor,
                   Addr    => Laddr_Ptr,
                   Addrlen => Laddrlen_Ptr);

            Errno := Finish_System_Call;

            IF (Tcp_Connection < 0) THEN
               Status := Convert_Errno (Errno => Errno);
               IF Errno /= System_Interface.Error.Eintr THEN
                  RETURN;  
               END IF;  
            ELSE
               EXIT Accept_Loop;
            END IF;
         END LOOP Accept_Loop;

      Temp_Connection.Socket_Status         := Connected;
      Temp_Connection.Tcp_Socket_Descriptor := Tcp_Connection;
      Temp_Connection.Remote_Sockaddr_In    := To_Sockaddr_In (Laddr_Ptr.ALL);

   END Connect;



   PROCEDURE Disconnect (Connection : Transport.Connection_Id) IS

      Temp_Connect       : Transport.Connection_Id := Connection;
      System_Call_Result : Unix_Base_Types.Int;
      File_Descriptor    : Unix_Base_Types.Int;

   BEGIN
      IF Temp_Connect = Null_Connection_Id OR ELSE
         Temp_Connect.Socket_Status /= Connected THEN
         RETURN;
      END IF;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      IF Temp_Connect.Kind = Client THEN
         System_Call_Result :=  
            Socket_System_Interface.Shutdown (S => File_Descriptor, How => 2);
      END IF;

      System_Call_Result :=  
         System_Interface.File_Io.Close (Fildes => File_Descriptor);

      IF System_Call_Result < 0 THEN
         RAISE Program_Error;
      ELSE

         IF Temp_Connect.Kind = Server THEN  
            Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
            Temp_Connect.Socket_Status         := Open;
         ELSE
            Temp_Connect.Local_Socket_Descriptor := Unix_Error;
            Temp_Connect.Socket_Status           := Closed;
         END IF;

      END IF;
   END Disconnect;


   FUNCTION Is_Open (Connection : Transport.Connection_Id) RETURN Boolean IS
   BEGIN
      IF Connection = Null_Connection_Id THEN
         RETURN False;
      END IF;


      CASE Connection.Kind IS
         WHEN Server | Client =>
            RETURN (Connection.Socket_Status = Open) OR
                      (Connection.Socket_Status = Not_Connected);
         WHEN OTHERS =>
            RETURN False;
      END CASE;
   END Is_Open;


   FUNCTION Is_Connected
               (Connection : Transport.Connection_Id) RETURN Boolean IS
   BEGIN
      IF Connection = Null_Connection_Id THEN
         RETURN False;
      END IF;


      CASE Connection.Kind IS
         WHEN Server | Client =>
            RETURN Connection.Socket_Status = Connected;
         WHEN OTHERS =>
            RETURN False;
      END CASE;
   END Is_Connected;



   PROCEDURE Transmit (Connection :     Transport.Connection_Id;
                       Status     : OUT Transport_Defs.Status_Code;
                       Data       :     Byte_Defs.Byte_String;
                       Count      : OUT Natural;
                       Max_Wait   :     Duration := Duration'Last;
                       More       :     Boolean  := False) IS

      File_Descriptor    : Unix_Base_Types.Int;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int;
      Temp_Connect       : Transport.Connection_Id := Connection;
      Amount_Remaining   : Natural                 := Data'Length;
      Index              : Natural                 := Data'First;
      Lcount             : Natural                 := 0;

   BEGIN

      Count := 0;

      IF Temp_Connect = Null_Connection_Id THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      END IF;

      IF Temp_Connect.Socket_Status /= Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Status := Transport_Defs.Ok;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      Transmit_Loop:
         WHILE Amount_Remaining > 0 LOOP

            Start_System_Call;

            System_Call_Result :=  
               System_Interface.File_Io.Write
                  (Fildes => File_Descriptor,
                   Buf => Unix_Base_Types.To_Char_Ptr (Data (Index)'Address),
                   Nbyte => Amount_Remaining);

            Errno := Finish_System_Call;

            IF (System_Call_Result < 0) THEN

               Status := Convert_Errno (Errno => Errno);

               IF Temp_Connect.Kind = Client THEN
                  System_Call_Result :=  
                     Socket_System_Interface.Shutdown
                        (S => File_Descriptor, How => 2);
               END IF;

               System_Call_Result :=  
                  System_Interface.File_Io.Close (Fildes => File_Descriptor);

               IF System_Call_Result < 0 THEN
                  RAISE Program_Error;
               ELSE

                  IF Temp_Connect.Kind = Server THEN  
                     Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
                     Temp_Connect.Socket_Status         := Not_Connected;
                  ELSE
                     Temp_Connect.Local_Socket_Descriptor := Unix_Error;
                     Temp_Connect.Socket_Status           := Closed;
                  END IF;

               END IF;

               RETURN;

            END IF;

            Lcount           := Lcount + System_Call_Result;
            Amount_Remaining := Amount_Remaining - System_Call_Result;
            Index            := Index + System_Call_Result;  
            Count            := Lcount;

         END LOOP Transmit_Loop;

   END Transmit;


   PROCEDURE Receive (Connection :     Transport.Connection_Id;
                      Status     : OUT Transport_Defs.Status_Code;
                      Data       : OUT Byte_Defs.Byte_String;
                      Count      : OUT Natural;
                      Max_Wait   :     Duration := Duration'Last) IS

      File_Descriptor    : Unix_Base_Types.Int;
      Length             : Unix_Base_Types.Int;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int := System_Interface.Error.Eintr;
      Temp_Connect       : Transport.Connection_Id := Connection;

   BEGIN

      Count := 0;

      IF Temp_Connect = Null_Connection_Id THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      END IF;

      IF Temp_Connect.Socket_Status /= Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      Status := Transport_Defs.Ok;

      Start_System_Call;

      Length := System_Interface.File_Io.Read
                   (Fildes => File_Descriptor,
                    Buf    => Unix_Base_Types.To_Char_Ptr (Data'Address),
                    Nbyte  => Data'Length);

      Errno := Finish_System_Call;

      IF (Length > 0) THEN

         Count := Length;

      ELSE


         IF (Length < 0) THEN

            Status := Convert_Errno (Errno => Errno);

         ELSIF (Length = 0) THEN

            Status := Transport_Defs.Not_Connected;

         END IF;

         IF Temp_Connect.Kind = Client THEN
            System_Call_Result :=  
               Socket_System_Interface.Shutdown
                  (S => File_Descriptor, How => 2);
         END IF;

         System_Call_Result :=  
            System_Interface.File_Io.Close (Fildes => File_Descriptor);

         IF System_Call_Result < 0 THEN
            RAISE Program_Error;
         ELSE

            IF Temp_Connect.Kind = Server THEN  
               Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
               Temp_Connect.Socket_Status         := Not_Connected;
            ELSE
               Temp_Connect.Local_Socket_Descriptor := Unix_Error;
               Temp_Connect.Socket_Status           := Closed;
            END IF;

         END IF;

      END IF;

   END Receive;
   PROCEDURE Set_Mode (Connection :     Transport.Connection_Id;
                       Status     : OUT Transport_Defs.Status_Code;
                       Blocking   :     Boolean := True) IS
      System_Call_Result    : Unix_Base_Types.Int;
      Errno                 : Unix_Base_Types.Int;  
      Not_Used              : CONSTANT Integer := 1;
      Not_Implemented_Error : EXCEPTION;
   BEGIN  
      IF Blocking THEN
         System_Call_Result :=
            System_Interface.File_Io.Ioctl
               (Fildes  => Connection.Local_Socket_Descriptor,
                Request => System_Interface.File_Io.Fionbio,
                Arg     => Not_Used);
      ELSE
         RAISE Not_Implemented_Error;   --[may be done fcntl]
      END IF;


      IF (System_Call_Result < 0) THEN
         Status := Convert_Errno (Errno => Errno);
         RETURN;
      END IF;
   END Set_Mode;
END Transport;

E3 Meta Data

    nblk1=20
    nid=0
    hdr6=40
        [0x00] rec0=1c rec1=00 rec2=01 rec3=07a
        [0x01] rec0=1a rec1=00 rec2=02 rec3=036
        [0x02] rec0=04 rec1=00 rec2=1f rec3=012
        [0x03] rec0=1c rec1=00 rec2=03 rec3=042
        [0x04] rec0=1b rec1=00 rec2=04 rec3=062
        [0x05] rec0=18 rec1=00 rec2=05 rec3=016
        [0x06] rec0=20 rec1=00 rec2=06 rec3=030
        [0x07] rec0=00 rec1=00 rec2=1e rec3=00c
        [0x08] rec0=1c rec1=00 rec2=07 rec3=03c
        [0x09] rec0=00 rec1=00 rec2=1d rec3=014
        [0x0a] rec0=18 rec1=00 rec2=08 rec3=054
        [0x0b] rec0=01 rec1=00 rec2=1c rec3=004
        [0x0c] rec0=21 rec1=00 rec2=09 rec3=034
        [0x0d] rec0=00 rec1=00 rec2=1b rec3=008
        [0x0e] rec0=1c rec1=00 rec2=0a rec3=042
        [0x0f] rec0=00 rec1=00 rec2=1a rec3=012
        [0x10] rec0=1f rec1=00 rec2=0b rec3=040
        [0x11] rec0=00 rec1=00 rec2=19 rec3=010
        [0x12] rec0=21 rec1=00 rec2=0c rec3=018
        [0x13] rec0=00 rec1=00 rec2=18 rec3=018
        [0x14] rec0=23 rec1=00 rec2=0d rec3=038
        [0x15] rec0=00 rec1=00 rec2=17 rec3=022
        [0x16] rec0=1b rec1=00 rec2=0e rec3=080
        [0x17] rec0=05 rec1=00 rec2=16 rec3=022
        [0x18] rec0=23 rec1=00 rec2=0f rec3=022
        [0x19] rec0=1d rec1=00 rec2=10 rec3=00a
        [0x1a] rec0=00 rec1=00 rec2=15 rec3=038
        [0x1b] rec0=1b rec1=00 rec2=11 rec3=03a
        [0x1c] rec0=04 rec1=00 rec2=14 rec3=002
        [0x1d] rec0=27 rec1=00 rec2=12 rec3=04a
        [0x1e] rec0=1d rec1=00 rec2=13 rec3=018
        [0x1f] rec0=16 rec1=00 rec2=20 rec3=000
    tail 0x2151ce424838e789368b7 0x489e0066482863c01