内存池

/// <author>cxg 2020-8-24</author>
/// 跨操作系统内存池
unit MemPool;

interface

uses
  Math, Classes, SysUtils, SyncObjs;

type
  TMemBlock = record
    buf: Pointer;
    size: Integer;
  end;

  pMemBlock = ^TMemBlock;

  TMemPool = class
  private
    freelist, uselist: TList;
    FBlkSize: Integer;
    FBlkCnt: Integer;
    FCS: TCriticalSection;
    procedure Lock;
    procedure UnLock;
    procedure GetRes(const ABlocks: Integer);
    procedure FreeRes;
  public
    constructor Create(const ABlocks: Integer; const ABlockSize: Integer);
    destructor Destroy; override;
    function GetBuf: Pointer;
    procedure FreeBuf(const ABuffer: Pointer);
    property BlockSize: Integer read FBlkSize;
  end;

type
  TMemList = class
  private
    FPool: TMemPool;
    FList: TList;
    function GetSize: integer;
  public
    constructor Create(const pool: TMemPool);
    destructor Destroy; override;
    procedure addBuf(const buf: Pointer; const len: Integer);
    procedure freeList(const list: TList);
    procedure list2stream(list: TList; ms: TMemoryStream);
    procedure stream2list(ms: TMemoryStream; list: TList);
    property list: TList read FList;
  end;

implementation

{ TMemPool }
constructor TMemPool.Create(const ABlocks, ABlockSize: Integer);
begin
  FCS := TCriticalSection.Create;
  FBlkCnt := ABlocks;
  FBlkSize := ABlockSize;
  freelist := TList.Create;
  uselist := TList.Create;
  GetRes(ABlocks);
end;

destructor TMemPool.Destroy;
begin
//  FreeRes;
  FreeAndNil(freelist);
  FreeAndNil(uselist);
  FreeAndNil(FCS);
  inherited;
end;

procedure TMemPool.FreeBuf(const ABuffer: Pointer);
begin
  Lock;
  try
    freelist.Add(ABuffer);
    uselist.Delete(uselist.IndexOf(ABuffer));
  finally
    UnLock;
  end;
end;

procedure TMemPool.FreeRes;
var
  p: pMemBlock;
  i: Integer;
begin
  for i := freelist.count-1 downto 0 do
  begin
    p := freelist[i];
    FreeMem(p.buf);
    Dispose(p);
    freelist.Delete(i);
  end;
  for i := uselist.count-1 downto 0 do
  begin
    p := uselist[i];
    FreeMem(p.buf);
    Dispose(p);
    uselist.Delete(i);
  end;
end;

function TMemPool.GetBuf: Pointer;
begin
  Lock;
  try
    if freelist.Count = 0 then
      GetRes(100);

    Result := freelist.Last;
    uselist.Add(Result);
    freelist.Delete(freelist.Count-1);
  finally
    UnLock;
  end;
end;

procedure TMemPool.GetRes(const ABlocks: Integer);
var
  i: Integer;
  p: pMemBlock;
begin
  for i := 1 to ABlocks do
  begin
    New(p);
    GetMem(p.buf, FBlkSize);
    freelist.Add(p);
  end;
end;

procedure TMemPool.Lock;
begin
  FCS.Enter;
end;

procedure TMemPool.UnLock;
begin
  FCS.Leave;
end;

{ TMemList }

procedure TMemList.addBuf(const buf: Pointer; const len: Integer);
var
  p: pMemBlock;
begin
  p := FPool.GetBuf;
  p.buf := buf;
  p.size := len;
  FList.Add(p);
end;

constructor TMemList.Create(const pool: TMemPool);
begin
  FPool := pool;
  FList := TList.Create;
end;

destructor TMemList.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;

procedure TMemList.freeList(const list: TList);
var
  p: pMemBlock;
  i: integer;
begin
  for i := list.Count - 1 downto 0 do
  begin
    p := pmemblock(list[i]);
    FPool.FreeBuf(p);
    list.Delete(i);
  end;
end;

function TMemList.GetSize: integer;
var
  i: Integer;
begin
  i := FList.Count;
  Result := FPool.FBlkSize * (i - 1) + pMemblock(FList[i - 1]).size;
end;

procedure TMemList.list2stream(list: TList; ms: TMemoryStream);
var
  i: integer;
  p: pMemBlock;
begin
  ms.SetSize(GetSize);
  for i := 0 to list.Count - 1 do
  begin
    p := pmemblock(list[i]);
    ms.Write(p.buf^, p.size);
  end;
end;

procedure TMemList.stream2list(ms: TMemoryStream; list: TList);
var
  p: pMemBlock;
  qty, remain, n, i: Integer;
begin
  qty := Ceil(ms.Size / FPool.FBlkSize);
  n := qty - 1;
  remain := ms.Size - (n * FPool.FBlkSize);
  for i := 1 to qty do
  begin
    p := FPool.GetBuf;
    if i = qty then
    begin
      ms.Read(p.buf, remain);
      p.size := remain;
    end
    else
    begin
      ms.Read(p.buf, FPool.FBlkSize);
      p.size := FPool.FBlkSize;
    end;
    list.Add(p);
  end;
end;

end.