procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] GNAT.Serial_Communications: simplify the Serial_Port structure

Browse source 
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
This commit is contained in:
Dmitriy Anisimkov 2019-07-08 08:14:59 +00:00 • committed by Pierre-Marie de Rodat
parent aec80f204f
commit 55d4e2ba07
7 changed files with 114 additions and 70 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
gcc/ada/ChangeLog
View file

@ -1,3 +1,21 @@
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:

9
gcc/ada/libgnat/g-sercom.adb
View file

@ -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 --
-----------

25
gcc/ada/libgnat/g-sercom.ads
View file

@ -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
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.
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 Port_Data;
type Port_Data_Access is access Port_Data;
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;

49
gcc/ada/libgnat/g-sercom__linux.adb
View file

@ -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;

57
gcc/ada/libgnat/g-sercom__mingw.adb
View file

@ -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,

23
gcc/ada/s-oscons-tmplt.c
View file

@ -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)

3
gcc/ada/xoscons.adb
View file

@ -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);