mempools.pas

由delphi实现的bt下载器示例程序

    leavecriticalsection(lock);
  end;
end;

procedure TMemPool.CombineBlock(b, p, c, n: Integer);
var
  l: Integer;
  x, y, z: Integer;
begin
  if (p>0) and (n>0) and (blocks[b][p] >= 0) and (blocks[b][n]>=0) then
  begin
    //debugout('combine 3 blocks:'+inttostr(p)+'/'+inttostr(blocks[b,p])+','+
    //    inttostr(c)+'/'+inttostr(blocks[b,c])+','+inttostr(n)+'/'+inttostr(blocks[b,n]));
    l := blocks[b][p]+blocks[b][n]+blocks[b][c];
    x := findpt(encodehandle(b, p), 0, emptye-1);
    y := findpt(encodehandle(b, n), 0, emptye-1);
    if x > y then
    begin
      z := x;
      x := y;
      y := z;
    end;
    z := findpt(encodehandle(b, p), 0, emptye-1, l)-1;
    blocks[b][p] := l;
    blocks[b][p+l-1] := l;
    move(emptys[x+1], emptys[x], (y-x-1)*4);
    move(emptys[y+1], emptys[y-1], (z-y)*4);
    emptys[z-1] := encodehandle(b, p);
    dec(emptye);
    move(emptys[z+1], emptys[z], (emptye-z)*4);
  end
  else if (p>0) and (blocks[b][p]>=0) then
  begin
    //debugout('combine prev block:'+inttostr(p)+'/'+inttostr(blocks[b,p])+','+inttostr(c)+'/'+inttostr(blocks[b,c]));
    l := blocks[b][c]+blocks[b][p];
    x := findpt(encodehandle(b, p), 0, emptye-1);
    y := findpt(encodehandle(b, p), 0, emptye-1, l)-1;
    move(emptys[x+1], emptys[x], (y-x)*4);
    emptys[y] := encodehandle(b, p);
    blocks[b][p] := l;
    blocks[b][p+l-1] := l;
  end
  else if (n>0) and (blocks[b][n]>=0) then
  begin
    //debugout('combine next block:'+inttostr(c)+'/'+inttostr(blocks[b,c])+','+inttostr(n)+'/'+inttostr(blocks[b,n]));
    l := blocks[b][c]+blocks[b][n];
    x := findpt(encodehandle(b, n), 0, emptye-1);
    y := findpt(encodehandle(b, c), 0, emptye-1, l)-1;
    move(emptys[x+1], emptys[x], (y-x)*4);
    emptys[y] := encodehandle(b, c);
    blocks[b][c] := l;
    blocks[b][c+l-1] := l;
  end
  else begin
    //debugout('add empty block:'+inttostr(c)+'/'+inttostr(blocks[b,c]));
    x := findpt(encodehandle(b, c), 0, emptye-1, blocks[b][c]);
    if emptye=length(emptys) then
      setlength(emptys, length(emptys)+BUCKET_INC);
    move(emptys[x], emptys[x+1], (emptye-x)*4);
    emptys[x] := encodehandle(b, c);
    inc(emptye);
  end;
end;

function TMemPool.DebugMem: string;
var
  i, n: Integer;
begin
  result := 'BlockSize: '+inttostr(bufSize);
  result := result + ' BlockCnt: '+InttoStr(Blocke)+#13#10;
  for i := 0 to blocke-1 do
  begin
    result := result + 'Block['+inttostr(i)+']:'#13#10;
    n := 1;
    while n < bufsize do
    begin
      if blocks[i][n] > 0 then
        result := result + inttostr(n)+'/'+inttostr(blocks[i][n])+'(Empty),'
      else if blocks[i][n] < 0 then
        result := result + inttostr(n)+'/'+inttostr(blocks[i][n] and $7FFFFFFF)+'(Used),'
      else begin
        result := result + inttostr(n)+'/ERROR!!!';
        break;
      end;
      n := n + (blocks[i][n] and $7FFFFFFF);
    end;
  end;
  result := result + #13#10+'Emptys('+inttostr(emptye)+'):'#13#10;
  for i := 0 to emptye-1 do
    result := result + inttostr(emptys[i])+',';
  result := result + #13#10;
