mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-19 22:21:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Sockets.Poll implementation

Browse Source 
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.
This commit is contained in:
Dmitriy Anisimkov 2020-08-08 18:49:27 +06:00 committed by Pierre-Marie de Rodat
parent 66e97274ce
commit d08d481912
15 changed files with 1235 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/Makefile.rtl
View File

@ -820,7 +820,7 @@ GNATLIB_SHARED = gnatlib
# to LIBGNAT_TARGET_PAIRS.
GNATRTL_SOCKETS_OBJS = g-soccon$(objext) g-socket$(objext) g-socthi$(objext) \
g-soliop$(objext) g-sothco$(objext)
g-soliop$(objext) g-sothco$(objext) g-socpol$(objext)
DUMMY_SOCKETS_TARGET_PAIRS = \
g-socket.adb<libgnat/g-socket__dummy.adb \
@ -828,7 +828,9 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
g-socthi.adb<libgnat/g-socthi__dummy.adb \
g-socthi.ads<libgnat/g-socthi__dummy.ads \
g-sothco.adb<libgnat/g-sothco__dummy.adb \
g-sothco.ads<libgnat/g-sothco__dummy.ads
g-sothco.ads<libgnat/g-sothco__dummy.ads \
g-socpol.adb<libgnat/g-socpol__dummy.adb \
g-socpol.ads<libgnat/g-socpol__dummy.ads
# On platforms where atomic increment/decrement operations are supported,
# special version of Ada.Strings.Unbounded package can be used.
@ -1043,6 +1045,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworksspe vxworks7% vxworks7spe
s-vxwork.ads<libgnarl/s-vxwork__ppc.ads \
g-socthi.ads<libgnat/g-socthi__vxworks.ads \
g-socthi.adb<libgnat/g-socthi__vxworks.adb \
g-sopowa.adb<libgnat/g-sopowa__posix.adb \
g-stsifd.adb<libgnat/g-stsifd__sockets.adb \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS)
@ -1203,6 +1206,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae vxworksaespe,$(target_cpu) $(t
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<libgnat/g-socthi__vxworks.ads \
g-socthi.adb<libgnat/g-socthi__vxworks.adb \
g-sopowa.adb<libgnat/g-sopowa__posix.adb \
g-stsifd.adb<libgnat/g-stsifd__sockets.adb
endif
@ -1261,6 +1265,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae,$(target_cpu) $(target_vendor) $(ta
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<libgnat/g-socthi__vxworks.ads \
g-socthi.adb<libgnat/g-socthi__vxworks.adb \
g-sopowa.adb<libgnat/g-sopowa__posix.adb \
g-stsifd.adb<libgnat/g-stsifd__sockets.adb
endif
@ -1291,6 +1296,7 @@ ifeq ($(strip $(filter-out %86 x86_64 wrs vxworks vxworks7%,$(target_cpu) $(targ
s-vxwork.ads<libgnarl/s-vxwork__x86.ads \
g-socthi.ads<libgnat/g-socthi__vxworks.ads \
g-socthi.adb<libgnat/g-socthi__vxworks.adb \
g-sopowa.adb<libgnat/g-sopowa__posix.adb \
g-stsifd.adb<libgnat/g-stsifd__sockets.adb \
$(ATOMICS_TARGET_PAIRS)
@ -1435,6 +1441,7 @@ ifeq ($(strip $(filter-out aarch64 arm% coff wrs vx%,$(target_cpu) $(target_vend
s-taspri.ads<libgnarl/s-taspri__vxworks.ads \
g-socthi.ads<libgnat/g-socthi__vxworks.ads \
g-socthi.adb<libgnat/g-socthi__vxworks.adb \
g-sopowa.adb<libgnat/g-sopowa__posix.adb \
g-stsifd.adb<libgnat/g-stsifd__sockets.adb
ifeq ($(strip $(filter-out aarch64, $(target_cpu))),)
@ -2166,7 +2173,8 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),)
else
LIBGNAT_TARGET_PAIRS = \
g-socthi.ads<libgnat/g-socthi__mingw.ads \
g-socthi.adb<libgnat/g-socthi__mingw.adb
g-socthi.adb<libgnat/g-socthi__mingw.adb \
g-sopowa.adb<libgnat/g-sopowa__mingw.adb
endif
LIBGNAT_TARGET_PAIRS += \
a-dirval.adb<libgnat/a-dirval__mingw.adb \

6
gcc/ada/gsocket.h
View File

@ -80,6 +80,12 @@
#define FD_SETSIZE 1024
#ifdef __MINGW32__
/* winsock2.h allows WSAPoll related definitions only when
* _WIN32_WINNT >= 0x0600 */
#if !defined(_WIN32_WINNT) || _WIN32_WINNT < 0x0600
#define _WIN32_WINNT 0x0600
#endif
#include <winsock2.h>
#include <ws2tcpip.h>
#include <versionhelpers.h>

1
gcc/ada/impunit.adb
View File

@ -310,6 +310,7 @@ package body Impunit is
("g-sha512", F), -- GNAT.SHA512
("g-signal", F), -- GNAT.Signals
("g-socket", F), -- GNAT.Sockets
("g-socpol", F), -- GNAT.Sockets.Poll
("g-souinf", F), -- GNAT.Source_Info
("g-speche", F), -- GNAT.Spell_Checker
("g-spchge", F), -- GNAT.Spell_Checker_Generic

4
gcc/ada/libgnat/g-socket.adb
View File

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

4
gcc/ada/libgnat/g-socket.ads
View File

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

430
gcc/ada/libgnat/g-socpol.adb Normal file
View File

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

216
gcc/ada/libgnat/g-socpol.ads Normal file
View File

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

32
gcc/ada/libgnat/g-socpol__dummy.adb Normal file
View File

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

37
gcc/ada/libgnat/g-socpol__dummy.ads Normal file
View File

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

56
gcc/ada/libgnat/g-sopowa.adb Normal file
View File

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

92
gcc/ada/libgnat/g-sopowa__mingw.adb Normal file
View File

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

91
gcc/ada/libgnat/g-sopowa__posix.adb Normal file
View File

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

139
gcc/ada/libgnat/g-spogwa.adb Normal file
View File

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

50
gcc/ada/libgnat/g-spogwa.ads Normal file
View File

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

71
gcc/ada/s-oscons-tmplt.c
View File

@ -96,7 +96,7 @@ pragma Style_Checks ("M32766");
/* Define _BSD_SOURCE to get CRTSCTS */
# define _BSD_SOURCE
#endif /* defined (__linux__) */
#endif /* defined (__linux__) || defined (__ANDROID__) */
/* Include gsocket.h before any system header so it can redefine FD_SETSIZE */
@ -121,6 +121,8 @@ pragma Style_Checks ("M32766");
**/
# include <vxWorks.h>
#elif !defined(__MINGW32__)
#include <poll.h>
#endif
#include "adaint.h"
@ -1735,12 +1737,28 @@ CND(SIZEOF_sigset, "sigset")
#endif
#if defined(_WIN32) || defined(__vxworks)
#define SIZEOF_nfds_t sizeof (int) * 8
#define SIZEOF_socklen_t sizeof (size_t)
#else
#define SIZEOF_nfds_t sizeof (nfds_t) * 8
#define SIZEOF_socklen_t sizeof (socklen_t)
#endif
CND(SIZEOF_nfds_t, "Size of nfds_t");
CND(SIZEOF_socklen_t, "Size of socklen_t");
{
#if defined(__vxworks)
#define SIZEOF_fd_type sizeof (int) * 8
#define SIZEOF_pollfd_events sizeof (short) * 8
#else
const struct pollfd v_pollfd;
#define SIZEOF_fd_type sizeof (v_pollfd.fd) * 8
#define SIZEOF_pollfd_events sizeof (v_pollfd.events) * 8
#endif
CND(SIZEOF_fd_type, "Size of socket fd");
CND(SIZEOF_pollfd_events, "Size of pollfd.events");
}
#ifndef IF_NAMESIZE
#ifdef IF_MAX_STRING_SIZE
#define IF_NAMESIZE IF_MAX_STRING_SIZE
@ -1750,6 +1768,50 @@ CND(SIZEOF_socklen_t, "Size of socklen_t");
#endif
CND(IF_NAMESIZE, "Max size of interface name with 0 terminator");
/*
-- Poll values
*/
#if defined(__vxworks)
#ifndef POLLIN
#define POLLIN 1
#endif
#ifndef POLLPRI
#define POLLPRI 2
#endif
#ifndef POLLOUT
#define POLLOUT 4
#endif
#ifndef POLLERR
#define POLLERR 8
#endif
#ifndef POLLHUP
#define POLLHUP 16
#endif
#ifndef POLLNVAL
#define POLLNVAL 32
#endif
#elif defined(_WIN32)
#define POLLPRI 0
/* If the POLLPRI flag is set on a socket for the Microsoft Winsock provider,
* the WSAPoll function will fail. */
#endif
CND(POLLIN, "There is data to read");
CND(POLLPRI, "Urgent data to read");
CND(POLLOUT, "Writing will not block");
CND(POLLERR, "Error (output only)");
CND(POLLHUP, "Hang up (output only)");
CND(POLLNVAL, "Invalid request");
/*
-- Fields of struct msghdr
@ -1799,6 +1861,13 @@ CST(Inet_Pton_Linkname, "")
#endif
CST(Inet_Ntop_Linkname, "")
#if defined(_WIN32)
# define Poll_Linkname "WSAPoll"
#else
# define Poll_Linkname "poll"
#endif
CST(Poll_Linkname, "")
#endif /* HAVE_SOCKETS */
/*