FreeBSD support

[lcore.git] / lcoreselect.pas

diff --git a/lcoreselect.pas b/lcoreselect.pas
old mode 100755 (executable)
new mode 100644 (file)
index e0351eb..d3685ae
--- a/lcoreselect.pas
+++ b/lcoreselect.pas
@@ -6,12 +6,12 @@
   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   which is included in the package\r
   ----------------------------------------------------------------------------- }\r
   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
 \r
 unit lcoreselect;\r
 \r


@@ -21,7 +21,7 @@ uses
   {$ifdef VER1_0}\r
     linux,\r
   {$else}\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
   {$endif}\r
   fd_utils;\r
 var\r


@@ -31,18 +31,24 @@ var
 function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}\r
 function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}\r
 \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
 implementation\r
 uses\r
   lcore,sysutils,\r
   classes,pgtypes,bfifo,\r
   {$ifndef nosignal}\r

-    lsignal;\r
+    lsignal,\r

   {$endif}\r
   {$endif}\r

+  ltimevalstuff;\r

 \r
 {$include unixstuff.inc}\r
 \r
 {$include unixstuff.inc}\r

-{$include ltimevalstuff.inc}\r
+\r
+const\r
+  absolutemaxs_select = (sizeof(fdset)*8)-1;\r
+\r

 var\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
 type\r
   tselecteventcore=class(teventcore)\r
     public\r


@@ -58,12 +64,12 @@ type
 \r
 procedure processtimers;inline;\r
 var\r
 \r
 procedure processtimers;inline;\r
 var\r

-  tv           ,tvnow     : ttimeval ;\r
+  tvnow     : ttimeval ;\r

   currenttimer            : tltimer   ;\r
   temptimer               : tltimer  ;\r
 \r
 begin\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
   currenttimer := firsttimer;\r
   while assigned(currenttimer) do begin\r
     //writeln(currenttimer.enabled);\r


@@ -78,42 +84,46 @@ begin
     end;\r
     temptimer := currenttimer;\r
     currenttimer := currenttimer.nexttimer;\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
   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
   dw,bt:integer;\r

+  currentfdword:fdword;\r
+  fd : integer;\r

 begin\r
 begin\r

+  //writeln('entering processasios');\r

 {  inc(lcoretestcount);}\r
 \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
     //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
       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
       {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
         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
         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
       except\r
         on E: exception do begin\r
           currentsocket.HandleBackGroundException(e);\r


@@ -129,23 +139,12 @@ begin
     end;\r
   end;\r
 \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
   {\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
 \r
   - what happens if calling handlefdtrigger for a socket which does not have an event\r
   }\r


@@ -178,6 +177,7 @@ begin
     end;\r
   end; *)\r
 {  debugout('socketcount='+inttostr(socketcount));}\r
     end;\r
   end; *)\r
 {  debugout('socketcount='+inttostr(socketcount));}\r

+  //writeln('leaving processasios');\r

 end;\r
 \r
 procedure tselecteventcore.processmessages;\r
 end;\r
 \r
 procedure tselecteventcore.processmessages;\r


@@ -190,7 +190,7 @@ begin
     prepsigpipe;\r
   {$endif}\r
   selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);\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
+  while (selectresult>0) or assigned(firsttask) do begin;\r

 \r
     processtasks;\r
     processtimers;\r
 \r
     processtasks;\r
     processtimers;\r


@@ -209,7 +209,7 @@ var
 \r
 var\r
   fdsrmaster , fdswmaster               : fdset      ;\r
 \r
 var\r
   fdsrmaster , fdswmaster               : fdset      ;\r

-
+\r

 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
 begin\r
   result := fdsrmaster;\r
 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
 begin\r
   result := fdsrmaster;\r


@@ -218,12 +218,24 @@ function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
 begin\r
   result := fdswmaster;\r
 end;\r
 begin\r
   result := fdswmaster;\r
 end;\r

-
-
+\r
+\r
+{\r
+select in linux/sysV subtracts from timeout for time spent in it, but in BSD it doesn't\r
+enabling select_no_autotv here makes doSelect mimic the decrement behavior, in case the caller needs it\r
+the caller here in lcoreselect does not need it, and enabling it would have a slight perf hit.\r
+it is safe for this to be enabled even if the OS does it too (it will not subtract twice)\r
+it is currently disabled but can be enabled if needed\r
+}\r
+{$ifndef linux}{-$define select_no_autotv}{$endif}\r
+\r

 Function  doSelect(timeOut:PTimeVal):longint;//inline;\r
 var\r
   localtimeval : ttimeval;\r
   maxslocal    : integer;\r
 Function  doSelect(timeOut:PTimeVal):longint;//inline;\r
 var\r
   localtimeval : ttimeval;\r
   maxslocal    : integer;\r

