Multithreading 对象池-同步-Delphi

我正在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;

客户端池保护是一个单位变量。该池工作正常，但是我可以在GetClient方法中使用“uClientQueryPool.CLIENT\u pool\u GUARD.Acquire（）；”和“uClientQueryPool.CLIENT\u pool\u GUARD.Release；”吗

像这样：

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

1） 我将从线程代码中删除获取/发布代码-它是脆弱的。在一个线程中，你忘了叫它-和巴邦！根据经验，安全措施应该由服务器集中实施，而不是模糊地分布在客户端

2） 获取/释放调用应该防止出错，否则任何异常都将永远锁定所有线程

 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对象上双重调用acquire/release会将您的所有赌注都押在TCriticalSection文档中一个注释的含义上，由_Fox指出。 “每个释放调用都应与先前的获取调用保持平衡”

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

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

1）我将从线程代码中删除获取/发布代码-它是脆弱的。在一个线程中，你忘了叫它-和巴邦！根据经验，安全措施应该由服务器集中实施，而不是模糊地分布在客户端

2） 获取/释放调用应该防止出错，否则任何异常都将永远锁定所有线程

 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对象上双重调用acquire/release会将您的所有赌注都押在TCriticalSection文档中一个注释的含义上，由_Fox指出。 “每个释放调用都应与先前的获取调用保持平衡”

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

这是脆弱的做法。多线程代码以创建Heisenbug而闻名，当客户端站点出现问题时，您无法复制并在内部找到它。

---

如果将来你们的公司将扩展到不同的平台或不同的语言实现，这将是一个潜在的地雷。这种地雷很难通过室内测试找到。在多线程代码中，您最好过于谨慎，不要让任何不确定性发生。

在get/pop/which方法中移动锁很好，使CriticalSection实例成为pool类的私有成员也是如此。在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.

---

在get/pop/whicher方法中移动锁很好，使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.

---

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

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.

使用
SyncObjs；
变量
全局数据：整数=0；
类型
TDataObject=类
使用：布尔值；
程序更新数据；
结束；
类型
TPool=class
鸥群：TCriticalSection；
FSemaphore:TSemaphore；
FDataObjects:TDataObject的数组[0..9]；
构造函数创建；
毁灭者毁灭；推翻