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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (hide annotations)
Mon Feb 21 21:40:05 2011 UTC (8 years, 8 months ago) by beware
File size: 10935 byte(s)
eliminated a lot of hints and warnings
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 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     socketcount : integer ; // for debugging perposes :)
94     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     //the message loop will exit if all lasio's and ltimer's and lsignal's 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 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     - when/why does the mustrefreshfds select apply, sheck 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 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     //the message loop will exit if all lasio's and ltimer's and lsignal's 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_substract(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 plugwash 82 //writeln('rmasterset called with fd ',fd);
337 plugwash 1 if fd > absoloutemaxs then raise esocketexception.create('file discriptor 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 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 plugwash 1 if fd > absoloutemaxs then raise esocketexception.create('file discriptor 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 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 2 absoloutemaxs := absoloutemaxs_select;
386    
387 plugwash 1 maxs := 0;
388     fd_zero(fdsrmaster);
389     fd_zero(fdswmaster);
390 beware 20 end;
391    
392 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