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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 57 - (hide annotations)
Sat Oct 31 00:20:41 2009 UTC (10 years ago) by plugwash
File size: 10605 byte(s)
change ltimevalstuff to a unit and move defintion of ttimeval on windows 
there

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