Delphi распараллеливает мертвую блокировку

Регистрация сообщений - это лишь одна из тех областей, где 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 для вызова события уведомления в основном потоке, но не более нескольких десятков раз в секунду.