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

Contents of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (show annotations)
Fri Mar 28 03:18:52 2014 UTC (3 years, 8 months ago) by beware
File size: 10922 byte(s)
fix spelling mistakes
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 absolutemaxs_select = (sizeof(fdset)*8)-1;
49
50 var
51 fdreverse:array[0..absolutemaxs_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 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 socketcount : integer ; // for debugging purposes :)
94 dw,bt:integer;
95 currentfdword:fdword;
96 fd : integer;
97 begin
98 //writeln('entering processasios');
99 { inc(lcoretestcount);}
100
101 //the message loop will exit if all lasios and ltimers and lsignals 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 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 inc(socketcount);
111 fd := dw shl fdwordshift or bt;
112 //writeln('reversing fd ',fd);
113 currentsocket := fdreverse[fd];
114 {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 fdclose(fd);
119 continue
120 end;
121 if currentsocket.fdhandlein < 0 then begin
122 fdclose(fd);
123 continue
124 end;
125 try
126 currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));
127 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, check 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 //writeln('leaving processasios');
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 lasios and ltimers and lsignals 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_subtract(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 //writeln('rmasterset called with fd ',fd);
337 if fd > absolutemaxs then raise esocketexception.create('file descriptor 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 //writeln('rmasterclr called with fd ',fd);
347 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 //writeln('wmasterset called with fd ',fd);
356 if fd > absolutemaxs then raise esocketexception.create('file descriptor 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 //writeln('wmasterclr called with fd ',fd);
367 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 var
377 inited:boolean;
378
379 procedure lcoreinit;
380 begin
381 if inited then exit;
382 inited := true;
383 eventcore := tselecteventcore.create;
384
385 absolutemaxs := absolutemaxs_select;
386
387 maxs := 0;
388 fd_zero(fdsrmaster);
389 fd_zero(fdswmaster);
390 end;
391
392 end.

Properties

Name Value
svn:eol-style CRLF

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