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