X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/85ef2ce64f0cc31a063fccea69fdcc7281d51548..2e969e5e75fb8f544ff468584fb4e33d891e2954:/lcoreselect.pas?ds=sidebyside diff --git a/lcoreselect.pas b/lcoreselect.pas old mode 100755 new mode 100644 index 16134ee..d3685ae --- a/lcoreselect.pas +++ b/lcoreselect.pas @@ -21,7 +21,7 @@ uses {$ifdef VER1_0} linux, {$else} - baseunix,unix,unixutil, + baseunix,unix,unixutil,sockets, {$endif} fd_utils; var @@ -38,17 +38,17 @@ uses lcore,sysutils, classes,pgtypes,bfifo, {$ifndef nosignal} - lsignal; + lsignal, {$endif} + ltimevalstuff; {$include unixstuff.inc} -{$include ltimevalstuff.inc} const - absoloutemaxs_select = (sizeof(fdset)*8)-1; + absolutemaxs_select = (sizeof(fdset)*8)-1; var - fdreverse:array[0..absoloutemaxs_select] of tlasio; + fdreverse:array[0..absolutemaxs_select] of tlasio; type tselecteventcore=class(teventcore) public @@ -64,12 +64,12 @@ type procedure processtimers;inline; var - tv ,tvnow : ttimeval ; + tvnow : ttimeval ; currenttimer : tltimer ; temptimer : tltimer ; begin - gettimeofday(tvnow); + gettimemonotonic(tvnow); currenttimer := firsttimer; while assigned(currenttimer) do begin //writeln(currenttimer.enabled); @@ -84,42 +84,46 @@ begin end; temptimer := currenttimer; currenttimer := currenttimer.nexttimer; - if temptimer.released then temptimer.free; end; end; procedure processasios(var fdsr,fdsw:fdset);//inline; var currentsocket : tlasio ; - tempsocket : tlasio ; - socketcount : integer ; // for debugging perposes :) + socketcount : integer ; // for debugging purposes :) dw,bt:integer; + currentfdword:fdword; + fd : integer; begin + //writeln('entering processasios'); { inc(lcoretestcount);} - //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed + //the message loop will exit if all lasios and ltimers and lsignals 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 + for dw := (maxs shr fdwordshift) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin + currentfdword := (fdsr[dw] or fdsw[dw]); + for bt := fdwordmaxbit downto 0 do if currentfdword and (1 shl bt) <> 0 then begin inc(socketcount); - currentsocket := fdreverse[dw shl 5 or bt]; + fd := dw shl fdwordshift or bt; + //writeln('reversing fd ',fd); + currentsocket := fdreverse[fd]; {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); + fdclose(fd); continue end; if currentsocket.fdhandlein < 0 then begin - fdclose(dw shl 5 or bt); + fdclose(fd); continue end; try - currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw)); + currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw)); except on E: exception do begin currentsocket.HandleBackGroundException(e); @@ -135,23 +139,12 @@ begin end; end; - if asinreleaseflag then begin - asinreleaseflag := false; - currentsocket := firstasin; - while assigned(currentsocket) do begin - tempsocket := currentsocket; - currentsocket := currentsocket.nextasin; - if tempsocket.released then begin - tempsocket.free; - 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? + - when/why does the mustrefreshfds select apply, check if i did it correctly? - what happens if calling handlefdtrigger for a socket which does not have an event } @@ -184,6 +177,7 @@ begin end; end; *) { debugout('socketcount='+inttostr(socketcount));} + //writeln('leaving processasios'); end; procedure tselecteventcore.processmessages; @@ -196,7 +190,7 @@ begin prepsigpipe; {$endif} selectresult := select(maxs+1,@fdsr,@fdsw,nil,0); - while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin; + while (selectresult>0) or assigned(firsttask) do begin; processtasks; processtimers; @@ -226,10 +220,22 @@ begin end; +{ +select in linux/sysV subtracts from timeout for time spent in it, but in BSD it doesn't +enabling select_no_autotv here makes doSelect mimic the decrement behavior, in case the caller needs it +the caller here in lcoreselect does not need it, and enabling it would have a slight perf hit. +it is safe for this to be enabled even if the OS does it too (it will not subtract twice) +it is currently disabled but can be enabled if needed +} +{$ifndef linux}{-$define select_no_autotv}{$endif} + Function doSelect(timeOut:PTimeVal):longint;//inline; var localtimeval : ttimeval; maxslocal : integer; + {$ifdef select_no_autotv} + timeoutcopy,tvstart,tvend : ttimeval; + {$endif} begin //unblock signals //zeromemory(@sset,sizeof(sset)); @@ -249,18 +255,46 @@ begin {$ifndef nosignal} sigprocmask(SIG_UNBLOCK,@blockset,nil); {$endif} + + {$ifdef select_no_autotv} + if assigned(timeout) then begin + timeoutcopy.tv_sec := timeOut.tv_sec; + timeoutcopy.tv_usec := timeOut.tv_usec; + gettimemonotonic(tvstart); + end; + {$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 + // we received a signal it is not a problem end else begin raise esocketexception.create('select returned error '+inttostr(linuxerror)); end; + end + {$ifdef select_no_autotv} + else if (result = 0) and assigned(timeout) then begin + //timeout reached: zero the timeval + timeout.tv_sec := 0; + timeout.tv_usec := 0; + end; + end else if assigned(timeout) then begin + //successful result: subtract elapsed time + gettimemonotonic(tvend); + tv_subtract(tvend,tvstart); + tv_subtract(timeoutcopy,tvend); + timeout.tv_sec := timeoutcopy.tv_sec; + timeout.tv_usec := timeoutcopy.tv_usec; + if (timeout.tv_sec < 0) then begin + timeout.tv_sec := 0; + timeout.tv_usec := 0; end; + {$endif} //select_no_autotv end; + {$ifndef nosignal} sigprocmask(SIG_BLOCK,@blockset,nil); {$endif} @@ -294,26 +328,7 @@ begin repeat - //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)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit; - {fd_zero(FDSR); - fd_zero(FDSW); - currentsocket := firstasin; - if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed - - repeat - if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr); - if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw); - if currentsocket is tlsocket then begin - if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw); - end; - tempsocket := currentsocket; - currentsocket := currentsocket.nextasin; - if tempsocket.released then begin - tempsocket.free; - end; - until not assigned(currentsocket); - } + //the message loop will exit if all lasios and ltimers and lsignals are destroyed processtasks; //currenttask := nil; {beware} @@ -334,8 +349,8 @@ begin selectresult := doselect(nil); end else begin - gettimeofday(tvnow); - tv_substract(tv,tvnow); + gettimemonotonic(tvnow); + tv_subtract(tv,tvnow); //writeln('timers active'); if tv.tv_sec < 0 then begin @@ -358,7 +373,8 @@ end; procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean); begin - if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range'); + //writeln('rmasterset called with fd ',fd); + if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range'); if fd > maxs then maxs := fd; if fd_isset(fd,fdsrmaster) then exit; fd_set(fd,fdsrmaster); @@ -367,6 +383,7 @@ end; procedure tselecteventcore.rmasterclr(fd: integer); begin + //writeln('rmasterclr called with fd ',fd); if not fd_isset(fd,fdsrmaster) then exit; fd_clr(fd,fdsrmaster); @@ -375,7 +392,8 @@ end; procedure tselecteventcore.wmasterset(fd : integer); begin - if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range'); + //writeln('wmasterset called with fd ',fd); + if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range'); if fd > maxs then maxs := fd; if fd_isset(fd,fdswmaster) then exit; @@ -385,6 +403,7 @@ end; procedure tselecteventcore.wmasterclr(fd: integer); begin + //writeln('wmasterclr called with fd ',fd); if not fd_isset(fd,fdswmaster) then exit; fd_clr(fd,fdswmaster); end; @@ -403,7 +422,7 @@ begin inited := true; eventcore := tselecteventcore.create; - absoloutemaxs := absoloutemaxs_select; + absolutemaxs := absolutemaxs_select; maxs := 0; fd_zero(fdsrmaster);