Link to home
Start Free TrialLog in
Avatar of ivanxerone
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.processmessages;      // doesnt make a difference in the results
      st:='test';   //test code
      st:=ansiuppercase(st);  //test code
      st:=ansilowercase(st);  //test code
      END;
   STARTTIME:=gettickcount-starttime;
   memo1.lines.add(format('FINISHED (%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?
Avatar of Lukasz Zielinski
Lukasz Zielinski
Flag of Poland image

try this:
 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-starttime;
 memo1.lines.add(format('FINISHED (%dms)',[starttime]));

btw.
memo1.lines.add(format('FINISHED (%dms)',[starttime]));
should be synchronized
ziolko.
Avatar of ivanxerone
ivanxerone

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.

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.
>>same priority<< should be same or higher... my mistake

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.
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(CreateSuspended: 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.
forgot to add, my project DID hit 100% on CPU usage

ziolko.
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

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
> 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)
>>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.
ASKER CERTIFIED SOLUTION
Avatar of TheRealLoki
TheRealLoki
Flag of New Zealand image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
That was the issue. String management from Delphi.
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.
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)