From 55d4e2ba076049f88c24011f2f63aa226e6c87a0 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Mon, 8 Jul 2019 08:14:59 +0000 Subject: [PATCH] [Ada] GNAT.Serial_Communications: simplify the Serial_Port structure 2019-07-08 Dmitriy Anisimkov 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 | 18 +++++++++ gcc/ada/libgnat/g-sercom.adb | 9 +++++ gcc/ada/libgnat/g-sercom.ads | 25 +++++++++++-- gcc/ada/libgnat/g-sercom__linux.adb | 49 ++++++++++++------------- gcc/ada/libgnat/g-sercom__mingw.adb | 57 ++++++++++++++--------------- gcc/ada/s-oscons-tmplt.c | 23 +++++++----- gcc/ada/xoscons.adb | 3 +- 7 files changed, 114 insertions(+), 70 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af36d68052d..7df6448096b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-07-08 Dmitriy Anisimkov + + * 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 * doc/gnat_rm/standard_and_implementation_defined_restrictions.rst: diff --git a/gcc/ada/libgnat/g-sercom.adb b/gcc/ada/libgnat/g-sercom.adb index c3bed832eef..ccf5239d4c8 100644 --- a/gcc/ada/libgnat/g-sercom.adb +++ b/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 -- ----------- diff --git a/gcc/ada/libgnat/g-sercom.ads b/gcc/ada/libgnat/g-sercom.ads index e807dababaa..52447db1fb5 100644 --- a/gcc/ada/libgnat/g-sercom.ads +++ b/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; diff --git a/gcc/ada/libgnat/g-sercom__linux.adb b/gcc/ada/libgnat/g-sercom__linux.adb index f116aeae90f..87143e23531 100644 --- a/gcc/ada/libgnat/g-sercom__linux.adb +++ b/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; diff --git a/gcc/ada/libgnat/g-sercom__mingw.adb b/gcc/ada/libgnat/g-sercom__mingw.adb index 88a23eaa2eb..c13e7b3bba8 100644 --- a/gcc/ada/libgnat/g-sercom__mingw.adb +++ b/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, diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index f63ea52a4ff..1e883b9f69c 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/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) diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 0d5f635ba7d..7c72e4e299b 100644 --- a/gcc/ada/xoscons.adb +++ b/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); -- 2.30.2