ivanxerone
asked on
Delphi Threads timing don't add up
Here is some sample code in Delphi (D7), a single form with:
1 tspinedit, 1 tmemo, 1 tbutton, 1 TJvMTManager, and 1 TJvMTThread
//======================== ========== ========== ========== ==
procedure TForm1.JvMTThread1Execute( Sender: TJvMTThread; MTThread: TJvMTSingleThread);
Var X:integer;
ST:STRING;
STARTTIME:LONGINT;
begin
starttime:=gettickcount;
FOR X:=1 TO 100000 DO BEGIN
//if (x mod 10)=0 then
application.processmessage s; // doesnt make a difference in the results
st:='test'; //test code
st:=ansiuppercase(st); //test code
st:=ansilowercase(st); //test code
END;
STARTTIME:=gettickcount-st arttime;
memo1.lines.add(format('FI NISHED (%dms)',[starttime]));
end;
//======================== ========== ========== ========== ==
procedure TForm1.Button1Click(Sender : TObject);
var x:integer;
begin
memo1.clear;
for x:=1 to SpinEdit1.value do
JvMTThread1.RunCopy;
end;
//======================== ========== ========== ========== ==
I found the issue with TThread, and then I got the same results with TJvMTThread.
The issue is shown in the results:
1 single thread runs at ~200ms
2 threads results in ~2600ms (more than 6 times of what it should be?)
4 threads ~5500 ms
In no moment CPU usage goes over %50, even when setting thread priority to real_time.
Now, those numbers could be lowered significantly by using a criticalsection.enter / leave (For instance, 2 threads should run at ~400ms) but that's not the way threads should work.
The way I want threads to work is exactly the same way as when executing this application twice and running it in sync, resulting them both running at ~200ms.
Something else about threads I don't know?
1 tspinedit, 1 tmemo, 1 tbutton, 1 TJvMTManager, and 1 TJvMTThread
//========================
procedure TForm1.JvMTThread1Execute(
Var X:integer;
ST:STRING;
STARTTIME:LONGINT;
begin
starttime:=gettickcount;
FOR X:=1 TO 100000 DO BEGIN
//if (x mod 10)=0 then
application.processmessage
st:='test'; //test code
st:=ansiuppercase(st); //test code
st:=ansilowercase(st); //test code
END;
STARTTIME:=gettickcount-st
memo1.lines.add(format('FI
end;
//========================
procedure TForm1.Button1Click(Sender
var x:integer;
begin
memo1.clear;
for x:=1 to SpinEdit1.value do
JvMTThread1.RunCopy;
end;
//========================
I found the issue with TThread, and then I got the same results with TJvMTThread.
The issue is shown in the results:
1 single thread runs at ~200ms
2 threads results in ~2600ms (more than 6 times of what it should be?)
4 threads ~5500 ms
In no moment CPU usage goes over %50, even when setting thread priority to real_time.
Now, those numbers could be lowered significantly by using a criticalsection.enter / leave (For instance, 2 threads should run at ~400ms) but that's not the way threads should work.
The way I want threads to work is exactly the same way as when executing this application twice and running it in sync, resulting them both running at ~200ms.
Something else about threads I don't know?
ASKER
Adding Sleep command does make threads take the same time no matter how many they are; but that is not the fix I'm interested on, that fix makes that loop take ~500 times the time it's suppose to take.
I need to use the CPU as much as possible, not idle it.
I need to use the CPU as much as possible, not idle it.
>>I need to use the CPU as much as possible, not idle it.
try to change thread's priority, also if it's multiprocessor system take a look at SetProcessAffinityMask (http://msdn2.microsoft.com/en-us/library/ms686223.aspx) and SetThreadAffinityMask (http://msdn2.microsoft.com/en-us/library/ms686247.aspx)
ziolko.
try to change thread's priority, also if it's multiprocessor system take a look at SetProcessAffinityMask (http://msdn2.microsoft.com/en-us/library/ms686223.aspx) and SetThreadAffinityMask (http://msdn2.microsoft.com/en-us/library/ms686247.aspx)
ziolko.
btw. if you decide to increase thread's priority you may as well change
Sleep(1) to Sleep(0).
Sleep(0) releases processor time to other threads but only those which same priority.
in other words if your thread has priority of 'tpHigher', Sleep(0) will cause threads with priority tpHigher (and only those) do their part of job while Sleep(1) will give processor time to all threads.
ziolko.
Sleep(1) to Sleep(0).
Sleep(0) releases processor time to other threads but only those which same priority.
in other words if your thread has priority of 'tpHigher', Sleep(0) will cause threads with priority tpHigher (and only those) do their part of job while Sleep(1) will give processor time to all threads.
ziolko.
>>same priority<< should be same or higher... my mistake
ziolko.
ziolko.
You have gotten some very good advice from ziolko, I just want to add this. I did my own version of your example with a couple of minor modifications. From my observations the results you are getting are most likely due to windows use of your processor. The processor only has so many clock cycles and windows shares them between processes and threads. Add to that the fact that you are using one processor and the increased time on each thread makes sense. If yo ustart a new thread initially the processor is at 2 percent usage. Running it causes it to go to 5 percent usage. Start another thread and 5 becomes 7, etc. If you have 10 processors to process 10 threads (and use ziolko's advice to request a different processor for each) then you should see better results. Here is the code I ran (using a TThread named TJVMThread), and it's results.
-------------------------- ---------- ---------- ---------- ---------- ---
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;
type
TForm1 = class(TForm)
SpinEdit1: TSpinEdit;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TJVMThread = class(TThread)
private
fMessage : string;
protected
procedure Execute; override;
procedure ShowMessage;
public
Lines : TStrings;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TJVMThread }
procedure TJVMThread.Execute;
var
x : integer;
ST : STRING;
STARTTIME : LONGINT;
begin
starttime := gettickcount;
x := 1;
while (not Terminated) and (x < 100000) do
begin
st := 'test'; //test code
st := ansiuppercase(st); //test code
st := ansilowercase(st); //test code
Inc(x);
end;
STARTTIME := gettickcount-starttime;
if Terminated then
fMessage := 'Terminated'
else
fMessage := format('FINISHED (%dms)', [starttime]);
Synchronize(ShowMessage);
end;
procedure TJVMThread.ShowMessage;
begin
Lines.add(fMessage);
end;
procedure TForm1.Button1Click(Sender : TObject);
var
x : integer;
NewThread : TJVMThread;
begin
Memo1.Clear;
for x := 1 to SpinEdit1.value do
begin
NewThread := TJVMThread.Create(true);
NewThread.Priority := tpTimeCritical;
NewThread.Lines := Memo1.Lines;
NewThread.Resume;
end;
end;
end.
-------------------------- ---------- ---------- ---------- ---------- ---
FINISHED (438ms)
FINISHED (469ms)
FINISHED (547ms)
FINISHED (610ms) --increasing from initial
FINISHED (640ms)
FINISHED (687ms)
FINISHED (781ms)
FINISHED (797ms)
FINISHED (781ms) --likely a thread or two finished so you see a decrease
FINISHED (797ms) --starting this one up adds again.
--------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;
type
TForm1 = class(TForm)
SpinEdit1: TSpinEdit;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TJVMThread = class(TThread)
private
fMessage : string;
protected
procedure Execute; override;
procedure ShowMessage;
public
Lines : TStrings;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TJVMThread }
procedure TJVMThread.Execute;
var
x : integer;
ST : STRING;
STARTTIME : LONGINT;
begin
starttime := gettickcount;
x := 1;
while (not Terminated) and (x < 100000) do
begin
st := 'test'; //test code
st := ansiuppercase(st); //test code
st := ansilowercase(st); //test code
Inc(x);
end;
STARTTIME := gettickcount-starttime;
if Terminated then
fMessage := 'Terminated'
else
fMessage := format('FINISHED (%dms)', [starttime]);
Synchronize(ShowMessage);
end;
procedure TJVMThread.ShowMessage;
begin
Lines.add(fMessage);
end;
procedure TForm1.Button1Click(Sender
var
x : integer;
NewThread : TJVMThread;
begin
Memo1.Clear;
for x := 1 to SpinEdit1.value do
begin
NewThread := TJVMThread.Create(true);
NewThread.Priority := tpTimeCritical;
NewThread.Lines := Memo1.Lines;
NewThread.Resume;
end;
end;
end.
--------------------------
FINISHED (438ms)
FINISHED (469ms)
FINISHED (547ms)
FINISHED (610ms) --increasing from initial
FINISHED (640ms)
FINISHED (687ms)
FINISHED (781ms)
FINISHED (797ms)
FINISHED (781ms) --likely a thread or two finished so you see a decrease
FINISHED (797ms) --starting this one up adds again.
ok, so here's my bit:)
TMyThread = class(TThread)
private
FHandle: Cardinal;
FID: Integer;
protected
procedure Execute;override;
public
constructor Create(CreateSuspended: Boolean;AID: Integer;AHandle: Cardinal);reintroduce;
end;
procedure TForm1.Button1Click(Sender : TObject);
var cnt: Integer;
begin
Memo1.Lines.Clear;
for cnt := 0 to 5 do
with TMyThread.Create(True, cnt, Handle) do begin
FreeOnTerminate := True;
Priority := tpTimeCritical;
Resume;
end;
end;
{ TMyThread }
constructor TMyThread.Create(CreateSus pended: Boolean;AID: Integer;AHandle: Cardinal);
begin
inherited Create(CreateSuspended);
FID := AID;
FHandle := AHandle;
end;
procedure TMyThread.Execute;
var x: Integer;
starttime: LongInt;
st: string;
begin
starttime := gettickcount;
x := 1;
while (not Terminated) and (x < 100000) do begin
st := 'test'; //test code
st := ansiuppercase(st); //test code
st := ansilowercase(st); //test code
Inc(x);
Sleep(0);
end;
starttime := gettickcount-starttime;
PostMessage(FHandle, WM_MYMESSAGE, FID, starttime);
end;
procedure TForm1.WMThreadTime(var Msg: TMessage);
begin
Memo1.Lines.Add(Format('%d finished in: %d', [Msg.WParam, Msg.LParam]));
end;
and results:
0 finished in: 191
1 finished in: 180
2 finished in: 180
3 finished in: 191
4 finished in: 180
5 finished in: 180
ziolko.
TMyThread = class(TThread)
private
FHandle: Cardinal;
FID: Integer;
protected
procedure Execute;override;
public
constructor Create(CreateSuspended: Boolean;AID: Integer;AHandle: Cardinal);reintroduce;
end;
procedure TForm1.Button1Click(Sender
var cnt: Integer;
begin
Memo1.Lines.Clear;
for cnt := 0 to 5 do
with TMyThread.Create(True, cnt, Handle) do begin
FreeOnTerminate := True;
Priority := tpTimeCritical;
Resume;
end;
end;
{ TMyThread }
constructor TMyThread.Create(CreateSus
begin
inherited Create(CreateSuspended);
FID := AID;
FHandle := AHandle;
end;
procedure TMyThread.Execute;
var x: Integer;
starttime: LongInt;
st: string;
begin
starttime := gettickcount;
x := 1;
while (not Terminated) and (x < 100000) do begin
st := 'test'; //test code
st := ansiuppercase(st); //test code
st := ansilowercase(st); //test code
Inc(x);
Sleep(0);
end;
starttime := gettickcount-starttime;
PostMessage(FHandle, WM_MYMESSAGE, FID, starttime);
end;
procedure TForm1.WMThreadTime(var Msg: TMessage);
begin
Memo1.Lines.Add(Format('%d
end;
and results:
0 finished in: 191
1 finished in: 180
2 finished in: 180
3 finished in: 191
4 finished in: 180
5 finished in: 180
ziolko.
forgot to add, my project DID hit 100% on CPU usage
ziolko.
ziolko.
ASKER
Ok then, there's gotta be something wrong with my version of delphi. Are you using D7 build 8.1?
I executed your sample,
1 thread:
1 finished in: 359
2 threads (consistent above 5500):
2 finished in: 5672
1 finished in: 5688
3 threads:
3 finished in: 9844
1 finished in: 9844
2 finished in: 9844
Now, it is weird when i switch applications while test is running results always go down, like this:
1 finished in: 3766
2 finished in: 3766
I executed your sample,
1 thread:
1 finished in: 359
2 threads (consistent above 5500):
2 finished in: 5672
1 finished in: 5688
3 threads:
3 finished in: 9844
1 finished in: 9844
2 finished in: 9844
Now, it is weird when i switch applications while test is running results always go down, like this:
1 finished in: 3766
2 finished in: 3766
Hi ivanxerone,
here's my observations
ziolko's comment about the "memo1.lines.add" being in a synchronize is spot on.
you risk horrid access violations otherwise, but this is not important in this discussion.
> The way I want threads to work is exactly the same way as when executing this application twice and running it in sync, resulting them both running at ~200ms.
you are being tricked here a little...
The trouble is, that your code takes around 2/10ths of a second to run...
The chances of starting both apps at the same time (or clicking button1 on each) is almost zero...
You can prove this by makiing your app run only 1 thread, but increasing the loop to 5000000
this takes around 6 seconds on my beast
if i run 2 versions of the app at the same time, the duration is about 10 seconds
however, if I run 2 threads in the same app, the time is so slow I can grab a coffee in between...about 25 x slower
The problem is indeed, mainly, timeslices, (but I don't think it ends there...)
Windows is handling out slices to processes, and the processes are then sharing it up among threads.
so you are getting measurably less than 2 separate processes doing the same thing.
By the way, the same thing happens if you duplicate the code in the main thread, run it there, and also i a thread at the same time (obvious, but I thought I'd do it just to make sure)
hope this helps
here's my observations
ziolko's comment about the "memo1.lines.add" being in a synchronize is spot on.
you risk horrid access violations otherwise, but this is not important in this discussion.
> The way I want threads to work is exactly the same way as when executing this application twice and running it in sync, resulting them both running at ~200ms.
you are being tricked here a little...
The trouble is, that your code takes around 2/10ths of a second to run...
The chances of starting both apps at the same time (or clicking button1 on each) is almost zero...
You can prove this by makiing your app run only 1 thread, but increasing the loop to 5000000
this takes around 6 seconds on my beast
if i run 2 versions of the app at the same time, the duration is about 10 seconds
however, if I run 2 threads in the same app, the time is so slow I can grab a coffee in between...about 25 x slower
The problem is indeed, mainly, timeslices, (but I don't think it ends there...)
Windows is handling out slices to processes, and the processes are then sharing it up among threads.
so you are getting measurably less than 2 separate processes doing the same thing.
By the way, the same thing happens if you duplicate the code in the main thread, run it there, and also i a thread at the same time (obvious, but I thought I'd do it just to make sure)
hope this helps
> Now, it is weird when i switch applications while test is running results always go down, like this:
> 1 finished in: 3766
> 2 finished in: 3766
1 other thing to check is whether you ahve priorirty set to foreground applications or background
Control Panel
System
Advanced tab
Performance box (Settings button)
Advanced tab
"Processor Scheduling'
(the above may differ depending on your OS)
> 1 finished in: 3766
> 2 finished in: 3766
1 other thing to check is whether you ahve priorirty set to foreground applications or background
Control Panel
System
Advanced tab
Performance box (Settings button)
Advanced tab
"Processor Scheduling'
(the above may differ depending on your OS)
>>Ok then, there's gotta be something wrong with my version of delphi.
i don't think so. it's rather general PC performance, also running in debug mode vs. stand alone app may affect those times
>> Are you using D7 build 8.1?
D7.0 ver.4.453
ziolko.
i don't think so. it's rather general PC performance, also running in debug mode vs. stand alone app may affect those times
>> Are you using D7 build 8.1?
D7.0 ver.4.453
ziolko.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
That was the issue. String management from Delphi.
Problem is also fixed by declaring st as string[120] per say.
Problem is also fixed by declaring st as string[120] per say.
in addition try FastMM it's not only memory leak reporter but also more efficient memmory manager plus you can configyre it to be more efficient on multithreaded apps
ziolko.
ziolko.
ASKER
Excellent reference, FastMM resolves string performance, tested it i get %1,000 performance on my main app.
go to your FastMM4Options.inc and make sure then you have it without "."
{$define AssumeMultiThreaded}
ziolko.
p.s. gimme some poinks :) (just joking)
{$define AssumeMultiThreaded}
ziolko.
p.s. gimme some poinks :) (just joking)
starttime:=gettickcount;
x := 1;
while (not Terminated) and (x < 100000) do begin
st:='test'; //test code
st:=ansiuppercase(st); //test code
st:=ansilowercase(st); //test code
Inc(x);
Sleep(1);
end;
STARTTIME:=gettickcount-st
memo1.lines.add(format('FI
btw.
memo1.lines.add(format('FI
should be synchronized
ziolko.