end;

{ TFixedMemPool }

constructor TFixedMemPool.Create(ABlockSize, IncreaseCnt: Cardinal);
begin
  initializeCriticalSection(lock);
  BlockSize := ABlockSize;
  IncValue := IncreaseCnt;
end;

destructor TFixedMemPool.Destroy;
var
  i: Integer;
begin
  for i := 0 to high(buffers) do
    if (cardinal(buffers[i])<bigbuffer) or (cardinal(buffers[i])>=bigbuffer+bigbuflen) then
      dispose(buffers[i]);
  if bigbuffer <> 0 then
    dispose(pointer(bigbuffer));
  setlength(buffers, 0);
  setlength(emptys, 0);
  setlength(translater, 0);
  setlength(transIdx, 0);
  inherited;
  deletecriticalsection(lock);
end;

function TFixedMemPool.Get: Pointer;
var
  l: cardinal;
  p: Pointer;
  i: Integer;
begin
  result := nil;
  entercriticalsection(lock);
  try
  l := emptye - emptyb;
  if l = 0 then
  begin
    emptyb := 0;
    emptye := 0;
    setlength(buffers, length(buffers)+1);
    setlength(emptys, length(emptys)+Integer(incvalue));
    getmem(p, blocksize * IncValue);
    buffers[high(buffers)] := p;
    for i := 0 to IncValue - 1 do
    begin
      emptys[i] := p;
      p := pointer(integer(p)+Integer(blocksize));
      inc(emptye);
    end;
  end;
  result := emptys[emptyb mod cardinal(length(emptys))];
  inc(emptyb);
  except
  end;
  leavecriticalsection(lock);
  fillchar(result^, blocksize, #0);
end;

procedure TFixedMemPool.Put(p: Pointer);
begin
  entercriticalsection(lock);
  try
  emptys[emptye mod cardinal(length(emptys))] := p;
  inc(emptye);
  except
  end;
  leavecriticalsection(lock);
end;

procedure TFixedMemPool.LoadFromFileId(Fid: Integer);
{
文件结构:
  'FXMEMIMG'
  BlockSize: Integer
  IncValue: Integer
  bufcnt: dword
  oldpt: array [0..bufcnt-1] of dword
  index: array [0..bufcnt-1] of word
  blocks: array [0..bufcnt-1] of dword
  buffersize: cardinal
  buffers: sum(blocks)
  emptyb: Integer
  emptye: Integer
  emptycnt: dword;
  emptys: array [0..emptycnt-1] of dword
}
var
  i: Integer;
  buf: array [0..7] of char;
begin
  entercriticalsection(lock);
  try
  fileread(fid, buf, 8);
  if comparemem(@buf, pchar('FXMEMIMG'), 8) then
  begin
    for i := 0 to high(buffers) do
      if (cardinal(buffers[i])<bigbuffer) or (cardinal(buffers[i])>=bigbuffer+bigbuflen) then
        dispose(buffers[i]);
    if bigbuffer <> 0 then
      dispose(pointer(bigbuffer));
    setlength(buffers, 0);
    setlength(emptys, 0);
    setlength(translater, 0);
    setlength(transIdx, 0);

    fileread(fid, blocksize, 4);
    fileread(fid, incvalue, 4);
    fileread(fid, buf, 2);
    setlength(transidx, pword(@buf)^);
    setlength(buffers, pword(@buf)^);
    setlength(translater, pword(@buf)^);
    fileread(fid, translater[0], length(translater)*4);
    fileread(fid, transidx[0], length(transidx)*2);
    fileread(fid, buffers[0], length(buffers)*4);
    fileread(fid, bigbuflen, 4);
    getmem(pointer(bigbuffer), bigbuflen);
    fileread(fid, pbyte(bigbuffer)^, bigbuflen);
    for i := 0 to high(buffers) do
      buffers[i] := pointer(cardinal(buffers[i])+bigbuffer);
    fileread(fid, emptyb, 4);
    fileread(fid, emptye, 4);
    fileread(fid, buf, 4);
    setlength(emptys, pcardinal(@buf)^);
    fileread(fid, emptys[0], length(emptys)*4);
    translate(emptys[0], length(emptys));
  end;
  except
  end;
  leavecriticalsection(lock);
end;

procedure TFixedMemPool.SaveToFileID(Fid: Integer);
{
文件结构:
  'FXMEMIMG'
  BlockSize: Integer
  IncValue: Integer
  bufcnt: dword
  oldpt: array [0..bufcnt-1] of dword
  index: array [0..bufcnt-1] of word
  blocks: array [0..bufcnt-1] of dword
  buffersize: cardinal
  buffers: sum(blocks)
  emptyb: Integer
  emptye: Integer
  emptycnt: dword;
  emptys: array [0..emptycnt-1] of dword
}
var
  i, l: Integer;
  cnts: array of Integer;
  Idx: array of Integer;

  procedure InsertIdx(Ind: word);
  var
    b, e, c: Integer;
  begin
    b := 0;
    e := high(Idx);
    while b <= e do
    begin
      c := (b + e) shr 1;
      if cardinal(buffers[ind])>cardinal(buffers[Idx[c]]) then
        b := c + 1
      else if cardinal(buffers[ind]) < cardinal(buffers[Idx[c]]) then
        e := c - 1
      else exit;
    end;
    setlength(Idx, length(Idx)+1);
    move(Idx[b], Idx[b+1], (High(Idx)-b)*2);
    Idx[b] := Ind;
  end;

begin
  entercriticalsection(lock);
  try
  filewrite(fid, pchar('FXMEMIMG')^, 8);
  filewrite(fid, blocksize, 4);
  filewrite(fid, incvalue, 4);
  l := length(buffers);
  filewrite(fid, l, 2);
  setlength(idx, 0);
  setlength(cnts, length(buffers));
  filewrite(fid, buffers[0], length(buffers)*4);
  l := 0;
  for i := 0 to high(buffers) do
  begin
    InsertIdx(i);
    cnts[i] := l;
    inc(l, PInteger(Integer(buffers[i])-4)^ and $7FFFFFF8);
  end;
  filewrite(fid, idx[0], length(idx)*2);
  filewrite(fid, cnts[0], length(cnts)*4);
  filewrite(fid, l, 4);
  for i := 0 to high(buffers) do
    filewrite(fid, pbyte(buffers[i])^, PInteger(Integer(buffers[i])-4)^ and $7FFFFFF8);
  filewrite(fid, emptyb, 4);
  filewrite(fid, emptye, 4);
  filewrite(fid, emptys[0], length(emptys));
  except
  end;
  leavecriticalsection(lock);
end;

procedure TFixedMemPool.Translate(var Buf; Cnt: Integer);
var
  p: PCardinal;
  i, b, e, c: Integer;
begin
  if length(translater)=0 then exit;
  p := Pcardinal(@buf);
  for i := 1 to cnt do
  begin
    b := 0;
    e := high(transidx);
    while b <= e do
    begin
      c := (b + e) shr 1;
      if p^ > translater[transidx[c]] then
        b := c + 1
      else if p^ < translater[transidx[c]] then
        e := c - 1
      else begin
        e := c;
        break;
      end;
    end;
    dec(p^, translater[transidx[e]]);
    inc(p^, cardinal(buffers[transidx[e]]));
    p := pointer(integer(p)+4);
  end;
end;

procedure TFixedMemPool.LoadFromFile(FName: string);
var
  fid: Integer;
begin
  fid := fileopen(fname, fmOpenRead or fmShareDenyNone);
  if fid >= 0 then
    loadfromfileid(fid);
  fileclose(fid);
end;

procedure TFixedMemPool.SaveToFile(FName: string);
var
  fid: Integer;
begin
  fid := filecreate(fname);
  if fid >= 0 then
    savetofileid(fid);
  fileclose(fid);
end;

{ TFIFOBuffer }

constructor TFIFOBuffer.Create(ABlockSize: Integer);
begin
  BlockSize := ABlockSize;
  Current := allocmem(BlockSize*4+sizeof(TFIFOBlock));
  Last:=Current;
  first := current;
  InitializeCriticalSection(Lock);
end;

destructor TFIFOBuffer.Destroy;
begin
  entercriticalsection(lock);
  try
    repeat
      current := first^.Next;
      dispose(first);
    until current = nil;
  except
  end;
  leavecriticalsection(lock);
  inherited;
  deletecriticalsection(lock);
end;

procedure TFIFOBuffer.Clear;
var
  p1, pc: PFIFOBlock;
begin
  entercriticalsection(lock);
  p1 := first;
  first := allocmem(BlockSize*4+sizeof(TFIFOBlock));
  current := first;
  last := first;
  endport := nil;
  totalsize := 0;
  leavecriticalsection(lock);
  try
    repeat
      pc := p1^.Next;
      dispose(p1);
    until pc = nil;
  except
  end;
end;

procedure TFIFOBuffer.Jump;
begin
  entercriticalsection(lock);
  try
  if first^.B=first^.E then
  begin
    Leavecriticalsection(lock);
    exit;
  end
  else begin
    dec(totalsize);
    inc(first^.B);
    if (first^.B = first^.E) and (first <> current) then
    begin
      first^.B := 0;
      first^.E := 0;
      last^.Next := first;
      last := first;
      first := first^.Next;
      last^.Next := nil;
    end;
  end;
  except
  end;
  leavecriticalsection(lock);
end;

function TFIFOBuffer.Peek(var AValue: Cardinal): Boolean;
var
  n: Cardinal;
  pt: PCardinal;
begin
  if first^.B=first^.E then
  begin
    result := false;
    avalue := 0;
    endport := nil;
    exit;
  end;
  n := first^.B mod blocksize;
  pt := pointer(cardinal(first)+n*4+sizeof(TFIFOBlock));
  if (endport <> nil) and (pt=endport) then
  begin
    endport := nil;
    AValue := 0;
    result := false;
  end
  else begin
    result := true;
    avalue := pt^;
  end;
end;

function TFIFOBuffer.Pop(var AValue: Cardinal): Boolean;
var
  n: cardinal;
  pt: PCardinal;
begin
  result := false;
  entercriticalsection(lock);
  try
  if first^.B=first^.E then
  begin
    endport := nil;
    result := false;
    AValue := 0;
  end
  else begin
    n := first^.B mod blocksize;
    pt := PCardinal(cardinal(first)+n*4+sizeof(TFIFOBlock));
    if (endport<>nil) and (pt=endport) then
    begin
      AValue := 0;
      result := false;
      endport := nil;
    end
    else begin
      dec(totalsize);
      result := true;
      AValue := pt^;
      inc(first^.B);
      if (first^.B = first^.E) and (first <> current) then
      begin
        first^.B := 0;
        first^.E := 0;
        last^.Next := first;
        last := first;
        first := first^.Next;
        last^.Next := nil;
      end;
    end;
  end;
  except
  end;
  leavecriticalsection(lock);
end;

procedure TFIFOBuffer.Push(AValue: Cardinal);
var
  n: Cardinal;
begin
  entercriticalsection(lock);
  try
  if current^.E-current^.B>=blocksize then
    if current <> last then
      current := current^.Next
    else begin
      current := allocmem(blocksize*4+sizeof(TFIFOBlock));
      last^.Next := current;
      last := current;
    end;
  n := current^.E mod blocksize;
  inc(current^.E);
  pcardinal(n*4+sizeof(TFIFOBlock)+cardinal(current))^ := avalue;
  Inc(TotalSize);
  except
  end;
  leavecriticalsection(lock);
end;

procedure TFIFOBuffer.SetEndPort;
var
  n: cardinal;
begin
  entercriticalsection(lock);
  try
  n := current^.E mod blocksize;
  endport := pointer(cardinal(current)+n*4+sizeof(TFIFOBlock));
  except
  end;
  leavecriticalsection(lock);
end;

{$IFDEF LOG2FILE}
initialization
  if fileexists('d:\debuglog.log') then
    deletefile('d:\debuglog.log');
{$ENDIF}

end.