Delphi 2010:没有线程与线程

时间:2010-09-03 03:50:56

标签: multithreading delphi delphi-2010

我是delphi 2010的用户,我目前的机器是intel核心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;

单击Button1将显示12.25秒,而Button2将显示12.14秒。我的问题是为什么我不能获得更明显的时间差异(少于10秒)虽然我正在运行并行线程?

3 个答案:

答案 0 :(得分:7)

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

如果用

替换有效载荷
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:除非你真的知道自己在做什么,否则你不应该在线程级别上混淆亲和力掩码。系统非常智能,可以很好地安排线程。

答案 1 :(得分:1)

如果您有内存密集型线程(许多内存分配/解除分配),最好使用TopMM而不是FastMM:http://www.topsoftwaresite.nl/

FastMM使用一个锁定所有其他线程的锁,TopMM不会这样,它在多核/ cpus上扩展得更好!

答案 2 :(得分:0)

我不是百分百肯定,但是有可能从TThread的上下文调用OnTerminate事件。如果是这种情况(我必须承认我没有检查过这个),你最好在FCount上使用InterlockedDecrement,并同步GUI更新。只是一个小问题,但在生产代码中这些事情很重要。