Question

I am implementing a pool of objects in Delphi. I need to synchronize the threads to get the objects from the pool.

Thread Code:

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

Pool Code:

var
   CLIENT_POOL_GUARD: TCriticalSection;

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

The CLIENT_POOL_GUARD is a unit variable. The pool is working well, but can I use “uClientQueryPool.CLIENT_POOL_GUARD.Acquire();” and “uClientQueryPool.CLIENT_POOL_GUARD.Release;” inside the GetClient method?

Like this:

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

Answer 1

Moving the lock inside the get/pop/whatever method is just fine, as is making the CriticalSection instance a private member of the pool class. Use the same CS in the release() call that pushes the objects back onto the pool.

Been doing this for decades, usually with TObjectQueue as the pool queue, a CS to protect it and a semaphore to count the pool contents and something for requesting threads to block on if the pool empties temporarily.

Don’t know where that ‘double acquire’ thread came from. Either the lock is inside the pool class, or outside. I really can’t imagine why anyone would code up both!

Example classes:

First, thread-safe P-C queue, for holding the pooled objects:

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.

then object pool:

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.