Multithreading Delphi2010：无线程vs线程

我是Delphi2010的用户，我当前的机器是intel core i7，运行windows 7 x64。我编写了以下代码：

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FCount: Integer;
    FTickCount: Cardinal;
    procedure DoTest;
    procedure OnTerminate(Sender: TObject);
  end;

  TMyThread = class(TThread)
  private
    FMethod: TProc;
  protected
    procedure Execute; override;
  public
    constructor Create(const aCreateSuspended: Boolean; const aMethod: TProc);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
    T1, T2: Cardinal;
begin
  T1 := GetTickCount;
  for i := 0 to 9 do
    DoTest;
  T2 := GetTickCount;
  Memo1.Lines.Add(Format('no thread=%4f', [(T2 - T1)/1000]));
end;

procedure TForm1.Button2Click(Sender: TObject);
var T: TMyThread;
    i: integer;
begin
  FCount := 0;
  FTickCount := GetTickCount;

  for i := 0 to 9 do begin
    T := TMyThread.Create(True, DoTest);
    T.OnTerminate := OnTerminate;
    T.Priority := tpTimeCritical;

    if SetThreadAffinityMask(T.Handle, 1 shl (i mod 8)) = 0 then
      raise Exception.Create(IntToStr(GetLastError));

    Inc(FCount);
    T.Start;
  end;
end;

procedure TForm1.DoTest;
var i: integer;
begin
  for i := 1 to 10000000 do
    IntToStr(i);
end;

procedure TForm1.OnTerminate(Sender: TObject);
begin
  Dec(FCount);
  if FCount = 0 then
    Memo1.Lines.Add(Format('thread=%4f', [(GetTickCount - FTickCount)/1000]));
end;

constructor TMyThread.Create(const aCreateSuspended: Boolean; const aMethod:
    TProc);
begin
  inherited Create(aCreateSuspended);
  FMethod := aMethod;
  FreeOnTerminate := True;
end;

procedure TMyThread.Execute;
begin
  FMethod;
end;

---

单击按钮1将显示12.25秒，而按钮2将显示12.14秒。我的问题是，尽管我在运行并行线程，为什么我无法获得更明显的时间差（少于10秒）？

内存分配似乎是这里的主要问题

如果将有效载荷替换为

procedure TForm6.DoTest;
var i: integer;
  a: double;
begin
  a := 0;
  for i := 1 to 10000000 do
    a := Cos(a);
end;

代码将很好地并行化，表明您的框架没有真正的问题

但是，如果使用内存分配/释放替换有效负载

procedure TForm6.DoTest;
var i: integer;
  p: pointer;
begin
  for i := 1 to 10000000 do begin
    GetMem(p, 10);
    FreeMem(p);
  end;
end;

并行版本的运行速度将比单线程版本慢得多

调用IntToStr时，会分配并销毁一个临时字符串，该分配/解除分配会造成瓶颈

BTW1：除非你真的知道自己在做什么，否则我强烈建议不要以tpTimeCritical优先级运行线程。即使你真的知道自己在做什么，你也不应该那样做

---

BTW2：除非您真的知道自己在做什么，否则不应该在线程级别上弄乱关联掩码。系统足够智能，可以很好地调度线程。

如果您有内存密集型线程（许多内存分配/释放），最好使用TopMM而不是FastMM：

---

FastMM使用一个锁来阻止所有其他线程，TopMM没有，所以它在多核/CPU上的扩展性更好

我不是100%确定，但是有可能从TThread的上下文调用OnTerminate事件。如果是这样的话（我必须承认我没有检查这个），那么最好在FCount上使用

InterlockedDecrement

，并同步GUI更新。这只是一个小问题，但在生产代码中，这些事情很重要。

请记住下次格式化您的问题TPTimeCritical不会做您认为它会做的事情。线程优先级不会使线程运行得更快；它只是让它们抢占当前运行的优先级较低的任何其他线程。例如，IDE的主线程可能是这些线程之一；调试时，您可能无法打断该进程。线程优先级只有在处理器发生争用时才有实际意义，即另一个线程在一个内核上运行并保持100%的优先级。将线程优先级用于其他事情（如同步）是一个错误，不应该这样做。要完成此回答：当IsMultiThread全局变量设置为True（并且usint TThread将其设置为True）时，通常内存管理器必须保护并发线程的内存分配请求。如果内存分配是热点，这会增加一些开销，实际上会降低应用程序的速度。要完成Idsandor的添加：）Delphi 2010内存管理器（即FastMM）在不同的块中保持不同的分配大小，每个块都有自己的锁保护。如果线程分配不同大小的区域，它们不会相互阻塞。但是，在这种情况下，所有分配都来自同一个块，内存管理器的锁强制线程序列化。在FastMM4中，您还可以设置define AssumeMultiThread，它将跳过检查“if IsMultiThread then”，始终使用MT代码。当然，这将导致单线程应用程序的性能下降。