X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..69598fec083b67c8567293c7b8a397b64175bd45:/bfifo.pas?ds=inline

diff --git a/bfifo.pas b/bfifo.pas
old mode 100755
new mode 100644
index 55cc24a..25781b7
--- a/bfifo.pas
+++ b/bfifo.pas
@@ -9,74 +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;
-  a:integer;
 begin
   if len > size then len := size;
   if len <= 0 then begin
@@ -84,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;