Delphi 线程死锁

Question

我在销毁某些线程时有时会遇到死锁问题。我已经尝试调试问题，但在 IDE 中调试时似乎永远不会出现死锁，这可能是因为 IDE 中的事件速度低。

问题:

主线程在应用程序启动时创建多个线程。线程始终处于事件状态并与主线程同步。完全没有问题。当应用程序结束 (mainform.onclose) 时，线程会被销毁，如下所示:

thread1.terminate;
thread1.waitfor;
thread1.free;

等等。

但有时其中一个线程(使用同步将一些字符串记录到备忘录中)会在关闭时锁定整个应用程序。我怀疑当我调用 waitform 时线程正在同步并且发生了harmaggeddon，但这只是一个猜测，因为调试时从未发生死锁(或者我一直无法重现它)。有什么建议吗？

Answer 1

记录消息只是 Synchronize() 的领域之一没有任何意义。您应该改为创建一个日志目标对象，该对象具有一个字符串列表，受临界区保护，并将您的日志消息添加到其中。让主 VCL 线程从该列表中删除日志消息，并在日志窗口中显示它们。这有几个优点:

您不需要拨打Synchronize() ，这只是一个坏主意。好的副作用是你的那种关机问题消失了。

工作线程可以继续工作，而不会阻塞主线程事件处理，或阻塞其他试图记录消息的线程。

性能提高，因为可以一次性将多条消息添加到日志窗口。如果您使用 BeginUpdate()和 EndUpdate()这将加快速度。

我没有看到任何缺点 - 日志消息的顺序也被保留。

编辑:

我将添加一些更多的信息和一些代码来使用，以说明有更好的方法来做你需要做的事情。

调用 Synchronize()来自与 VCL 程序中的主应用程序线程不同的线程将导致调用线程阻塞，传递的代码将在 VCL 线程的上下文中执行，然后调用线程将被解除阻塞并继续运行。在单处理器机器时代，这可能是一个好主意，无论如何一次只能运行一个线程，但是对于多个处理器或内核，这是一种巨大的浪费，应该不惜一切代价避免。如果您在 8 核机器上有 8 个工作线程，请让它们调用 Synchronize()可能会将吞吐量限制为可能的一小部分。

实际上，拨打 Synchronize()从来都不是一个好主意，因为它可能导致僵局。永远不要使用它的另一个令人信服的理由。

使用 PostMessage()发送日志消息将解决死锁问题，但它有其自身的问题:

每个日志字符串都会导致一条消息被发布和处理，造成很大的开销。无法一次性处理多个日志消息。

Windows 消息只能在参数中携带机器字大小的数据。因此，发送字符串是不可能的。在类型转换后发送字符串到 PChar是不安全的，因为在处理消息时字符串可能已被释放。在工作线程中分配内存并在处理消息后在 VCL 线程中释放该内存是一种出路。一种增加更多开销的方法。

Windows 中的消息队列的大小是有限的。发布过多的消息会导致队列变满并丢弃消息。这不是一件好事，再加上前面的一点，它会导致内存泄漏。

在生成任何计时器或绘制消息之前，将处理队列中的所有消息。因此，源源不断地发布许多消息可能会导致程序无响应。

收集日志消息的数据结构可能如下所示:

type
  TLogTarget = class(TObject)
  private
    fCritSect: TCriticalSection;
    fMsgs: TStrings;
  public
    constructor Create;
    destructor Destroy; override;

    procedure GetLoggedMsgs(AMsgs: TStrings);
    procedure LogMessage(const AMsg: string);
  end;

constructor TLogTarget.Create;
begin
  inherited;
  fCritSect := TCriticalSection.Create;
  fMsgs := TStringList.Create;
end;

destructor TLogTarget.Destroy;
begin
  fMsgs.Free;
  fCritSect.Free;
  inherited;
end;

procedure TLogTarget.GetLoggedMsgs(AMsgs: TStrings);
begin
  if AMsgs <> nil then begin
    fCritSect.Enter;
    try
      AMsgs.Assign(fMsgs);
      fMsgs.Clear;
    finally
      fCritSect.Leave;
    end;
  end;
end;

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
  finally
    fCritSect.Leave;
  end;
end;

多线程可以拨打LogMessage()同时，进入临界区将序列化对列表的访问，并且在添加他们的消息后，线程可以继续他们的工作。

这就留下了 VCL 线程如何知道何时调用 GetLoggedMsgs() 的问题。从对象中删除消息并将它们添加到窗口中。一个穷人的版本是有一个计时器和民意调查。更好的方法是调用 PostMessage()添加日志消息时:

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
    PostMessage(fNotificationHandle, WM_USER, 0, 0);
  finally
    fCritSect.Leave;
  end;
end;

这仍然存在发布消息过多的问题。只有在处理完前一条消息后，才需要发布一条消息:

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
    if InterlockedExchange(fMessagePosted, 1) = 0 then
      PostMessage(fNotificationHandle, WM_USER, 0, 0);
  finally
    fCritSect.Leave;
  end;
end;

不过，这仍然可以改进。使用计时器解决了发布消息填满队列的问题。下面是一个实现这个的小类:

type
  TMainThreadNotification = class(TObject)
  private
    fNotificationMsg: Cardinal;
    fNotificationRequest: integer;
    fNotificationWnd: HWND;
    fOnNotify: TNotifyEvent;
    procedure DoNotify;
    procedure NotificationWndMethod(var AMsg: TMessage);
  public
    constructor Create;
    destructor Destroy; override;

    procedure RequestNotification;
  public
    property OnNotify: TNotifyEvent read fOnNotify write fOnNotify;
  end;

constructor TMainThreadNotification.Create;
begin
  inherited Create;
  fNotificationMsg := RegisterWindowMessage('thrd_notification_msg');
  fNotificationRequest := -1;
  fNotificationWnd := AllocateHWnd(NotificationWndMethod);
end;

destructor TMainThreadNotification.Destroy;
begin
  if IsWindow(fNotificationWnd) then
    DeallocateHWnd(fNotificationWnd);
  inherited Destroy;
end;

procedure TMainThreadNotification.DoNotify;
begin
  if Assigned(fOnNotify) then
    fOnNotify(Self);
end;

procedure TMainThreadNotification.NotificationWndMethod(var AMsg: TMessage);
begin
  if AMsg.Msg = fNotificationMsg then begin
    SetTimer(fNotificationWnd, 42, 10, nil);
    // set to 0, so no new message will be posted
    InterlockedExchange(fNotificationRequest, 0);
    DoNotify;
    AMsg.Result := 1;
  end else if AMsg.Msg = WM_TIMER then begin
    if InterlockedExchange(fNotificationRequest, 0) = 0 then begin
      // set to -1, so new message can be posted
      InterlockedExchange(fNotificationRequest, -1);
      // and kill timer
      KillTimer(fNotificationWnd, 42);
    end else begin
      // new notifications have been requested - keep timer enabled
      DoNotify;
    end;
    AMsg.Result := 1;
  end else begin
    with AMsg do
      Result := DefWindowProc(fNotificationWnd, Msg, WParam, LParam);
  end;
end;

procedure TMainThreadNotification.RequestNotification;
begin
  if IsWindow(fNotificationWnd) then begin
    if InterlockedIncrement(fNotificationRequest) = 0 then
     PostMessage(fNotificationWnd, fNotificationMsg, 0, 0);
  end;
end;

可以将类的实例添加到 TLogTarget , 在主线程中调用一个通知事件，但最多每秒几十次。