Thread safe values, version 1.2

A while back (a year perhaps?) I posted an article about protected values. In short: anyone who has ever worked with multi-threading should know that sharing values between your application and thread(s) is not always as straight forward as we like to believe.

The latest versions of Delphi have made threading a lot simpler, especially async coding. But even though Delphi has gotten better on the subject, there is no denying that archetypical languages like object pascal and c++ are intrinsically low-level. It’s not like Java and C# where they put training-wheels on everything and you can just ignore the laws of physics (because your application is the digital version of a padded cell).

Note: While we are on the subject you may want to check out my delayed callback unit, which implents TW3Dispatch from Smart Mobile Studio.

Protected values version 1.2

So what are protected values? Well, in short it’s a series of classes that automatically protects a piece of data (intrinsic datatypes like “string”, “integer”, “boolean” but also class instances) and will lock and unlock when you read or change the value.

Multithreading can be a total bitch if you dont do it right

What is new in version 1.2 is that I have extended the model with an exclusive locking mechanism, an anonymous procedure, which gives you exclusive access to the data for the duration of your callback. You also have read/write access properties and a few other improvements.

It is, like many of my units, simple yet powerful. Some may argue that they don’t need it, that it’s not atomic – but that was never really the point. For atomic values you can dig into WinAPI but I personally like to keep my code as platform independent as possible.

The purpose of this library is, simply put, to have a uniform way of creating thread safe variables and fields. Values that can be safely changed from a thread without any extra padding or care, and likewise – values that a thread can expose without read/write synchronizing, instance checking and thread callbacks.

Examples

Creating a protected container is very simple. The unit uses generics, so you can take your pick of datatype:

var
  LData: TProtectedValue<string>;
begin
  LData := TProtectedValue<string>.create;
  RegisterWithThreads(LData);
  LData.Value := 'This is a test';
end;

In the code above the object is locked while the assignment lasts, so it will never collide with another thread accessing it. If you want exclusive access for the duration of a process or task, use the synchronize call:

var
  LData: TProtectedValue<string>;
begin
  LData := TProtectedValue<string>.create;
  RegisterWithThreads(LData);
  LData.Synchronize( procedure (var Data: string)
    begin
      //Access is blocked for the duration of this proc
      for item in GlobalList do
        Data := Data + item.ToString();
    end);
end;

The next feature I added was better support for object lists. In the previous version you had to create the list-instance yourself and then wrap that in a container. Now the container is the objectlist and we use generic to denote the type. The same locked access mechanisms are available there.

var
  LData: TProtectedObjectList<TMyItem>;
begin
  LData := TProtectedObjectList<TMyItem>.create;
  LData.ForEach( procedure (Item: TObject; var Cancel: boolean)
    begin
      // Set Cancel to True to abort the loop
      // ForEach() will iterate through the items stored in
      // the objectlist. Sadly you must typecast here due to scope
    end);
end;

And of course, the normal locking mechanisms for lists:

type
  TMyListType = TObjectList<TMyItem>;

var
  LData: TProtectedObjectList<TMyItem>;
begin
  LData := TProtectedObjectList<TMyItem>.create;
  LList := TMyListType( LData.Lock );
  try
    //Process list here
  finally
    LData.Unlock();
  end;
end;

