[Ada] Sockets.Poll implementation

gcc/ada/

	* Makefile.rtl (GNATRTL_SOCKETS_OBJS): New object
	g-socpol$(objext) New source files noted: g-socpol.adb,
	g-socpol.ads, g-socpol__dummy.adb, g-socpol__dummy.ads,
	g-sopowa.adb, g-sopowa__posix.adb, g-sopowa__mingw.adb,
	g-spogwa.adb, g-spogwa.ads.
	* impunit.adb (Non_Imp_File_Names_95): New base filename
	g-socpol in "GNAT Library Units" section for GNAT.Sockets.Poll
	unit.
	* libgnat/g-socket.ads, libgnat/g-socket.adb:
	(Raise_Socket_Error): Moved from body to private part of
	specification to use in GNAT.Sockets.Poll.
	* libgnat/g-socpol.ads, libgnat/g-socpol.adb: Main unit of the
	implementation.
	* libgnat/g-socpol__dummy.ads, libgnat/g-socpol__dummy.adb:
	Empty unit for the systems without sockets support.
	* libgnat/g-spogwa.ads, libgnat/g-spogwa.adb: Generic unit
	implementing sockets poll on top of select system call.
	* libgnat/g-sopowa.adb (Wait): Separate implementation for
	operation systems with poll system call support.
	* libgnat/g-sopowa__posix.adb (Wait): Separate implementation
	for POSIX select system call.
	* libgnat/g-sopowa__mingw.adb (Wait): Separate implementation
	for Windows select system call.
	* gsocket.h (_WIN32_WINNT): Increase to 0x0600 for winsock2.h to
	allow WSAPoll related definitions.
	* s-oscons-tmplt.c: Fix comment next to #endif for
	#if defined (__linux__) || defined (__ANDROID__) line.  Include
	<poll.h> for all except VxWorks and Windows.
	(SIZEOF_nfds_t): New definition.
	(SIZEOF_fd_type): New definition.
	(SIZEOF_pollfd_events): New definition.
	(POLLIN, POLLPRI, POLLOUT, POLLERR, POLLHUP, POLLNVAL): New
	definitions for VxWorks to be able to emulate poll on top of
	select in it.  Define POLLPRI as zero on Windows as it is not
	supported there.
	(Poll_Linkname): New definition, because the poll system call
	has different name in Windows and POSIX.

11 files changed, 1147 insertions, 4 deletions

diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index 719d9a9..57a8800 100644
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -186,10 +186,6 @@ package body GNAT.Sockets is
        else Value);
    --  Removes dot at the end of error message
 
-   procedure Raise_Socket_Error (Error : Integer);
-   --  Raise Socket_Error with an exception message describing the error code
-   --  from errno.
-
    procedure Raise_Host_Error (H_Error : Integer; Name : String);
    --  Raise Host_Error exception with message describing error code (note
    --  hstrerror seems to be obsolete) from h_errno. Name is the name
diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads
index 9e64bc8..bf78777 100644
--- a/gcc/ada/libgnat/g-socket.ads
+++ b/gcc/ada/libgnat/g-socket.ads
@@ -1573,4 +1573,8 @@ private
    Wait_For_A_Full_Reception : constant Request_Flag_Type := 4;
    Send_End_Of_Record        : constant Request_Flag_Type := 8;
 
+   procedure Raise_Socket_Error (Error : Integer);
+   --  Raise Socket_Error with an exception message describing the error code
+   --  from errno.
+
 end GNAT.Sockets;
