why is threads blocked on critical section owned by thread XXXXX

Question

Threads are being blocked by giving message in wait chain section "Blocked on critical section owned by thread xxxxx" if i give sleep after creating thread they are running fine. not sure why they are being blocked on critical section nothing much code in critical section. Can any one help to solve this issue.

My thread execute method which is having a global variable which is in critical section as shown below

procedure TMyThread.Execute();
Var
Filename : String;
FIleDone : Boolean;
begin
  inherited;
  FIleDone := False;
  while not FIleDone do                     //while there are still files
  begin
    try
    EnterCriticalSection(CriticalSection);   //Try to catch the critical section
                     //Access the shared variables
    //Are there still files available
    if FileList.Count = 0 then
    begin
      //Leave the critical section, when there are no files left
      LeaveCriticalSection(CriticalSection);
      //Leave the while loop
      FIleDone := true;
      self.Terminate;
      break;
    end
    else
    begin
      //Read the filename
      Filename := FileList.Strings[0];
      //Delete the file from the list
      FileList.Delete(0);
      //Leave the critical section
      LeaveCriticalSection(CriticalSection);

      CopyTable(ChangeFileExt(filename,''),Form1.TargetDir.Text);
    end;
    except
      LeaveCriticalSection(CriticalSection);
    end;
  end;

end;



procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
   t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15 : TMythread;
  TimeThen: TDateTime;
  TimeNow: TDateTime;
  Counter,id1,id2 : Integer;
begin

  TimeThen := now;
  FileList := TStringList.create();

  if Length(TargetDir.Text) > 1 then
    if TargetDir.Text[Length(TargetDir.Text)] <> '\' then
       TargetDir.Text := TargetDir.Text + '\';
  GetFileStringList(TargetDir.Text + '*.db', FileList);
  ProgressBar.Max := FileList.Count;
  t1  := TMyThread.create(false);
  //sleep(1000);
  t2 := TMyThread.create(false);
  //sleep(1000);
  t3 := TMyThread.create(false);
  //sleep(1000);
  t4 := TMyThread.create(false);
  //sleep(1000);
  t5 := TMyThread.create(false);
  //sleep(1000);
  t6  := TMyThread.create(false);
  //sleep(1000);
  t7 := TMyThread.create(false);
  //sleep(1000);
  t8 := TMyThread.create(false);
  //sleep(1000);
  t9 := TMyThread.create(false);
  //sleep(1000);
  t10 := TMyThread.create(false);
  //sleep(1000);
  t11 := TMyThread.create(false);
  //sleep(1000);
  t12 := TMyThread.create(false);
  //sleep(1000);
  t13 := TMyThread.create(false);
  //sleep(1000);
  t14 := TMyThread.create(false);
  //sleep(1000);
  //t15 := TMyThread.create(false);
 // sleep(1000);
  //mythread.Execute;
   while Done < 14 do
  begin
    progressBar.Position :=   ProgressBar.Max - FileList.Count;

    Application.ProcessMessages;
  end;

  // end;
    //ProgressBar.Position := ProgressBar.Position + 1;
  //end;
  //ChangeCOCompanyLegalName();
  TimeNow := Now;
  if ((TimeNow - TimeThen) * 24 * 60 * 60) < 60 then
    ShowMessage('done in ' + FormatFloat('###',((Now - TimeThen) * 24 * 60 * 60)) + ' seconds')
  else
    if ((TimeNow - TimeThen) * 24 * 60) < 60 then
      ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24 * 60)) + ' minutes')
    else
      ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24)) + ' hours');

  //FileList.Free;
end;

Remy Lebeau Remy Lebeau · Accepted Answer · 2014-12-11T19:36:23

You are not managing the critical section correctly (or even using it at all when updating your progress bar). And there are other problems with your code, for instance the use of Form1.TargetDir.Text inside of TMyThread.Execute() is not thread-safe so you need to get rid of that.

Try something more like this instead:

type
  TMyThread = class(TThread)
  private
    FTargetDir: string;
    ...
  protected
    procedure Execute; override;
  public
    constructor Create(const ATargetDir: String); reintroduce;
  end;

var
  CriticalSection: TRTLCriticalSection;
  FileList: TStringList;

constructor TMyThread.Create(const ATargetDir: String);
begin  
  inherited Create(False);
  FTargetDir := ATargetDir;
end;

procedure TMyThread.Execute;
var
  Filename : String;
begin
  while not Terminated do
  begin
    EnterCriticalSection(CriticalSection);
    try
      if FileList.Count = 0 then Exit;
      Filename := FileList.Strings[0];
      FileList.Delete(0);
    finally
      LeaveCriticalSection(CriticalSection);
    end;

    if not Terminated then
      CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  MaxThreads = 15;
var
  Idx, NumThreads: Integer;
  Threads: array[0..MaxThreads-1] of TMyThread;
  Handles: array[0..MaxThreads-1] of THandle;
  TimeStart, TimeElapsed, Ret: DWORD;
  Dir: string;
