Delphi 2010: No thread vs threads - multithreading

Question

I'm user of delphi 2010, my current machine is intel core i7, running windows 7 x64. I've write the following codes:
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;
Click on Button1 will shows 12.25 seconds, while Button2 will shows 12.14 seconds. My problem is why i cannot get more obvious difference of time taken (less than 10 seconds) although i'm running parallel threads ?

Answer 1

Memory allocation seems to be the main problem here.
If you replace the payload with
procedure TForm6.DoTest;
var i: integer;
a: double;
begin
a := 0;
for i := 1 to 10000000 do
a := Cos(a);
end;
the code will parallelize nicely indicating that there's no real problem with your framework.
If you, however, replace the payload with memory allocation/deallocation
procedure TForm6.DoTest;
var i: integer;
p: pointer;
begin
for i := 1 to 10000000 do begin
GetMem(p, 10);
FreeMem(p);
end;
end;
the parallel version will run much slower than the single-threaded one.
When calling IntToStr, a temporary string is allocated and destroyed and this allocations/deallocations are creating the bottleneck.
BTW1: Unless you really really know what you're doing, I'm strongly advising against running threads at tpTimeCritical priority. Even if you really really know what you're doing you shouldn't be doing that.
BTW2: Unless you really really know what you're doing, you should not mess with affinity masks on thread level. System is smart enough to schedule threads nicely.

Answer 2

If you have memory intensive threads (many memory allocations/deallocations) you better use TopMM instead of FastMM: http://www.topsoftwaresite.nl/
FastMM uses a lock which blocks all other threads, TopMM does not so it scales much better on multi cores/cpus!

Answer 3

I'm not 100% sure, but there's a chance that the OnTerminate event is called from the context of the TThread. If that's the case (I must admit I haven't checked this), you'd be better off using InterlockedDecrement on FCount, and synchronizing the GUI updates. Just a minor point, but in production code these things matter.