在Delphi中同步两个线程的最佳方法

时间:2014-11-14 17:56:26

标签: multithreading delphi synchronization delphi-xe7

我目前正在尝试找到最好的(*)方法让两个线程交替运行并让它们互相等待。

(*)具有低CPU成本的快速的最佳组合

到目前为止,我找到了三种方法,我将它放在一些演示应用程序中,以显示我发现的问题。

使用遵循经典等待/脉冲模式的TMonitor由于所有锁定而执行得不是很好(根据SamplingProfiler在这些函数中大部分时间都会消耗)。我尝试使用Windows事件(SyncObjs.TEvent),但它执行类似(即坏)。

使用调用TThread.Yield的等待循环表现最佳,但显然会像疯狂一样烧掉CPU周期。如果切换发生得非常快并不重要,但是当线程实际等待时会受到伤害(你可以在演示中看到)。

使用TSpinWait表现很好(如果不是这三个中最好的),但只有在交换非常快的情况下才会发生。由于TSpinWait的工作方式,切换性能越差,性能越差。

由于多线程不是我的优势之一,我想知道是否有这些方法的组合或一些完全不同的方法来在两种情况下(快速和慢速切换)实现良好的性能。

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.

更新

我想出了一个事件和spinwait的组合:

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;

在快速切换时,这比基于光纤的实现慢大约5到6倍,在Ping调用之间添加一些工作时慢不到1%。它当然在2个核心上运行,而不是在使用光纤时只运行一个核心。

1 个答案:

答案 0 :(得分:3)

当我发现自己处于这种情况时,我喜欢使用Windows事件。 它们使用TEvent类在Delphi中公开,您可以使用WaitForSingleObject。

因此,您可以使用两个事件:Thread1NotActive和Thread2NotActive。 一旦完成Thread1,它就会设置Thread1NotActive标志,该标志由Thread2等待。 相反,如果Thread2停止处理,它会设置Thread2NotActive,由Thread1监视。

这应该允许你避免竞争条件(这就是为什么我建议使用两个事件而不是1)并且应该让你在这个过程中保持理智,同时不要消耗过多的CPU时间。

如果你需要一个更完整的例子,明天你必须等待:)