Multithreading Delphi TMonitor。等待多线程问题

我们在后端服务中遇到了这个多线程问题：

在具有30多个线程的多线程Windows服务应用程序中，SysUtils.EventCache出现问题。问题是NewWaitObj函数有时返回NIL而不是事件对象。此功能用于t监视同步方法等待TMonitor.Wait在事件对象为零时停止工作。这会影响许多VCL和RTL线程同步源代码，并在多线程应用程序中导致不同的副问题，例如TThreadedQueue。PopItem不会等待新项目到达队列，并立即返回超时结果

NewWaitObj函数中出现问题：

function NewWaitObj: Pointer;
var
  EventItem: PEventItemHolder;
begin
  EventItem := Pop(EventCache);
  if EventItem <> nil then
  begin
    Result := EventItem.Event;
    EventItem.Event := nil;
    Push(EventItemHolders, EventItem);
  end else
    Result := NewSyncWaitObj;
  ResetSyncWaitObj(Result);
end;

在60个测试线程上的测试应用程序中，问题大约在10-20秒内出现，30个线程更难发生，通常需要5-10分钟。一旦出现问题-它永远不会停止，直到重新启动应用程序。在测试应用程序中，线程同步中断后-使用EventCache返回NIL时，大约每5次操作中就有一次。看起来有什么东西在原子CMPExchange中被破坏了，我已经检查了生成的代码-它只是一条CMPXCHG指令，还有几条用于设置寄存器。我不太确定问题的原因是什么-例如，当一个线程设置寄存器调用CMPXCHG时，或者在调用后处理结果时，是否可以从其他线程获得干预

试图了解问题的原因，以便找到最佳解决方法。现在我计划用我自己的替换原始的NewWaitObj，它只调用原始版本，直到它返回有效的对象。这个问题在我们的开发、测试和生产环境中经常出现，对于生产服务器上的真正的中间件服务来说，需要几个小时（有时几天）才能出现问题，然后重新启动才能修复问题。 测试应用程序可从Embarcadero JIRA的发行版下载：

编辑：TestApp:

Delphi源代码示例：

unit FormMainEventCacheBugU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.StdCtrls;

const
   MaxProducers = 60;

type
  TFormEventCacheBug = class(TForm)
    BtnMaxProducers: TButton;
    BtnRemoveProducer: TButton;
    BtnAddProducer: TButton;
    procedure BtnMaxProducersClick(Sender: TObject);
    procedure BtnRemoveProducerClick(Sender: TObject);
    procedure BtnAddProducerClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

   TEventEater = class(TThread)
   private
      SleepTime: Integer;
      SMsg, EMsg, NMsg: PChar;
      procedure EatEvent;
   protected
      procedure Execute; override;
   public
      constructor Create;
   end;

var
  FormEventCacheBug: TFormEventCacheBug;
  Producers: array[1..MaxProducers] of TThread;
  ProdCount: Integer;

implementation

{$R *.dfm}

procedure AddProducer;
begin
   if ProdCount < MaxProducers then
   begin
      Inc(ProdCount);
      Producers[ProdCount] := TEventEater.Create;
      Producers[ProdCount].FreeOnTerminate := True;
   end;
end;

procedure RemoveProducer;
begin
   if ProdCount > 0 then
   begin
      Producers[ProdCount].Terminate;
      Dec(ProdCount);
   end;
end;

{ TEventEater }

constructor TEventEater.Create;
begin
   inherited Create(False);
   SleepTime := RandomRange(1, 3);
end;

procedure TEventEater.EatEvent;
var
   EventHandle: Pointer;
begin
   //OutputDebugString(SMsg);
   EventHandle := System.MonitorSupport.NewWaitObject;
   try
      if EventHandle = nil then
         OutputDebugString('NIL');
      Sleep(SleepTime);
   finally
      if EventHandle <> nil then
         System.MonitorSupport.FreeWaitObject(EventHandle);
//      OutputDebugString(EMsg);
   end;
end;

procedure TEventEater.Execute;
begin
   SMsg := PChar('S:' + GetCurrentThreadId.ToString);
   EMsg := PChar('E:' + GetCurrentThreadId.ToString);
   NMsg := PChar('NIL:' + GetCurrentThreadId.ToString);
   while not Terminated do
   begin
      EatEvent;
      Sleep(SleepTime);
   end;
end;

procedure TFormEventCacheBug.BtnAddProducerClick(Sender: TObject);
begin
   AddProducer;
end;

procedure TFormEventCacheBug.BtnRemoveProducerClick(Sender: TObject);
begin
   RemoveProducer;
end;

procedure TFormEventCacheBug.BtnMaxProducersClick(Sender: TObject);
var
   i: Integer;
begin
   for i := ProdCount + 1 to MaxProducers do
      AddProducer;
end;

end.

