+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:
Unimplemented;
end Read;
+ ------------
+ -- To_Ada --
+ ------------
+
+ procedure To_Ada (Port : out Serial_Port; Fd : Serial_Port_Descriptor) is
+ begin
+ Unimplemented;
+ end To_Ada;
+
-----------
-- Write --
-----------
with Ada.Streams;
with Interfaces.C;
+with System.OS_Constants;
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;
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 :=
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;
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;
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;
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");
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");
-- 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
-- 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 --
-----------
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");
-----------
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;
-- 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;
-- 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);
-----------
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");
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,
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;
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,
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;
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;
Success :=
SetCommTimeouts
- (hFile => HANDLE (Port.H.all),
+ (hFile => HANDLE (Port.H),
lpCommTimeouts => Com_Time_Out'Access);
if Success = Win32.FALSE then
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 --
-----------
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,
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
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);
#define SIZEOF_unsigned_int sizeof (unsigned int)
CND(SIZEOF_unsigned_int, "Size of unsigned int")
+SUB(Serial_Port_Descriptor)
+
/*
-------------------
#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)
*/
#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)
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);
projects / gcc.git / commitdiff