bfifo.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 unit bfifo;\r
   6 {$ifdef fpc}\r
   7   {$mode delphi}\r
   8 {$endif}\r
   9 \r
  10 interface\r
  11 \r
  12 {-$define bfifo_assert}\r
  13 \r
  14 uses\r
  15   {$ifdef bfifo_assert}\r
  16   sysutils,\r
  17   {$endif}\r
  18   pgtypes;\r
  19 \r
  20 var\r
  21   bfifo_minallocsize:integer=4096;\r
  22 \r
  23 type\r
  24   tfifo=class(tobject)\r
  25   private\r
  26     allocsize:integer;\r
  27     lastallocsize:integer; //last seen before we freed the buffer\r
  28     lastalloccount:integer;\r
  29     p:pointer;\r
  30     head,tail:integer;\r
  31     function getallocsizeforsize(i:integer):integer;\r
  32   public\r
  33     size:integer;\r
  34 \r
  35     procedure add(data:pointer;len:integer);\r
  36     function get(var resultptr:pointer;len:integer):integer;\r
  37     procedure del(len:integer);\r
  38     destructor destroy; override;\r
  39   end;\r
  40 \r
  41 implementation\r
  42 \r
  43 function tfifo.getallocsizeforsize(i:integer):integer;\r
  44 var\r
  45   a:integer;\r
  46 begin\r
  47   //get smallest power of two >= i and >= minallocsize\r
  48 \r
  49   if (i <= bfifo_minallocsize) then begin\r
  50     result := bfifo_minallocsize;\r
  51     exit;\r
  52   end;\r
  53 \r
  54   result := i - 1;\r
  55   for a := 1 to 31 do result := result or (i shr a);\r
  56   inc(result);\r
  57 \r
  58 end;\r
  59 \r
  60 procedure tfifo.add;\r
  61 var\r
  62   a:integer;\r
  63   p2:pointer;\r
  64 begin\r
  65   if len <= 0 then exit;\r
  66 \r
  67   {$ifdef bfifo_assert}\r
  68   if (size < 0) then raise exception.create('tfifo.add: size<0: '+inttostr(size));\r
  69   if (allocsize < 0) then raise exception.create('tfifo.add: allocsize<0: '+inttostr(allocsize));\r
  70   if assigned(p) and (size = 0) then raise exception.create('tfifo.add: p assigned and size=0');\r
  71   if assigned(p) and (allocsize = 0) then raise exception.create('tfifo.add: p assigned and allocsize=0');\r
  72   {$endif}\r
  73 \r
  74   if not assigned(p) then begin\r
  75     {$ifdef bfifo_assert}\r
  76     if (size > 0) then raise exception.create('tfifo.add: p not assigned and size>0: '+inttostr(size));\r
  77     if (allocsize > 0) then raise exception.create('tfifo.add: p not assigned and allocsize>0: '+inttostr(allocsize));\r
  78     {$endif}\r
  79 \r
  80     //no buffer is allocated, allocate big enough one now\r
  81     allocsize := getallocsizeforsize(len);\r
  82 \r
  83     //reuse the biggest size seen to avoid unnecessary growing of the buffer all the time, but sometimes shrink it\r
  84     //so an unnecessary big buffer isn't around forever\r
  85     inc(lastalloccount);\r
  86     if (lastalloccount and 7 = 0) then lastallocsize := getallocsizeforsize(lastallocsize div 2);\r
  87 \r
  88     if allocsize < lastallocsize then allocsize := lastallocsize;\r
  89 \r
  90     getmem(p,allocsize);\r
  91     head := 0;\r
  92     tail := 0;\r
  93   end else if (head + len > allocsize) then begin\r
  94     //buffer is not big enough to add new data to the end\r
  95 \r
  96     if (size + len <= allocsize) then begin\r
  97       //it will fit if we move the data in the buffer to the start first\r
  98       if (size > 0) then move(pointer(taddrint(p) + tail)^,p^,size);\r
  99       //if (size > 0) then move(p[tail],p[0],size);\r
 100     end else begin\r
 101       //grow the buffer\r
 102 \r
 103       allocsize := getallocsizeforsize(size + len);\r
 104 \r
 105       getmem(p2,allocsize);\r
 106       move(pointer(taddrint(p) + tail)^,p2^,size);\r
 107       freemem(p);\r
 108       p := p2;\r
 109     end;\r
 110     head := size;\r
 111     tail := 0;\r
 112   end;\r
 113 \r
 114   {$ifdef bfifo_assert}\r
 115   if (head + len > allocsize) or (head < 0) then raise exception.create('tfifo.add: allocsize - head < len: '+inttostr(allocsize)+' '+inttostr(head)+' '+inttostr(len));\r
 116   if (not assigned(p)) then raise exception.create('tfifo.add: p '+inttostr(size));\r
 117   {$endif}\r
 118 \r
 119   inc(size,len);\r
 120 \r
 121   move(data^,pointer(taddrint(p) + head)^,len);\r
 122   inc(head,len);\r
 123 end;\r
 124 \r
 125 function tfifo.get;\r
 126 begin\r
 127   if len > size then len := size;\r
 128   if len <= 0 then begin\r
 129     result := 0;\r
 130     resultptr := nil;\r
 131     exit;\r
 132   end;\r
 133 \r
 134   //return a pointer into the buffer without copying\r
 135   result := len;\r
 136 \r
 137   resultptr := pointer(taddrint(p) + tail);\r
 138 end;\r
 139 \r
 140 procedure tfifo.del;\r
 141 begin\r
 142   if len <= 0 then exit;\r
 143 \r
 144   {$ifdef bfifo_assert}\r
 145   if (size < 0) then raise exception.create('tfifo.del: size negative: '+inttostr(size));\r
 146   if (head - tail <> size) then raise exception.create('tfifo.del: size head tail: '+inttostr(size)+' '+inttostr(head)+' '+inttostr(tail));\r
 147   if (head > allocsize) then raise exception.create('tfifo.del: head allocsize: '+inttostr(head)+' '+inttostr(allocsize));\r
 148   {$endif}\r
 149 \r
 150   if (len > size) then len := size;\r
 151 \r
 152   dec(size,len);\r
 153   inc(tail,len);\r
 154 \r
 155   if (size <= 0) then begin\r
 156     if (allocsize > lastallocsize) then lastallocsize := allocsize;\r
 157     allocsize := 0;\r
 158     head := 0;\r
 159     tail := 0;\r
 160     if assigned(p) then freemem(p);\r
 161     p := nil;\r
 162   end;\r
 163 end;\r
 164 \r
 165 destructor tfifo.destroy;\r
 166 begin\r
 167   del(size);\r
 168 \r
 169   {$ifdef bfifo_assert}\r
 170   if assigned(p) then raise exception.create('tfifo.destroy: did not free '+inttostr(size)+' '+inttostr(allocsize));\r
 171   {$endif}\r
 172 \r
 173   inherited destroy;\r
 174 end;\r
 175 \r
 176 end.\r