diff --git a/gcc/ada/libgnat/g-socpol.adb b/gcc/ada/libgnat/g-socpol.adb
new file mode 100644
index 0000000..ab3286c
--- /dev/null
+++ b/gcc/ada/libgnat/g-socpol.adb
@@ -0,0 +1,430 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    G N A T . S O C K E T S . P O L L                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Calendar;
+
+with GNAT.Sockets.Thin;
+
+package body GNAT.Sockets.Poll is
+
+   To_C : constant array (Wait_Event_Type) of Events_Type :=
+            (Input => SOC.POLLIN or SOC.POLLPRI, Output => SOC.POLLOUT);
+   --  To convert Wait_Event_Type to C I/O events flags
+
+   procedure Set_Mode (Item : out Pollfd; Mode : Wait_Event_Set);
+   --  Set I/O waiting mode on Item
+
+   procedure Set_Event
+     (Item : out Pollfd; Event : Wait_Event_Type; Value : Boolean);
+   --  Set or reset waiting state on I/O event
+
+   procedure Check_Range (Self : Set; Index : Positive) with Inline;
+   --  raise Constraint_Error if Index is more than number of sockets in Self
+
+   function Status (Item : Pollfd) return Event_Set is
+     (Input           => (Item.REvents and To_C (Input)) /= 0,
+      Output          => (Item.REvents and To_C (Output)) /= 0,
+      Error           => (Item.REvents and SOC.POLLERR) /= 0,
+      Hang_Up         => (Item.REvents and SOC.POLLHUP) /= 0,
+      Invalid_Request => (Item.REvents and SOC.POLLNVAL) /= 0);
+   --  Get I/O events from C word
+
+   procedure Wait
+     (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer);
+   --  Waits until one or more of the sockets descriptors become ready for some
+   --  class of I/O operation or error state occurs on one or more of them.
+   --  Timeout is in milliseconds. Result mean how many sockets ready for I/O
+   --  or have error state.
+
+   ----------
+   -- Wait --
+   ----------
+
+   procedure Wait
+     (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
+   is separate;
+
+   ------------
+   -- Create --
+   ------------
+
+   function Create (Size : Positive) return Set is
+   begin
+      return Result : Set (Size);
+   end Create;
+
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set
+     (Socket : Socket_Type;
+      Events : Wait_Event_Set;
+      Size   : Positive := 1) return Set is
+   begin
+      return Result : Set (Size) do
+         Append (Result, Socket, Events);
+      end return;
+   end To_Set;
+
+   ------------
+   -- Append --
+   ------------
+
+   procedure Append
+     (Self : in out Set; Socket : Socket_Type; Events : Wait_Event_Set) is
+   begin
+      Insert (Self, Socket, Events, Self.Length + 1);
+   end Append;
+
+   ------------
+   -- Insert --
+   ------------
+
+   procedure Insert
+     (Self       : in out Set;
+      Socket     : Socket_Type;
+      Events     : Wait_Event_Set;
+      Index      : Positive;
+      Keep_Order : Boolean := False) is
+   begin
+      if Self.Size <= Self.Length then
+         raise Constraint_Error with "Socket set is full";
+
+      elsif Index > Self.Length + 1 then
+         raise Constraint_Error with "Insert out of range";
+      end if;
+
+      if Socket < 0 then
+         raise Socket_Error with
+           "Wrong socket descriptor " & Socket_Type'Image (Socket);
+      end if;
+
+      Self.Length := Self.Length + 1;
+
+      if Index /= Self.Length then
+         if Keep_Order then
+            Self.Fds (Index + 1 .. Self.Length) :=
+              Self.Fds (Index .. Self.Length - 1);
+         else
+            Self.Fds (Self.Length) := Self.Fds (Index);
+         end if;
+
+         Self.Fds (Index).Events := 0;
+      end if;
+
+      Self.Fds (Index).Socket := FD_Type (Socket);
+      Set_Mode (Self.Fds (Index), Events);
+
+      if FD_Type (Socket) > Self.Max_FD then
+         Self.Max_FD := FD_Type (Socket);
+         Self.Max_OK := True;
+      end if;
+   end Insert;
+
+   -----------------
+   -- Check_Range --
+   -----------------
+
+   procedure Check_Range (Self : Set; Index : Positive) is
+   begin
+      if Index > Self.Length then
+         raise Constraint_Error;
+      end if;
+   end Check_Range;
+
+   ----------
+   -- Copy --
+   ----------
+
+   procedure Copy (Source : Set; Target : out Set) is
+   begin
+      if Target.Size < Source.Length then
+         raise Constraint_Error with
+           "Can't copy because size of target less than source length";
+      end if;
+
+      Target.Fds (1 .. Source.Length) := Source.Fds (1 .. Source.Length);
+
+      Target.Length := Source.Length;
+      Target.Max_FD := Source.Max_FD;
+      Target.Max_OK := Source.Max_OK;
+   end Copy;
+
+   ----------------
+   -- Get_Events --
+   ----------------
+
+   function Get_Events
+     (Self : Set; Index  : Positive) return Wait_Event_Set is
+   begin
+      Check_Range (Self, Index);
+      return
+        (Input  => (Self.Fds (Index).Events and To_C (Input)) /= 0,
+         Output => (Self.Fds (Index).Events and To_C (Output)) /= 0);
+   end Get_Events;
+
+   ------------
+   -- Growth --
+   ------------
+
+   function Growth (Self : Set) return Set is
+   begin
+      return Resize
+        (Self,
+         (case Self.Size is
+             when 1  .. 20 => 32,
+             when 21 .. 50 => 64,
+             when 51 .. 99 => Self.Size + Self.Size / 3,
+             when others   => Self.Size + Self.Size / 4));
+   end Growth;
+
+   ------------
+   -- Remove --
+   ------------
+
+   procedure Remove
+     (Self : in out Set; Index : Positive; Keep_Order : Boolean := False) is
+   begin
+      Check_Range (Self, Index);
+
+      if Self.Max_FD = Self.Fds (Index).Socket then
+         Self.Max_OK := False;
+      end if;
+
+      if Index < Self.Length then
+         if Keep_Order then
+            Self.Fds (Index .. Self.Length - 1) :=
+              Self.Fds (Index + 1 .. Self.Length);
+         else
+            Self.Fds (Index) := Self.Fds (Self.Length);
+         end if;
+      end if;
+
+      Self.Length := Self.Length - 1;
+   end Remove;
+
+   ------------
+   -- Resize --
+   ------------
+
+   function Resize (Self : Set; Size : Positive) return Set is
+   begin
+      return Result : Set (Size) do
+         Copy (Self, Result);
+      end return;
+   end Resize;
+
+   ---------------
+   -- Set_Event --
+   ---------------
+
+   procedure Set_Event
+     (Self  : in out Set;
+      Index : Positive;
+      Event : Wait_Event_Type;
+      Value : Boolean) is
+   begin
+      Check_Range (Self, Index);
+      Set_Event (Self.Fds (Index), Event, Value);
+   end Set_Event;
+
+   procedure Set_Event
+     (Item : out Pollfd; Event : Wait_Event_Type; Value : Boolean) is
+   begin
+      if Value then
+         Item.Events := Item.Events or To_C (Event);
+      else
+         Item.Events := Item.Events and not To_C (Event);
+      end if;
+   end Set_Event;
+
+   ----------------
+   -- Set_Events --
+   ----------------
+
+   procedure Set_Events
+     (Self   : in out Set;
+      Index  : Positive;
+      Events : Wait_Event_Set) is
+   begin
+      Check_Range (Self, Index);
+      Set_Mode (Self.Fds (Index), Events);
+   end Set_Events;
+
+   --------------
+   -- Set_Mode --
+   --------------
+
+   procedure Set_Mode (Item : out Pollfd; Mode : Wait_Event_Set) is
+   begin
+      for J in Mode'Range loop
+         Set_Event (Item, J, Mode (J));
+      end loop;
+   end Set_Mode;
+
+   ------------
+   -- Socket --
+   ------------
+
+   function Socket (Self : Set; Index : Positive) return Socket_Type is
+   begin
+      Check_Range (Self, Index);
+      return Socket_Type (Self.Fds (Index).Socket);
+   end Socket;
+
+   -----------
+   -- State --
+   -----------
+
+   procedure State
+     (Self   : Set;
+      Index  : Positive;
+      Socket : out Socket_Type;
+      Status : out Event_Set) is
+   begin
+      Check_Range (Self, Index);
+      Socket := Socket_Type (Self.Fds (Index).Socket);
+      Status := Poll.Status (Self.Fds (Index));
+   end State;
+
+   ----------
+   -- Wait --
+   ----------
+
+   procedure Wait (Self : in out Set; Timeout : Duration; Count : out Natural)
+   is
+      use Ada.Calendar;
+      --  Used to calculate partially consumed timeout on EINTR.
+      --  Better to use Ada.Real_Time, but we can't in current GNAT because
+      --  Ada.Real_Time is in tasking part of runtime.
+
+      Result       : Integer;
+      Poll_Timeout : Duration := Timeout;
+      C_Timeout    : Interfaces.C.int;
+      Errno        : Integer;
+      Stamp        : constant Time := Clock;
+   begin
+      if Self.Length = 0 then
+         Count := 0;
+         return;
+      end if;
+
+      loop
+         if Poll_Timeout >= Duration (Interfaces.C.int'Last - 8) / 1_000 then
+            --  Minus 8 is to workaround Linux kernel 2.6.24 bug with close to
+            --  Integer'Last poll timeout values.
+            --  syscall (SYS_poll, &ufds, 1, 2147483644); // is waiting
+            --  syscall (SYS_poll, &ufds, 1, 2147483645); // is not waiting
+            --  Timeout values close to maximum could be not safe because of
+            --  possible time conversion boundary errors in the kernel.
+            --  Use unlimited timeout instead of maximum 24 days timeout for
+            --  safety reasons.
+
+            C_Timeout := -1;
+         else
+            C_Timeout := Interfaces.C.int (Poll_Timeout * 1_000);
+         end if;
+
+         Wait (Self, C_Timeout, Result);
+
+         exit when Result >= 0;
+
+         Errno := Thin.Socket_Errno;
+
+         --  In case of EINTR error we have to continue waiting for network
+         --  events.
+
+         if Errno = SOC.EINTR then
+            if C_Timeout >= 0 then
+               Poll_Timeout := Timeout - (Clock - Stamp);
+
+               if Poll_Timeout < 0.0 then
+                  Count := 0;
+                  return;
+
+               elsif Poll_Timeout > Timeout then
+                  --  Clock moved back in time. This should not be happen when
+                  --  we use monotonic time.
+
+                  Poll_Timeout := Timeout;
+               end if;
+            end if;
+
+         else
+            Raise_Socket_Error (Errno);
+         end if;
+      end loop;
+
+      Count := Result;
+   end Wait;
+
+   ----------
+   -- Next --
+   ----------
+
+   procedure Next (Self : Set; Index : in out Natural) is
+   begin
+      loop
+         Index := Index + 1;
+
+         if Index > Self.Length then
+            Index := 0;
+            return;
+
+         elsif Self.Fds (Index).REvents /= 0 then
+            return;
+         end if;
+      end loop;
+   end Next;
+
+   ------------
+   -- Status --
+   ------------
+
+   function Status (Self : Set; Index : Positive) return Event_Set is
+   begin
+      Check_Range (Self, Index);
+      return Status (Self.Fds (Index));
+   end Status;
+
+   --------------
+   -- C_Status --
+   --------------
+
+   function C_Status
+     (Self : Set; Index : Positive) return Interfaces.C.unsigned is
+   begin
+      Check_Range (Self, Index);
+      return Interfaces.C.unsigned (Self.Fds (Index).REvents);
+   end C_Status;
+
+end GNAT.Sockets.Poll;
diff --git a/gcc/ada/libgnat/g-socpol.ads b/gcc/ada/libgnat/g-socpol.ads
new file mode 100644
index 0000000..c03c578
--- /dev/null
+++ b/gcc/ada/libgnat/g-socpol.ads
@@ -0,0 +1,216 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    G N A T . S O C K E T S . P O L L                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides an interface to wait for one of a set of sockets to
+--  become ready to perform I/O.
+
+with System.OS_Constants;
+
+package GNAT.Sockets.Poll is
+
+   type Event_Type is (Input, Output, Error, Hang_Up, Invalid_Request);
+   --  I/O events we can expect on socket.
+   --  Input           - socket ready to read;
+   --  Output          - socket available for write;
+   --  Error           - socket is in error state;
+   --  Hang_Up         - peer closed;
+   --  Invalid_Request - invalid socket;
+
+   type Event_Set is array (Event_Type) of Boolean;
+   --  The type to get results on events waiting
+
+   subtype Wait_Event_Type is Event_Type range Input .. Output;
+   type Wait_Event_Set is array (Wait_Event_Type) of Boolean;
+   --  The type to set events to wait. Note that Error event would be waited
+   --  anyway.
+
+   -------------------------------
+   --  Predefined set of events --
+   -------------------------------
+
+   Input_Event  : constant Wait_Event_Set;
+   --  Wait for input availability only
+
+   Output_Event : constant Wait_Event_Set;
+   --  Wait for output availability only
+
+   Both_Events : constant Wait_Event_Set;
+   --  Wait for Input and Output availability
+
+   Error_Event : constant Wait_Event_Set;
+   --  Wait only for error state on socket
+
+   type Set (Size : Positive) is private;
+   --  Set of sockets with I/O event set to wait on
+
+   function Create (Size : Positive) return Set;
+   --  Create empty socket set with defined size
+
+   function To_Set
+     (Socket : Socket_Type;
+      Events : Wait_Event_Set;
+      Size   : Positive := 1) return Set;
+   --  Create socket set and put the Socket there at the first place.
+   --  Events parameter is defining what state of the socket we are going to
+   --  wait.
+
+   procedure Append
+     (Self   : in out Set;
+      Socket : Socket_Type;
+      Events : Wait_Event_Set);
+   --  Add Socket and its I/O waiting state at the end of Self
+
+   procedure Insert
+     (Self       : in out Set;
+      Socket     : Socket_Type;
+      Events     : Wait_Event_Set;
+      Index      : Positive;
+      Keep_Order : Boolean := False);
+   --  Insert Socket and its I/O waiting state at the Index position.
+   --  If Keep_Order is True then all next elements moved to the next index up.
+   --  Otherwise the old element from Index moved to the end of the Self set.
+
+   procedure Remove
+     (Self : in out Set; Index : Positive; Keep_Order : Boolean := False);
+   --  Remove socket from Index. If Keep_Order is True then move all next
+   --  elements after removed one to previous index. If Keep_Order is False
+   --  then move the last element on place of the removed one.
+
+   procedure Set_Event
+     (Self  : in out Set;
+      Index : Positive;
+      Event : Wait_Event_Type;
+      Value : Boolean);
+   --  Set I/O waiting event to Value for the socket at Index position
+
+   procedure Set_Events
+     (Self   : in out Set;
+      Index  : Positive;
+      Events : Wait_Event_Set);
+   --  Set I/O waiting events for the socket at Index position
+
+   function Get_Events
+     (Self : Set; Index : Positive) return Wait_Event_Set;
+   --  Get I/O waiting events for the socket at Index position
+
+   function Length (Self : Set) return Natural;
+   --  Get the number of sockets currently in the Self set
+
+   function Full (Self : Set) return Boolean;
+   --  Return True if there is no more space in the Self set for new sockets
+
+   procedure Wait (Self : in out Set; Timeout : Duration; Count : out Natural);
+   --  Wait no longer than Timeout on the socket set for the I/O events.
+   --  Count output parameter is the number of elements in the Self set are
+   --  detected for I/O events. Zero Count mean timeout on wait.
+   --  The iteration over activated elements in set could be done with routine
+   --  Next. The kind of I/O events on element could be cheched with State or
+   --  Status routines.
+
+   procedure Next (Self : Set; Index : in out Natural);
+   --  Iterate over set looking for the next index with active I/O event state.
+   --  Put 0 initially into Index. Each iteration increments Index and then
+   --  checks for state. End of iterations can be detected by 0 in the Index.
+
+   procedure Copy (Source : Set; Target : out Set);
+   --  Copy sockets and its I/O waiting events from Source set into Target
+
+   function Resize (Self : Set; Size : Positive) return Set;
+   --  Returns the copy of Source with modified Size
+
+   function Growth (Self : Set) return Set;
+   --  Returns the copy of Source with increased Size
+
+   function Socket (Self : Set; Index : Positive) return Socket_Type;
+   --  Returns the Socket from Index position
+
+   function Status (Self : Set; Index : Positive) return Event_Set;
+   --  Returns I/O events detected in previous Wait call at Index position
+
+   procedure State
+     (Self   : Set;
+      Index  : Positive;
+      Socket : out Socket_Type;
+      Status : out Event_Set);
+   --  Returns Socket and its I/O events detected in previous Wait call at
+   --  Index position.
+
+   function C_Status
+     (Self : Set; Index : Positive) return Interfaces.C.unsigned;
+   --  Return word with I/O events detected flags in previous Wait call at
+   --  Index position. Possible flags are defined in System.OS_Constants names
+   --  starting with POLL prefix.
+
+private
+
+   Input_Event  : constant Wait_Event_Set := (Input => True, Output => False);
+   Output_Event : constant Wait_Event_Set := (Input => False, Output => True);
+   Both_Events  : constant Wait_Event_Set := (others => True);
+   Error_Event  : constant Wait_Event_Set := (others => False);
+
+   package SOC renames System.OS_Constants;
+
+   type nfds_t is mod 2 ** SOC.SIZEOF_nfds_t;
+   for nfds_t'Size use SOC.SIZEOF_nfds_t;
+
+   FD_Type_Bound : constant := 2 ** (SOC.SIZEOF_fd_type - 1);
+
+   type FD_Type is range -FD_Type_Bound .. FD_Type_Bound - 1;
+   for FD_Type'Size use SOC.SIZEOF_fd_type;
+
+   type Events_Type is mod 2 ** SOC.SIZEOF_pollfd_events;
+   for Events_Type'Size use SOC.SIZEOF_pollfd_events;
+
+   type Pollfd is record
+      Socket  : FD_Type;
+      Events  : Events_Type := 0;
+      REvents : Events_Type := 0;
+   end record with Convention => C;
+
+   type Poll_Set is array (Positive range <>) of Pollfd with Convention => C;
+
+   type Set (Size : Positive) is record
+      Length : Natural := 0;
+      Max_FD : FD_Type := 0;
+      Max_OK : Boolean;
+      --  Is the Max_FD actual. It can became inactual after remove socket with
+      --  Max_FD from set and became actual again after add socket with FD more
+      --  than Max_FD.
+      Fds    : Poll_Set (1 .. Size);
+   end record;
+
+   function Length (Self : Set) return Natural
+   is (Self.Length);
+
+   function Full (Self : Set) return Boolean
+   is (Self.Size = Self.Length);
+
+end GNAT.Sockets.Poll;
diff --git a/gcc/ada/libgnat/g-socpol__dummy.adb b/gcc/ada/libgnat/g-socpol__dummy.adb
new file mode 100644
index 0000000..01c7cc5
--- /dev/null
+++ b/gcc/ada/libgnat/g-socpol__dummy.adb
@@ -0,0 +1,32 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    G N A T . S O C K E T S . P O L L                     --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                         Copyright (C) 2020, AdaCore                      --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma No_Body;
diff --git a/gcc/ada/libgnat/g-socpol__dummy.ads b/gcc/ada/libgnat/g-socpol__dummy.ads
new file mode 100644
index 0000000..507471e
--- /dev/null
+++ b/gcc/ada/libgnat/g-socpol__dummy.ads
@@ -0,0 +1,37 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    G N A T . S O C K E T S . P O L L                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                         Copyright (C) 2020, AdaCore                      --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package is a placeholder for the sockets binding for platforms where
+--  it is not implemented.
+
+package GNAT.Sockets.Thin_Common is
+   pragma Unimplemented_Unit;
+end GNAT.Sockets.Thin_Common;
diff --git a/gcc/ada/libgnat/g-sopowa.adb b/gcc/ada/libgnat/g-sopowa.adb
new file mode 100644
index 0000000..fc6e6d9
--- /dev/null
+++ b/gcc/ada/libgnat/g-sopowa.adb
@@ -0,0 +1,56 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                G N A T . S O C K E T S . P O L L . W A I T               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Wait implementation on top of native poll call
+--
+--  This submodule can be used on systems where poll system call is natively
+--  supported. Microsoft Windows supports WSAPoll system call from Vista
+--  version and this submodule can be used on such Windows versions too, the
+--  System.OS_Constants.Poll_Linkname constant defines appropriate link name
+--  for Windows. But we do not use WSAPoll in GNAT.Sockets.Poll implementation
+--  for now because it is much slower than select system call, at least in
+--  Windows version 10.0.18363.1016.
+
+separate (GNAT.Sockets.Poll)
+
+procedure Wait
+  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
+is
+
+   function Poll
+     (Fds     : Poll_Set;
+      Nfds    : nfds_t;
+      Timeout : Interfaces.C.int) return Integer
+     with Import, Convention => Stdcall, External_Name => SOC.Poll_Linkname;
+
+begin
+   Result := Poll (Fds.Fds, nfds_t (Fds.Length), Timeout);
+end Wait;
diff --git a/gcc/ada/libgnat/g-sopowa__mingw.adb b/gcc/ada/libgnat/g-sopowa__mingw.adb
new file mode 100644
index 0000000..3d66437
--- /dev/null
+++ b/gcc/ada/libgnat/g-sopowa__mingw.adb
@@ -0,0 +1,92 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                G N A T . S O C K E T S . P O L L . W A I T               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Wait implementation on top of Windows select call
+--
+--  Microsoft Windows from Vista version has WSAPoll function in API which is
+--  similar to POSIX poll call, but experiments show that the WSAPoll is much
+--  slower than select at least in Windows version 10.0.18363.1016.
+
+with GNAT.Sockets.Poll.G_Wait;
+
+separate (GNAT.Sockets.Poll)
+
+procedure Wait
+  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
+is
+   use Interfaces;
+
+   type FD_Array is array (1 .. Fds.Length) of FD_Type
+     with Convention => C;
+
+   type FD_Set_Type is record
+      Count : C.int;
+      Set   : FD_Array;
+   end record with Convention => C;
+
+   procedure Reset_Socket_Set (Set : in out FD_Set_Type) with Inline;
+
+   procedure Insert_Socket_In_Set (Set : in out FD_Set_Type; FD : FD_Type)
+     with Inline;
+
+   function Is_Socket_In_Set (Set : FD_Set_Type; FD : FD_Type) return C.int
+     with Import, Convention => C,
+          External_Name => "__gnat_is_socket_in_set";
+
+   --------------------------
+   -- Insert_Socket_In_Set --
+   --------------------------
+
+   procedure Insert_Socket_In_Set (Set : in out FD_Set_Type; FD : FD_Type) is
+   begin
+      Set.Count := Set.Count + 1;
+      Set.Set (Integer (Set.Count)) := FD;
+   end Insert_Socket_In_Set;
+
+   ----------------------
+   -- Reset_Socket_Set --
+   ----------------------
+
+   procedure Reset_Socket_Set (Set : in out FD_Set_Type) is
+   begin
+      Set.Count := 0;
+   end Reset_Socket_Set;
+
+   ----------
+   -- Poll --
+   ----------
+
+   procedure Poll is new G_Wait
+     (FD_Set_Type, Reset_Socket_Set, Insert_Socket_In_Set, Is_Socket_In_Set);
+
+begin
+   Poll (Fds, Timeout, Result);
+end Wait;
diff --git a/gcc/ada/libgnat/g-sopowa__posix.adb b/gcc/ada/libgnat/g-sopowa__posix.adb
new file mode 100644
index 0000000..02ccb77
--- /dev/null
+++ b/gcc/ada/libgnat/g-sopowa__posix.adb
@@ -0,0 +1,91 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                G N A T . S O C K E T S . P O L L . W A I T               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Wait implementation on top of posix select call
+
+with GNAT.Sockets.Poll.G_Wait;
+
+separate (GNAT.Sockets.Poll)
+
+procedure Wait
+  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
+is
+   use Interfaces;
+
+   function Get_Max_FD return FD_Type;
+   --  Check is Max_FD is actual and correct it if necessary
+
+   type FD_Set_Type is array (0 .. Get_Max_FD / C.long'Size) of C.long
+     with Convention => C;
+
+   procedure Reset_Socket_Set (Set : in out FD_Set_Type);
+   --  Use own FD_ZERO routine because FD_Set_Type size depend on Fds.Max_FD
+
+   procedure Insert_Socket_In_Set (Set : in out FD_Set_Type; FD : FD_Type)
+     with Import, Convention => C,
+          External_Name => "__gnat_insert_socket_in_set";
+
+   function Is_Socket_In_Set (Set : FD_Set_Type; FD : FD_Type) return C.int
+     with Import, Convention => C,
+          External_Name => "__gnat_is_socket_in_set";
+
+   procedure Reset_Socket_Set (Set : in out FD_Set_Type) is
+   begin
+      Set := (others => 0);
+   end Reset_Socket_Set;
+
+   procedure Poll is new G_Wait
+     (FD_Set_Type, Reset_Socket_Set, Insert_Socket_In_Set, Is_Socket_In_Set);
+
+   ----------------
+   -- Get_Max_FD --
+   ----------------
+
+   function Get_Max_FD return FD_Type is
+   begin
+      if not Fds.Max_OK then
+         Fds.Max_FD := Fds.Fds (Fds.Fds'First).Socket;
+
+         for J in Fds.Fds'First + 1 .. Fds.Length loop
+            if Fds.Max_FD < Fds.Fds (J).Socket then
+               Fds.Max_FD := Fds.Fds (J).Socket;
+            end if;
+         end loop;
+
+         Fds.Max_OK := True;
+      end if;
+
+      return Fds.Max_FD;
+   end Get_Max_FD;
+
+begin
+   Poll (Fds, Timeout, Result);
+end Wait;
diff --git a/gcc/ada/libgnat/g-spogwa.adb b/gcc/ada/libgnat/g-spogwa.adb
new file mode 100644
index 0000000..a9135ea
--- /dev/null
+++ b/gcc/ada/libgnat/g-spogwa.adb
@@ -0,0 +1,139 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--             G N A T . S O C K E T S . P O L L . G _ W A I T              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with GNAT.Sockets.Thin_Common;
+
+procedure GNAT.Sockets.Poll.G_Wait
+  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
+is
+   use Interfaces;
+
+   use type C.int;
+
+   function C_Select
+     (Nfds      : C.int;
+      readfds   : access FD_Set_Type;
+      writefds  : access FD_Set_Type;
+      exceptfds : access FD_Set_Type;
+      timeout   : access Thin_Common.Timeval) return Integer
+     with Import => True, Convention => Stdcall, External_Name => "select";
+
+   Timeout_V : aliased Thin_Common.Timeval;
+   Timeout_A : access Thin_Common.Timeval;
+
+   Rfds      : aliased FD_Set_Type;
+   Rcount    : Natural := 0;
+   Wfds      : aliased FD_Set_Type;
+   Wcount    : Natural := 0;
+   Efds      : aliased FD_Set_Type;
+
+   Rfdsa     : access FD_Set_Type;
+   Wfdsa     : access FD_Set_Type;
+
+   FD_Events : Events_Type;
+
+begin
+   --  Setup (convert data from poll to select layout)
+
+   if Timeout >= 0 then
+      Timeout_A := Timeout_V'Access;
+      Timeout_V.tv_sec  := Thin_Common.time_t  (Timeout / 1000);
+      Timeout_V.tv_usec := Thin_Common.suseconds_t (Timeout rem 1000 * 1000);
+   end if;
+
+   Reset_Socket_Set (Rfds);
+   Reset_Socket_Set (Wfds);
+   Reset_Socket_Set (Efds);
+
+   for J in Fds.Fds'First .. Fds.Length loop
+      Fds.Fds (J).REvents := 0;
+
+      FD_Events := Fds.Fds (J).Events;
+
+      if (FD_Events and (SOC.POLLIN or SOC.POLLPRI)) /= 0 then
+         Insert_Socket_In_Set (Rfds, Fds.Fds (J).Socket);
+         Rcount := Rcount + 1;
+      end if;
+
+      if (FD_Events and SOC.POLLOUT) /= 0 then
+         Insert_Socket_In_Set (Wfds, Fds.Fds (J).Socket);
+         Wcount := Wcount + 1;
+      end if;
+
+      Insert_Socket_In_Set (Efds, Fds.Fds (J).Socket);
+
+      if Fds.Fds (J).Socket > Fds.Max_FD then
+         raise Program_Error with "Wrong Max_FD";
+      end if;
+   end loop;
+
+   --  Any non-null descriptor set must contain at least one handle
+   --  to a socket on Windows (MSDN).
+
+   if Rcount /= 0 then
+      Rfdsa := Rfds'Access;
+   end if;
+
+   if Wcount /= 0 then
+      Wfdsa := Wfds'Access;
+   end if;
+
+   --  Call OS select
+
+   Result :=
+     C_Select (C.int (Fds.Max_FD + 1), Rfdsa, Wfdsa, Efds'Access, Timeout_A);
+
+   --  Build result (convert back from select to poll layout)
+
+   if Result > 0 then
+      Result := 0;
+
+      for J in Fds.Fds'First .. Fds.Length loop
+         if Is_Socket_In_Set (Rfds, Fds.Fds (J).Socket) /= 0 then
+            --  Do not need "or" with Poll_Ptr (J).REvents because it's zero
+
+            Fds.Fds (J).REvents := SOC.POLLIN;
+         end if;
+
+         if Is_Socket_In_Set (Wfds, Fds.Fds (J).Socket) /= 0 then
+            Fds.Fds (J).REvents := Fds.Fds (J).REvents or SOC.POLLOUT;
+         end if;
+
+         if Is_Socket_In_Set (Efds, Fds.Fds (J).Socket) /= 0 then
+            Fds.Fds (J).REvents := Fds.Fds (J).REvents or SOC.POLLERR;
+         end if;
+
+         if Fds.Fds (J).REvents /= 0 then
+            Result := Result + 1;
+         end if;
+      end loop;
+   end if;
+end GNAT.Sockets.Poll.G_Wait;
diff --git a/gcc/ada/libgnat/g-spogwa.ads b/gcc/ada/libgnat/g-spogwa.ads
new file mode 100644
index 0000000..bde6a69
--- /dev/null
+++ b/gcc/ada/libgnat/g-spogwa.ads
@@ -0,0 +1,50 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--             G N A T . S O C K E T S . P O L L . G _ W A I T              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                       Copyright (C) 2020, AdaCore                        --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Interfaces.C;
+
+private generic
+   type FD_Set_Type is private;
+   with procedure Reset_Socket_Set (Set : in out FD_Set_Type);
+   with procedure Insert_Socket_In_Set
+          (Set : in out FD_Set_Type; FD : FD_Type);
+   with function Is_Socket_In_Set
+          (Set : FD_Set_Type; FD : FD_Type) return Interfaces.C.int;
+procedure GNAT.Sockets.Poll.G_Wait
+  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer);
+--  Common code to implement GNAT.Sockets.Poll.Wait routine on top of posix or
+--  win32 select API.
+--  Posix and Win32 select has the same API but different socket set structure.
+--  C API for select has socket set size defined at compilation stage. This Ada
+--  implementation allow to define size of socket set at the execution time.
+--  Unlike C select API we do not need allocate socket set for maximum number
+--  of sockets when we need to check only few of them. And we are not limited
+--  with FD_SETSIZE when we need more sockets to check.