[fpc-pascal] extreme memory growth using cthreads and default heap manager

[Seth Grover]

I am experiencing a weird issue regarding threading and shared libraries
under Linux. I've boiled it down to a very simple test case in hopes you
can help me understand what I'm doing wrong.

I'm running this test with FPC 3.0 (built from source) on x86_64 Debian
Linux.

First, I have this shared library:

===========================================================================
library fpcso1;

{$mode objfpc}{$H+}

uses
  cthreads,
  // cmem,
  SysUtils;

procedure Blow; cdecl;
var
  p : pbyte;
begin
  p := GetMem(1024);
  FreeMem(p);
  p := nil;
end;

exports
  Blow name 'fpcso1_blow';

end.
===========================================================================

It is used by this program:
===========================================================================
program fpcprog;

{$mode objfpc}{$H+}

uses
  cthreads,
  cmem,
  Classes,
  SysUtils,
  DateUtils;

const
  lib1Name = 'libfpcso1.so';

procedure fpcso1_blow; cdecl; external lib1Name;

var
  finishedThreads : longint = 0;
  runningThreads : longint = 0;
  startedThreads : longint = 0;

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

  constructor TTestThread.Create;
  begin
    inherited Create(true, 1024*1024);
    FreeOnTerminate := true;
  end;

  procedure TTestThread.Execute;
  begin
    InterLockedIncrement(runningThreads);
    try
      fpcso1_blow();
    finally
      InterLockedIncrement(finishedThreads);
      InterLockedDecrement(runningThreads);
    end;
  end;

procedure BeginTestThread();
var
  tmpThread : TTestThread;
begin
  tmpThread := TTestThread.Create();
  tmpThread.Start;
end;

const
  threadCount = 100000;
  threadMaxConcurrent = 30;
var
  lastTime : TDateTime;
  lastCount : longint = 0;
begin
  lastCount := 0;
  lastTime := now;
  while (startedThreads < threadCount) do begin
    if (runningThreads < threadMaxConcurrent) then begin
      InterLockedIncrement(startedThreads);
      BeginTestThread();
    end else begin
      sleep(1);
    end;
    if MilliSecondsBetween(lastTime, now) >= 1000 then begin
      writeln(runningThreads, ' threads runningThreads, ',
                finishedThreads, ' threads finished (',
                finishedThreads-lastCount, '/sec)');
      lastCount := finishedThreads;
      lastTime := now;
    end;
  end;
  while (runningThreads > 0) do begin
    sleep(1000);
    writeln(runningThreads, ' threads runningThreads, ', finishedThreads,
              ' threads finished (', finishedThreads-lastCount, '/sec)');
    lastCount := finishedThreads;
  end;
  sleep(1000);
  writeln(runningThreads, ' threads runningThreads, ',
            finishedThreads, ' threads finished');

end.
===========================================================================

When I execute the program, over the course of the ten seconds it takes
to run, I watch the process' memory usage grow to over a gigabyte:

 1s  235.81 MiB
 2s  351.34 MiB
 3s  463.64 MiB
 4s  575.35 MiB
 5s  688.54 MiB
 6s  799.47 MiB
 7s  916.26 MiB
 8s    1.01 GiB
 9s    1.12 GiB
10s    1.15 GiB

However, if I uncomment the "// cmem," line in the library, the memory does
not grow.

Why does using the default memory manager seem to leak memory like crazy if
I'm doing heavy threading? I'm setting FreeOnTerminate to true in
conjunction
with creating the thread suspended, then calling Start, which the
examples in the wiki and documentation seems to indicate is valid.

Is cmem *required* if I'm using threading on Linux? I hope not, because
while this example is boiled down to as simple as I could make it, I'm
having the same issue in my production application, in which I'm using my
own power-of-two memory manager, and I would really like to figure out
what I can do to continue to use my own memory manager, plus threading,
without it leaking so much memory for every thread that starts/finishes.

Thanks,

-Seth Grover
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20151210/b136e4f1/attachment.html>