[Ada] GNAT.Serial_Communications: simplify the Serial_Port structure

2019-07-08  Dmitriy Anisimkov  <anisimko@adacore.com>

gcc/ada/

	* libgnat/g-sercom.ads
	(Serial_Port_Descriptor): New type.
	(Serial_Port): Add a comment, make it hold a
	Serial_Port_Descriptor.
	(To_Ada, To_C): New procedures.
	(Port_Data, Port_Data_Access): Remove types.
	* libgnat/g-sercom.adb (To_Ada): New stub.
	* libgnat/g-sercom__linux.adb, libgnat/g-sercom__mingw.adb:
	Update implementations accordingly.
	* s-oscons-tmplt.c: Bind Serial_Port_Descriptor to
	System.Win32.HANDLE on Windows, and to Interfaces.C.int on
	Linux. Add "Interfaces.C." prefix for other basic integer type
	bindings.
	* xoscons.adb (Output_Info): Remove the "Interfaces.C." prefix
	for subtypes generation.

From-SVN: r273225

gcc/ada/ChangeLog

+2019-07-08  Dmitriy Anisimkov  <anisimko@adacore.com>
+
+	* libgnat/g-sercom.ads
+	(Serial_Port_Descriptor): New type.
+	(Serial_Port): Add a comment, make it hold a
+	Serial_Port_Descriptor.
+	(To_Ada, To_C): New procedures.
+	(Port_Data, Port_Data_Access): Remove types.
+	* libgnat/g-sercom.adb (To_Ada): New stub.
+	* libgnat/g-sercom__linux.adb, libgnat/g-sercom__mingw.adb:
+	Update implementations accordingly.
+	* s-oscons-tmplt.c: Bind Serial_Port_Descriptor to
+	System.Win32.HANDLE on Windows, and to Interfaces.C.int on
+	Linux. Add "Interfaces.C." prefix for other basic integer type
+	bindings.
+	* xoscons.adb (Output_Info): Remove the "Interfaces.C." prefix
+	for subtypes generation.
+
 2019-07-08  Arnaud Charlet  <charlet@adacore.com>
 
 	* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst:

gcc/ada/libgnat/g-sercom.adb

@@ -103,6 +103,15 @@ package body GNAT.Serial_Communications is
       Unimplemented;
    end Read;
 
+   ------------
+   -- To_Ada --
+   ------------
+
+   procedure To_Ada (Port : out Serial_Port; Fd : Serial_Port_Descriptor) is
+   begin
+      Unimplemented;
+   end To_Ada;
+
    -----------
    -- Write --
    -----------

gcc/ada/libgnat/g-sercom.ads

@@ -33,6 +33,7 @@
 
 with Ada.Streams;
 with Interfaces.C;
+with System.OS_Constants;
 
 package GNAT.Serial_Communications is
 
@@ -122,6 +123,11 @@ package GNAT.Serial_Communications is
    --  No flow control, hardware flow control, software flow control
 
    type Serial_Port is new Ada.Streams.Root_Stream_Type with private;
+   --  Serial port stream type
+
+   type Serial_Port_Descriptor is
+     new System.OS_Constants.Serial_Port_Descriptor;
+   --  OS specific serial port descriptor
 
    procedure Open
      (Port : out Serial_Port;
@@ -168,13 +174,21 @@ package GNAT.Serial_Communications is
    procedure Close (Port : in out Serial_Port);
    --  Close port
 
-private
+   procedure To_Ada (Port : out Serial_Port; Fd : Serial_Port_Descriptor)
+     with Inline;
+   --  Convert a serial port descriptor to Serial_Port. This is useful when a
+   --  serial port descriptor is obtained from an external library call.
 
-   type Port_Data;
-   type Port_Data_Access is access Port_Data;
+   function To_C
+     (Port : Serial_Port) return Serial_Port_Descriptor with Inline;
+   --  Return a serial port descriptor to be used by external subprograms.
+   --  This is useful for C functions that are not yet interfaced in this
+   --  package.
+
+private
 
    type Serial_Port is new Ada.Streams.Root_Stream_Type with record
-      H : Port_Data_Access;
+      H : Serial_Port_Descriptor := -1;
    end record;
 
    Data_Rate_Value : constant array (Data_Rate) of Interfaces.C.unsigned :=
@@ -205,4 +219,7 @@ private
                         B3500000 => 3_500_000,
                         B4000000 => 4_000_000);
 
