Best way to sync two threads to each other in Delphi

Question

I'm currently trying to find a better way (*) to have alternatives for two threads and make them wait for each other.

(*) the best combination of fast work at a low processor cost

I found three methods so far that I have put together in some demo application to show the problems that I have found.

Using TMonitor after the classic wait / impulse pattern is not doing very well due to all the blocking (according to SamplingProfiler it most often burns in these functions). I tried the same with Windows events (SyncObjs.TEvent), but it did the same (i.e. Bad).

Using a wait loop that calls TThread.Yield works best, but obviously burns CPU cycles, such as crazy ones. It doesn’t matter if the switch is very fast, but it hurts when the thread is really waiting (you can see it in the demo).

Using TSpinWait works great (if not the best of the three), but only if the switches happen very quickly. The longer the switchover is required, the worse the performance is achieved due to how TSpinWait works.

Since multithreading is not one of my strengths, I was wondering if there was some combination of these methods or some completely different approach to achieve good performance in both scenarios (fast and slow switches).

program PingPongThreads; {$APPTYPE CONSOLE} {$R *.res} uses Classes, Diagnostics, SyncObjs, SysUtils; type TPingPongThread = class(TThread) private fCount: Integer; protected procedure Execute; override; procedure Pong; virtual; public procedure Ping; virtual; property Count: Integer read fCount; end; TPingPongThreadClass = class of TPingPongThread; TMonitorThread = class(TPingPongThread) protected procedure Pong; override; procedure TerminatedSet; override; public procedure Ping; override; end; TYieldThread = class(TPingPongThread) private fState: Integer; protected procedure Pong; override; public procedure Ping; override; end; TSpinWaitThread = class(TPingPongThread) private fState: Integer; protected procedure Pong; override; public procedure Ping; override; end; { TPingPongThread } procedure TPingPongThread.Execute; begin while not Terminated do Pong; end; procedure TPingPongThread.Ping; begin TInterlocked.Increment(fCount); end; procedure TPingPongThread.Pong; begin TInterlocked.Increment(fCount); end; { TMonitorThread } procedure TMonitorThread.Ping; begin inherited; TMonitor.Enter(Self); try if Suspended then Start else TMonitor.Pulse(Self); TMonitor.Wait(Self, INFINITE); finally TMonitor.Exit(Self); end; end; procedure TMonitorThread.Pong; begin inherited; TMonitor.Enter(Self); try TMonitor.Pulse(Self); if not Terminated then TMonitor.Wait(Self, INFINITE); finally TMonitor.Exit(Self); end; end; procedure TMonitorThread.TerminatedSet; begin TMonitor.Enter(Self); try TMonitor.Pulse(Self); finally TMonitor.Exit(Self); end; end; { TYieldThread } procedure TYieldThread.Ping; begin inherited; if Suspended then Start else fState := 3; while TInterlocked.CompareExchange(fState, 2, 1) <> 1 do TThread.Yield; end; procedure TYieldThread.Pong; begin inherited; fState := 1; while TInterlocked.CompareExchange(fState, 0, 3) <> 3 do if Terminated then Abort else TThread.Yield; end; { TSpinWaitThread } procedure TSpinWaitThread.Ping; var w: TSpinWait; begin inherited; if Suspended then Start else fState := 3; w.Reset; while TInterlocked.CompareExchange(fState, 2, 1) <> 1 do w.SpinCycle; end; procedure TSpinWaitThread.Pong; var w: TSpinWait; begin inherited; fState := 1; w.Reset; while TInterlocked.CompareExchange(fState, 0, 3) <> 3 do if Terminated then Abort else w.SpinCycle; end; procedure TestPingPongThread(threadClass: TPingPongThreadClass; quickSwitch: Boolean); const MAXCOUNT = 10000; var t: TPingPongThread; i: Integer; sw: TStopwatch; w: TSpinWait; begin t := threadClass.Create(True); try for i := 1 to MAXCOUNT do begin t.Ping; if not quickSwitch then begin // simulate some work w.Reset; while w.Count < 20 do w.SpinCycle; end; if i = 1 then begin if not quickSwitch then begin Writeln('Check CPU usage. Press <Enter> to continue'); Readln; end; sw := TStopwatch.StartNew; end; end; Writeln(threadClass.ClassName, ' quick switches: ', quickSwitch); Writeln('Duration: ', sw.ElapsedMilliseconds, ' ms'); Writeln('Call count: ', t.Count); Writeln; finally t.Free; end; end; procedure Main; begin TestPingPongThread(TMonitorThread, False); TestPingPongThread(TYieldThread, False); TestPingPongThread(TSpinWaitThread, False); TestPingPongThread(TMonitorThread, True); TestPingPongThread(TYieldThread, True); TestPingPongThread(TSpinWaitThread, True); end; begin try Main; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Writeln('Press <Enter> to exit'); Readln; end. 

Update:

I came up with a combination of event and spinweigth:

 constructor TSpinEvent.Create; begin inherited Create(nil, False, False, ''); end; procedure TSpinEvent.SetEvent; begin fState := 1; inherited; end; procedure TSpinEvent.WaitFor; var startCount: Cardinal; begin startCount := TThread.GetTickCount; while TInterlocked.CompareExchange(fState, 0, 1) <> 1 do begin if (TThread.GetTickCount - startCount) >= YieldTimeout then // YieldTimeout = 10 inherited WaitFor(INFINITE) else TThread.Yield; end; end; 

This happens about 5-6 times slower than the fiber based implementation when fast switching is performed and less than 1% slower when adding some work between Ping calls. It, of course, works on 2 cores, and not just fiber.

Answer 1

When I am in such situations, I like to use Windows events. They are displayed in Delphi using the TEvent class, which you WaitForSingleObject.

So, you can use two events: Thread1NotActive and Thread2NotActive. Once Thread1 is executed, it sets the Thread1NotActive flag, which Thread2 is waiting for. Conversely, if Thread2 stops processing, it installs Thread2NotActive, which is controlled by Thread1.

This should allow you to avoid race conditions (which is why I suggest using two events instead of 1) and should support you in this state without consuming excessive amounts of processor time.

If you need a more complete example, you have to wait tomorrow :)