X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/9763940f8849e5c807566157829a1e6d2c9172ee..HEAD:/lcore.pas diff --git a/lcore.pas b/lcore.pas index d346c52..ce72179 100644 --- a/lcore.pas +++ b/lcore.pas @@ -40,9 +40,10 @@ interface - be safe for either "ethernet v1" or "PPPoE", both take 8 bytes - IPv6 header: 40 bytes (IPv4 is 20) - TCP/UDP header: 20 bytes + packetbasesize is deprecated and should not be used anymore } packetbasesize = 1432; - receivebufsize=packetbasesize*8; + receivebufsize=16384; var absolutemaxs:integer=0; @@ -106,6 +107,15 @@ interface lasterror:integer; destroying:boolean; recvbufsize:integer; + datasentcalled:boolean; + {$ifdef mswindows} + sendflushlasterror:integer; + {$endif} + + sendflushmaxwrite:integer; + //how much to write to the socket internally in one go. higher values allow faster throughput especially if latency is high + //but it also causes onsenddata to be called less often (typically once for every sendflushmaxwrite bytes) + function receivestr:tbufferstring; virtual; procedure close; procedure abort; @@ -221,7 +231,7 @@ procedure exitmessageloop; var firsttimer : tltimer ; - firsttask , lasttask , currenttask : tltask ; + firsttask , lasttask : tltask ; numread : integer ; mustrefreshfds : boolean ; @@ -339,6 +349,7 @@ begin state := wsclosed; fdhandlein := -1; fdhandleout := -1; + sendflushmaxwrite := 16384; end; destructor tlasio.destroy; @@ -484,12 +495,20 @@ begin result := -1; exit; end; + datasentcalled := false; + + lensent := sendflushmaxwrite; + if (lensent <= 0) then lensent := sendq.size; - lensent := sendq.get(data,packetbasesize*2); + lensent := sendq.get(data,lensent); if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0; if result = -1 then lensent := 0 else lensent := result; + {$ifdef mswindows} + if (result = -1) then sendflushlasterror := getlasterror else sendflushlasterror := 0; + {$endif} + //sendq := copy(sendq,lensent+1,length(sendq)-lensent); sendq.del(lensent); @@ -562,14 +581,14 @@ begin end else begin {$ifdef mswindows} - if getlasterror=WSAEWOULDBLOCK then begin + if sendflushlasterror=WSAEWOULDBLOCK then begin //the asynchronous nature of windows messages means we sometimes //get here with the buffer full //so do nothing in that case end else {$endif} begin - internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif}); + internalclose({$ifdef mswindows}sendflushlasterror{$else}linuxerror{$endif}); end end; end; @@ -577,7 +596,13 @@ begin end else begin //everything is sent fire off ondatasent event if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster); - if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0); + if assigned(ondatasent) then begin + if not datasentcalled then begin + tltask.create(self.dodatasent,self,0,0); + datasentcalled := true; + end; + end; + end; if assigned(onfdwrite) then onfdwrite(self,0); end; @@ -654,7 +679,7 @@ end; {$ifndef mswindows} procedure tltimer.resettimes; begin - gettimeofday(nextts); + gettimemonotonic(nextts); {if not initialevent then} tv_add(nextts,interval); end; {$endif} @@ -798,26 +823,18 @@ end; procedure processtasks;//inline; var - temptask : tltask ; - + currenttask:tltask; begin - if not assigned(currenttask) then begin + while assigned(firsttask) do begin currenttask := firsttask; - firsttask := nil; - lasttask := nil; - end; - while assigned(currenttask) do begin + firsttask := firsttask.nexttask; + if not assigned(firsttask) then lasttask := nil; if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam); - if assigned(currenttask) then begin - temptask := currenttask; - currenttask := currenttask.nexttask; - temptask.free; - end; - //writeln('processed a task'); + currenttask.free; end; - + currenttask := nil; end; @@ -826,23 +843,18 @@ end; procedure disconnecttasks(aobj:tobject); var currenttasklocal : tltask ; - counter : byte ; + begin - for counter := 0 to 1 do begin - if counter = 0 then begin - currenttasklocal := firsttask; //main list of tasks - end else begin - currenttasklocal := currenttask; //needed in case called from a task - end; - // note i don't bother to destroy the links here as that will happen when - // the list of tasks is processed anyway - while assigned(currenttasklocal) do begin - if currenttasklocal.obj = aobj then begin - currenttasklocal.obj := nil; - currenttasklocal.handler := nil; - end; - currenttasklocal := currenttasklocal.nexttask; + currenttasklocal := firsttask; //main list of tasks + + // note i don't bother to destroy the links here as that will happen when + // the list of tasks is processed anyway + while assigned(currenttasklocal) do begin + if currenttasklocal.obj = aobj then begin + currenttasklocal.obj := nil; + currenttasklocal.handler := nil; end; + currenttasklocal := currenttasklocal.nexttask; end; end;