change uint32 from longword to cardinal for posix delphi

[lcore.git] / bfifo.pas

diff --git a/bfifo.pas b/bfifo.pas
index 667c0da863da557c29d37f65f1c00b8d141e54ab..25781b7f314b9fc8c9d70e046a086c5c975fbb6b 100644 (file)
--- a/bfifo.pas
+++ b/bfifo.pas
@@ -9,73 +9,120 @@ unit bfifo;
 \r
 interface\r
 \r
 \r
 interface\r
 \r

-uses blinklist,pgtypes;\r
+{-$define bfifo_assert}\r

 \r
 \r

-const\r
-  pagesize=1420;\r
+uses\r
+  {$ifdef bfifo_assert}\r
+  sysutils,\r
+  {$endif}\r
+  pgtypes;\r
+\r
+var\r
+  bfifo_minallocsize:integer=4096;\r

 \r
 type\r
   tfifo=class(tobject)\r
   private\r
 \r
 type\r
   tfifo=class(tobject)\r
   private\r

-    l:tlinklist;     {add to}\r
-    getl:tlinklist; {remove from}\r
-    ofs:integer;\r
-    getofs:integer;\r
+    allocsize:integer;\r
+    lastallocsize:integer; //last seen before we freed the buffer\r
+    lastalloccount:integer;\r
+    p:pointer;\r
+    head,tail:integer;\r
+    function getallocsizeforsize(i:integer):integer;\r

   public\r
     size:integer;\r
   public\r
     size:integer;\r

+\r

     procedure add(data:pointer;len:integer);\r
     function get(var resultptr:pointer;len:integer):integer;\r
     procedure del(len:integer);\r
     procedure add(data:pointer;len:integer);\r
     function get(var resultptr:pointer;len:integer):integer;\r
     procedure del(len:integer);\r

-    constructor create;\r

     destructor destroy; override;\r
   end;\r
 \r
     destructor destroy; override;\r
   end;\r
 \r

-\r

 implementation\r
 \r
 implementation\r
 \r

+function tfifo.getallocsizeforsize(i:integer):integer;\r

 var\r
 var\r

-  testcount:integer;\r
-\r
-{\r
+  a:integer;\r
+begin\r
+  //get smallest power of two >= i and >= minallocsize\r

 \r
 \r

-xx1..... add\r
-xxxxxxxx\r
-....2xxx delete\r
+  if (i <= bfifo_minallocsize) then begin\r
+    result := bfifo_minallocsize;\r
+    exit;\r
+  end;\r

 \r
 \r

-1 ofs\r
-2 getofs\r
+  result := i - 1;\r
+  for a := 1 to 31 do result := result or (i shr a);\r
+  inc(result);\r

 \r
 \r

-}\r
+end;\r

 \r
 procedure tfifo.add;\r
 var\r
   a:integer;\r
 \r
 procedure tfifo.add;\r
 var\r
   a:integer;\r

-  p:tlinklist;\r
+  p2:pointer;\r

 begin\r
   if len <= 0 then exit;\r
 begin\r
   if len <= 0 then exit;\r

-  inc(size,len);\r
-  while len > 0 do begin\r
-    p := l;\r
-    if ofs = pagesize then begin\r
-      p := tplinklist.create;\r
-      if getl = nil then getl := p;\r
-      getmem(tplinklist(p).p,pagesize);\r
-      inc(testcount);\r
-      linklistadd(l,p);\r
-      ofs := 0;\r
+\r
+  {$ifdef bfifo_assert}\r
+  if (size < 0) then raise exception.create('tfifo.add: size<0: '+inttostr(size));\r
+  if (allocsize < 0) then raise exception.create('tfifo.add: allocsize<0: '+inttostr(allocsize));\r
+  if assigned(p) and (size = 0) then raise exception.create('tfifo.add: p assigned and size=0');\r
+  if assigned(p) and (allocsize = 0) then raise exception.create('tfifo.add: p assigned and allocsize=0');\r
+  {$endif}\r
+\r
+  if not assigned(p) then begin\r
+    {$ifdef bfifo_assert}\r
+    if (size > 0) then raise exception.create('tfifo.add: p not assigned and size>0: '+inttostr(size));\r
+    if (allocsize > 0) then raise exception.create('tfifo.add: p not assigned and allocsize>0: '+inttostr(allocsize));\r
+    {$endif}\r
+\r
+    //no buffer is allocated, allocate big enough one now\r
+    allocsize := getallocsizeforsize(len);\r
+\r
+    //reuse the biggest size seen to avoid unnecessary growing of the buffer all the time, but sometimes shrink it\r
+    //so an unnecessary big buffer isn't around forever\r
+    inc(lastalloccount);\r
+    if (lastalloccount and 7 = 0) then lastallocsize := getallocsizeforsize(lastallocsize div 2);\r
+\r
+    if allocsize < lastallocsize then allocsize := lastallocsize;\r
+\r
+    getmem(p,allocsize);\r
+    head := 0;\r
+    tail := 0;\r
+  end else if (head + len > allocsize) then begin\r
+    //buffer is not big enough to add new data to the end\r
+\r
+    if (size + len <= allocsize) then begin\r
+      //it will fit if we move the data in the buffer to the start first\r
+      if (size > 0) then move(pointer(taddrint(p) + tail)^,p^,size);\r
+      //if (size > 0) then move(p[tail],p[0],size);\r
+    end else begin\r
+      //grow the buffer\r
+\r
+      allocsize := getallocsizeforsize(size + len);\r
+\r
+      getmem(p2,allocsize);\r
+      move(pointer(taddrint(p) + tail)^,p2^,size);\r
+      freemem(p);\r
+      p := p2;\r

     end;\r
     end;\r

