Delphi service always runs at 15% processor load

Question

I just encountered a problem with a service I wrote some time ago. This service is meant to translate various programs by calling a multilizer application via CreateProcess. The problem is that once the checks of the given directories cleared and the actual translation method is called the cpu load will rise to about 15-20% and remain at this level even if all files have been processed. The OnStart-event of the service creates a non delayed thread which has an execute-method that looks like this:

procedure TTranslateThread.Execute;
var count : integer;

begin
  sleep(ServiceObject.hInterval);
  while not Terminated do
  begin
    Inc(Count);
    if Count>= 10 then
    begin
      Count :=0;
      if ServiceObject.CheckDirCount>0 then
      begin
      ServiceObject.TranslateService;
      sleep(ServiceObject.hInterval);
    end;
   end;
end;

However I suppose the main cause of the problem lies in the way I have to call the multilizer. That is because the service has to wait for the multilizer to finish translating. I used WaitForSingleObject to wait for the multilizer to finish although I know it's kind of a bad idea. This is the method that calls the multilizer:

procedure WaitForML7(hName: string);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  hCreateOK: Boolean;
  AParameterFinal,AFileName: String;
begin
  AFileName := hMultilizerPath+'Ml7Build.exe';
  AParameterFinal := 'b '+hName+'.exe.m7p';


  FillChar(si,SizeOf(TStartupInfo),#0);
  FillChar(pi,SizeOf(TProcessInformation),#0);
  si.cb := SizeOf(TStartupInfo);
  AParameterFinal := Format ('"%s" %s', [AFilename, TrimRight(AParameterFinal)]);
  slog.Info('CreateProcess wird versucht');

  hCReateOK := CreateProcess(nil,PChar(AParameterFinal), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
  PChar(hMultilizerPath) ,si,pi);
  if hCreateOK then
  begin
    slog.Error('Multilizeraufruf war erfolgreich für Prg: '+hName);
    WaitForSingleObject(pi.hProcess,INFINITE);
  end
  else
  begin
  slog.Error('Aufruf war nicht erfolgreich -> keine Uebersetzung');
  end;
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

I don't really understand why the processor load remains high even there is nothing more to do. Thanks in advance.

Answer 1

Your thread runs a busy loop.

while not Terminated do
begin
  Inc(Count);
  if Count>= 10 then
  begin
    Count :=0;
    if ServiceObject.CheckDirCount>0 then
    begin
      ServiceObject.TranslateService;
      sleep(ServiceObject.hInterval);
    end;
  end;
end;

Note that I've added the missing end from your code. I hope that's the only error you made, because obviously when you post code that is not the real code, it's plausible that the problem lies in the real code rather than the code you posted.

Anyway, suppose that CheckDirCount always evaluates to 0, then the loop looks like this:

while not Terminated do
begin
  Inc(Count);
  if Count>= 10 then
  begin
    Count :=0;
    ServiceObject.CheckDirCount;
  end;
end;

That is a busy loop. When you run a busy loop, the processor gets hot.

I don't really want to propose solutions to this because I don't know any of the details of what your program is doing. I'm just trying to answer the question of why your thread consumes CPU.

Answer 2

Your wait loop will run without waiting within a Sleep(), so will burn some CPU until Sleep() is reached. This is not a good implementation pattern.

A common solution is to use semaphores to notify the thread to wake up and handle the pending tasks. It won't use any CPU until the semaphore (e.g. TEvent) is triggered.

Take a look at TEvent documentation.

For more complex multi-thread content, consider using a dedicated library like OmniThreadLibrary. It features high-level lists and parallel processing, tuned and stable. Using such a library will save you plenty of time and money. Multi-threading programming can be very difficult to stabilize, so OmniThreadLibrary is worth a look.

Answer 3

In addition to David's answer:

your main execute block can be simplified, doing Sleep unconditionally to prevent a busy loop:

procedure TTranslateThread.Execute;
begin
 while not Terminated do
  begin
   sleep(ServiceObject.hInterval);
   if ServiceObject.CheckDirCount>0 then
    ServiceObject.TranslateService;
  end;
end;

Please note that you can avoid the sleep loop by using Shell notification events.