TMonitor redux

Rather embarrassingly, it appears the wait/pulse functionality of TMonitor is hopelessly broken. That’ll teach me for trying to demo something new, eh? In my (partial) defence, I had found serious issues before, but came to believe they must have arisen from how I was originally trying to use TMonitor. Obviously not though!

Frankly, if the wait/pulse functionality can’t be relied upon, TMonitor is pretty pointless in my view given its only other function replicates what TRTLCriticalSection/TCriticalSection already provided for. Even worse though, Eric Grange has now posted claiming TMonitor doesn’t work properly even as a TCriticalSection alternative – while exceptions don’t get raised, ‘you can quickly run into situations where everything gets serialized, even when there is no need to’. In the comments he goes further, claiming that with the test code presented, ‘A single thread runs in 70 ms on the quad-core here, two threads run in 140 ms, 3 threads in 210 ms, etc.’

The statement in the comments especially I found surprising, and given the test code used looked just a little too simple to me, I thought I’d do some tests myself. Obviously, if I had the brains for it I could write a sampling profiler or something, but I dashed off the following test program instead. It does pretty much the same thing as Eric’s code — i.e., it tests for when threads are uncontended — but in just a slightly fuller form:

program TMonitorVsTCriticalSection;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  Diagnostics,
  SyncObjs;

type
  TTestThread = class(TThread)
  strict private
    FThreadCounter: TCountdownEvent;
  public
    constructor Create(AThreadCounter: TCountdownEvent); virtual;
    destructor Destroy; override;
  end;

  TTestThreadClass = class of TTestThread;

constructor TTestThread.Create(AThreadCounter: TCountdownEvent);
begin
  inherited Create(True);
  FThreadCounter := AThreadCounter;
  FreeOnTerminate := True;
end;

destructor TTestThread.Destroy;
begin
  FThreadCounter.Signal;
  inherited Destroy;
end;

procedure RunTest(const TestName: string; ThreadCount: Integer;
  ThreadClass: TTestThreadClass);
var
  ThreadCounter: TCountdownEvent;
  I: Integer;
  Stopwatch: TStopwatch;
  Threads: array of TThread;
begin
  SetLength(Threads, ThreadCount);
  ThreadCounter := TCountdownEvent.Create(ThreadCount);
  try
    for I := 0 to ThreadCount - 1 do
      Threads[I] := ThreadClass.Create(ThreadCounter);
    Stopwatch := TStopwatch.StartNew;
    for I := 0 to ThreadCount - 1 do
      Threads[I].Start;
    ThreadCounter.WaitFor;
    Stopwatch.Stop;
    Writeln(TestName, ': ', ThreadCount, ' thread(s) took ',
      Stopwatch.ElapsedMilliseconds, 'ms');
  finally
    ThreadCounter.Free;
  end;
end;

const
  CountdownFrom = $FFFFFF; //increase if necessary...
  MaxThreads = 10;

type
  TCriticalSectionThread = class(TTestThread)
  strict private
    FCriticalSection: TCriticalSection;
  protected
    procedure Execute; override;
  public
    constructor Create(AThreadCounter: TCountdownEvent); override;
    destructor Destroy; override;
  end;

  TMonitorThread = class(TTestThread)
  protected
    procedure Execute; override;
  end;

constructor TCriticalSectionThread.Create(AThreadCounter: TCountdownEvent);
begin
  inherited Create(AThreadCounter);
  FCriticalSection := TCriticalSection.Create;
end;

destructor TCriticalSectionThread.Destroy;
begin
  FCriticalSection.Free;
  inherited Destroy;
end;

procedure TCriticalSectionThread.Execute;
var
  Counter: Integer;
