1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--             G N A T . S O C K E T S . P O L L . G _ W A I T              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                       Copyright (C) 2020, AdaCore                        --
10--                                                                          --
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.                                     --
17--                                                                          --
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.               --
21--                                                                          --
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/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32with GNAT.Sockets.Thin_Common;
33
34procedure GNAT.Sockets.Poll.G_Wait
35  (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
36is
37   use Interfaces;
38
39   function C_Select
40     (Nfds      : C.int;
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";
46
47   Timeout_V : aliased Thin_Common.Timeval;
48   Timeout_A : access Thin_Common.Timeval;
49
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;
55
56   Rfdsa     : access FD_Set_Type;
57   Wfdsa     : access FD_Set_Type;
58
59   FD_Events : Events_Type;
60
61begin
62   --  Setup (convert data from poll to select layout)
63
64   if Timeout >= 0 then
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);
68   end if;
69
70   Reset_Socket_Set (Rfds);
71   Reset_Socket_Set (Wfds);
72   Reset_Socket_Set (Efds);
73
74   for J in Fds.Fds'First .. Fds.Length loop
75      Fds.Fds (J).REvents := 0;
76
77      FD_Events := Fds.Fds (J).Events;
78
79      if (FD_Events and (SOC.POLLIN or SOC.POLLPRI)) /= 0 then
80         Insert_Socket_In_Set (Rfds, Fds.Fds (J).Socket);
81         Rcount := Rcount + 1;
82      end if;
83
84      if (FD_Events and SOC.POLLOUT) /= 0 then
85         Insert_Socket_In_Set (Wfds, Fds.Fds (J).Socket);
86         Wcount := Wcount + 1;
87      end if;
88
89      Insert_Socket_In_Set (Efds, Fds.Fds (J).Socket);
90
91      if Fds.Fds (J).Socket > Fds.Max_FD then
92         raise Program_Error with "Wrong Max_FD";
93      end if;
94   end loop;
95
96   --  Any non-null descriptor set must contain at least one handle
97   --  to a socket on Windows (MSDN).
98
99   if Rcount /= 0 then
100      Rfdsa := Rfds'Access;
101   end if;
102
103   if Wcount /= 0 then
104      Wfdsa := Wfds'Access;
105   end if;
106
107   --  Call OS select
108
109   Result :=
110     C_Select (C.int (Fds.Max_FD + 1), Rfdsa, Wfdsa, Efds'Access, Timeout_A);
111
112   --  Build result (convert back from select to poll layout)
113
114   if Result > 0 then
115      Result := 0;
116
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
120
121            Fds.Fds (J).REvents := SOC.POLLIN;
122         end if;
123
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;
126         end if;
127
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;
130         end if;
131
132         if Fds.Fds (J).REvents /= 0 then
133            Result := Result + 1;
134         end if;
135      end loop;
136   end if;
137end GNAT.Sockets.Poll.G_Wait;
138