+  {$ifdef select_no_autotv}\r
+  timeoutcopy,tvstart,tvend : ttimeval;\r
+  {$endif}\r

 begin\r
   //unblock signals\r
   //zeromemory(@sset,sizeof(sset));\r
 begin\r
   //unblock signals\r
   //zeromemory(@sset,sizeof(sset));\r


@@ -243,18 +255,46 @@ begin
   {$ifndef nosignal}\r
     sigprocmask(SIG_UNBLOCK,@blockset,nil);\r
   {$endif}\r
   {$ifndef nosignal}\r
     sigprocmask(SIG_UNBLOCK,@blockset,nil);\r
   {$endif}\r

+\r
+  {$ifdef select_no_autotv}\r
+  if assigned(timeout) then begin\r
+    timeoutcopy.tv_sec := timeOut.tv_sec;\r
+    timeoutcopy.tv_usec := timeOut.tv_usec;\r
+    gettimemonotonic(tvstart);\r
+  end;\r
+  {$endif}\r
+\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
   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
+        // 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
       end else begin\r
         raise esocketexception.create('select returned error '+inttostr(linuxerror));\r
       end;\r

+    end\r
+  {$ifdef select_no_autotv}\r
+    else if (result = 0) and assigned(timeout) then begin\r
+      //timeout reached: zero the timeval\r
+      timeout.tv_sec := 0;\r
+      timeout.tv_usec := 0;\r

     end;\r
     end;\r

+  end else if assigned(timeout) then begin\r
+    //successful result: subtract elapsed time\r
+    gettimemonotonic(tvend);\r
+    tv_subtract(tvend,tvstart);\r
+    tv_subtract(timeoutcopy,tvend);\r
+    timeout.tv_sec := timeoutcopy.tv_sec;\r
+    timeout.tv_usec := timeoutcopy.tv_usec;\r
+    if (timeout.tv_sec < 0) then begin\r
+      timeout.tv_sec := 0;\r
+      timeout.tv_usec := 0;\r
+    end;\r
+  {$endif} //select_no_autotv\r

   end;\r
   end;\r

+\r

   {$ifndef nosignal}\r
     sigprocmask(SIG_BLOCK,@blockset,nil);\r
   {$endif}\r
   {$ifndef nosignal}\r
     sigprocmask(SIG_BLOCK,@blockset,nil);\r
   {$endif}\r


@@ -288,26 +328,7 @@ begin
 \r
   repeat\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
+    //the message loop will exit if all lasios and ltimers and lsignals are destroyed\r

     processtasks;\r
     //currenttask := nil;\r
     {beware}\r
     processtasks;\r
     //currenttask := nil;\r
     {beware}\r


@@ -328,8 +349,8 @@ begin
       selectresult := doselect(nil);\r
 \r
     end else begin\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
       //writeln('timers active');\r
       if tv.tv_sec < 0 then begin\r


@@ -352,7 +373,8 @@ end;
 \r
 procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);\r
 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
   if fd > maxs then maxs := fd;\r
   if fd_isset(fd,fdsrmaster) then exit;\r
   fd_set(fd,fdsrmaster);\r


@@ -361,6 +383,7 @@ end;
 \r
 procedure tselecteventcore.rmasterclr(fd: integer);\r
 begin\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
   if not fd_isset(fd,fdsrmaster) then exit;\r
   fd_clr(fd,fdsrmaster);\r
 \r


@@ -369,7 +392,8 @@ end;
 \r
 procedure tselecteventcore.wmasterset(fd : integer);\r
 begin\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
   if fd > maxs then maxs := fd;\r
 \r
   if fd_isset(fd,fdswmaster) then exit;\r


@@ -379,6 +403,7 @@ end;
 \r
 procedure tselecteventcore.wmasterclr(fd: integer);\r
 begin\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
   if not fd_isset(fd,fdswmaster) then exit;\r
   fd_clr(fd,fdswmaster);\r
 end;\r


@@ -388,12 +413,20 @@ begin
   fdreverse[fd] := reverseto;\r
 end;\r
 \r
   fdreverse[fd] := reverseto;\r
 end;\r
 \r

+var\r
+  inited:boolean;\r

 \r
 \r

-\r
+procedure lcoreinit;\r

 begin\r
 begin\r

+  if inited then exit;\r
+  inited := true;\r

   eventcore := tselecteventcore.create;\r
 \r
   eventcore := tselecteventcore.create;\r
 \r

+  absolutemaxs := absolutemaxs_select;\r
+\r

   maxs := 0;\r
   fd_zero(fdsrmaster);\r
   fd_zero(fdswmaster);\r
   maxs := 0;\r
   fd_zero(fdsrmaster);\r
   fd_zero(fdswmaster);\r

+end;\r
+\r

 end.\r
 end.\r