From 1c8b91ca0f6891a397357c7cf7d77af18c15937d Mon Sep 17 00:00:00 2001
From: beware <beware@bircd.org>
Date: Mon, 3 Apr 2023 23:30:09 +0000
Subject: [PATCH] fix slow send speed, new fifo allows get of entire buffer

---
 bfifo.pas | 193 +++++++++++++++++++++++++++++++-----------------------
 lcore.pas |  14 +++-
 2 files changed, 123 insertions(+), 84 deletions(-)

diff --git a/bfifo.pas b/bfifo.pas
index 667c0da..25781b7 100644
--- a/bfifo.pas
+++ b/bfifo.pas
@@ -9,73 +9,120 @@ unit bfifo;
 
 interface
 
-uses blinklist,pgtypes;
+{-$define bfifo_assert}
 
-const
-  pagesize=1420;
+uses
+  {$ifdef bfifo_assert}
+  sysutils,
+  {$endif}
+  pgtypes;
+
+var
+  bfifo_minallocsize:integer=4096;
 
 type
   tfifo=class(tobject)
   private
-    l:tlinklist;     {add to}
-    getl:tlinklist; {remove from}
-    ofs:integer;
-    getofs:integer;
+    allocsize:integer;
+    lastallocsize:integer; //last seen before we freed the buffer
+    lastalloccount:integer;
+    p:pointer;
+    head,tail:integer;
+    function getallocsizeforsize(i:integer):integer;
   public
     size:integer;
+
     procedure add(data:pointer;len:integer);
     function get(var resultptr:pointer;len:integer):integer;
     procedure del(len:integer);
-    constructor create;
     destructor destroy; override;
   end;
 
-
 implementation
 
+function tfifo.getallocsizeforsize(i:integer):integer;
 var
-  testcount:integer;
-
-{
+  a:integer;
+begin
+  //get smallest power of two >= i and >= minallocsize
 
-xx1..... add
-xxxxxxxx
-....2xxx delete
+  if (i <= bfifo_minallocsize) then begin
+    result := bfifo_minallocsize;
+    exit;
+  end;
 
-1 ofs
-2 getofs
+  result := i - 1;
+  for a := 1 to 31 do result := result or (i shr a);
+  inc(result);
 
-}
+end;
 
 procedure tfifo.add;
 var
   a:integer;
-  p:tlinklist;
+  p2:pointer;
 begin
   if len <= 0 then exit;
-  inc(size,len);
-  while len > 0 do begin
-    p := l;
-    if ofs = pagesize then begin
-      p := tplinklist.create;
-      if getl = nil then getl := p;
-      getmem(tplinklist(p).p,pagesize);
-      inc(testcount);
-      linklistadd(l,p);
-      ofs := 0;
+
+  {$ifdef bfifo_assert}
+  if (size < 0) then raise exception.create('tfifo.add: size<0: '+inttostr(size));
+  if (allocsize < 0) then raise exception.create('tfifo.add: allocsize<0: '+inttostr(allocsize));
+  if assigned(p) and (size = 0) then raise exception.create('tfifo.add: p assigned and size=0');
+  if assigned(p) and (allocsize = 0) then raise exception.create('tfifo.add: p assigned and allocsize=0');
+  {$endif}
+
+  if not assigned(p) then begin
+    {$ifdef bfifo_assert}
+    if (size > 0) then raise exception.create('tfifo.add: p not assigned and size>0: '+inttostr(size));
+    if (allocsize > 0) then raise exception.create('tfifo.add: p not assigned and allocsize>0: '+inttostr(allocsize));
+    {$endif}
+
+    //no buffer is allocated, allocate big enough one now
+    allocsize := getallocsizeforsize(len);
+
+    //reuse the biggest size seen to avoid unnecessary growing of the buffer all the time, but sometimes shrink it
+    //so an unnecessary big buffer isn't around forever
+    inc(lastalloccount);
+    if (lastalloccount and 7 = 0) then lastallocsize := getallocsizeforsize(lastallocsize div 2);
+
+    if allocsize < lastallocsize then allocsize := lastallocsize;
+
+    getmem(p,allocsize);
+    head := 0;
+    tail := 0;
+  end else if (head + len > allocsize) then begin
+    //buffer is not big enough to add new data to the end
+
+    if (size + len <= allocsize) then begin
+      //it will fit if we move the data in the buffer to the start first
+      if (size > 0) then move(pointer(taddrint(p) + tail)^,p^,size);
+      //if (size > 0) then move(p[tail],p[0],size);
+    end else begin
+      //grow the buffer
+
+      allocsize := getallocsizeforsize(size + len);
+
+      getmem(p2,allocsize);
+      move(pointer(taddrint(p) + tail)^,p2^,size);
+      freemem(p);
+      p := p2;
     end;