-    a := pagesize - ofs;\r
-    if len < a then a := len;\r
-    move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);\r
-    inc(taddrint(data),a);\r
-    dec(len,a);\r
-    inc(ofs,a);\r
+    head := size;\r
+    tail := 0;\r

   end;\r
   end;\r

+\r
+  {$ifdef bfifo_assert}\r
+  if (head + len > allocsize) or (head < 0) then raise exception.create('tfifo.add: allocsize - head < len: '+inttostr(allocsize)+' '+inttostr(head)+' '+inttostr(len));\r
+  if (not assigned(p)) then raise exception.create('tfifo.add: p '+inttostr(size));\r
+  {$endif}\r
+\r
+  inc(size,len);\r
+\r
+  move(data^,pointer(taddrint(p) + head)^,len);\r
+  inc(head,len);\r

 end;\r
 \r
 function tfifo.get;\r
 end;\r
 \r
 function tfifo.get;\r

-var\r
-  p:tlinklist;\r

 begin\r
   if len > size then len := size;\r
   if len <= 0 then begin\r
 begin\r
   if len > size then len := size;\r
   if len <= 0 then begin\r


@@ -83,64 +130,46 @@ begin
     resultptr := nil;\r
     exit;\r
   end;\r
     resultptr := nil;\r
     exit;\r
   end;\r

-  p := getl;\r
-  resultptr := pointer(taddrint(tplinklist(p).p)+getofs);\r
-  result := pagesize-getofs;\r
-  if result > len then result := len;\r
+\r
+  //return a pointer into the buffer without copying\r
+  result := len;\r
+\r
+  resultptr := pointer(taddrint(p) + tail);\r

 end;\r
 \r
 procedure tfifo.del;\r
 end;\r
 \r
 procedure tfifo.del;\r

-var\r
-  a:integer;\r
-  p,p2:tlinklist;\r

 begin\r
   if len <= 0 then exit;\r
 begin\r
   if len <= 0 then exit;\r

-  p := getl;\r
-  if len > size then len := size;\r
-  dec(size,len);\r

 \r
 \r

-  if len = 0 then exit;\r
-\r
-  while len > 0 do begin\r
-    a := pagesize-getofs;\r
-    if a > len then a := len;\r
-    inc(getofs,a);\r
-    dec(len,a);\r
-    if getofs = pagesize then begin\r
-      p2 := p.prev;\r
-      freemem(tplinklist(p).p);\r
-      dec(testcount);\r
-      linklistdel(l,p);\r
-      p.destroy;\r
-      p := p2;\r
-      getl := p;\r
-      getofs := 0;\r
-    end;\r
-  end;\r
+  {$ifdef bfifo_assert}\r
+  if (size < 0) then raise exception.create('tfifo.del: size negative: '+inttostr(size));\r
+  if (head - tail <> size) then raise exception.create('tfifo.del: size head tail: '+inttostr(size)+' '+inttostr(head)+' '+inttostr(tail));\r
+  if (head > allocsize) then raise exception.create('tfifo.del: head allocsize: '+inttostr(head)+' '+inttostr(allocsize));\r
+  {$endif}\r

 \r
 \r

-  if size = 0 then begin\r
-    if assigned(l) then begin\r
-      p := l;\r
-      freemem(tplinklist(p).p);\r
-      dec(testcount);\r
-      linklistdel(l,p);\r
-      p.destroy;\r
-      getl := nil;\r
-    end;\r
-    ofs := pagesize;\r
-    getofs := 0;\r
-  end;\r
-end;\r
+  if (len > size) then len := size;\r

 \r
 \r

-constructor tfifo.create;\r
-begin\r
-  ofs := pagesize;\r
-  inherited create;\r
+  dec(size,len);\r
+  inc(tail,len);\r
+\r
+  if (size <= 0) then begin\r
+    if (allocsize > lastallocsize) then lastallocsize := allocsize;\r
+    allocsize := 0;\r
+    head := 0;\r
+    tail := 0;\r
+    if assigned(p) then freemem(p);\r
+    p := nil;\r
+  end;\r

 end;\r
 \r
 destructor tfifo.destroy;\r
 begin\r
   del(size);\r
 end;\r
 \r
 destructor tfifo.destroy;\r
 begin\r
   del(size);\r

+\r
+  {$ifdef bfifo_assert}\r
+  if assigned(p) then raise exception.create('tfifo.destroy: did not free '+inttostr(size)+' '+inttostr(allocsize));\r
+  {$endif}\r
+\r

   inherited destroy;\r
 end;\r
 \r
   inherited destroy;\r
 end;\r
 \r