begin
  Counter := CountdownFrom;
  repeat
    FCriticalSection.Enter;
    try
      Dec(Counter);
    finally
      FCriticalSection.Leave;
    end;
  until (Counter end;

procedure TMonitorThread.Execute;
var
  Counter: Integer;
begin
  Counter := CountdownFrom;
  repeat
    TMonitor.Enter(Self);
    try
      Dec(Counter);
    finally
      TMonitor.Exit(Self);
    end;
  until (Counter end;

var
  I, J: Integer;
begin
  for I := 1 to 3 do
  begin
    Writeln('*** ROUND ', I, ' ***');
    for J := 1 to MaxThreads do
    begin
      RunTest('TCriticalSection', J, TCriticalSectionThread);
      RunTest('TMonitor', J, TMonitorThread);
    end;
    WriteLn;
  end;
  Write('Press ENTER to exit...');
  ReadLn;
end.

When run on my quad core laptop (Win7 64 bit, Delphi XE, stock memory manager, default debug build), I get results like the following:

*** ROUND 1 ***
TCriticalSection: 1 thread(s) took 1011ms
TMonitor: 1 thread(s) took 1957ms
TCriticalSection: 2 thread(s) took 2674ms
TMonitor: 2 thread(s) took 8667ms
TCriticalSection: 3 thread(s) took 5562ms
TMonitor: 3 thread(s) took 8996ms
TCriticalSection: 4 thread(s) took 5829ms
TMonitor: 4 thread(s) took 9154ms
TCriticalSection: 5 thread(s) took 4953ms
TMonitor: 5 thread(s) took 8936ms
TCriticalSection: 6 thread(s) took 3652ms
TMonitor: 6 thread(s) took 10578ms
TCriticalSection: 7 thread(s) took 3004ms
TMonitor: 7 thread(s) took 6982ms
TCriticalSection: 8 thread(s) took 8471ms
TMonitor: 8 thread(s) took 6903ms
TCriticalSection: 9 thread(s) took 5844ms
TMonitor: 9 thread(s) took 6310ms
TCriticalSection: 10 thread(s) took 3496ms
TMonitor: 10 thread(s) took 7285ms

My (initial) conclusion? There probably is some issue here, but it isn’t the case that going from (say) 2 threads to 4 doubles the problem – you take the hit at thread 2 or 3, and it stays stable after that. Moreover, TCriticalSection appears to suffer from the *same* issue. However, TCriticalSection is fundamentally faster than TMonitor, given the situation in question (i.e., where locks are being acquired on different objects). [Or is it? See the updates below…]

Note that for slight variant, you might exchange

TMonitor.Enter;

for

if not TMonitor.TryEnter then
  raise EProgrammerNotFound.Create('Where on Earth is he?');

While the exception not being raised doesn’t prove there’s no thread contention where there shouldn’t be, it does make for a verification of the explicit contract made by TMonitor’s interface.

Update 1 – using spin counts

Andreas Hausladen in the comments suggests initialising the spin count of the critical section object to something other than its default value of 0, and indeed, that finally gets the expected behaviour (at least for me), i.e. the cost of the extra threads minus the startup time coming to effectively nil [see update 3 below though!]. Here’s the TTestThread descendant to ‘show’ this — you’ll need to add Windows to the uses clause too:

  TRTLCriticalSectionThread = class(TTestThread)
  strict private
    FCriticalSection: TRTLCriticalSection;
  protected
    procedure Execute; override;
  public
    constructor Create(AThreadCounter: TCountdownEvent); override;
    destructor Destroy; override;
  end;

constructor TRTLCriticalSectionThread.Create(AThreadCounter: TCountdownEvent);
begin
  inherited Create(AThreadCounter);
  InitializeCriticalSectionAndSpinCount(FCriticalSection, 4000);
end;

destructor TRTLCriticalSectionThread.Destroy;
begin
  DeleteCriticalSection(FCriticalSection);
  inherited Destroy;
end;

procedure TRTLCriticalSectionThread.Execute;
var
  Counter: Integer;
begin
  Counter := CountdownFrom;
  repeat
    FCriticalSection.Enter;
    try
      Dec(Counter);
    finally
      FCriticalSection.Leave;
    end;
  until (Counter end;

You can initialise the spin count of the TMonitor too by calling TMonitor.SetSpinCount before the first call to Enter. However, that doesn’t make a difference for me. On the other hand, I wouldn’t expect it to – after all, each thread in the example has its own monitor or critical section object, so where does the possibility for needing to spin or block arise in the first place? [It doesn’t – see below.]

Update 2 – comparing with C#/.NET 4

Here’s a quick C# translation (insofar as I can write C# ‘quickly’…) – as I’m using the CountdownEvent class (like I used TCountdownEvent in the Delphi version), it requires the 4.0 Framework:

using System;
using System.Diagnostics;
using System.Collections.Generic;
using System.Threading;

namespace ConsoleApplication1
{
    class Program
    {
        const int CountdownFrom = 0xFFFFFF;
        const int MaxThreads = 10;

        static void RunTest(int ThreadCount)
        {
            CountdownEvent ThreadCounter = new CountdownEvent(ThreadCount);
            List<Thread> Threads = new List<Thread>(ThreadCount);
            for (int I = 0; I < ThreadCount; I++)
                Threads.Add(new Thread( delegate() {
                    try
                    {
                        int Counter = CountdownFrom;
                        object Key = new object();
                        do
                        {
                            lock (Key)
                            {
                                Counter--;
                            }
                        }
                        while (Counter > 0);
                    }
                    finally
                    {
                        ThreadCounter.Signal();
                    }
                }));
            Stopwatch Stopwatch = Stopwatch.StartNew();
            for (int I = 0; I < ThreadCount; I++)
            {
                Threads[I].Start();
            }
            ThreadCounter.Wait();
            Stopwatch.Stop();
            Console.WriteLine("{0} thread(s) took {1}ms", ThreadCount,
                Stopwatch.ElapsedMilliseconds);
        }
        static void Main(string[] args)
        {
            for (int I = 1; I <= 3; I++)
            {
                Console.WriteLine("*** ROUND {0} ***", I);
                for (int J = 1; J <= MaxThreads; J++)
                {
                    RunTest(J);
                }
                Console.WriteLine();
            }
            Console.Write("Press ENTER to exit...");
            Console.ReadLine();
        }
    }
}

I find this beating even the TRTLCriticalSectionThread Delphi class so long as the number of threads doesn’t exceed the number of cores. Once it does, the times progressively increase, but still nowhere near the TMonitor ones. Go figure…

Update 3 – problem found…

Eric Grange, and equally importantly, his blog commentators have been back on the case and found the issue: TMonitor allocates a small block of memory internally, and given my test code initialises a series of monitors in quick succession, all have their internal memory block allocated in the same cache line. Use a different (read: typically less good) memory manager from the stock FastMM, and the problem can dissipate; e.g., it halves for me when using a custom memory manager that wraps the WinAPI’s HeapXXX functions. To make it totally disappear, the TMonitorThread class previously presented can be modified as thus (the Execute method stays the same):

  TMonitorThread = class(TTestThread)
  protected
    FDummyIntfs: array[0..32] of IInterface;
    procedure Execute; override;
  public
    constructor Create(AThreadCounter: TCountdownEvent); override;
  end;

constructor TMonitorThread.Create(AThreadCounter: TCountdownEvent);
var
  I: Integer;
begin
  inherited;
  //force our monitor to be initialised
  TMonitor.Enter(Self);
  TMonitor.Exit(Self);
  //cause some further dynamic memory allocations
  for I := Low(FDummyIntfs) to High(FDummyIntfs) do
    FDummyIntfs[I] := TInterfaceList.Create;
end;

On my laptop, TMonitor now easily beats TCriticalSection for spead, though still not TRTLCriticalSection. I’ve also discovered that enabling spinning on the latter was a red herring – just avoiding the class wrapper (even though said wrapper is extremely simple!) was the key thing. In fact, if TRTLCriticalSectionThread allocates its TRTLCriticalSection record dynamically using New, its advantage over TCriticalSectionThread melts away, and would be completely gone were TCriticalSection to map its Acquire and Release methods onto Enter and Leave rather than vice versa. I almost feel a follow up post coming on…