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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 83 - (hide annotations)
Sat Feb 20 18:33:54 2010 UTC (9 years, 6 months ago) by beware
File size: 10978 byte(s)
fd related central definition and small performance tweak in lcoreselect
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     absoloutemaxs_select = (sizeof(fdset)*8)-1;
49    
50 plugwash 1 var
51 beware 2 fdreverse:array[0..absoloutemaxs_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     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 beware 83 currentfdword:fdword;
97 plugwash 82 fd : integer;
98 plugwash 1 begin
99 plugwash 82 //writeln('entering processasios');
100 plugwash 1 { 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 beware 83 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 plugwash 1 inc(socketcount);
112 beware 83 fd := dw shl fdwordshift or bt;
113 plugwash 82 //writeln('reversing fd ',fd);
114     currentsocket := fdreverse[fd];
115 plugwash 1 {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 plugwash 82 fdclose(fd);
120 plugwash 1 continue
121     end;
122     if currentsocket.fdhandlein < 0 then begin
123 plugwash 82 fdclose(fd);
124 plugwash 1 continue
125     end;
126     try
127 plugwash 82 currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));
128 plugwash 1 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 plugwash 82 //writeln('leaving processasios');
182 plugwash 1 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 plugwash 10
214 plugwash 1 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 plugwash 10
223    
224 plugwash 1 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 plugwash 82 //writeln('rmasterset called with fd ',fd);
338 plugwash 1 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 plugwash 82 //writeln('rmasterclr called with fd ',fd);
348 plugwash 1 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 plugwash 82 //writeln('wmasterset called with fd ',fd);
357 plugwash 1 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 plugwash 82 //writeln('wmasterclr called with fd ',fd);
368 plugwash 1 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 beware 20 var
378     inited:boolean;
379 plugwash 1
380 beware 20 procedure lcoreinit;
381 plugwash 1 begin
382 beware 20 if inited then exit;
383     inited := true;
384 plugwash 1 eventcore := tselecteventcore.create;
385    
386 beware 2 absoloutemaxs := absoloutemaxs_select;
387    
388 plugwash 1 maxs := 0;
389     fd_zero(fdsrmaster);
390     fd_zero(fdswmaster);
391 beware 20 end;
392    
393 plugwash 1 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