1 |
plugwash |
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 |
plugwash |
10 |
|
10 |
|
|
{$ifdef fpc}
|
11 |
|
|
{$ifndef ver1_0}
|
12 |
|
|
{$define useinline}
|
13 |
|
|
{$endif}
|
14 |
beware |
2 |
{$endif}
|
15 |
plugwash |
1 |
|
16 |
|
|
unit lcoreselect;
|
17 |
|
|
|
18 |
|
|
|
19 |
|
|
interface
|
20 |
|
|
uses
|
21 |
|
|
{$ifdef VER1_0}
|
22 |
|
|
linux,
|
23 |
|
|
{$else}
|
24 |
plugwash |
60 |
baseunix,unix,unixutil,sockets,
|
25 |
plugwash |
1 |
{$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 |
beware |
20 |
procedure lcoreinit;
|
35 |
|
|
|
36 |
plugwash |
1 |
implementation
|
37 |
|
|
uses
|
38 |
|
|
lcore,sysutils,
|
39 |
|
|
classes,pgtypes,bfifo,
|
40 |
|
|
{$ifndef nosignal}
|
41 |
plugwash |
57 |
lsignal,
|
42 |
plugwash |
1 |
{$endif}
|
43 |
plugwash |
59 |
ltimevalstuff;
|
44 |
plugwash |
1 |
|
45 |
|
|
{$include unixstuff.inc}
|
46 |
beware |
2 |
|
47 |
|
|
const
|
48 |
beware |
136 |
absolutemaxs_select = (sizeof(fdset)*8)-1;
|
49 |
beware |
2 |
|
50 |
plugwash |
1 |
var
|
51 |
beware |
136 |
fdreverse:array[0..absolutemaxs_select] of tlasio;
|
52 |
plugwash |
1 |
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 |
beware |
94 |
tvnow : ttimeval ;
|
68 |
plugwash |
1 |
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 |
beware |
136 |
socketcount : integer ; // for debugging purposes :)
|
94 |
plugwash |
1 |
dw,bt:integer;
|
95 |
beware |
83 |
currentfdword:fdword;
|
96 |
plugwash |
82 |
fd : integer;
|
97 |
plugwash |
1 |
begin
|
98 |
plugwash |
82 |
//writeln('entering processasios');
|
99 |
plugwash |
1 |
{ inc(lcoretestcount);}
|
100 |
|
|
|
101 |
beware |
136 |
//the message loop will exit if all lasios and ltimers and lsignals are destroyed
|
102 |
plugwash |
1 |
//if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
|
103 |
|
|
|
104 |
|
|
|
105 |
|
|
{------- test optimised loop}
|
106 |
|
|
socketcount := 0;
|
107 |
beware |
83 |
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 |
plugwash |
1 |
inc(socketcount);
|
111 |
beware |
83 |
fd := dw shl fdwordshift or bt;
|
112 |
plugwash |
82 |
//writeln('reversing fd ',fd);
|
113 |
|
|
currentsocket := fdreverse[fd];
|
114 |
plugwash |
1 |
{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 |
plugwash |
82 |
fdclose(fd);
|
119 |
plugwash |
1 |
continue
|
120 |
|
|
end;
|
121 |
|
|
if currentsocket.fdhandlein < 0 then begin
|
122 |
plugwash |
82 |
fdclose(fd);
|
123 |
plugwash |
1 |
continue
|
124 |
|
|
end;
|
125 |
|
|
try
|
126 |
plugwash |
82 |
currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));
|
127 |
plugwash |
1 |
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 |
beware |
136 |
- when/why does the mustrefreshfds select apply, check if i did it correctly?
|
148 |
plugwash |
1 |
|
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 |
plugwash |
82 |
//writeln('leaving processasios');
|
181 |
plugwash |
1 |
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 |
plugwash |
10 |
|
213 |
plugwash |
1 |
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 |
plugwash |
10 |
|
222 |
|
|
|
223 |
plugwash |
1 |
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 |
beware |
136 |
//the message loop will exit if all lasios and ltimers and lsignals are destroyed
|
292 |
plugwash |
1 |
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 |
beware |
136 |
tv_subtract(tv,tvnow);
|
314 |
plugwash |
1 |
|
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 |
plugwash |
82 |
//writeln('rmasterset called with fd ',fd);
|
337 |
beware |
136 |
if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range');
|
338 |
plugwash |
1 |
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 |
plugwash |
82 |
//writeln('rmasterclr called with fd ',fd);
|
347 |
plugwash |
1 |
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 |
plugwash |
82 |
//writeln('wmasterset called with fd ',fd);
|
356 |
beware |
136 |
if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range');
|
357 |
plugwash |
1 |
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 |
plugwash |
82 |
//writeln('wmasterclr called with fd ',fd);
|
367 |
plugwash |
1 |
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 |
beware |
20 |
var
|
377 |
|
|
inited:boolean;
|
378 |
plugwash |
1 |
|
379 |
beware |
20 |
procedure lcoreinit;
|
380 |
plugwash |
1 |
begin
|
381 |
beware |
20 |
if inited then exit;
|
382 |
|
|
inited := true;
|
383 |
plugwash |
1 |
eventcore := tselecteventcore.create;
|
384 |
|
|
|
385 |
beware |
136 |
absolutemaxs := absolutemaxs_select;
|
386 |
beware |
2 |
|
387 |
plugwash |
1 |
maxs := 0;
|
388 |
|
|
fd_zero(fdsrmaster);
|
389 |
|
|
fd_zero(fdswmaster);
|
390 |
beware |
20 |
end;
|
391 |
|
|
|
392 |
plugwash |
1 |
end.
|