begin
  TimeStart := GetTickCount;

  FileList := TStringList.Create;
  try
    Dir := TargetDir.Text;
    if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);

    GetFileStringList(Dir + '*.db', FileList);
    ProgressBar.Max := FileList.Count;
    if FileList.Count = 0 then Exit;

    NumThreads := 0;
    try
      for Idx := 1 to MaxThreads do
      begin
        Threads[NumThreads] := TMyThread.Create(Dir);
        Handles[NumThreads] := Threads[NumThreads].Handle;
        Inc(NumThreads);
      end;

      Timer1.Enabled := True;
      try
        repeat
          Ret := WaitForMultipleObjects(NumThreads, PWOHandleArray(@Handles), False, INFINITE);
          if Ret := WAIT_FAILED then RaiseLastOSError;
          if (Ret >= WAIT_OBJECT_0) and (Ret < (WAIT_OBJECT_0+NumThreads)) then
          begin
            Idx := Integer(Ret - WAIT_OBJECT_0);
            Threads[Idx].Free;
            if Idx < (NumThreads-1) then
            begin
              Move(Threads[Idx+1], Threads[idx], (NumThreads-(Idx+1)) * SizeOf(TMyThread));
              Move(Handles[Idx+1], Handles[Idx], (NumThreads-(Idx+1)) * SizeOf(THandle));
            end;
            Dec(NumThreads);
          end
          else if Ret = (WAIT_OBJECT_0+NumThreads) then
          begin
            Application.ProcessMessages;
          end;
        until NumThreads = 0;
      finally
        Timer1.Enabled := False;
      end;
    finally
      for Idx := 0 to NumThreads-1 do
      begin
        Threads[Idx].Terminate;
        Threads[Idx].WaitFor;
        Threads[Idx].Free;
      end;
    end;
  finally
    FileList.Free;
  end;

  TimeElapsed := GetTickCount - TimeStart;

  if TimeElapsed < 1000 then
    ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
  else if TimeElapsed < (1000 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
  else if TimeElapsed < (1000 * 60 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
  else
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Cnt: Integer;
begin    
  EnterCriticalSection(CriticalSection);
  try
    Cnt := FileList.Count;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
  ProgressBar.Position := ProgressBar.Max - Cnt;
end;

Alternatively, change the UI code to not use a wait loop at all:

type
  TMyThread = class(TThread)
  private
    FTargetDir: string;
    ...
  protected
    procedure Execute; override;
  public
    constructor Create(const ATargetDir: String); reintroduce;
  end;

var
  CriticalSection: TRTLCriticalSection;
  FileList: TStringList;

constructor TMyThread.Create(const ATargetDir: String);
begin  
  inherited Create(True);
  FreeOnTerminate := True;
  FTargetDir := ATargetDir;
end;

procedure TMyThread.Execute;
var
  Filename : String;
begin
  while not Terminated do
  begin
    EnterCriticalSection(CriticalSection);
    try
      if FileList.Count = 0 then Exit;
      Filename := FileList.Strings[0];
      FileList.Delete(0);
    finally
      LeaveCriticalSection(CriticalSection);
    end;

    if not Terminated then
      CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
  end;
end;

const
  MaxThreads = 15;

var
  Threads: TList;
  TimeStart: DWORD;

procedure TForm1.Button1Click(Sender: TObject);
var
  Idx: Integer;
  Thread: TMyThread;
  Dir: string;
begin
  if Threads <> nil then
  begin
    while Threads.Count > 0 do
    begin
      with TMyThread(Threads[0]) do
      begin
        OnTerminate := nil;
        Terminate;
      end;
      Threads.Delete(0);
    end;
  end;

  if FileList = nil then
    FileList := TStringList.Create;

  Dir := TargetDir.Text;
  if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);

  TimeStart := GetTickCount;

  GetFileStringList(Dir + '*.db', FileList);
  ProgressBar.Max := FileList.Count;
  if FileList.Count = 0 then Exit;

  if Threads = nil then
    Threads := TList.Create;

  for Idx := 1 to MaxThreads do
  begin
    Thread := TMyThread.Create(Dir);
    Thread.OnTerminate := ThreadTerminated;
    try
      Threads.Add(Thread);
      try
        Thread.Resume;
      except
        Threads.Remove(Thread);
        raise;
      end;
    except
      Thread.Free;
      raise;
    end;
  end;

  Timer1.Enabled := True;
end;

procedure TForm1.ThreadTerminated(Sender: TObject);
var
  TimeElapsed: DWORD;
begin
  Threads.Remove(TMyThread(Sender));
  if Threads.Count > 0 then Exit;

  Timer1.Enabled := False;
  FreeAndNil(Threads);
  FreeAndNil(FileList);

  TimeElapsed := GetTickCount - TimeStart;

  if TimeElapsed < 1000 then
    ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
  else if TimeElapsed < (1000 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
  else if TimeElapsed < (1000 * 60 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
  else
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Cnt: Integer;
begin    
  EnterCriticalSection(CriticalSection);
  try
    Cnt := FileList.Count;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
  ProgressBar.Position := ProgressBar.Max - Cnt;
end;

why is threads blocked on critical section owned by thread XXXXX

1 Answers