httpserver_20080306/lcoreselect.pas

   1 {lsocket.pas}\r
   2 \r
   3 {io and timer code by plugwash}\r
   4 \r
   5 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   6   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   7   which is included in the package\r
   8   ----------------------------------------------------------------------------- }\r
   9 \r
  10 \r
  11 unit lcoreselect;\r
  12 \r
  13 \r
  14 interface\r
  15 uses\r
  16   fd_utils;\r
  17 var\r
  18   maxs                                  : longint    ;\r
  19   exitloopflag                          : boolean    ; {if set by app, exit mainloop}\r
  20 \r
  21 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
  22 function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}\r
  23 \r
  24 implementation\r
  25 uses\r
  26   lcore,sysutils,\r
  27   {$ifdef VER1_0}\r
  28     linux,\r
  29   {$else}\r
  30     baseunix,unix,\r
  31   {$endif}\r
  32   classes,pgtypes,bfifo,\r
  33   {$ifndef nosignal}\r
  34     lsignal;\r
  35   {$endif}\r
  36 \r
  37 {$include unixstuff.inc}\r
  38 {$include ltimevalstuff.inc}\r
  39 var\r
  40   fdreverse:array[0..absoloutemaxs] of tlasio;\r
  41 type\r
  42   tselecteventcore=class(teventcore)\r
  43     public\r
  44       procedure processmessages; override;\r
  45       procedure messageloop; override;\r
  46       procedure exitmessageloop;override;\r
  47       procedure setfdreverse(fd : integer;reverseto : tlasio); override;\r
  48       procedure rmasterset(fd : integer;islistensocket : boolean); override;\r
  49       procedure rmasterclr(fd: integer); override;\r
  50       procedure wmasterset(fd : integer); override;\r
  51       procedure wmasterclr(fd: integer); override;\r
  52     end;\r
  53 \r
  54 procedure processtimers;inline;\r
  55 var\r
  56   tv           ,tvnow     : ttimeval ;\r
  57   currenttimer            : tltimer   ;\r
  58   temptimer               : tltimer  ;\r
  59 \r
  60 begin\r
  61   gettimeofday(tvnow);\r
  62   currenttimer := firsttimer;\r
  63   while assigned(currenttimer) do begin\r
  64     //writeln(currenttimer.enabled);\r
  65     if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin\r
  66       //if assigned(currenttimer.ontimer) then begin\r
  67       //  if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);\r
  68       //  currenttimer.initialdone := true;\r
  69       //end;\r
  70       if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);\r
  71       currenttimer.nextts := timeval(tvnow);\r
  72       tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);\r
  73     end;\r
  74     temptimer := currenttimer;\r
  75     currenttimer := currenttimer.nexttimer;\r
  76     if temptimer.released then temptimer.free;\r
  77   end;\r
  78 end;\r
  79 \r
  80 procedure processasios(var fdsr,fdsw:fdset);//inline;\r
  81 var\r
  82   currentsocket : tlasio  ;\r
  83   tempsocket    : tlasio  ;\r
  84   socketcount   : integer ; // for debugging perposes :)\r
  85   dw,bt:integer;\r
  86 begin\r
  87 {  inc(lcoretestcount);}\r
  88 \r
  89     //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
  90     //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;\r
  91 \r
  92 \r
  93   {------- test optimised loop}\r
  94   socketcount := 0;\r
  95   for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin\r
  96     for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin\r
  97       inc(socketcount);\r
  98       currentsocket := fdreverse[dw shl 5 or bt];\r
  99       {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');\r
 100       if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}\r
 101       {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}\r
 102       if not assigned(currentsocket) then begin\r
 103         fdclose(dw shl 5 or bt);\r
 104         continue\r
 105       end;\r
 106       if currentsocket.fdhandlein < 0 then begin\r
 107         fdclose(dw shl 5 or bt);\r
 108         continue\r
 109       end;\r
 110       try\r
 111         currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));\r
 112       except\r
 113         on E: exception do begin\r
 114           currentsocket.HandleBackGroundException(e);\r
 115         end;\r
 116       end;\r
 117 \r
 118       if mustrefreshfds then begin\r
 119         if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin\r
 120           fd_zero(fdsr);\r
 121           fd_zero(fdsw);\r
 122         end;\r
 123       end;\r
 124     end;\r
 125   end;\r
 126 \r
 127   if asinreleaseflag then begin\r
 128     asinreleaseflag := false;\r
 129     currentsocket := firstasin;\r
 130     while assigned(currentsocket) do begin\r
 131       tempsocket := currentsocket;\r
 132       currentsocket := currentsocket.nextasin;\r
 133       if tempsocket.released then begin\r
 134         tempsocket.free;\r
 135       end;\r
 136     end;\r
 137   end;\r
 138   {\r
 139   !!! issues:\r
 140   - sockets which are released may not be freed because theyre never processed by the loop\r
 141   made new code for handling this, using asinreleaseflag\r
 142 \r
 143   - when/why does the mustrefreshfds select apply, sheck if i did it correctly?\r
 144 \r
 145   - what happens if calling handlefdtrigger for a socket which does not have an event\r
 146   }\r
 147   {------- original loop}\r
 148 \r
 149   (*\r
 150   currentsocket := firstasin;\r
 151   socketcount := 0;\r
 152   while assigned(currentsocket) do begin\r
 153     if mustrefreshfds then begin\r
 154       if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin\r
 155         fd_zero(fdsr);\r
 156         fd_zero(fdsw);\r
 157       end;\r
 158     end;\r
 159     try\r
 160       if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin\r
 161         currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));\r
 162       end;\r
 163     except\r
 164       on E: exception do begin\r
 165         currentsocket.HandleBackGroundException(e);\r
 166       end;\r
 167     end;\r
 168     tempsocket := currentsocket;\r
 169     currentsocket := currentsocket.nextasin;\r
 170     inc(socketcount);\r
 171     if tempsocket.released then begin\r
 172       tempsocket.free;\r
 173     end;\r
 174   end; *)\r
 175 {  debugout('socketcount='+inttostr(socketcount));}\r
 176 end;\r
 177 \r
 178 procedure tselecteventcore.processmessages;\r
 179 var\r
 180   fdsr         , fdsw : fdset   ;\r
 181   selectresult        : longint ;\r
 182 begin\r
 183   mustrefreshfds := false;\r
 184   {$ifndef nosignal}\r
 185     prepsigpipe;\r
 186   {$endif}\r
 187   selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);\r
 188   while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;\r
 189 \r
 190     processtasks;\r
 191     processtimers;\r
 192     if selectresult > 0 then begin\r
 193       processasios(fdsr,fdsw);\r
 194     end;\r
 195     selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);\r
 196 \r
 197   end;\r
 198   mustrefreshfds := true;\r
 199 end;\r
 200 \r
 201 \r
 202 var\r
 203   FDSR , FDSW : fdset;\r
 204 \r
 205 Function  doSelect(timeOut:PTimeVal):longint;//inline;\r
 206 var\r
 207   localtimeval : ttimeval;\r
 208   maxslocal    : integer;\r
 209 begin\r
 210   //unblock signals\r
 211   //zeromemory(@sset,sizeof(sset));\r
 212   //sset[0] := ;\r
 213   fdsr := getfdsrmaster;\r
 214   fdsw := getfdswmaster;\r
 215 \r
 216   if assigned(firsttask) then begin\r
 217     localtimeval.tv_sec  := 0;\r
 218     localtimeval.tv_usec := 0;\r
 219     timeout := @localtimeval;\r
 220   end;\r
 221 \r
 222   maxslocal := maxs;\r
 223   mustrefreshfds := false;\r
 224 {  debugout('about to call select');}\r
 225   {$ifndef nosignal}\r
 226     sigprocmask(SIG_UNBLOCK,@blockset,nil);\r
 227   {$endif}\r
 228   result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);\r
 229   if result <= 0 then begin\r
 230     fd_zero(FDSR);\r
 231     fd_zero(FDSW);\r
 232     if result=-1 then begin\r
 233       if linuxerror = SYS_EINTR then begin\r
 234         // we received a signal it's not a problem\r
 235       end else begin\r
 236         raise esocketexception.create('select returned error '+inttostr(linuxerror));\r
 237       end;\r
 238     end;\r
 239   end;\r
 240   {$ifndef nosignal}\r
 241     sigprocmask(SIG_BLOCK,@blockset,nil);\r
 242   {$endif}\r
 243 {  debugout('select complete');}\r
 244 end;\r
 245 \r
 246 procedure tselecteventcore.exitmessageloop;\r
 247 begin\r
 248   exitloopflag := true\r
 249 end;\r
 250 \r
 251 \r
 252 \r
 253 procedure tselecteventcore.messageloop;\r
 254 var\r
 255   tv           ,tvnow     : ttimeval ;\r
 256   currenttimer            : tltimer  ;\r
 257   selectresult:integer;\r
 258 begin\r
 259   {$ifndef nosignal}\r
 260     prepsigpipe;\r
 261   {$endif}\r
 262   {currentsocket := firstasin;\r
 263   if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
 264   repeat\r
 265 \r
 266     if currentsocket.state = wsconnected then currentsocket.sendflush;\r
 267     currentsocket := currentsocket.nextasin;\r
 268   until not assigned(currentsocket);}\r
 269 \r
 270 \r
 271   repeat\r
 272 \r
 273     //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
 274     if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;\r
 275     {fd_zero(FDSR);\r
 276     fd_zero(FDSW);\r
 277     currentsocket := firstasin;\r
 278     if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
 279 \r
 280     repeat\r
 281       if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);\r
 282       if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);\r
 283       if currentsocket is tlsocket then begin\r
 284          if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);\r
 285       end;\r
 286       tempsocket := currentsocket;\r
 287       currentsocket := currentsocket.nextasin;\r
 288       if tempsocket.released then begin\r
 289         tempsocket.free;\r
 290       end;\r
 291     until not assigned(currentsocket);\r
 292     }\r
 293     processtasks;\r
 294     //currenttask := nil;\r
 295     {beware}\r
 296     //if assigned(firsttimer) then begin\r
 297     //  tv.tv_sec := maxlongint;\r
 298     tv := tv_invalidtimebig;\r
 299     currenttimer := firsttimer;\r
 300     while assigned(currenttimer) do begin\r
 301       if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;\r
 302       currenttimer := currenttimer.nexttimer;\r
 303     end;\r
 304 \r
 305 \r
 306     if tv_compare(tv,tv_invalidtimebig) then begin    \r
 307       //writeln('no timers active');\r
 308       if exitloopflag then break;\r
 309 {    sleep(10);}\r
 310       selectresult := doselect(nil);\r
 311 \r
 312     end else begin\r
 313       gettimeofday(tvnow);\r
 314       tv_substract(tv,tvnow);\r
 315 \r
 316       //writeln('timers active');\r
 317       if tv.tv_sec < 0 then begin\r
 318         tv.tv_sec := 0;\r
 319         tv.tv_usec := 0; {0.1 sec}\r
 320       end;\r
 321       if exitloopflag then break;\r
 322 {    sleep(10);}\r
 323       selectresult := doselect(@tv);\r
 324       processtimers;\r
 325 \r
 326     end;\r
 327     if selectresult > 0 then processasios(fdsr,fdsw);\r
 328     {!!!only call processasios if select has asio events -beware}\r
 329 \r
 330     {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}\r
 331   until false;\r
 332 end;\r
 333 \r
 334 var\r
 335   fdsrmaster , fdswmaster               : fdset      ;\r
 336 \r
 337 procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);\r
 338 begin\r
 339   if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');\r
 340   if fd > maxs then maxs := fd;\r
 341   if fd_isset(fd,fdsrmaster) then exit;\r
 342   fd_set(fd,fdsrmaster);\r
 343 \r
 344 end;\r
 345 \r
 346 procedure tselecteventcore.rmasterclr(fd: integer);\r
 347 begin\r
 348   if not fd_isset(fd,fdsrmaster) then exit;\r
 349   fd_clr(fd,fdsrmaster);\r
 350 \r
 351 end;\r
 352 \r
 353 \r
 354 procedure tselecteventcore.wmasterset(fd : integer);\r
 355 begin\r
 356   if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');\r
 357   if fd > maxs then maxs := fd;\r
 358 \r
 359   if fd_isset(fd,fdswmaster) then exit;\r
 360   fd_set(fd,fdswmaster);\r
 361 \r
 362 end;\r
 363 \r
 364 procedure tselecteventcore.wmasterclr(fd: integer);\r
 365 begin\r
 366   if not fd_isset(fd,fdswmaster) then exit;\r
 367   fd_clr(fd,fdswmaster);\r
 368 end;\r
 369 \r
 370 procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);\r
 371 begin\r
 372   fdreverse[fd] := reverseto;\r
 373 end;\r
 374 \r
 375 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
 376 begin\r
 377   result := fdsrmaster;\r
 378 end;\r
 379 function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}\r
 380 begin\r
 381   result := fdswmaster;\r
 382 end;\r
 383 \r
 384 \r
 385 begin\r
 386   eventcore := tselecteventcore.create;\r
 387 \r
 388   maxs := 0;\r
 389   fd_zero(fdsrmaster);\r
 390   fd_zero(fdswmaster);\r
 391 end.\r