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

Contents of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (show annotations)
Sat Feb 20 13:48:27 2010 UTC (9 years, 9 months ago) by plugwash
File size: 10882 byte(s)
fix signal hang

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