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
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
