/[lcore]/trunk/lcoreselect.pas
ViewVC logotype

Contents of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 83 - (show annotations)
Sat Feb 20 18:33:54 2010 UTC (9 years, 8 months ago) by beware
File size: 10978 byte(s)
fd related central definition and small performance tweak in lcoreselect
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 absoloutemaxs_select = (sizeof(fdset)*8)-1;
49
50 var
51 fdreverse:array[0..absoloutemaxs_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 tv ,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 tempsocket : tlasio ;
94 socketcount : integer ; // for debugging perposes :)
95 dw,bt:integer;
96 currentfdword:fdword;
97 fd : integer;
98 begin
99 //writeln('entering processasios');
100 { inc(lcoretestcount);}
101
102 //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
103 //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
104
105
106 {------- test optimised loop}
107 socketcount := 0;
108 for dw := (maxs shr fdwordshift) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
109 currentfdword := (fdsr[dw] or fdsw[dw]);
110 for bt := fdwordmaxbit downto 0 do if currentfdword and (1 shl bt) <> 0 then begin
111 inc(socketcount);
112 fd := dw shl fdwordshift or bt;
113 //writeln('reversing fd ',fd);
114 currentsocket := fdreverse[fd];
115 {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
116 if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
117 {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
118 if not assigned(currentsocket) then begin
119 fdclose(fd);
120 continue
121 end;
122 if currentsocket.fdhandlein < 0 then begin
123 fdclose(fd);
124 continue
125 end;
126 try
127 currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));
128 except
129 on E: exception do begin
130 currentsocket.HandleBackGroundException(e);
131 end;
132 end;
133
134 if mustrefreshfds then begin
135 if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
136 fd_zero(fdsr);
137 fd_zero(fdsw);
138 end;
139 end;
140 end;
141 end;
142
143 {
144 !!! issues:
145 - sockets which are released may not be freed because theyre never processed by the loop
146 made new code for handling this, using asinreleaseflag
147
148 - when/why does the mustrefreshfds select apply, sheck if i did it correctly?
149
150 - what happens if calling handlefdtrigger for a socket which does not have an event
151 }
152 {------- original loop}
153
154 (*
155 currentsocket := firstasin;
156 socketcount := 0;
157 while assigned(currentsocket) do begin
158 if mustrefreshfds then begin
159 if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
160 fd_zero(fdsr);
161 fd_zero(fdsw);
162 end;
163 end;
164 try
165 if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
166 currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
167 end;
168 except
169 on E: exception do begin
170 currentsocket.HandleBackGroundException(e);
171 end;
172 end;
173 tempsocket := currentsocket;
174 currentsocket := currentsocket.nextasin;
175 inc(socketcount);
176 if tempsocket.released then begin
177 tempsocket.free;
178 end;
179 end; *)
180 { debugout('socketcount='+inttostr(socketcount));}
181 //writeln('leaving processasios');
182 end;
183
184 procedure tselecteventcore.processmessages;
185 var
186 fdsr , fdsw : fdset ;
187 selectresult : longint ;
188 begin
189 mustrefreshfds := false;
190 {$ifndef nosignal}
191 prepsigpipe;
192 {$endif}
193 selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
194 while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
195
196 processtasks;
197 processtimers;
198 if selectresult > 0 then begin
199 processasios(fdsr,fdsw);
200 end;
201 selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
202
203 end;
204 mustrefreshfds := true;
205 end;
206
207
208 var
209 FDSR , FDSW : fdset;
210
211 var
212 fdsrmaster , fdswmaster : fdset ;
213
214 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
215 begin
216 result := fdsrmaster;
217 end;
218 function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
219 begin
220 result := fdswmaster;
221 end;
222
223
224 Function doSelect(timeOut:PTimeVal):longint;//inline;
225 var
226 localtimeval : ttimeval;
227 maxslocal : integer;
228 begin
229 //unblock signals
230 //zeromemory(@sset,sizeof(sset));
231 //sset[0] := ;
232 fdsr := getfdsrmaster;
233 fdsw := getfdswmaster;
234
235 if assigned(firsttask) then begin
236 localtimeval.tv_sec := 0;
237 localtimeval.tv_usec := 0;
238 timeout := @localtimeval;
239 end;
240
241 maxslocal := maxs;
242 mustrefreshfds := false;
243 { debugout('about to call select');}
244 {$ifndef nosignal}
245 sigprocmask(SIG_UNBLOCK,@blockset,nil);
246 {$endif}
247 result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
248 if result <= 0 then begin
249 fd_zero(FDSR);
250 fd_zero(FDSW);
251 if result=-1 then begin
252 if linuxerror = SYS_EINTR then begin
253 // we received a signal it's not a problem
254 end else begin
255 raise esocketexception.create('select returned error '+inttostr(linuxerror));
256 end;
257 end;
258 end;
259 {$ifndef nosignal}
260 sigprocmask(SIG_BLOCK,@blockset,nil);
261 {$endif}
262 { debugout('select complete');}
263 end;
264
265 procedure tselecteventcore.exitmessageloop;
266 begin
267 exitloopflag := true
268 end;
269
270
271
272 procedure tselecteventcore.messageloop;
273 var
274 tv ,tvnow : ttimeval ;
275 currenttimer : tltimer ;
276 selectresult:integer;
277 begin
278 {$ifndef nosignal}
279 prepsigpipe;
280 {$endif}
281 {currentsocket := firstasin;
282 if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
283 repeat
284
285 if currentsocket.state = wsconnected then currentsocket.sendflush;
286 currentsocket := currentsocket.nextasin;
287 until not assigned(currentsocket);}
288
289
290 repeat
291
292 //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
293 processtasks;
294 //currenttask := nil;
295 {beware}
296 //if assigned(firsttimer) then begin
297 // tv.tv_sec := maxlongint;
298 tv := tv_invalidtimebig;
299 currenttimer := firsttimer;
300 while assigned(currenttimer) do begin
301 if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
302 currenttimer := currenttimer.nexttimer;
303 end;
304
305
306 if tv_compare(tv,tv_invalidtimebig) then begin
307 //writeln('no timers active');
308 if exitloopflag then break;
309 { sleep(10);}
310 selectresult := doselect(nil);
311
312 end else begin
313 gettimeofday(tvnow);
314 tv_substract(tv,tvnow);
315
316 //writeln('timers active');
317 if tv.tv_sec < 0 then begin
318 tv.tv_sec := 0;
319 tv.tv_usec := 0; {0.1 sec}
320 end;
321 if exitloopflag then break;
322 { sleep(10);}
323 selectresult := doselect(@tv);
324 processtimers;
325
326 end;
327 if selectresult > 0 then processasios(fdsr,fdsw);
328 {!!!only call processasios if select has asio events -beware}
329
330 {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
331 until false;
332 end;
333
334
335 procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
336 begin
337 //writeln('rmasterset called with fd ',fd);
338 if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
339 if fd > maxs then maxs := fd;
340 if fd_isset(fd,fdsrmaster) then exit;
341 fd_set(fd,fdsrmaster);
342
343 end;
344
345 procedure tselecteventcore.rmasterclr(fd: integer);
346 begin
347 //writeln('rmasterclr called with fd ',fd);
348 if not fd_isset(fd,fdsrmaster) then exit;
349 fd_clr(fd,fdsrmaster);
350
351 end;
352
353
354 procedure tselecteventcore.wmasterset(fd : integer);
355 begin
356 //writeln('wmasterset called with fd ',fd);
357 if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
358 if fd > maxs then maxs := fd;
359
360 if fd_isset(fd,fdswmaster) then exit;
361 fd_set(fd,fdswmaster);
362
363 end;
364
365 procedure tselecteventcore.wmasterclr(fd: integer);
366 begin
367 //writeln('wmasterclr called with fd ',fd);
368 if not fd_isset(fd,fdswmaster) then exit;
369 fd_clr(fd,fdswmaster);
370 end;
371
372 procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
373 begin
374 fdreverse[fd] := reverseto;
375 end;
376
377 var
378 inited:boolean;
379
380 procedure lcoreinit;
381 begin
382 if inited then exit;
383 inited := true;
384 eventcore := tselecteventcore.create;
385
386 absoloutemaxs := absoloutemaxs_select;
387
388 maxs := 0;
389 fd_zero(fdsrmaster);
390 fd_zero(fdswmaster);
391 end;
392
393 end.

Properties

Name Value
svn:eol-style CRLF
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22