123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382 |
- {lsocket.pas}
-
- {io and timer code by plugwash}
-
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- {$ifdef fpc}
- {$ifndef ver1_0}
- {$define useinline}
- {$endif}
- {$endif}
-
- unit lcoreselect;
-
-
- interface
- uses
- {$ifdef VER1_0}
- linux,
- {$else}
- baseunix,unix,unixutil,
- {$endif}
- fd_utils;
- var
- maxs : longint ;
- exitloopflag : boolean ; {if set by app, exit mainloop}
-
- function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}
- function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}
-
- procedure lcoreinit;
-
- implementation
- uses
- lcore,sysutils,
- classes,pgtypes,bfifo,
- {$ifndef nosignal}
- lsignal;
- {$endif}
-
- {$include unixstuff.inc}
- {$include ltimevalstuff.inc}
-
- const
- absoloutemaxs_select = (sizeof(fdset)*8)-1;
-
- var
- fdreverse:array[0..absoloutemaxs_select] of tlasio;
- type
- tselecteventcore=class(teventcore)
- public
- procedure processmessages; override;
- procedure messageloop; override;
- procedure exitmessageloop;override;
- procedure setfdreverse(fd : integer;reverseto : tlasio); override;
- procedure rmasterset(fd : integer;islistensocket : boolean); override;
- procedure rmasterclr(fd: integer); override;
- procedure wmasterset(fd : integer); override;
- procedure wmasterclr(fd: integer); override;
- end;
-
- procedure processtimers;inline;
- var
- tv ,tvnow : ttimeval ;
- currenttimer : tltimer ;
- temptimer : tltimer ;
-
- begin
- gettimeofday(tvnow);
- currenttimer := firsttimer;
- while assigned(currenttimer) do begin
- //writeln(currenttimer.enabled);
- if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
- //if assigned(currenttimer.ontimer) then begin
- // if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
- // currenttimer.initialdone := true;
- //end;
- if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
- currenttimer.nextts := timeval(tvnow);
- tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
- end;
- temptimer := currenttimer;
- currenttimer := currenttimer.nexttimer;
- end;
- end;
-
- procedure processasios(var fdsr,fdsw:fdset);//inline;
- var
- currentsocket : tlasio ;
- tempsocket : tlasio ;
- socketcount : integer ; // for debugging perposes :)
- dw,bt:integer;
- begin
- { inc(lcoretestcount);}
-
- //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
- //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
-
-
- {------- test optimised loop}
- socketcount := 0;
- for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
- for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin
- inc(socketcount);
- currentsocket := fdreverse[dw shl 5 or bt];
- {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
- if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
- {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
- if not assigned(currentsocket) then begin
- fdclose(dw shl 5 or bt);
- continue
- end;
- if currentsocket.fdhandlein < 0 then begin
- fdclose(dw shl 5 or bt);
- continue
- end;
- try
- currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
- except
- on E: exception do begin
- currentsocket.HandleBackGroundException(e);
- end;
- end;
-
- if mustrefreshfds then begin
- if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
- fd_zero(fdsr);
- fd_zero(fdsw);
- end;
- end;
- end;
- end;
-
- {
- !!! issues:
- - sockets which are released may not be freed because theyre never processed by the loop
- made new code for handling this, using asinreleaseflag
-
- - when/why does the mustrefreshfds select apply, sheck if i did it correctly?
-
- - what happens if calling handlefdtrigger for a socket which does not have an event
- }
- {------- original loop}
-
- (*
- currentsocket := firstasin;
- socketcount := 0;
- while assigned(currentsocket) do begin
- if mustrefreshfds then begin
- if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
- fd_zero(fdsr);
- fd_zero(fdsw);
- end;
- end;
- try
- if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
- currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
- end;
- except
- on E: exception do begin
- currentsocket.HandleBackGroundException(e);
- end;
- end;
- tempsocket := currentsocket;
- currentsocket := currentsocket.nextasin;
- inc(socketcount);
- if tempsocket.released then begin
- tempsocket.free;
- end;
- end; *)
- { debugout('socketcount='+inttostr(socketcount));}
- end;
-
- procedure tselecteventcore.processmessages;
- var
- fdsr , fdsw : fdset ;
- selectresult : longint ;
- begin
- mustrefreshfds := false;
- {$ifndef nosignal}
- prepsigpipe;
- {$endif}
- selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
- while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
-
- processtasks;
- processtimers;
- if selectresult > 0 then begin
- processasios(fdsr,fdsw);
- end;
- selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
-
- end;
- mustrefreshfds := true;
- end;
-
-
- var
- FDSR , FDSW : fdset;
-
- var
- fdsrmaster , fdswmaster : fdset ;
-
- function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
- begin
- result := fdsrmaster;
- end;
- function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
- begin
- result := fdswmaster;
- end;
-
-
- Function doSelect(timeOut:PTimeVal):longint;//inline;
- var
- localtimeval : ttimeval;
- maxslocal : integer;
- begin
- //unblock signals
- //zeromemory(@sset,sizeof(sset));
- //sset[0] := ;
- fdsr := getfdsrmaster;
- fdsw := getfdswmaster;
-
- if assigned(firsttask) then begin
- localtimeval.tv_sec := 0;
- localtimeval.tv_usec := 0;
- timeout := @localtimeval;
- end;
-
- maxslocal := maxs;
- mustrefreshfds := false;
- { debugout('about to call select');}
- {$ifndef nosignal}
- sigprocmask(SIG_UNBLOCK,@blockset,nil);
- {$endif}
- result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
- if result <= 0 then begin
- fd_zero(FDSR);
- fd_zero(FDSW);
- if result=-1 then begin
- if linuxerror = SYS_EINTR then begin
- // we received a signal it's not a problem
- end else begin
- raise esocketexception.create('select returned error '+inttostr(linuxerror));
- end;
- end;
- end;
- {$ifndef nosignal}
- sigprocmask(SIG_BLOCK,@blockset,nil);
- {$endif}
- { debugout('select complete');}
- end;
-
- procedure tselecteventcore.exitmessageloop;
- begin
- exitloopflag := true
- end;
-
-
-
- procedure tselecteventcore.messageloop;
- var
- tv ,tvnow : ttimeval ;
- currenttimer : tltimer ;
- selectresult:integer;
- begin
- {$ifndef nosignal}
- prepsigpipe;
- {$endif}
- {currentsocket := firstasin;
- if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
- repeat
-
- if currentsocket.state = wsconnected then currentsocket.sendflush;
- currentsocket := currentsocket.nextasin;
- until not assigned(currentsocket);}
-
-
- repeat
-
- //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
- processtasks;
- //currenttask := nil;
- {beware}
- //if assigned(firsttimer) then begin
- // tv.tv_sec := maxlongint;
- tv := tv_invalidtimebig;
- currenttimer := firsttimer;
- while assigned(currenttimer) do begin
- if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
- currenttimer := currenttimer.nexttimer;
- end;
-
-
- if tv_compare(tv,tv_invalidtimebig) then begin
- //writeln('no timers active');
- if exitloopflag then break;
- { sleep(10);}
- selectresult := doselect(nil);
-
- end else begin
- gettimeofday(tvnow);
- tv_substract(tv,tvnow);
-
- //writeln('timers active');
- if tv.tv_sec < 0 then begin
- tv.tv_sec := 0;
- tv.tv_usec := 0; {0.1 sec}
- end;
- if exitloopflag then break;
- { sleep(10);}
- selectresult := doselect(@tv);
- processtimers;
-
- end;
- if selectresult > 0 then processasios(fdsr,fdsw);
- {!!!only call processasios if select has asio events -beware}
-
- {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
- until false;
- end;
-
-
- procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
- begin
- if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
- if fd > maxs then maxs := fd;
- if fd_isset(fd,fdsrmaster) then exit;
- fd_set(fd,fdsrmaster);
-
- end;
-
- procedure tselecteventcore.rmasterclr(fd: integer);
- begin
- if not fd_isset(fd,fdsrmaster) then exit;
- fd_clr(fd,fdsrmaster);
-
- end;
-
-
- procedure tselecteventcore.wmasterset(fd : integer);
- begin
- if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
- if fd > maxs then maxs := fd;
-
- if fd_isset(fd,fdswmaster) then exit;
- fd_set(fd,fdswmaster);
-
- end;
-
- procedure tselecteventcore.wmasterclr(fd: integer);
- begin
- if not fd_isset(fd,fdswmaster) then exit;
- fd_clr(fd,fdswmaster);
- end;
-
- procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
- begin
- fdreverse[fd] := reverseto;
- end;
-
- var
- inited:boolean;
-
- procedure lcoreinit;
- begin
- if inited then exit;
- inited := true;
- eventcore := tselecteventcore.create;
-
- absoloutemaxs := absoloutemaxs_select;
-
- maxs := 0;
- fd_zero(fdsrmaster);
- fd_zero(fdswmaster);
- end;
-
- end.
|