Crash with lots of threads on x64 executable

[obones]

Hello,

We are developing a massively parallel application and are hitting the limits of the default Delphi memory allocator in this situation. As a result, we are investigating replacements for which BrainMM appears to be a very promising candidate. However, we are hitting an issue where we get InvalidPtr exceptions in the x64 version of our application. We narrowed it down to the following command line application:

program BrainMMTest;

{$APPTYPE CONSOLE}

uses
  BrainMM,
  System.Diagnostics,
  System.TimeSpan,
  System.SysUtils,
  System.Classes,
  System.Generics.Collections,
  Winapi.Windows;

{$R *.res}

type
  TTestThread = class(TThread)
  public
    procedure Execute; override;
  end;

var
  Stopwatch: TStopwatch;
  Elapsed: TTimeSpan;
  ThreadList: TList<TThread>;
  Threads: array of TTestThread;
  iGlobal: Integer;

const
  C_StrL = 16351;

{ TTestThread }

procedure TTestThread.Execute;
var
  CurrentStringList: TStringList;
  i: Integer;
  CurrentString: string;
begin
  CurrentStringList := TStringList.Create;
  try
    for I := 1 to 1571000 do
    begin
      SetLength(CurrentString, C_StrL);
      SetLength(CurrentString, 0);
      CurrentStringList.Add(IntToStr(Random(i)) + 'bob' + IntToStr(Random(i)));
    end;
  finally
    CurrentStringList.Free;
  end;
end;

begin
  try
    Stopwatch := TStopwatch.StartNew;

    SetLength(Threads, 40); // highly parallel
    ThreadList := TList<TThread>.Create;
    try
      for iGlobal := Low(Threads) to High(Threads) do
      begin
        Threads[iGlobal] := TTestThread.Create;
        ThreadList.Add(Threads[iGlobal]);
      end;

      while ThreadList.Count > 0 do
      begin
        if ThreadList[0].WaitFor = WAIT_OBJECT_0 then
          ThreadList.Delete(0);
        Sleep(10);
      end;
    finally
      ThreadList.Free;
    end;

    Elapsed := Stopwatch.Elapsed;
    Writeln(Format('BrainMM took %n milliseconds', [Elapsed.TotalMilliseconds]));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.

In 32bits mode, either debug or release, it works fine and takes about 15s on my computer.

In 64bits mode, either debug or release, it rarely works in which case it takes about 7s. But most often, and even more so when run via the IDE (Delphi Seattle) it crashes almost immediately.

Looking at the call stack, the exception is raised by RaiseInvalidPtr from ResizeDifficult itself being called by BrainMMReallocMem which seems quite logical as the program above does a lot of memory reallocation.

Fiddling with different options, we discovered that defining PUREPASCAL at the top of the BrainMM unit makes the error disappear, which hints that the issue may be in the x64 version of the assembly code for BrainMMReallocMem.

However, we were not able to figure out what's wrong in that code, it's a bit too difficult for us to understand, let alone offer a fix.

Any suggestion would be most welcome.

[obones]

As the test program above no longer crashed, we decided to try the PUREPASCAL mode inside our real application, but sadly it does not solve the issue completely, the exception is raised from the same location but at a less frequent pace.