For conditions of distribution and use, see copyright notice in zlib_license.txt\r
which is included in the package\r
----------------------------------------------------------------------------- }\r
-
-{$ifdef fpc}
- {$ifndef ver1_0}
- {$define useinline}
- {$endif}
-{$endif} \r
+\r
+{$ifdef fpc}\r
+ {$ifndef ver1_0}\r
+ {$define useinline}\r
+ {$endif}\r
+{$endif}\r
\r
unit lcoreselect;\r
\r
{$ifdef VER1_0}\r
linux,\r
{$else}\r
- baseunix,unix,unixutil,\r
+ baseunix,unix,unixutil,sockets,\r
{$endif}\r
fd_utils;\r
var\r
function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}\r
function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}\r
\r
+procedure lcoreinit;\r
+\r
implementation\r
uses\r
lcore,sysutils,\r
classes,pgtypes,bfifo,\r
{$ifndef nosignal}\r
- lsignal;\r
+ lsignal,\r
{$endif}\r
+ ltimevalstuff;\r
\r
{$include unixstuff.inc}\r
-{$include ltimevalstuff.inc}\r
+\r
+const\r
+ absolutemaxs_select = (sizeof(fdset)*8)-1;\r
+\r
var\r
- fdreverse:array[0..absoloutemaxs] of tlasio;\r
+ fdreverse:array[0..absolutemaxs_select] of tlasio;\r
type\r
tselecteventcore=class(teventcore)\r
public\r
\r
procedure processtimers;inline;\r
var\r
- tv ,tvnow : ttimeval ;\r
+ tvnow : ttimeval ;\r
currenttimer : tltimer ;\r
temptimer : tltimer ;\r
\r
begin\r
- gettimeofday(tvnow);\r
+ gettimemonotonic(tvnow);\r
currenttimer := firsttimer;\r
while assigned(currenttimer) do begin\r
//writeln(currenttimer.enabled);\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
+ socketcount : integer ; // for debugging purposes :)\r
dw,bt:integer;\r
+ currentfdword:fdword;\r
+ fd : integer;\r
begin\r
+ //writeln('entering processasios');\r
{ inc(lcoretestcount);}\r
\r
- //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
+ //the message loop will exit if all lasios and ltimers and lsignals 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
+ for dw := (maxs shr fdwordshift) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin\r
+ currentfdword := (fdsr[dw] or fdsw[dw]);\r
+ for bt := fdwordmaxbit downto 0 do if currentfdword and (1 shl bt) <> 0 then begin\r
inc(socketcount);\r
- currentsocket := fdreverse[dw shl 5 or bt];\r
+ fd := dw shl fdwordshift or bt;\r
+ //writeln('reversing fd ',fd);\r
+ currentsocket := fdreverse[fd];\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
+ fdclose(fd);\r
continue\r
end;\r
if currentsocket.fdhandlein < 0 then begin\r
- fdclose(dw shl 5 or bt);\r
+ fdclose(fd);\r
continue\r
end;\r
try\r
- currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));\r
+ currentsocket.handlefdtrigger(fd_isset(fd,fdsr),fd_isset(fd,fdsw));\r
except\r
on E: exception do begin\r
currentsocket.HandleBackGroundException(e);\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
+ - when/why does the mustrefreshfds select apply, check if i did it correctly?\r
\r
- what happens if calling handlefdtrigger for a socket which does not have an event\r
}\r
end;\r
end; *)\r
{ debugout('socketcount='+inttostr(socketcount));}\r
+ //writeln('leaving processasios');\r
end;\r
\r
procedure tselecteventcore.processmessages;\r
\r
var\r
fdsrmaster , fdswmaster : fdset ;\r
-
+\r
function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
begin\r
result := fdsrmaster;\r
begin\r
result := fdswmaster;\r
end;\r
-
-
+\r
+\r
Function doSelect(timeOut:PTimeVal):longint;//inline;\r
var\r
localtimeval : ttimeval;\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
+ // we received a signal it is not a problem\r
end else begin\r
raise esocketexception.create('select returned error '+inttostr(linuxerror));\r
end;\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
+ //the message loop will exit if all lasios and ltimers and lsignals are destroyed\r
processtasks;\r
//currenttask := nil;\r
{beware}\r
selectresult := doselect(nil);\r
\r
end else begin\r
- gettimeofday(tvnow);\r
- tv_substract(tv,tvnow);\r
+ gettimemonotonic(tvnow);\r
+ tv_subtract(tv,tvnow);\r
\r
//writeln('timers active');\r
if tv.tv_sec < 0 then begin\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
+ //writeln('rmasterset called with fd ',fd);\r
+ if fd > absolutemaxs then raise esocketexception.create('file descriptor 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
procedure tselecteventcore.rmasterclr(fd: integer);\r
begin\r
+ //writeln('rmasterclr called with fd ',fd);\r
if not fd_isset(fd,fdsrmaster) then exit;\r
fd_clr(fd,fdsrmaster);\r
\r
\r
procedure tselecteventcore.wmasterset(fd : integer);\r
begin\r
- if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');\r
+ //writeln('wmasterset called with fd ',fd);\r
+ if fd > absolutemaxs then raise esocketexception.create('file descriptor out of range');\r
if fd > maxs then maxs := fd;\r
\r
if fd_isset(fd,fdswmaster) then exit;\r
\r
procedure tselecteventcore.wmasterclr(fd: integer);\r
begin\r
+ //writeln('wmasterclr called with fd ',fd);\r
if not fd_isset(fd,fdswmaster) then exit;\r
fd_clr(fd,fdswmaster);\r
end;\r
fdreverse[fd] := reverseto;\r
end;\r
\r
+var\r
+ inited:boolean;\r
\r
-\r
+procedure lcoreinit;\r
begin\r
+ if inited then exit;\r
+ inited := true;\r
eventcore := tselecteventcore.create;\r
\r
+ absolutemaxs := absolutemaxs_select;\r
+\r
maxs := 0;\r
fd_zero(fdsrmaster);\r
fd_zero(fdswmaster);\r
+end;\r
+\r
end.\r
lcore.org gitweb / lcore.git / blobdiff