+   function To_C (Port : Serial_Port) return Serial_Port_Descriptor is
+      (Port.H);
+
 end GNAT.Serial_Communications;

gcc/ada/libgnat/g-sercom__linux.adb

@@ -33,12 +33,10 @@
 
 with Ada.Streams;                use Ada.Streams;
 with Ada;                        use Ada;
-with Ada.Unchecked_Deallocation;
 
 with System;               use System;
 with System.Communication; use System.Communication;
 with System.CRTL;          use System.CRTL;
-with System.OS_Constants;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 
@@ -48,8 +46,6 @@ package body GNAT.Serial_Communications is
 
    use type Interfaces.C.unsigned;
 
-   type Port_Data is new int;
-
    subtype unsigned is Interfaces.C.unsigned;
    subtype char is Interfaces.C.char;
    subtype unsigned_char is Interfaces.C.unsigned_char;
@@ -124,20 +120,16 @@ package body GNAT.Serial_Communications is
       Res    : int;
 
    begin
-      if Port.H = null then
-         Port.H := new Port_Data;
-      end if;
-
-      Port.H.all := Port_Data (open
+      Port.H := Serial_Port_Descriptor (open
          (C_Name (C_Name'First)'Address, int (O_RDWR + O_NOCTTY + O_NDELAY)));
 
-      if Port.H.all = -1 then
+      if Port.H = -1 then
          Raise_Error ("open: open failed");
       end if;
 
       --  By default we are in blocking mode
 
-      Res := fcntl (int (Port.H.all), F_SETFL, 0);
+      Res := fcntl (int (Port.H), F_SETFL, 0);
 
       if Res = -1 then
          Raise_Error ("open: fcntl failed");
@@ -169,11 +161,11 @@ package body GNAT.Serial_Communications is
       Res : ssize_t;
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("read: port not opened", 0);
       end if;
 
-      Res := read (Integer (Port.H.all), Buffer'Address, Len);
+      Res := read (Integer (Port.H), Buffer'Address, Len);
 
       if Res = -1 then
          Raise_Error ("read failed");
@@ -228,13 +220,13 @@ package body GNAT.Serial_Communications is
       --  Warnings off, since we don't always test the result
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("set: port not opened", 0);
       end if;
 
       --  Get current port settings
 
-      Res := tcgetattr (int (Port.H.all), Current'Address);
+      Res := tcgetattr (int (Port.H), Current'Address);
 
       --  Change settings now
 
@@ -269,18 +261,27 @@ package body GNAT.Serial_Communications is
 
       --  Set port settings
 
-      Res := tcflush (int (Port.H.all), TCIFLUSH);
-      Res := tcsetattr (int (Port.H.all), TCSANOW, Current'Address);
+      Res := tcflush (int (Port.H), TCIFLUSH);
+      Res := tcsetattr (int (Port.H), TCSANOW, Current'Address);
 
       --  Block
 
-      Res := fcntl (int (Port.H.all), F_SETFL, (if Block then 0 else FNDELAY));
+      Res := fcntl (int (Port.H), F_SETFL, (if Block then 0 else FNDELAY));
 
       if Res = -1 then
          Raise_Error ("set: fcntl failed");
       end if;
    end Set;
 
+   ------------
+   -- To_Ada --
+   ------------
+
+   procedure To_Ada (Port : out Serial_Port; Fd : Serial_Port_Descriptor) is
+   begin
+      Port.H := Fd;
+   end To_Ada;
+
    -----------
    -- Write --
    -----------
@@ -293,11 +294,11 @@ package body GNAT.Serial_Communications is
       Res : ssize_t;
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("write: port not opened", 0);
       end if;
 
-      Res := write (int (Port.H.all), Buffer'Address, Len);
+      Res := write (int (Port.H), Buffer'Address, Len);
 
       if Res = -1 then
          Raise_Error ("write failed");
@@ -311,16 +312,12 @@ package body GNAT.Serial_Communications is
    -----------
 
    procedure Close (Port : in out Serial_Port) is
-      procedure Unchecked_Free is
-        new Unchecked_Deallocation (Port_Data, Port_Data_Access);
-
       Res : int;
       pragma Unreferenced (Res);
 
    begin
-      if Port.H /= null then
-         Res := close (int (Port.H.all));
-         Unchecked_Free (Port.H);
+      if Port.H /= -1 then
+         Res := close (int (Port.H));
       end if;
    end Close;
 

gcc/ada/libgnat/g-sercom__mingw.adb

@@ -31,13 +31,11 @@
 
 --  This is the Windows implementation of this package
 
-with Ada.Streams;                use Ada.Streams;
-with Ada.Unchecked_Deallocation; use Ada;
+with Ada.Streams;          use Ada.Streams, Ada;
 
 with System;               use System;
 with System.Communication; use System.Communication;
 with System.CRTL;          use System.CRTL;
-with System.OS_Constants;
 with System.Win32;         use System.Win32;
 with System.Win32.Ext;     use System.Win32.Ext;
 
@@ -49,8 +47,6 @@ package body GNAT.Serial_Communications is
 
    --  Common types
 
-   type Port_Data is new HANDLE;
-
    C_Bits      : constant array (Data_Bits) of Interfaces.C.unsigned := (8, 7);
    C_Parity    : constant array (Parity_Check) of Interfaces.C.unsigned :=
                    (None => NOPARITY, Odd => ODDPARITY, Even => EVENPARITY);
@@ -69,15 +65,11 @@ package body GNAT.Serial_Communications is
    -----------
 
    procedure Close (Port : in out Serial_Port) is
-      procedure Unchecked_Free is
-        new Unchecked_Deallocation (Port_Data, Port_Data_Access);
-
       Success : BOOL;
 
    begin
-      if Port.H /= null then
-         Success := CloseHandle (HANDLE (Port.H.all));
-         Unchecked_Free (Port.H);
+      if Port.H /= -1 then
+         Success := CloseHandle (HANDLE (Port.H));
 
          if Success = Win32.FALSE then
             Raise_Error ("error closing the port");
@@ -114,13 +106,11 @@ package body GNAT.Serial_Communications is
       pragma Unreferenced (Success);
 
    begin
-      if Port.H = null then
-         Port.H := new Port_Data;
-      else
-         Success := CloseHandle (HANDLE (Port.H.all));
+      if Port.H /= -1 then
+         Success := CloseHandle (HANDLE (Port.H));
       end if;
 
-      Port.H.all := CreateFileA
+      Port.H := CreateFileA
         (lpFileName            => C_Name (C_Name'First)'Address,
          dwDesiredAccess       => GENERIC_READ or GENERIC_WRITE,
          dwShareMode           => 0,
@@ -129,7 +119,9 @@ package body GNAT.Serial_Communications is
          dwFlagsAndAttributes  => 0,
          hTemplateFile         => 0);
 
-      if Port.H.all = Port_Data (INVALID_HANDLE_VALUE) then
+      pragma Assert (INVALID_HANDLE_VALUE = -1);
+
+      if Port.H = Serial_Port_Descriptor (INVALID_HANDLE_VALUE) then
          Raise_Error ("cannot open com port");
       end if;
    end Open;
@@ -159,13 +151,13 @@ package body GNAT.Serial_Communications is
       Read_Last : aliased DWORD;
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("read: port not opened", 0);
       end if;
 
       Success :=
         ReadFile
-          (hFile                => HANDLE (Port.H.all),
+          (hFile                => HANDLE (Port.H),
            lpBuffer             => Buffer (Buffer'First)'Address,
            nNumberOfBytesToRead => DWORD (Buffer'Length),
            lpNumberOfBytesRead  => Read_Last'Access,
@@ -200,15 +192,14 @@ package body GNAT.Serial_Communications is
       Com_Settings : aliased DCB;
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("set: port not opened", 0);
       end if;
 
-      Success := GetCommState (HANDLE (Port.H.all), Com_Settings'Access);
+      Success := GetCommState (HANDLE (Port.H), Com_Settings'Access);
 
       if Success = Win32.FALSE then
-         Success := CloseHandle (HANDLE (Port.H.all));
-         Port.H.all := 0;
+         Success := CloseHandle (HANDLE (Port.H));
          Raise_Error ("set: cannot get comm state");
       end if;
 
@@ -240,11 +231,10 @@ package body GNAT.Serial_Communications is
       Com_Settings.Parity        := BYTE (C_Parity (Parity));
       Com_Settings.StopBits      := BYTE (C_Stop_Bits (Stop_Bits));
 
-      Success := SetCommState (HANDLE (Port.H.all), Com_Settings'Access);
+      Success := SetCommState (HANDLE (Port.H), Com_Settings'Access);
 
       if Success = Win32.FALSE then
-         Success := CloseHandle (HANDLE (Port.H.all));
-         Port.H.all := 0;
+         Success := CloseHandle (HANDLE (Port.H));
          Raise_Error ("cannot set comm state");
       end if;
 
@@ -274,7 +264,7 @@ package body GNAT.Serial_Communications is
 
       Success :=
         SetCommTimeouts
-          (hFile          => HANDLE (Port.H.all),
+          (hFile          => HANDLE (Port.H),
            lpCommTimeouts => Com_Time_Out'Access);
 
       if Success = Win32.FALSE then
@@ -282,6 +272,15 @@ package body GNAT.Serial_Communications is
       end if;
    end Set;
 
+   ------------
+   -- To_Ada --
+   ------------
+
+   procedure To_Ada (Port : out Serial_Port; Fd : Serial_Port_Descriptor) is
+   begin
+      Port.H := Fd;
+   end To_Ada;
+
    -----------
    -- Write --
    -----------
@@ -294,13 +293,13 @@ package body GNAT.Serial_Communications is
       Temp_Last : aliased DWORD;
 
    begin
-      if Port.H = null then
+      if Port.H = -1 then
          Raise_Error ("write: port not opened", 0);
       end if;
 
       Success :=
         WriteFile
-          (hFile                  => HANDLE (Port.H.all),
+          (hFile                  => HANDLE (Port.H),
            lpBuffer               => Buffer'Address,
            nNumberOfBytesToWrite  => DWORD (Buffer'Length),
            lpNumberOfBytesWritten => Temp_Last'Access,

gcc/ada/s-oscons-tmplt.c

@@ -261,6 +261,14 @@ main (void) {
 TXT("--  This is the version for " TARGET)
 TXT("")
 TXT("with Interfaces.C;")
+#if defined (__MINGW32__)
+# define TARGET_OS "Windows"
+# define Serial_Port_Descriptor "System.Win32.HANDLE"
+TXT("with System.Win32;")
+#else
+# define TARGET_OS "Other_OS"
+# define Serial_Port_Descriptor "Interfaces.C.int"
+#endif
 
 /*
 package System.OS_Constants is
@@ -280,11 +288,6 @@ package System.OS_Constants is
 
    type OS_Type is (Windows, Other_OS);
 */
-#if defined (__MINGW32__)
-# define TARGET_OS "Windows"
-#else
-# define TARGET_OS "Other_OS"
-#endif
 C("Target_OS", OS_Type, TARGET_OS, "")
 /*
    pragma Warnings (Off, Target_OS);
@@ -303,6 +306,8 @@ CST(Target_Name, "")
 #define SIZEOF_unsigned_int sizeof (unsigned int)
 CND(SIZEOF_unsigned_int, "Size of unsigned int")
 
+SUB(Serial_Port_Descriptor)
+
 /*
 
    -------------------
@@ -405,10 +410,10 @@ CND(FNDELAY, "Nonblocking")
 
 #if defined (__FreeBSD__) || defined (__DragonFly__)
 # define CNI CNU
-# define IOCTL_Req_T "unsigned"
+# define IOCTL_Req_T "Interfaces.C.unsigned"
 #else
 # define CNI CND
-# define IOCTL_Req_T "int"
+# define IOCTL_Req_T "Interfaces.C.int"
 #endif
 
 SUB(IOCTL_Req_T)
@@ -1628,9 +1633,9 @@ CND(IF_NAMESIZE, "Max size of interface name with 0 terminator");
 */
 
 #if defined (__sun__) || defined (__hpux__)
-# define Msg_Iovlen_T "int"
+# define Msg_Iovlen_T "Interfaces.C.int"
 #else
-# define Msg_Iovlen_T "size_t"
+# define Msg_Iovlen_T "Interfaces.C.size_t"
 #endif
 
 SUB(Msg_Iovlen_T)

gcc/ada/xoscons.adb

@@ -229,8 +229,7 @@ procedure XOSCons is
             case Lang is
                when Lang_Ada =>
                   Put ("   subtype " & Info.Constant_Name.all
-                       & " is Interfaces.C."
-                       & Info.Text_Value.all & ";");
+                       & " is " & Info.Text_Value.all & ";");
                when Lang_C =>
                   Put ("#define " & Info.Constant_Name.all & " "
                        & Info.Text_Value.all);