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