对象池 - 同步 - Delphi

Question

我正在 Delphi 中实现一个对象池。我需要同步线程以从池中获取对象。

线程代码：

uClientQueryPool.CLIENT_POOL_GUARD.Acquire();
QueryClient := QUERY_POOL.GetClient();
uClientQueryPool.CLIENT_POOL_GUARD.Release;

池代码：

var
   CLIENT_POOL_GUARD: TCriticalSection;

type
   TClientQueryPool = class
public
   function GetClient(): TQueryClient;
end;

CLIENT_POOL_GUARD 是一个单元变量。池运行良好，但我可以使用“uClientQueryPool.CLIENT_POOL_GUARD.Acquire();”吗和“uClientQueryPool.CLIENT_POOL_GUARD.Release；”在 GetClient 方法中？

像这样：

function TClientQueryPool.GetClient: TQueryClient;
begin
    CLIENT_POOL_GUARD.Acquire();
    ...
    CLIENT_POOL_GUARD.Release;
end;

Answer 1

在 get/pop/whatever 方法中移动锁就可以了，就像让 CriticalSection 实例成为池类的私有成员一样。在将对象推回池中的 release() 调用中使用相同的 CS。

几十年来一直在这样做，通常使用 TObjectQueue 作为池队列，一个 CS 来保护它，一个信号量来计算池内容，以及在池暂时清空时请求线程阻塞的东西。

不知道那个“双重获取”线程来自哪里。锁要么在池类内部，要么在外部。我真的无法想象为什么有人会同时编写代码！

示例类：

首先，线程安全的 P-C 队列，用于保存池化对象：

unit tinySemaphoreQueue;

interface

uses
  Windows, Messages, SysUtils, Classes,syncObjs,contnrs;


type

pObject=^Tobject;


TsemaphoreMailbox=class(TobjectQueue)
private
  countSema:Thandle;
protected
  access:TcriticalSection;
public
  property semaHandle:Thandle read countSema;
  constructor create; virtual;
  procedure push(aObject:Tobject); virtual;
  function pop(pResObject:pObject;timeout:DWORD):boolean;  virtual;
end;


implementation

{ TsemaphoreMailbox }

constructor TsemaphoreMailbox.create;
begin
  inherited Create;
  access:=TcriticalSection.create;
  countSema:=createSemaphore(nil,0,maxInt,nil);
end;

function TsemaphoreMailbox.pop(pResObject: pObject;
  timeout: DWORD): boolean;
begin // wait for a unit from the semaphore
  result:=(WAIT_OBJECT_0=waitForSingleObject(countSema,timeout));
  if result then // if a unit was supplied before the timeout,
  begin
    access.acquire;
    try
      pResObject^:=inherited pop; // get an object from the queue
    finally
      access.release;
    end;
  end;
end;

procedure TsemaphoreMailbox.push(aObject: Tobject);
begin
  access.acquire;
  try
    inherited push(aObject); // shove the object onto the queue
  finally
    access.release;
  end;
  releaseSemaphore(countSema,1,nil); // release one unit to semaphore
end;

end.

然后是对象池：

unit tinyObjectPool;

interface

uses
  Windows, Messages, SysUtils, Classes,syncObjs,contnrs,
  tinySemaphoreQueue;

type
  TobjectPool=class;

  TpooledObject=class(TObject)
  private
    FmyPool:TObjectPool;
  protected
    Fparameter:TObject;
  public
    procedure release;
    constructor create(parameter:TObject); virtual;
  end;

  TpooledObjectClass=class of TpooledObject;

  TobjectPool=class(TsemaphoreMailbox)
  private
    Fparameter:TObject;
    function getPoolLevel: integer;
  public
    property poolLevel:integer read getPoolLevel;
    constructor create(poolDepth:integer;
      pooledObjectClass:TpooledObjectClass;parameter:TObject); reintroduce; virtual;
  end;

implementation

{ TobjectPool }

constructor TobjectPool.create(poolDepth: integer;
  pooledObjectClass: TpooledObjectClass;parameter:TObject);
var objectCount:integer;
    thisObject:TpooledObject;
begin
  inherited create;
  Fparameter:=parameter; // a user parameter passed to all objects
  for objectCount:=0 to poolDepth-1 do // fill up the pool with objects
  begin
    thisObject:=pooledObjectClass.create(parameter);
    thisObject.FmyPool:=self;
    inherited push(thisObject);
  end;
end;

function TobjectPool.getPoolLevel: integer;
begin
  access.acquire;
  result:=inherited count;
  access.release;
end;



{ TpooledObject }

constructor TpooledObject.create(parameter: TObject);
begin
  inherited create;
  Fparameter:=parameter;
