Updating each thread's timer in a TListView without CPU overload

Question

Delphi used: 2007

Hello everyone,

I have a TListView with ViewStyle set to vsReport. When I click on a button, I launch about 50 threads. Each thread has a TListItem component. Each TListItem has a SubItem that is a timer. It starts at 250 and goes all the way down to 0. The user is able to see each timer decreasing in the TListView.

I have written the following code:

procedure TThreadWorker.DeleteTickets;
begin
 ListItem.Delete;
end;

procedure TThreadWorker.UpdateTimer;
begin
 ListItem.SubItems[1] := IntToStr(Timer);
end;

procedure TThreadWorker.TimerCounter;
begin
 Timer := 300;
 repeat
  Sleep(1000);
  Dec(Timer);
  Synchronize(UpdateTimer);
 until (Timer = 0);
 Synchronize(DeleteTickets);
end;

And... it works! But here's the thing: all these synchronizations seem to unnecessarily overload the CPU. Obviously, it's a bigger problem when I launch more threads (100, 200 or 300) or when I use a weaker computer. At first, I wasn't sure it was the synchronizations; but if I deactivate them, the CPU is no more overloaded.

To be frank, it's not that much of an issue. However, I have the feeling that decrementing timers shouldn't cause any sort of CPU overload: my code is probably not right. I tried calling UpdateTimer less often, and while it softens the CPU overload, it doesn't fix it in the end. Furthermore, I'd like the user to see the timer updated each second. The timer also needs to be as precise as possible.

Thank you.

Answer 1

I think you have placed the cart ahead of the horse here. Having all your threads synchronize into the main thread, each with their own timer and message queue, will place a heavy burden on the system. What's more, often times you don't want to burden your threads with running a message loop.

A better approach in my view is to place a single timer in the main thread. When it ticks, have it retrieve progress from each thread or task that it needs to report on. You'll need to serialize access to that progress, but that's not expensive.

Answer 2

I think threads are more expensive to the CPU than you might think. From what I remember, the CPU has overhead to swap each thread in and out of the cache. With the CPU swapping out 50 different threads, I'm not surprised its overloading

One solution might be to extend the TTimer component then dynamically create 50 of those rather than 50 threads. TTimer uses the windows api instead of threads. (The code below is untested, but should at least give you the idead)

TMyTimer = class(TTimer)
begin
  public
    Timer: integer;
    ListItem: TListItem;
end;
...
procedure ButtonClick(Sender: TObject)
begin
  for i := 0 to 50 do
  begin
     ltimer = TMyTimer.Create;
     ltimer.Timer := 300;
     ltimer.ListItem := TListItem.Create;
     //initialize list item here
     ltimer.OnTimer := DecTimer;
  end;
end;

procedure DecTimer(Sender: TObject)
begin
  dec(TMytimer(Sender).Timer);
  TMyTimer(Sender).ListItem.SubItem[1] := StrToInt(TMytimer(Sender).Timer)
end;

If the threads are all starting at the same time, try doing something like having one thread control up to 25 timer. i.e. For 50 timers you only have two threads. The timer event would then just loop through its 25 counters and decrement them. You'd still need to use synchronize for this.

The answer to this question might be of interest: How expensive are threads?

Answer 3

Here is example using TThread.Queue and a TSimpleEvent for timing the counter instead of a Sleep().

Type
  TThreadWorker = Class(TThread)
  private
    FTimer : Integer;
    FListItem : TListItem;
    procedure Execute; override;
    procedure UpdateTimer;
    procedure DeleteTicket;
  public
    constructor Create( aListItem : TListItem);
  End;

constructor TThreadWorker.Create(aListItem : TListItem);
begin
  Inherited Create(false);
  FListItem := aListItem;
  Self.FreeOnTerminate := true;
end;

procedure TThreadWorker.Execute;
var
  anEvent : TSimpleEvent;
begin
  anEvent := TSimpleEvent.Create(nil,true,false,'');
  try
    FTimer := 300;
    repeat
      anEvent.WaitFor(1000);
      Queue(UpdateTimer);
      Dec(FTimer);
    until (FTimer = 0);
    Self.Synchronize( DeleteTicket); // <-- Do not Queue this !
  finally
    anEvent.Free;
  end;
end;

procedure TThreadWorker.UpdateTimer;
begin
  FListItem.SubItems[1] := IntToStr(FTimer);
end;

procedure TThreadWorker.DeleteTicket;
begin
  FListItem.Delete;
end;

Just a note, the DeleteTicket must be synchronized. The thread is terminated when execute is done, and anything on the queue will be left dangling.