-    a := pagesize - ofs;
-    if len < a then a := len;
-    move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);
-    inc(taddrint(data),a);
-    dec(len,a);
-    inc(ofs,a);
+    head := size;
+    tail := 0;
   end;
+
+  {$ifdef bfifo_assert}
+  if (head + len > allocsize) or (head < 0) then raise exception.create('tfifo.add: allocsize - head < len: '+inttostr(allocsize)+' '+inttostr(head)+' '+inttostr(len));
+  if (not assigned(p)) then raise exception.create('tfifo.add: p '+inttostr(size));
+  {$endif}
+
+  inc(size,len);
+
+  move(data^,pointer(taddrint(p) + head)^,len);
+  inc(head,len);
 end;
 
 function tfifo.get;
-var
-  p:tlinklist;
 begin
   if len > size then len := size;
   if len <= 0 then begin
@@ -83,64 +130,46 @@ begin
     resultptr := nil;
     exit;
   end;
-  p := getl;
-  resultptr := pointer(taddrint(tplinklist(p).p)+getofs);
-  result := pagesize-getofs;
-  if result > len then result := len;
+
+  //return a pointer into the buffer without copying
+  result := len;
+
+  resultptr := pointer(taddrint(p) + tail);
 end;
 
 procedure tfifo.del;
-var
-  a:integer;
-  p,p2:tlinklist;
 begin
   if len <= 0 then exit;
-  p := getl;
-  if len > size then len := size;
-  dec(size,len);
 
-  if len = 0 then exit;
-
-  while len > 0 do begin
-    a := pagesize-getofs;
-    if a > len then a := len;
-    inc(getofs,a);
-    dec(len,a);
-    if getofs = pagesize then begin
-      p2 := p.prev;
-      freemem(tplinklist(p).p);
-      dec(testcount);
-      linklistdel(l,p);
-      p.destroy;
-      p := p2;
-      getl := p;
-      getofs := 0;
-    end;
-  end;
+  {$ifdef bfifo_assert}
+  if (size < 0) then raise exception.create('tfifo.del: size negative: '+inttostr(size));
+  if (head - tail <> size) then raise exception.create('tfifo.del: size head tail: '+inttostr(size)+' '+inttostr(head)+' '+inttostr(tail));
+  if (head > allocsize) then raise exception.create('tfifo.del: head allocsize: '+inttostr(head)+' '+inttostr(allocsize));
+  {$endif}
 
-  if size = 0 then begin
-    if assigned(l) then begin
-      p := l;
-      freemem(tplinklist(p).p);
-      dec(testcount);
-      linklistdel(l,p);
-      p.destroy;
-      getl := nil;
-    end;
-    ofs := pagesize;
-    getofs := 0;
-  end;
-end;
+  if (len > size) then len := size;
 
-constructor tfifo.create;
-begin
-  ofs := pagesize;
-  inherited create;
+  dec(size,len);
+  inc(tail,len);
+
+  if (size <= 0) then begin
+    if (allocsize > lastallocsize) then lastallocsize := allocsize;
+    allocsize := 0;
+    head := 0;
+    tail := 0;
+    if assigned(p) then freemem(p);
+    p := nil;
+  end;
 end;
 
 destructor tfifo.destroy;
 begin
   del(size);
+
+  {$ifdef bfifo_assert}
+  if assigned(p) then raise exception.create('tfifo.destroy: did not free '+inttostr(size)+' '+inttostr(allocsize));
+  {$endif}
+
   inherited destroy;
 end;
 
diff --git a/lcore.pas b/lcore.pas
index 08c242a..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;
@@ -110,6 +111,11 @@ interface
       {$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;
@@ -343,6 +349,7 @@ begin
   state := wsclosed;
   fdhandlein := -1;
   fdhandleout := -1;
+  sendflushmaxwrite := 16384;
 end;
 
 destructor tlasio.destroy;
@@ -490,7 +497,10 @@ begin
   end;
   datasentcalled := false;
 
-  lensent := sendq.get(data,packetbasesize*2);
+  lensent := sendflushmaxwrite;
+  if (lensent <= 0) then lensent := sendq.size;
+
+  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;
-- 
2.30.2