mainEventCacheBugu的单位；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
控件、窗体、对话框、数学、StdCtrls；
常数
最大值=60；
类型
TFormEventCacheBug=类（TForm）
BTN生产商：TButton；
BtnRemoveProducer:TButton；
BtnAddProducer:t按钮；
过程BTNMExproducersClick（发件人：ToObject）；
程序BtnRemoveProducerClick（发送方：ToObject）；
程序BtnAddProducerClick（发送方：TObject）；
私有的
{私有声明}
公众的
{公开声明}
结束；
Tevenater=class（TThread）
私有的
睡眠时间：整数；
SMsg、EMsg、NMsg:PChar；
排气程序；
受保护的
程序执行；推翻
公众的
构造函数创建；
结束；
变量
FormEventCacheBug:TFormEventCacheBug；
生产者：TThread的数组[1..MaxProducers]；
ProdCount：整数；
实施
{$R*.dfm}
生产程序；
开始
如果ProdCount0，则
开始
生产者[ProdCount]。终止；
12月（产品计数）；
结束；
结束；
{Teventeter}
构造函数teventeter.Create；
开始
继承创建（False）；
睡眠时间：=随机范围（1,3）；
结束；
程序TEVENTATER.EatEvent；
变量
EventHandle：指针；
开始
//OutputDebugString（SMsg）；
EventHandle:=System.MonitorSupport.NewWaitObject；
尝试
如果EventHandle=nil，则
OutputDebugString（'NIL'）；
睡眠（睡眠时间）；
最后
如果EventHandle为零，则
System.MonitorSupport.FreeWaitObject（EventHandle）；
//OutputDebugString（EMsg）；
结束；
结束；
程序teventeter.Execute；
开始
SMsg:=PChar（'S:'+GetCurrentThreadId.ToString）；
EMsg:=PChar（'E:'+GetCurrentThreadId.ToString）；
NMsg:=PChar（'NIL:'+GetCurrentThreadId.ToString）；
虽然没有终止
开始
食道；
睡眠（睡眠时间）；
结束；
结束；
程序TFormEventCacheBug.BtnAddProducerClick（发送方：ToObject）；
开始
生产商；
结束；
过程TFormEventCacheBug.BtnRemoveProducerClick（发送方：ToObject）；
开始
去除生产者；
结束；
过程TFormEventCacheBug.btnExproducersClick（发送方：ToObject）；
变量
i：整数；
开始
对于i:=ProdCount+1到MaxProducers do
生产商；
结束；
结束。

---

谢谢你的建议，

@MiroslavPenchev，谢谢你的帖子！ 在XE2中工作，并且有类似的问题。 Delphi 10.4.1使用带有计数器和128位比较交换的链表头解决了TMMonitor ABA问题。 不幸的是，对于XE2来说，这不是一个容易的选择

再次感谢您的建议，覆盖一些调用原始方法的MonitorSupport方法

下面是我正在使用的解决方案。它并不是100%完美的，因为它涉及到锁定，但对于并发性较差的环境，它至少使系统稳定并且没有100%的CPU问题

var
MonitorSupportFix:TMonitorSupport；
OldMonitorSupport:PMonitorSupport；
NewWaitObjCS:TCriticalSection；
函数NewWaitObjFix：指针；
开始
如果已分配（NewWaitObjCS），则
NewWaitObjCS.Enter；
尝试
结果：=OldMonitorSupport.NewWaitObject；
最后
如果已分配（NewWaitObjCS），则
离开；
结束；
结束；
过程FreeWaitObjFix（WaitObject:Pointer）；
开始
如果已分配（NewWaitObjCS），则
NewWaitObjCS.Enter；
尝试
OldMonitorSupport.FreeWaitObject（WaitObject）；
最后
如果已分配（NewWaitObjCS），则
离开；
结束；
结束；
程序InitMonitorSupportFix；
开始
OldMonitorSupport:=System.MonitorSupport；
MonitorSupportFix:=OldMonitorSupport^；
MonitorSupportFix.NewWaitObject：=
unit FormMainEventCacheBugU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.StdCtrls;

const
   MaxProducers = 60;

type
  TFormEventCacheBug = class(TForm)
    BtnMaxProducers: TButton;
    BtnRemoveProducer: TButton;
    BtnAddProducer: TButton;
    procedure BtnMaxProducersClick(Sender: TObject);
    procedure BtnRemoveProducerClick(Sender: TObject);
    procedure BtnAddProducerClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

   TEventEater = class(TThread)
   private
      SleepTime: Integer;
      SMsg, EMsg, NMsg: PChar;
      procedure EatEvent;
   protected
      procedure Execute; override;
   public
      constructor Create;
   end;

var
  FormEventCacheBug: TFormEventCacheBug;
  Producers: array[1..MaxProducers] of TThread;
  ProdCount: Integer;

implementation

{$R *.dfm}

procedure AddProducer;
begin
   if ProdCount < MaxProducers then
   begin
      Inc(ProdCount);
      Producers[ProdCount] := TEventEater.Create;
      Producers[ProdCount].FreeOnTerminate := True;
   end;
end;

procedure RemoveProducer;
begin
   if ProdCount > 0 then
   begin
      Producers[ProdCount].Terminate;
      Dec(ProdCount);
   end;
end;

{ TEventEater }

constructor TEventEater.Create;
begin
   inherited Create(False);
   SleepTime := RandomRange(1, 3);
end;

procedure TEventEater.EatEvent;
var
   EventHandle: Pointer;
begin
   //OutputDebugString(SMsg);
   EventHandle := System.MonitorSupport.NewWaitObject;
   try
      if EventHandle = nil then
         OutputDebugString('NIL');
      Sleep(SleepTime);
   finally
      if EventHandle <> nil then
         System.MonitorSupport.FreeWaitObject(EventHandle);
//      OutputDebugString(EMsg);
   end;
end;

procedure TEventEater.Execute;
begin
   SMsg := PChar('S:' + GetCurrentThreadId.ToString);
   EMsg := PChar('E:' + GetCurrentThreadId.ToString);
   NMsg := PChar('NIL:' + GetCurrentThreadId.ToString);
   while not Terminated do
   begin
      EatEvent;
      Sleep(SleepTime);
   end;
end;

procedure TFormEventCacheBug.BtnAddProducerClick(Sender: TObject);
begin
   AddProducer;
end;

procedure TFormEventCacheBug.BtnRemoveProducerClick(Sender: TObject);
begin
   RemoveProducer;
end;

procedure TFormEventCacheBug.BtnMaxProducersClick(Sender: TObject);
var
   i: Integer;
begin
   for i := ProdCount + 1 to MaxProducers do
      AddProducer;
end;

end.