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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations)
Sun Mar 30 00:16:07 2008 UTC (11 years, 7 months ago) by beware
File size: 11867 byte(s)
the big lot of changes by beware

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

Properties

Name Value
svn:executable

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