1 |
{lsocket.pas}
|
2 |
|
3 |
{io and timer code by plugwash}
|
4 |
|
5 |
{ Copyright (C) 2005 Bas Steendijk and Peter Green
|
6 |
For conditions of distribution and use, see copyright notice in zlib_license.txt
|
7 |
which is included in the package
|
8 |
----------------------------------------------------------------------------- }
|
9 |
|
10 |
{$ifdef fpc}
|
11 |
{$ifndef ver1_0}
|
12 |
{$define useinline}
|
13 |
{$endif}
|
14 |
{$endif}
|
15 |
|
16 |
unit lcoreselect;
|
17 |
|
18 |
|
19 |
interface
|
20 |
uses
|
21 |
{$ifdef VER1_0}
|
22 |
linux,
|
23 |
{$else}
|
24 |
baseunix,unix,unixutil,sockets,
|
25 |
{$endif}
|
26 |
fd_utils;
|
27 |
var
|
28 |
maxs : longint ;
|
29 |
exitloopflag : boolean ; {if set by app, exit mainloop}
|
30 |
|
31 |
function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}
|
32 |
function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}
|
33 |
|
34 |
procedure lcoreinit;
|
35 |
|
36 |
implementation
|
37 |
uses
|
38 |
lcore,sysutils,
|
39 |
classes,pgtypes,bfifo,
|
40 |
{$ifndef nosignal}
|
41 |
lsignal,
|
42 |
{$endif}
|
43 |
ltimevalstuff;
|
44 |
|
45 |
{$include unixstuff.inc}
|
46 |
|
47 |
const
|
48 |
absolutemaxs_select = (sizeof(fdset)*8)-1;
|
49 |
|
50 |
var
|
51 |
fdreverse:array[0..absolutemaxs_select] of tlasio;
|
52 |
type
|
53 |
tselecteventcore=class(teventcore)
|
54 |
public
|
55 |
procedure processmessages; override;
|
56 |
procedure messageloop; override;
|
57 |
procedure exitmessageloop;override;
|
58 |
procedure setfdreverse(fd : integer;reverseto : tlasio); override;
|
59 |
procedure rmasterset(fd : integer;islistensocket : boolean); override;
|
60 |
procedure rmasterclr(fd: integer); override;
|
61 |
procedure wmasterset(fd : integer); override;
|
62 |
procedure wmasterclr(fd: integer); override;
|
63 |
end;
|
64 |
|
65 |
procedure processtimers;inline;
|
66 |
var
|
67 |
tvnow : ttimeval ;
|
68 |
currenttimer : tltimer ;
|
69 |
temptimer : tltimer ;
|
70 |
|
71 |
begin
|
72 |
gettimeofday(tvnow);
|
73 |
currenttimer := firsttimer;
|
74 |
while assigned(currenttimer) do begin
|
75 |
//writeln(currenttimer.enabled);
|
76 |
if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
|
77 |
//if assigned(currenttimer.ontimer) then begin
|
78 |
// if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
|
79 |
// currenttimer.initialdone := true;
|
80 |
//end;
|
81 |
if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
|
82 |
currenttimer.nextts := timeval(tvnow);
|
83 |
tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
|
84 |
end;
|
85 |
temptimer := currenttimer;
|
86 |
currenttimer := currenttimer.nexttimer;
|
87 |
end;
|
88 |
end;
|
89 |
|
90 |
procedure processasios(var fdsr,fdsw:fdset);//inline;
|
91 |
var
|
92 |
currentsocket : tlasio ;
|
93 |
socketcount : integer ; // for debugging purposes :)
|
94 |
dw,bt:integer;
|
95 |
currentfdword:fdword;
|
96 |
fd : integer;
|
97 |
begin
|
98 |
//writeln('entering processasios');
|
99 |
{ inc(lcoretestcount);}
|
100 |
|
101 |
//the message loop will exit if all lasios and ltimers and lsignals are destroyed
|
102 |
//if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
|
103 |
|
104 |
|
105 |
{------- test optimised loop}
|
106 |
socketcount := 0;
|
107 |
for dw := (maxs shr fdwordshift) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
|
108 |
currentfdword := (fdsr[dw] or fdsw[dw]);
|
109 |
for bt := fdwordmaxbit downto 0 do if currentfdword and (1 shl bt) <> 0 then begin
|
110 |
inc(socketcount);
|
111 |
fd := dw shl fdwordshift or bt;
|
112 |
//writeln('reversing fd ',fd);
|
113 |
currentsocket := fdreverse[fd];
|
114 |
{if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
|
115 |
if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
|
116 |
{i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
|
117 |
if not assigned(currentsocket) then begin
|
118 |
fdclose(fd);
|
119 |
continue
|
120 |
end;
|
121 |
if currentsocket.fdhandlein < 0 then begin
|
122 |
fdclose(fd);
|
123 |
continue
|
124 |
end;
|
125 |
try
|
126 |
currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));
|
127 |
except
|
128 |
on E: exception do begin
|
129 |
currentsocket.HandleBackGroundException(e);
|
130 |
end;
|
131 |
end;
|
132 |
|
133 |
if mustrefreshfds then begin
|
134 |
if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
|
135 |
fd_zero(fdsr);
|
136 |
fd_zero(fdsw);
|
137 |
end;
|
138 |
end;
|
139 |
end;
|
140 |
end;
|
141 |
|
142 |
{
|
143 |
!!! issues:
|
144 |
- sockets which are released may not be freed because theyre never processed by the loop
|
145 |
made new code for handling this, using asinreleaseflag
|
146 |
|
147 |
- when/why does the mustrefreshfds select apply, check if i did it correctly?
|
148 |
|
149 |
- what happens if calling handlefdtrigger for a socket which does not have an event
|
150 |
}
|
151 |
{------- original loop}
|
152 |
|
153 |
(*
|
154 |
currentsocket := firstasin;
|
155 |
socketcount := 0;
|
156 |
while assigned(currentsocket) do begin
|
157 |
if mustrefreshfds then begin
|
158 |
if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
|
159 |
fd_zero(fdsr);
|
160 |
fd_zero(fdsw);
|
161 |
end;
|
162 |
end;
|
163 |
try
|
164 |
if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
|
165 |
currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
|
166 |
end;
|
167 |
except
|
168 |
on E: exception do begin
|
169 |
currentsocket.HandleBackGroundException(e);
|
170 |
end;
|
171 |
end;
|
172 |
tempsocket := currentsocket;
|
173 |
currentsocket := currentsocket.nextasin;
|
174 |
inc(socketcount);
|
175 |
if tempsocket.released then begin
|
176 |
tempsocket.free;
|
177 |
end;
|
178 |
end; *)
|
179 |
{ debugout('socketcount='+inttostr(socketcount));}
|
180 |
//writeln('leaving processasios');
|
181 |
end;
|
182 |
|
183 |
procedure tselecteventcore.processmessages;
|
184 |
var
|
185 |
fdsr , fdsw : fdset ;
|
186 |
selectresult : longint ;
|
187 |
begin
|
188 |
mustrefreshfds := false;
|
189 |
{$ifndef nosignal}
|
190 |
prepsigpipe;
|
191 |
{$endif}
|
192 |
selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
|
193 |
while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
|
194 |
|
195 |
processtasks;
|
196 |
processtimers;
|
197 |
if selectresult > 0 then begin
|
198 |
processasios(fdsr,fdsw);
|
199 |
end;
|
200 |
selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
|
201 |
|
202 |
end;
|
203 |
mustrefreshfds := true;
|
204 |
end;
|
205 |
|
206 |
|
207 |
var
|
208 |
FDSR , FDSW : fdset;
|
209 |
|
210 |
var
|
211 |
fdsrmaster , fdswmaster : fdset ;
|
212 |
|
213 |
function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
|
214 |
begin
|
215 |
result := fdsrmaster;
|
216 |
end;
|
217 |
function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
|
218 |
begin
|
219 |
result := fdswmaster;
|
220 |
end;
|
221 |
|
222 |
|
223 |
Function doSelect(timeOut:PTimeVal):longint;//inline;
|
224 |
var
|
225 |
localtimeval : ttimeval;
|
226 |
maxslocal : integer;
|
227 |
begin
|
228 |
//unblock signals
|
229 |
//zeromemory(@sset,sizeof(sset));
|
230 |
//sset[0] := ;
|
231 |
fdsr := getfdsrmaster;
|
232 |
fdsw := getfdswmaster;
|
233 |
|
234 |
if assigned(firsttask) then begin
|
235 |
localtimeval.tv_sec := 0;
|
236 |
localtimeval.tv_usec := 0;
|
237 |
timeout := @localtimeval;
|
238 |
end;
|
239 |
|
240 |
maxslocal := maxs;
|
241 |
mustrefreshfds := false;
|
242 |
{ debugout('about to call select');}
|
243 |
{$ifndef nosignal}
|
244 |
sigprocmask(SIG_UNBLOCK,@blockset,nil);
|
245 |
{$endif}
|
246 |
result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
|
247 |
if result <= 0 then begin
|
248 |
fd_zero(FDSR);
|
249 |
fd_zero(FDSW);
|
250 |
if result=-1 then begin
|
251 |
if linuxerror = SYS_EINTR then begin
|
252 |
// we received a signal it's not a problem
|
253 |
end else begin
|
254 |
raise esocketexception.create('select returned error '+inttostr(linuxerror));
|
255 |
end;
|
256 |
end;
|
257 |
end;
|
258 |
{$ifndef nosignal}
|
259 |
sigprocmask(SIG_BLOCK,@blockset,nil);
|
260 |
{$endif}
|
261 |
{ debugout('select complete');}
|
262 |
end;
|
263 |
|
264 |
procedure tselecteventcore.exitmessageloop;
|
265 |
begin
|
266 |
exitloopflag := true
|
267 |
end;
|
268 |
|
269 |
|
270 |
|
271 |
procedure tselecteventcore.messageloop;
|
272 |
var
|
273 |
tv ,tvnow : ttimeval ;
|
274 |
currenttimer : tltimer ;
|
275 |
selectresult:integer;
|
276 |
begin
|
277 |
{$ifndef nosignal}
|
278 |
prepsigpipe;
|
279 |
{$endif}
|
280 |
{currentsocket := firstasin;
|
281 |
if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
|
282 |
repeat
|
283 |
|
284 |
if currentsocket.state = wsconnected then currentsocket.sendflush;
|
285 |
currentsocket := currentsocket.nextasin;
|
286 |
until not assigned(currentsocket);}
|
287 |
|
288 |
|
289 |
repeat
|
290 |
|
291 |
//the message loop will exit if all lasios and ltimers and lsignals are destroyed
|
292 |
processtasks;
|
293 |
//currenttask := nil;
|
294 |
{beware}
|
295 |
//if assigned(firsttimer) then begin
|
296 |
// tv.tv_sec := maxlongint;
|
297 |
tv := tv_invalidtimebig;
|
298 |
currenttimer := firsttimer;
|
299 |
while assigned(currenttimer) do begin
|
300 |
if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
|
301 |
currenttimer := currenttimer.nexttimer;
|
302 |
end;
|
303 |
|
304 |
|
305 |
if tv_compare(tv,tv_invalidtimebig) then begin
|
306 |
//writeln('no timers active');
|
307 |
if exitloopflag then break;
|
308 |
{ sleep(10);}
|
309 |
selectresult := doselect(nil);
|
310 |
|
311 |
end else begin
|
312 |
gettimeofday(tvnow);
|
313 |
tv_subtract(tv,tvnow);
|
314 |
|
315 |
//writeln('timers active');
|
316 |
if tv.tv_sec < 0 then begin
|
317 |
tv.tv_sec := 0;
|
318 |
tv.tv_usec := 0; {0.1 sec}
|
319 |
end;
|
320 |
if exitloopflag then break;
|
321 |
{ sleep(10);}
|
322 |
selectresult := doselect(@tv);
|
323 |
processtimers;
|
324 |
|
325 |
end;
|
326 |
if selectresult > 0 then processasios(fdsr,fdsw);
|
327 |
{!!!only call processasios if select has asio events -beware}
|
328 |
|
329 |
{artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
|
330 |
until false;
|
331 |
end;
|
332 |
|
333 |
|
334 |
procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
|
335 |
begin
|
336 |
//writeln('rmasterset called with fd ',fd);
|
337 |
if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range');
|
338 |
if fd > maxs then maxs := fd;
|
339 |
if fd_isset(fd,fdsrmaster) then exit;
|
340 |
fd_set(fd,fdsrmaster);
|
341 |
|
342 |
end;
|
343 |
|
344 |
procedure tselecteventcore.rmasterclr(fd: integer);
|
345 |
begin
|
346 |
//writeln('rmasterclr called with fd ',fd);
|
347 |
if not fd_isset(fd,fdsrmaster) then exit;
|
348 |
fd_clr(fd,fdsrmaster);
|
349 |
|
350 |
end;
|
351 |
|
352 |
|
353 |
procedure tselecteventcore.wmasterset(fd : integer);
|
354 |
begin
|
355 |
//writeln('wmasterset called with fd ',fd);
|
356 |
if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range');
|
357 |
if fd > maxs then maxs := fd;
|
358 |
|
359 |
if fd_isset(fd,fdswmaster) then exit;
|
360 |
fd_set(fd,fdswmaster);
|
361 |
|
362 |
end;
|
363 |
|
364 |
procedure tselecteventcore.wmasterclr(fd: integer);
|
365 |
begin
|
366 |
//writeln('wmasterclr called with fd ',fd);
|
367 |
if not fd_isset(fd,fdswmaster) then exit;
|
368 |
fd_clr(fd,fdswmaster);
|
369 |
end;
|
370 |
|
371 |
procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
|
372 |
begin
|
373 |
fdreverse[fd] := reverseto;
|
374 |
end;
|
375 |
|
376 |
var
|
377 |
inited:boolean;
|
378 |
|
379 |
procedure lcoreinit;
|
380 |
begin
|
381 |
if inited then exit;
|
382 |
inited := true;
|
383 |
eventcore := tselecteventcore.create;
|
384 |
|
385 |
absolutemaxs := absolutemaxs_select;
|
386 |
|
387 |
maxs := 0;
|
388 |
fd_zero(fdsrmaster);
|
389 |
fd_zero(fdswmaster);
|
390 |
end;
|
391 |
|
392 |
end.
|