While all of this is cool, the core value of the library (at least for me) is that I can safely move values between the main process and threads without the typical insulation involved. I can use protected values as fields in my class and publish them as read only properties, killing two birds with one stone (both protecting the value and conforming to the multiple read, singular write law of memory.

The unit is tried and tested. It is presently used in 3 commercial products, so you can put a little faith in it. But as always, if you don’t need it then leave it alone.

If you like it, enjoy 🙂

The code

unit hex.log.locktypes;

interface

uses
  System.SysUtils,
  System.SyncObjs,
  System.Classes,
  System.Generics.Collections;

type

  {$DEFINE USE_SYNCHRO}

  TProtectedValueAccessRights = set of (lvRead, lvWrite);

  EProtectedValue = class(exception);
  EProtectedObject = class(exception);

  (* Thread safe intrinsic datatype container.
     When sharing values between processes, use this class
     to make read/write access safe and protected. *)

  {$IFDEF USE_SYNCHRO}
  TProtectedValue = class(TCriticalSection)
  {$ELSE}
  TProtectedValue = class(TObject)
  {$ENDIF}
  strict private
    {$IFNDEF USE_SYNCHRO}
    FLock: TCriticalSection;
    {$ENDIF}
    FData: T;
    FOptions: TProtectedValueAccessRights;
  strict protected
    function GetValue: T;virtual;
    procedure SetValue(Value: T);virtual;
    function GetAccessRights: TProtectedValueAccessRights;
    procedure SetAccessRights(Rights: TProtectedValueAccessRights);
  public
    type
      TProtectedValueEntry = reference to procedure (var Data: T);
  public
    constructor Create(Value: T); overload; virtual;
    constructor Create(Value: T; const Access: TProtectedValueAccessRights= [lvRead, lvWrite]); overload; virtual;
    constructor Create(const Access: TProtectedValueAccessRights = [lvRead, lvWrite]); overload; virtual;
    destructor Destroy;override;

    {$IFNDEF USE_SYNCHRO}
    procedure Acquire;
    procedure Release;
    {$ENDIF}
    procedure Synchronize(const Entry: TProtectedValueEntry);

    property AccessRights: TProtectedValueAccessRights read GetAccessRights;
    property Value: T read GetValue write SetValue;
  end;

  (* Thread safe object container.
     NOTE #1: This object container **CREATES** the instance and maintains it!
              Use Edit() to execute a protected block of code with access
              to the object.

     Note #2: SetValue() does not overwrite the object reference, but
              attempts to perform TPersistent.Assign(). If the instance
              does not inherit from TPersistent an exception is thrown. *)
  TProtectedObject = class(TObject)
  strict private
    FData:      T;
    FLock:      TCriticalSection;
    FOptions:   TProtectedValueAccessRights;
  strict protected
    function    GetValue: T;virtual;
    procedure   SetValue(Value: T);virtual;
    function    GetAccessRights: TProtectedValueAccessRights;
    procedure   SetAccessRights(Rights: TProtectedValueAccessRights);
  public
    type
      TProtectedObjectEntry = reference to procedure (const Data: T);
  public
    Property    Value: T read GetValue write SetValue;
    Property    AccessRights: TProtectedValueAccessRights read GetAccessRights;

    Function    Lock: T;
    procedure   Unlock;
    procedure   Synchronize(const Entry: TProtectedObjectEntry);

    Constructor Create(const AOptions:TProtectedValueAccessRights = [lvRead,lvWrite]);virtual;
    Destructor  Destroy;override;
  end;

  (* TProtectedObjectList:
     This is a thread-safe object list implementation.
     It works more or less like TThreadList, except it deals with objects *)
  TProtectedObjectList = Class(TInterfacedPersistent)
  strict private
    FObjects:   TObjectList;
    FLock:      TCriticalSection;
  strict protected
    function GetEmpty: Boolean;virtual;
    function GetCount: Integer;virtual;

    (* QueryObject Proxy: TInterfacedPersistent allows us to
       act as a proxy for QueryInterface/GetInterface. Override
       and provide another child instance here to expose
       interfaces from that instread *)
    function GetOwner: TPersistent;override;
  public
    type
      TProtectedObjectListProc = reference to procedure (item:TObject;var Cancel:Boolean);
  public
    constructor Create(OwnsObjects: Boolean = True);virtual;
    destructor  Destroy;Override;

    function    Contains(Instance: TObject): boolean;virtual;
    function    Lock: TObjectList;virtual;
    Procedure   UnLock;
    Procedure   Clear;

    procedure   ForEach(Callback: TProtectedObjectListProc);

    Property    Count:Integer read GetCount;
    Property    Empty:Boolean read GetEmpty;
  end;

implementation

//############################################################################
//  TProtectedObjectList
//############################################################################

constructor TProtectedObjectList.Create(OwnsObjects: Boolean = True);
begin
  inherited Create;
  FObjects := TObjectList.Create(OwnsObjects);
  FLock := TCriticalSection.Create;
end;

destructor TProtectedObjectList.Destroy;
begin
  FLock.Enter;
  FObjects.Free;
  FLock.Free;
  inherited;
end;

procedure TProtectedObjectList.Clear;
begin
  FLock.Enter;
  try
    FObjects.Clear;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.GetOwner: TPersistent;
begin
  result := NIL;
end;

procedure TProtectedObjectList.ForEach(Callback: TProtectedObjectListProc);
var
  mItem:  TObject;
  mCancel:  Boolean;
begin
  if assigned(Callback) then
  begin
    FLock.Enter;
    try
      mCancel:=False;
      for mItem in FObjects do
      begin
        CallBack(mItem,mCancel);
        if mCancel then
        break;
      end;
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObjectList.Contains(Instance: TObject): Boolean;
begin
  result := false;
  if assigned(Instance) then
  begin
    FLock.Enter;
    try
      result := FObjects.Contains(Instance);
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObjectList.GetCount: Integer;
begin
  FLock.Enter;
  try
    result :=FObjects.Count;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.GetEmpty: Boolean;
begin
  FLock.Enter;
  try
    result := FObjects.Count<1;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.Lock: TObjectList;
begin
  FLock.Enter;
  result:=FObjects;
end;

procedure TProtectedObjectList.UnLock;
begin
  FLock.Leave;
end;

//############################################################################
//  TProtectedObject
//############################################################################

constructor TProtectedObject.Create(const AOptions: TProtectedValueAccessRights = [lvRead, lvWrite]);
begin
  inherited Create;
  FLock:=TCriticalSection.Create;
  FOptions:=AOptions;
  FData := T.create;
end;

destructor TProtectedObject.Destroy;
begin
  FData.free;
  FLock.Free;
  inherited;
end;

function TProtectedObject.GetAccessRights: TProtectedValueAccessRights;
begin
  FLock.Enter;
  try
    result := FOptions;
  finally
    FLock.Leave;
  end;
end;

procedure TProtectedObject.SetAccessRights(Rights: TProtectedValueAccessRights);
begin
  FLock.Enter;
  try
    FOptions := Rights;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObject.Lock: T;
begin
  FLock.Enter;
  result := FData;
end;

procedure TProtectedObject.Unlock;
begin
  FLock.Leave;
end;

procedure TProtectedObject.Synchronize(const Entry: TProtectedObjectEntry);
begin
  if assigned(Entry) then
  begin
    FLock.Enter;
    try
      Entry(FData);
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObject.GetValue: T;
begin
  FLock.Enter;
  try
    if (lvRead in FOptions) then
    result := FData else
    raise EProtectedObject.CreateFmt('%s:Read not allowed error',[classname]);
  finally
    FLock.Leave;
  end;
end;

procedure TProtectedObject.SetValue(Value: T);
begin
  FLock.Enter;
  try
    if (lvWrite in FOptions) then
    begin
      if (TObject(FData) is TPersistent)
      or (TObject(FData).InheritsFrom(TPersistent)) then
      TPersistent(FData).Assign(TPersistent(Value)) else
      raise EProtectedObject.CreateFmt
        ('Locked object assign failed, %s does not inherit from %s',
        [TObject(FData).ClassName,'TPersistent']);

    end else
    raise EProtectedObject.CreateFmt('%s:Write not allowed error',[classname]);
  finally
    FLock.Leave;
  end;
end;

//############################################################################
//  TProtectedValue
//############################################################################

constructor TProtectedValue.Create(Value: T);
begin
  Create([lvRead, lvWrite]);
end;

constructor TProtectedValue.Create(Value: T; const Access: TProtectedValueAccessRights = [lvRead, lvWrite]);
begin
  Create([lvRead, lvWrite]);
  Synchronize( procedure (var Data: T)
    begin
      Data := Value;
    end);
end;

Constructor TProtectedValue.Create(const Access: TProtectedValueAccessRights = [lvRead,lvWrite]);
begin
  inherited Create;
  {$IFNDEF USE_SYNCHRO}
  FLock := TCriticalSection.Create;
  {$ENDIF}
  FOptions:=Access;
end;

Destructor TProtectedValue.Destroy;
begin
  {$IFNDEF USE_SYNCHRO}
  FLock.Free;
  {$ENDIF}
  inherited;
end;

function TProtectedValue.GetAccessRights: TProtectedValueAccessRights;
begin
  Acquire;
  try
    result := FOptions;
  finally
    Release;
  end;
end;

procedure TProtectedValue.SetAccessRights(Rights: TProtectedValueAccessRights);
begin
  Acquire;
  try
    FOptions := Rights;
  finally
    Release;
  end;
end;

{$IFNDEF USE_SYNCHRO}
procedure TProtectedValue.Acquire;
begin
  FLock.Acquire;
end;

procedure TProtectedValue.Release;
begin
  FLock.Release;
end;
{$ENDIF}

procedure TProtectedValue.Synchronize(const Entry: TProtectedValueEntry);
begin
  if assigned(Entry) then
  Begin
    Acquire;
    try
      Entry(FData);
    finally
      Release;
    end;
  end;
end;

function TProtectedValue.GetValue: T;
begin
  Acquire;
  try
    if (lvRead in FOptions) then
    result := FData else
    Raise EProtectedValue.CreateFmt('%s: Read not allowed error',[classname]);
  finally
    Release;
  end;
end;

procedure TProtectedValue.SetValue(Value: T);
begin
  Acquire;
  try
    if (lvWrite in FOptions) then
    FData:=Value else
    Raise EProtectedValue.CreateFmt('%s: Write not allowed error',[classname]);
  finally
    Release;
  end;
end;

end.