1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158 | --
-- Copyright (C) 2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--
with GNAT.OS_Lib;
with Spawn.Posix;
package body Spawn.Polls.POSIX_Polls is
function To_Event_Set
(Set : Watch_Event_Set) return Interfaces.C.unsigned_short;
function To_Event_Set (Set : Interfaces.C.unsigned_short) return Event_Set;
----------------
-- Initialize --
----------------
overriding procedure Initialize (Self : out POSIX_Poll) is
begin
Self.Initialized := True;
end Initialize;
--------------------
-- Is_Initialized --
--------------------
overriding function Is_Initialized (Self : POSIX_Poll) return Boolean is
begin
return Self.Initialized;
end Is_Initialized;
------------------
-- To_Event_Set --
------------------
function To_Event_Set
(Set : Watch_Event_Set) return Interfaces.C.unsigned_short
is
use type Interfaces.C.unsigned_short;
Map : constant array (Watch_Event) of Interfaces.C.unsigned_short :=
(Input => Posix.POLLIN,
Output => Posix.POLLOUT);
Result : Interfaces.C.unsigned_short := 0;
begin
for J in Set'Range loop
if Set (J) then
Result := Result + Map (J);
end if;
end loop;
return Result;
end To_Event_Set;
------------------
-- To_Event_Set --
------------------
function To_Event_Set
(Set : Interfaces.C.unsigned_short) return Event_Set
is
use type Interfaces.C.unsigned_short;
Map : constant array (Event) of Interfaces.C.unsigned_short :=
(Close => Posix.POLLHUP,
Input => Posix.POLLIN,
Output => Posix.POLLOUT,
others => 0);
Value : Interfaces.C.unsigned_short := Set;
Result : Event_Set := (Event => False);
begin
for J in Map'Range loop
if (Value and Map (J)) /= 0 then
Value := Value - Map (J);
Result (J) := True;
end if;
end loop;
Result (Error) := Value /= 0;
return Result;
end To_Event_Set;
-----------
-- Watch --
-----------
overriding procedure Watch
(Self : in out POSIX_Poll;
Value : Descriptor;
Events : Watch_Event_Set;
Listener : Listener_Access := null)
is
Cursor : constant Info_Maps.Cursor := Self.Map.Find (Value);
begin
if Events = Empty_Set then
Self.Map.Exclude (Value);
elsif Info_Maps.Has_Element (Cursor) then
Self.Map (Cursor) := (Events, Listener);
else
Self.Map.Insert (Value, (Events, Listener));
end if;
end Watch;
----------
-- Wait --
----------
overriding procedure Wait
(Self : in out POSIX_Poll;
Timeout : Duration)
is
use type Interfaces.C.int;
use type Interfaces.C.unsigned_short;
Length : constant Natural := Natural (Self.Map.Length);
Index : Positive := 1;
fds : Posix.pollfd_array (1 .. Length);
Listener : Listener_Access;
m_sec : constant Interfaces.C.int := Interfaces.C.int (Timeout * 1000.0);
-- Wait for an event in the poll
Count : Interfaces.C.int;
begin
for Cursor in Self.Map.Iterate loop
fds (Index).fd := Info_Maps.Key (Cursor);
fds (Index).events :=
To_Event_Set (Info_Maps.Element (Cursor).Events);
fds (Index).revents := 0;
Index := Index + 1;
end loop;
Count := Posix.poll (fds, fds'Length, m_sec);
if Count > 0 then
for J in fds'Range loop
if fds (J).revents /= 0 then
Count := Count - 1;
Listener := Self.Map (fds (J).fd).Listener;
Self.Map.Delete (fds (J).fd);
Listener.On_Event
(Self'Unchecked_Access,
fds (J).fd,
To_Event_Set (fds (J).revents));
end if;
end loop;
elsif Count < 0 then
raise Program_Error with GNAT.OS_Lib.Errno_Message;
end if;
end Wait;
end Spawn.Polls.POSIX_Polls;
|