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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Fri Mar 28 02:26:58 2008 UTC (11 years, 6 months ago) by plugwash
File size: 12017 byte(s)
initial import

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     {$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,
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     var
45     fdreverse:array[0..absoloutemaxs] of tlasio;
46     type
47     tselecteventcore=class(teventcore)
48     public
49     procedure processmessages; override;
50     procedure messageloop; override;
51     procedure exitmessageloop;override;
52     procedure setfdreverse(fd : integer;reverseto : tlasio); override;
53     procedure rmasterset(fd : integer;islistensocket : boolean); override;
54     procedure rmasterclr(fd: integer); override;
55     procedure wmasterset(fd : integer); override;
56     procedure wmasterclr(fd: integer); override;
57     end;
58    
59     procedure processtimers;inline;
60     var
61     tv ,tvnow : ttimeval ;
62     currenttimer : tltimer ;
63     temptimer : tltimer ;
64    
65     begin
66     gettimeofday(tvnow);
67     currenttimer := firsttimer;
68     while assigned(currenttimer) do begin
69     //writeln(currenttimer.enabled);
70     if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
71     //if assigned(currenttimer.ontimer) then begin
72     // if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
73     // currenttimer.initialdone := true;
74     //end;
75     if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
76     currenttimer.nextts := timeval(tvnow);
77     tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
78     end;
79     temptimer := currenttimer;
80     currenttimer := currenttimer.nexttimer;
81     if temptimer.released then temptimer.free;
82     end;
83     end;
84    
85     procedure processasios(var fdsr,fdsw:fdset);//inline;
86     var
87     currentsocket : tlasio ;
88     tempsocket : tlasio ;
89     socketcount : integer ; // for debugging perposes :)
90     dw,bt:integer;
91     begin
92     { inc(lcoretestcount);}
93    
94     //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
95     //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
96    
97    
98     {------- test optimised loop}
99     socketcount := 0;
100     for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
101     for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin
102     inc(socketcount);
103     currentsocket := fdreverse[dw shl 5 or bt];
104     {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
105     if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
106     {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
107     if not assigned(currentsocket) then begin
108     fdclose(dw shl 5 or bt);
109     continue
110     end;
111     if currentsocket.fdhandlein < 0 then begin
112     fdclose(dw shl 5 or bt);
113     continue
114     end;
115     try
116     currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
117     except
118     on E: exception do begin
119     currentsocket.HandleBackGroundException(e);
120     end;
121     end;
122    
123     if mustrefreshfds then begin
124     if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
125     fd_zero(fdsr);
126     fd_zero(fdsw);
127     end;
128     end;
129     end;
130     end;
131    
132     if asinreleaseflag then begin
133     asinreleaseflag := false;
134     currentsocket := firstasin;
135     while assigned(currentsocket) do begin
136     tempsocket := currentsocket;
137     currentsocket := currentsocket.nextasin;
138     if tempsocket.released then begin
139     tempsocket.free;
140     end;
141     end;
142     end;
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     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    
213     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    
222    
223     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     if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;
293     {fd_zero(FDSR);
294     fd_zero(FDSW);
295     currentsocket := firstasin;
296     if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
297    
298     repeat
299     if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);
300     if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);
301     if currentsocket is tlsocket then begin
302     if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);
303     end;
304     tempsocket := currentsocket;
305     currentsocket := currentsocket.nextasin;
306     if tempsocket.released then begin
307     tempsocket.free;
308     end;
309     until not assigned(currentsocket);
310     }
311     processtasks;
312     //currenttask := nil;
313     {beware}
314     //if assigned(firsttimer) then begin
315     // tv.tv_sec := maxlongint;
316     tv := tv_invalidtimebig;
317     currenttimer := firsttimer;
318     while assigned(currenttimer) do begin
319     if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
320     currenttimer := currenttimer.nexttimer;
321     end;
322    
323    
324     if tv_compare(tv,tv_invalidtimebig) then begin
325     //writeln('no timers active');
326     if exitloopflag then break;
327     { sleep(10);}
328     selectresult := doselect(nil);
329    
330     end else begin
331     gettimeofday(tvnow);
332     tv_substract(tv,tvnow);
333    
334     //writeln('timers active');
335     if tv.tv_sec < 0 then begin
336     tv.tv_sec := 0;
337     tv.tv_usec := 0; {0.1 sec}
338     end;
339     if exitloopflag then break;
340     { sleep(10);}
341     selectresult := doselect(@tv);
342     processtimers;
343    
344     end;
345     if selectresult > 0 then processasios(fdsr,fdsw);
346     {!!!only call processasios if select has asio events -beware}
347    
348     {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
349     until false;
350     end;
351    
352    
353     procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
354     begin
355     if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
356     if fd > maxs then maxs := fd;
357     if fd_isset(fd,fdsrmaster) then exit;
358     fd_set(fd,fdsrmaster);
359    
360     end;
361    
362     procedure tselecteventcore.rmasterclr(fd: integer);
363     begin
364     if not fd_isset(fd,fdsrmaster) then exit;
365     fd_clr(fd,fdsrmaster);
366    
367     end;
368    
369    
370     procedure tselecteventcore.wmasterset(fd : integer);
371     begin
372     if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
373     if fd > maxs then maxs := fd;
374    
375     if fd_isset(fd,fdswmaster) then exit;
376     fd_set(fd,fdswmaster);
377    
378     end;
379    
380     procedure tselecteventcore.wmasterclr(fd: integer);
381     begin
382     if not fd_isset(fd,fdswmaster) then exit;
383     fd_clr(fd,fdswmaster);
384     end;
385    
386     procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
387     begin
388     fdreverse[fd] := reverseto;
389     end;
390    
391    
392    
393     begin
394     eventcore := tselecteventcore.create;
395    
396     maxs := 0;
397     fd_zero(fdsrmaster);
398     fd_zero(fdswmaster);
399     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