同步 - - 对象池德尔福(Pool of Objects - Synchronize - De

2019-09-21 23:10发布

站内文章 / 前沿技术
73 0 0

我采取的对象在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内/不论用何种方法就好了，如使得CriticalSection的实例池类的私有成员。 使用相同的CS在推动对象放回池中释放（）调用。

在做这几十年来，通常TObjectQueue为池队列，CS，以保护它和信号计数池的内容和一些请求线程阻塞，如果池清空暂时的。

不知道哪里是“双获取”线是从哪里来的。 无论是锁是池类的内部，还是外部。 我真的无法想象为什么有人会两个符号UP！

实施例类：

首先，线程安全的PC队列，举办汇集对象： 

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-砰！ 安全性措施，作为一个经验法则，应该集中起来，并通过服务器，在客户分布不模糊的方式执行。

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对象把所有的赌注在影响从TCriticalSection文档中的一个音符，通过The_Fox指出。 “每次调用发布应该由先前调用收购是平衡” http://docwiki.embarcadero.com/Libraries/en/System.SyncObjs.TCriticalSection.Release

而在希望今天和明天的所有其他帕斯卡尔实现不会错过。

这是脆弱的做法。 和多线程代码是著名的创建Heisenbugs，当有在客户的网站的问题，但你不能复制和发现它在房子里。 如果将来你的公司将扩展到不同的平台或不同的语言实现，这使潜在的地雷。 而那种矿，这将是很难通过内部测试发现。 多线程代码是你最好要过defeinsive，只是不允许任何不确定的情况发生的地方。



文章来源: Pool of Objects - Synchronize - Delphi
标签： multithreading delphi pooling
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~