A shared memory class

There are situations in which many threads compete for a memory stream, as you might be aware, the concurrency model is a big issue in this kind of scenarios. So I have created a class that implements some kind of locking mechanism via TDictionary, what?

The idea behind is to do the same as databases to in the real world for locking (for our purpose, rows equal memory positions). The dictionary is a bit tuned otherwise would also have concurrent issues.

The file is locate in BB.Utils.SharedMemory

type
  TSharedMemory = class(TInterfacedObject, ISharedMemory)
  private
    FBuffer: pointer;
    FSize: cardinal;
    FLocks: TConcurrentDictionary<integer,integer>;

    function GetPointer(aOffset: integer): pointer; inline;
    procedure Lock(aOffset, aSize: Integer);
    procedure Unlock(aOffset, aSize: integer);
    procedure CheckSize(aSize: Integer); inline;
  public
    constructor Create(aSize: cardinal); overload;
    constructor Create(aBuffer: pointer; aSize: cardinal); overload;
    destructor Destroy; override;
    function Read(aOffset, aSize: integer): TArray<byte>;
    function Read8(aOffset: integer): byte; inline;
    function Read16(aOffset: integer): word; inline;
    function Read32(aOffset: integer): cardinal; inline;
    function Read64(aOffset: integer): Int64; inline;
    procedure Write(aOffset: integer; const aValues: TArray<byte>); overload;
    procedure Write(aOffset, aSize: integer; aSource: pointer); overload;
    procedure Write8(aOffset: integer; aValue: byte);
    procedure Write16(aOffset: integer; aValue: word);
    procedure Write32(aOffset: integer; aValue: cardinal);
    procedure Write64(aOffset: integer; aValue: Int64);

    property Size: cardinal read FSize;
  end;

I'm doing some test in order to see what performance best a direct lock or this way, and it depends..., reading/writing small portions of memory is better to use a TLock, but for big reading/writing big portions of memory the increase of speed is considerable.

{ TSharedMemory }

constructor TSharedMemory.Create(aSize: cardinal);
begin
  FLocks := TConcurrentDictionary<integer, integer>.Create;
  GetMem(FBuffer, aSize);
  FSize := aSize;
end;

constructor TSharedMemory.Create(aBuffer: pointer; aSize: cardinal);
begin
  FLocks := TConcurrentDictionary<integer, integer>.Create;
  FBuffer := aBuffer;
  FSize := aSize;
end;

destructor TSharedMemory.Destroy;
begin
  FreeMem(FBuffer);
  FLocks.Free;

  inherited;
end;

function TSharedMemory.GetPointer(aOffset: integer): pointer;
begin
  result := @PByteArray(FBuffer)[aOffset];
end;

function TSharedMemory.Read(aOffset: integer; aSize: integer): TArray<byte>;
var
  i: integer;

begin
  result := TArray<byte>.Create(aSize);
  for i := 0 to aSize - 1 do
    result[i] := Read8(aOffset + i);
end;

function TSharedMemory.Read16(aOffset: integer): word;
begin
  result := PWord(GetPointer(aOffset))^;
end;

function TSharedMemory.Read32(aOffset: integer): cardinal;
begin
  result := PCardinal(GetPointer(aOffset))^;
end;

function TSharedMemory.Read64(aOffset: integer): Int64;
begin
  result := PInt64(GetPointer(aOffset))^;
end;

function TSharedMemory.Read8(aOffset: integer): byte;
begin
  result := PByte(GetPointer(aOffset))^;
end;

procedure TSharedMemory.Unlock(aOffset, aSize: integer);
var
  i: integer;
  keys: array of integer;

begin
  SetLength(keys, aSize);
  for i := 0 to aSize - 1 do
    keys[i] := aOffset + i;
  FLocks.Remove(keys);
end;

procedure TSharedMemory.Write(aOffset: integer; const aValues: TArray<byte>);
var
  i: integer;

begin
  CheckSize(Length(aValues));

  Lock(aOffset, Length(aValues));
  try
    for i := 0 to Length(aValues) - 1 do
      PByte(GetPointer(aOffset + i))^ := aValues[i];
  finally
    Unlock(aOffset, Length(aValues));
  end;
end;

procedure TSharedMemory.Lock(aOffset, aSize: Integer);
var
  i: integer;
  //keys: array of integer;

begin
  for i := 0 to aSize - 1 do
  begin
    while not FLocks.TryAdd(aOffset + i, 1) do
      Sleep(10);
  end;

  {
  SetLength(keys, aSize);
  for i := 0 to aSize - 1 do
    keys[i] := aOffset + i;

  while not FLocks.TryAdd(keys) do
    Sleep(10);
    }
end;

procedure TSharedMemory.Write(aOffset, aSize: integer; aSource: pointer);
var
  i: integer;

begin
  CheckSize(aSize);

  Lock(aOffset, aSize);
  try
    i := aSize - 1;
    while i >= 0 do
      PByte(GetPointer(aOffset + i))^ := PByteArray(aSource)[i];
  finally
    Unlock(aOffset, aSize);
  end;
end;

procedure TSharedMemory.Write16(aOffset: integer; aValue: word);
begin
  Lock(aOffset, Sizeof(word));
  try
    PWord(GetPointer(aOffset))^ := aValue;
  finally
    Unlock(aOffset, SizeOf(word));
  end;
end;

procedure TSharedMemory.Write32(aOffset: integer; aValue: cardinal);
begin
  Lock(aOffset, SizeOf(cardinal));
  try
    PCardinal(GetPointer(aOffset))^ := aValue;
  finally
    Unlock(aOffset, SizeOf(cardinal));
  end;
end;

procedure TSharedMemory.Write64(aOffset: integer; aValue: Int64);
begin
  Lock(aOffset, SizeOf(Int64));
  try
    PInt64(GetPointer(aOffset))^ := aValue;
  finally
    Unlock(aOffset, SizeOf(Int64));
  end;
end;

procedure TSharedMemory.CheckSize(aSize: Integer);
begin
  if aSize > FSize then
    raise Exception.Create('Size is too big');
end;

procedure TSharedMemory.Write8(aOffset: integer; aValue: byte);
begin
  Lock(aOffset, SizeOf(byte));
  try
    PByte(GetPointer(aOffset))^ := aValue;
  finally
    Unlock(aOffset, Sizeof(byte));
  end;
end;

end.

I cannot provide an example, since is under test, but I will...