{ Copyright (C) 2005 Bas Steendijk and Peter Green
  For conditions of distribution and use, see copyright notice in zlib_license.txt
  which is included in the package
  ----------------------------------------------------------------------------- }
unit bfifo;
{$ifdef fpc}
  {$mode delphi}
{$endif}

interface

{-$define bfifo_assert}

uses
  {$ifdef bfifo_assert}
  sysutils,
  {$endif}
  pgtypes;

var
  bfifo_minallocsize:integer=4096;

type
  tfifo=class(tobject)
  private
    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);
    destructor destroy; override;
  end;

implementation

function tfifo.getallocsizeforsize(i:integer):integer;
var
  a:integer;
begin
  //get smallest power of two >= i and >= minallocsize

  if (i <= bfifo_minallocsize) then begin
    result := bfifo_minallocsize;
    exit;
  end;

  result := i - 1;
  for a := 1 to 31 do result := result or (i shr a);
  inc(result);

end;

procedure tfifo.add;
var
  a:integer;
  p2:pointer;
begin
  if len <= 0 then exit;

  {$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;
    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;
begin
  if len > size then len := size;
  if len <= 0 then begin
    result := 0;
    resultptr := nil;
    exit;
  end;

  //return a pointer into the buffer without copying
  result := len;

  resultptr := pointer(taddrint(p) + tail);
end;

procedure tfifo.del;
begin
  if len <= 0 then exit;

  {$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 (len > size) then len := size;

  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;

end.