end;

procedure TpooledObject.release;
begin
  FmyPool.push(self);
end;

end.

Answer 2

是的，你可以。请注意，尽管您可以以线程安全的方式从池中提取对象，但如果对象本身不是线程安全的，则使用它可能不是线程安全的。例如，在下面的示例中，池是线程安全的，如果池中的所有对象都在使用中，甚至使线程等待，但是一旦对象在使用中，使用它仍然不是线程安全的，因为它使用全局数据。

uses
  SyncObjs;

var
  GlobalData: Integer = 0;

type
  TDataObject = class
    Used: Boolean;
    procedure UpdateData;
  end;

type
  TPool = class
    FLock: TCriticalSection;
    FSemaphore: TSemaphore;
    FDataObjects: array[0..9] of TDataObject;
    constructor Create;
    destructor Destroy; override;
    function GetDataObject: TDataObject;
    procedure ReleaseDataObject(AObject: TDataObject);
  end;

var
  Pool: TPool;

type
  TDataThread = class(TThread)
    constructor Create;
    procedure Execute; override;
  end;

{ TPool }

constructor TPool.Create;
var
  i: Integer;
begin
  inherited Create;
  FLock := TCriticalSection.Create;
  FSemaphore := TSemaphore.Create(nil, Length(FDataObjects), Length(FDataObjects), '', False);

  for i := Low(FDataObjects) to High(FDataObjects) do
    FDataObjects[i] := TDataObject.Create;
end;

destructor TPool.Destroy;
var
  i: Integer;
begin
  for i := Low(FDataObjects) to High(FDataObjects) do
    FDataObjects[i].Free;

  FSemaphore.Free;
  FLock.Free;
end;

function TPool.GetDataObject: TDataObject;
var
  i: Integer;
begin
  Result := nil;

  FLock.Acquire;
  try
    FSemaphore.Acquire;
    for i := Low(FDataObjects) to High(FDataObjects) do
      if not FDataObjects[i].Used then
      begin
        Result := FDataObjects[i];
        Result.Used := True;
        Exit;
      end;

    Assert(Result <> nil, 'Pool did not return an object');
  finally
    FLock.Release;
  end;
end;

procedure TPool.ReleaseDataObject(AObject: TDataObject);
begin
  if not AObject.Used then
    raise Exception.Create('Data object cannot be released, because it is not in use.');

  AObject.Used := False;
  FSemaphore.Release;
end;

{ TDataObject }

procedure TDataObject.UpdateData;
begin
  Inc(GlobalData);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TDataThread.Create;
end;

{ TDataThread }

constructor TDataThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  Resume;
end;

procedure TDataThread.Execute;
var
  DataObject: TDataObject;
begin
  DataObject := Pool.GetDataObject;

  DataObject.UpdateData; // <-- Not thread-safe!

  Pool.ReleaseDataObject(DataObject);
end;

initialization
  Pool := TPool.Create;
finalization
  Pool.Free;
end.

Answer 3

1) 我会从线程代码中删除获取/发布代码 - 它很脆弱。在一个线程中，您忘记调用它 - 和 ba-bang！根据经验，安全措施应该由服务器集中和执行，而不是在客户端中以模糊的方式分布。

2) Acquire/Release 调用应避免错误，否则任何杂散异常将永远锁定所有线程。

 function TClientQueryPool.GetClient: TQueryClient;
 begin
   CS.Acquire;
   try
     // actually getting object, preferably just calling
     // internal non-public thread-unsafe method for it
   finally
     CS.Release;
   end;
  end;

3) 关键部分本身最好是池的内部非公共成员。这样，当您忘记实现细节时，您将被允许进行简单的重构，例如：

3.1) 实现多个池

3.2) 将池代码移动到另一个单元

3.3) 确保池外的任何杂散错误代码不会导致应用程序崩溃，从而随机获取或释放 CS

4) 对 TCriticalSection 对象的获取/释放的双重调用将您所有的赌注置于 TCriticalSection 文档中的单个注释的影响上，由 The_Fox 指出。 “每个对 Release 的调用都应该通过更早的对 Acquire 的调用来平衡” http://docwiki.embarcadero.com/Libraries/en/System.SyncObjs.TCriticalSection.Release

希望今天和明天的所有其他 Pascal 实现都不会错过它。

这是一种脆弱的做法。多线程代码以创建 Heisenbugs 而闻名，当客户站点出现问题时，您无法在内部重现并找到它。 如果将来您的公司将扩展到不同的平台或不同的语言实现，那将是一个潜在的地雷。而我的那种，通过内部测试很难找到。多线程代码是你最好过分挑剔的地方，不要让任何不确定性发生。