1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S . P O L L . G _ W A I T --
9 -- Copyright (C) 2020-2024, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with GNAT
.Sockets
.Thin_Common
;
34 procedure GNAT
.Sockets
.Poll
.G_Wait
35 (Fds
: in out Set
; Timeout
: Interfaces
.C
.int
; Result
: out Integer)
41 readfds
: access FD_Set_Type
;
42 writefds
: access FD_Set_Type
;
43 exceptfds
: access FD_Set_Type
;
44 timeout
: access Thin_Common
.Timeval
) return Integer
45 with Import
=> True, Convention
=> Stdcall
, External_Name
=> "select";
47 Timeout_V
: aliased Thin_Common
.Timeval
;
48 Timeout_A
: access Thin_Common
.Timeval
;
50 Rfds
: aliased FD_Set_Type
;
51 Rcount
: Natural := 0;
52 Wfds
: aliased FD_Set_Type
;
53 Wcount
: Natural := 0;
54 Efds
: aliased FD_Set_Type
;
56 Rfdsa
: access FD_Set_Type
;
57 Wfdsa
: access FD_Set_Type
;
59 FD_Events
: Events_Type
;
62 -- Setup (convert data from poll to select layout)
65 Timeout_A
:= Timeout_V
'Access;
66 Timeout_V
.Tv_Sec
:= Thin_Common
.time_t
(Timeout
/ 1000);
67 Timeout_V
.Tv_Usec
:= Thin_Common
.suseconds_t
(Timeout
rem 1000 * 1000);
70 Reset_Socket_Set
(Rfds
);
71 Reset_Socket_Set
(Wfds
);
72 Reset_Socket_Set
(Efds
);
74 for J
in Fds
.Fds
'First .. Fds
.Length
loop
75 Fds
.Fds
(J
).REvents
:= 0;
77 FD_Events
:= Fds
.Fds
(J
).Events
;
79 if (FD_Events
and (SOC
.POLLIN
or SOC
.POLLPRI
)) /= 0 then
80 Insert_Socket_In_Set
(Rfds
, Fds
.Fds
(J
).Socket
);
84 if (FD_Events
and SOC
.POLLOUT
) /= 0 then
85 Insert_Socket_In_Set
(Wfds
, Fds
.Fds
(J
).Socket
);
89 Insert_Socket_In_Set
(Efds
, Fds
.Fds
(J
).Socket
);
91 if Fds
.Fds
(J
).Socket
> Fds
.Max_FD
then
92 raise Program_Error
with "Wrong Max_FD";
96 -- Any non-null descriptor set must contain at least one handle
97 -- to a socket on Windows (MSDN).
100 Rfdsa
:= Rfds
'Access;
104 Wfdsa
:= Wfds
'Access;
110 C_Select
(C
.int
(Fds
.Max_FD
+ 1), Rfdsa
, Wfdsa
, Efds
'Access, Timeout_A
);
112 -- Build result (convert back from select to poll layout)
117 for J
in Fds
.Fds
'First .. Fds
.Length
loop
118 if Is_Socket_In_Set
(Rfds
, Fds
.Fds
(J
).Socket
) /= 0 then
119 -- Do not need "or" with Poll_Ptr (J).REvents because it's zero
121 Fds
.Fds
(J
).REvents
:= SOC
.POLLIN
;
124 if Is_Socket_In_Set
(Wfds
, Fds
.Fds
(J
).Socket
) /= 0 then
125 Fds
.Fds
(J
).REvents
:= Fds
.Fds
(J
).REvents
or SOC
.POLLOUT
;
128 if Is_Socket_In_Set
(Efds
, Fds
.Fds
(J
).Socket
) /= 0 then
129 Fds
.Fds
(J
).REvents
:= Fds
.Fds
(J
).REvents
or SOC
.POLLERR
;
132 if Fds
.Fds
(J
).REvents
/= 0 then
133 Result
:= Result
+ 1;
137 end GNAT
.Sockets
.Poll
.G_Wait
;