对象池 - 同步 - Delphi

时间:2012-08-30 14:45:26

标签: multithreading delphi pooling

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

3 个答案:

答案 0 :(得分:2)

在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.

答案 1 :(得分: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.

答案 2 :(得分:-3)

1)我将从线程代码中删除Acquire / Release代码 - 它很脆弱。在一个线程中你忘了称它 - 并且ba-bang!作为经验法则,安全措施应由服务器集中和强制执行,而不是以模糊的方式分发给客户。

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)关键部分本身最好是Pool的内部非公开成员。这样你将来会被允许,当你忘记实现细节,轻松重构时,比如:

3.1)实施多个池

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

3.3)确保池外的任何杂散错误代码都无法使应用程序崩溃,随机获取或释放CS

4)通过TCriticalSection对象双重调用获取/释放,将所有赌注都放在了由The_Fox指向的TCriticalSection文档中的单个注释中。 “对Release的每次调用应该通过之前的Acquire调用来平衡” http://docwiki.embarcadero.com/Libraries/en/System.SyncObjs.TCriticalSection.Release

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

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