Delphi TMonitor.Wait multi-threading problem

We have run into this multi-threading problem in our backend services:

In a multi-threading Windows service app, with 30+ threads, problem in SysUtils.EventCache arise. The problem is that NewWaitObj function sometimes return NIL instead of Event object. This function is used in TMonitor sync methods Wait. TMonitor.Wait stops working when it get NIL for event object. That affects many VCL and RTL thread sync source code and it cause different side problems in multi-threading apps, for example TThreadedQueue.PopItem doesnt wait for new item to arrive in Queue and returns immediately with timeout result.

Problem occurs in NewWaitObj function:

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;

Looks like Pop function is not well protected in heavy multi-threaded app and at some number of concurrent threads it starts to return one and the same EventItem instance to two (or more) threads. Then race conditions are happening in NewWaitObj:

1. One thread takes EventItem.Event and return it as Result and zero it with NIL, the racing parallel thread is getting the same EventItem.Event but it is already cleared by first thread.
2. That cause one of racing threads to return valid Event handle and the other(s) racing threads return NIL.
3. TMonitor.Wait function doesnt work, because it get NIL as Event handle.
4. TThreadedQueue.PopItem doesnt wait, other sync methods also doesnt work correctly.

For some reason thread sync in Pop method doesnt work when app have many concurrent threads:

function Pop(var Stack: PEventItemHolder): PEventItemHolder;
begin
  repeat
    Result := Stack;
    if Result = nil then
      Exit;
  until AtomicCmpExchange(Pointer(Stack), Result.Next, Result) = Result;
end;

In test app on 60 test threads problem arise in about 10-20 secs, with 30 threads its much harder to happens, usually 5-10 mins are needed. Once problem occurs - it never stop until restart of App. In test app after thread sync get broken - about one of each 5 operations with EventCache return NIL. Looks like something get broken in AtomicCmpExchange, I've checked the generated code - it's just one CMPXCHG instruction and few more to setup registers. I am not quite sure what cause the problem - can one thread get intervention from other thread for example while it setups registers to call CMPXCHG or after the call while it process the results?

Trying to understand what cause the problem, so I can find best workaround. For now I am planning to replace original NewWaitObj with my own, which will just call the original version till it return valid object. This problem occurs constantly in our dev, test and prod environments, for real middle-ware services on production servers it's needed few hours (sometimes couple of days) for problem to arise, after that only restart fix the problem. Test app can be downloaded from issue in Embarcadero JIRA: https://quality.embarcadero.com/browse/RSP-31154

EDIT: TestApp: https://quality.embarcadero.com/secure/attachment/31605/EventCacheBug.zip

Example Delphi source code:

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.

Thanks for any ideas,