View Issue Details

IDProjectCategoryView StatusLast Update
0036130FPCPatchpublic2020-01-08 17:23
ReporterAnton Kavalenka Assigned ToFlorian  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0036130: heaptrc: Improve tracing by printing actual module name (ether EXE or DLL)
DescriptionCurrently heaptrc prints the ParamStr(0) - i.e. the process path. When debugging process with lots of plugins (DLLs) which have their own heap mangers - often it is hard to determine - which one of them causes leak.

Proposed patch prints the actual module path, either for Linux and Windows regardless it is EXE or DLL. Not sure about BSD (but may work).
TagsNo tags attached.
Fixed in Revision43710
FPCOldBugId
FPCTarget-
Attached Files

Activities

Anton Kavalenka

2019-10-02 17:10

reporter  

heaptrc.diff (2,378 bytes)   
--- /projects/fpc/rtl/inc/heaptrc.pp	2019-09-27 20:17:33.308425224 +0300
+++ /projects/ext/ucdha4/heaptrc.pp	2019-10-02 18:01:19.979306195 +0300
@@ -12,7 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
+{$mode objfpc}
 {$checkpointer off}
 
 unit heaptrc;
@@ -1239,6 +1239,61 @@
   DumpHeap(GlobalSkipIfNoLeaks);
 end;
 
+const
+{$ifdef BSD}   // dlopen is in libc on FreeBSD.
+  LibDL = 'c';
+{$else}
+  {$ifdef HAIKU}
+    LibDL = 'root';
+  {$else}
+    LibDL = 'dl';
+  {$endif}
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+type
+  Pdl_info = ^dl_info;
+  dl_info = record
+    dli_fname      : Pchar;
+    dli_fbase      : pointer;
+    dli_sname      : Pchar;
+    dli_saddr      : pointer;
+  end;
+
+  function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; external LibDL name 'dladdr';
+{$elseif defined(MSWINDOWS)}
+  function _GetModuleFileNameA(hModule:HModule;lpFilename:PAnsiChar;nSize:cardinal):cardinal;stdcall; external 'kernel32' name 'GetModuleFileNameA';
+{$endif}
+
+function GetModuleName:string;
+var
+{$ifdef MSWINDOWS}
+  sz:cardinal;
+  buf:array[0..8191] of char;
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+  res:integer;
+  dli:dl_info;
+{$endif}
+begin
+  GetModuleName:='';
+  {$if defined(LINUX) or defined(BSD)}
+  res:=_dladdr(@ParamStr,@dli); { get any non-eliminated addres in SO space }
+  if (res<=0) then exit;
+  if Assigned(dli.dli_fname) then
+    GetModuleName:=PAnsiChar(dli.dli_fname);
+  {$endif}
+  {$if defined(MSWINDOWS)}
+  if (System.hInstance=0) then
+  begin
+    GetModuleName:=ParamStr(0);
+    exit;
+  end;
+  sz := _GetModuleFileNameA(hInstance,@buf,sizeof(buf));
+  if (sz>0) then
+    setstring(GetModuleName,PAnsiChar(@buf),sz)
+  {$endif}
+end;
+
 procedure dumpheap(SkipIfNoLeaks : Boolean);
 var
   pp : pheap_mem_info;
@@ -1256,7 +1311,7 @@
   pp:=loc_info^.heap_mem_root;
   if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
     exit;
-  Writeln(ptext^,'Heap dump by heaptrc unit of '+ParamStr(0));
+  Writeln(ptext^,'Heap dump by heaptrc unit of "'+GetModuleName()+'"');
   Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
     loc_info^.getmem_size,'/',loc_info^.getmem8_size);
   Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
heaptrc.diff (2,378 bytes)   

Tomas Hajny

2019-10-02 17:22

manager   ~0118253

The patch should contain the original functionality of referring to ParamStr(0) for platforms not covered by the new functionality, otherwise it causes a regression on those platforms. I might be able to provide an implementation for OS/2, but let's see (and obviously, there's still a bunch of other platforms)...

Anton Kavalenka

2019-10-02 17:31

reporter  

heaptrc1.diff (2,197 bytes)   
--- /projects/fpc/rtl/inc/heaptrc.pp	2019-09-27 20:17:33.308425224 +0300
+++ /projects/ext/ucdha4/heaptrc.pp	2019-10-02 18:30:11.259301126 +0300
@@ -1239,6 +1239,62 @@
   DumpHeap(GlobalSkipIfNoLeaks);
 end;
 
+const
+{$ifdef BSD}   // dlopen is in libc on FreeBSD.
+  LibDL = 'c';
+{$else}
+  {$ifdef HAIKU}
+    LibDL = 'root';
+  {$else}
+    LibDL = 'dl';
+  {$endif}
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+type
+  Pdl_info = ^dl_info;
+  dl_info = record
+    dli_fname      : Pchar;
+    dli_fbase      : pointer;
+    dli_sname      : Pchar;
+    dli_saddr      : pointer;
+  end;
+
+  function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; external LibDL name 'dladdr';
+{$elseif defined(MSWINDOWS)}
+  function _GetModuleFileNameA(hModule:HModule;lpFilename:PAnsiChar;nSize:cardinal):cardinal;stdcall; external 'kernel32' name 'GetModuleFileNameA';
+{$endif}
+
+function GetModuleName:string;
+var
+{$ifdef MSWINDOWS}
+  sz:cardinal;
+  buf:array[0..8191] of char;
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+  res:integer;
+  dli:dl_info;
+{$endif}
+begin
+  GetModuleName:='';
+  {$if defined(LINUX) or defined(BSD)}
+  res:=_dladdr(@ParamStr,@dli); { get any non-eliminated addres in SO space }
+  if (res<=0) then exit;
+  if Assigned(dli.dli_fname) then
+    GetModuleName:=PAnsiChar(dli.dli_fname);
+  {$elseif defined(MSWINDOWS)}
+  if (System.hInstance=0) then
+  begin
+    GetModuleName:=ParamStr(0);
+    exit;
+  end;
+  sz := _GetModuleFileNameA(hInstance,@buf,sizeof(buf));
+  if (sz>0) then
+    setstring(GetModuleName,PAnsiChar(@buf),sz)
+  {$else}
+  Result:=ParamStr(0);
+  {$endif}
+end;
+
 procedure dumpheap(SkipIfNoLeaks : Boolean);
 var
   pp : pheap_mem_info;
@@ -1256,7 +1312,7 @@
   pp:=loc_info^.heap_mem_root;
   if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
     exit;
-  Writeln(ptext^,'Heap dump by heaptrc unit of '+ParamStr(0));
+  Writeln(ptext^,'Heap dump by heaptrc unit of "'+GetModuleName()+'"');
   Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
     loc_info^.getmem_size,'/',loc_info^.getmem8_size);
   Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
heaptrc1.diff (2,197 bytes)   

Anton Kavalenka

2019-10-02 17:35

reporter   ~0118256

Last edited: 2019-10-02 17:35

View 2 revisions

even simpler windows handling ( OS/2 should be similar) in patch2

heaptrc2.diff (2,104 bytes)   
--- /projects/fpc/rtl/inc/heaptrc.pp	2019-09-27 20:17:33.308425224 +0300
+++ /projects/ext/ucdha4/heaptrc.pp	2019-10-02 18:34:08.475885539 +0300
@@ -1239,6 +1239,57 @@
   DumpHeap(GlobalSkipIfNoLeaks);
 end;
 
+const
+{$ifdef BSD}   // dlopen is in libc on FreeBSD.
+  LibDL = 'c';
+{$else}
+  {$ifdef HAIKU}
+    LibDL = 'root';
+  {$else}
+    LibDL = 'dl';
+  {$endif}
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+type
+  Pdl_info = ^dl_info;
+  dl_info = record
+    dli_fname      : Pchar;
+    dli_fbase      : pointer;
+    dli_sname      : Pchar;
+    dli_saddr      : pointer;
+  end;
+
+  function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; external LibDL name 'dladdr';
+{$elseif defined(MSWINDOWS)}
+  function _GetModuleFileNameA(hModule:HModule;lpFilename:PAnsiChar;nSize:cardinal):cardinal;stdcall; external 'kernel32' name 'GetModuleFileNameA';
+{$endif}
+
+function GetModuleName:string;
+var
+{$ifdef MSWINDOWS}
+  sz:cardinal;
+  buf:array[0..8191] of char;
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+  res:integer;
+  dli:dl_info;
+{$endif}
+begin
+  GetModuleName:='';
+  {$if defined(LINUX) or defined(BSD)}
+  res:=_dladdr(@ParamStr,@dli); { get any non-eliminated addres in SO space }
+  if (res<=0) then exit;
+  if Assigned(dli.dli_fname) then
+    GetModuleName:=PAnsiChar(dli.dli_fname);
+  {$elseif defined(MSWINDOWS)}
+  sz := _GetModuleFileNameA(hInstance,@buf,sizeof(buf));
+  if (sz>0) then
+    setstring(GetModuleName,PAnsiChar(@buf),sz)
+  {$else}
+  Result:=ParamStr(0);
+  {$endif}
+end;
+
 procedure dumpheap(SkipIfNoLeaks : Boolean);
 var
   pp : pheap_mem_info;
@@ -1256,7 +1307,7 @@
   pp:=loc_info^.heap_mem_root;
   if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
     exit;
-  Writeln(ptext^,'Heap dump by heaptrc unit of '+ParamStr(0));
+  Writeln(ptext^,'Heap dump by heaptrc unit of "'+GetModuleName()+'"');
   Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
     loc_info^.getmem_size,'/',loc_info^.getmem8_size);
   Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
heaptrc2.diff (2,104 bytes)   

Anton Kavalenka

2019-10-07 16:36

reporter   ~0118393

Patch fix for Windows. Tested under Windows and Linux.
Typical results looks like:

Heap dump by heaptrc unit of "p:\ext\ucdha4\dha4.dll"
385 memory blocks allocated : 17400/18016
385 memory blocks freed : 17400/18016
....

Heap dump by heaptrc unit of "/projects/ext/ucdha4/libdha4.so"
96892 memory blocks allocated : 6785884/7053728
96892 memory blocks freed : 6785884/7053728
...
heaptrc3.diff (2,266 bytes)   
Index: heaptrc.pp
===================================================================
--- heaptrc.pp	(revision 43144)
+++ heaptrc.pp	(working copy)
@@ -14,7 +14,6 @@
  **********************************************************************}
 
 {$checkpointer off}
-
 unit heaptrc;
 interface
 
@@ -1239,6 +1238,57 @@
   DumpHeap(GlobalSkipIfNoLeaks);
 end;
 
+const
+{$ifdef BSD}   // dlopen is in libc on FreeBSD.
+  LibDL = 'c';
+{$else}
+  {$ifdef HAIKU}
+    LibDL = 'root';
+  {$else}
+    LibDL = 'dl';
+  {$endif}
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+type
+  Pdl_info = ^dl_info;
+  dl_info = record
+    dli_fname      : Pchar;
+    dli_fbase      : pointer;
+    dli_sname      : Pchar;
+    dli_saddr      : pointer;
+  end;
+
+  function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; external LibDL name 'dladdr';
+{$elseif defined(MSWINDOWS)}
+  function _GetModuleFileNameA(hModule:HModule;lpFilename:PAnsiChar;nSize:cardinal):cardinal;stdcall; external 'kernel32' name 'GetModuleFileNameA';
+{$endif}
+
+function GetModuleName:string;
+var
+{$ifdef MSWINDOWS}
+  sz:cardinal;
+  buf:array[0..8191] of char;
+{$endif}
+{$if defined(LINUX) or defined(BSD)}
+  res:integer;
+  dli:dl_info;
+{$endif}
+begin
+  GetModuleName:='';
+  {$if defined(LINUX) or defined(BSD)}
+  res:=_dladdr(@ParamStr,@dli); { get any non-eliminated addres in SO space }
+  if (res<=0) then exit;
+  if Assigned(dli.dli_fname) then
+    GetModuleName:=PAnsiChar(dli.dli_fname);
+  {$elseif defined(MSWINDOWS)}
+  sz := _GetModuleFileNameA(hInstance,PChar(@buf),sizeof(buf));
+  if (sz>0) then
+    setstring(GetModuleName,PAnsiChar(@buf),sz)
+  {$else}
+  Result:=ParamStr(0);
+  {$endif}
+end;
+
 procedure dumpheap(SkipIfNoLeaks : Boolean);
 var
   pp : pheap_mem_info;
@@ -1256,7 +1306,7 @@
   pp:=loc_info^.heap_mem_root;
   if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
     exit;
-  Writeln(ptext^,'Heap dump by heaptrc unit of '+ParamStr(0));
+  Writeln(ptext^,'Heap dump by heaptrc unit of "'+GetModuleName()+'"');
   Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
     loc_info^.getmem_size,'/',loc_info^.getmem8_size);
   Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
heaptrc3.diff (2,266 bytes)   

Florian

2019-12-22 23:52

administrator   ~0120032

Thanks, applied.

Issue History

Date Modified Username Field Change
2019-10-02 17:10 Anton Kavalenka New Issue
2019-10-02 17:10 Anton Kavalenka File Added: heaptrc.diff
2019-10-02 17:22 Tomas Hajny Note Added: 0118253
2019-10-02 17:31 Anton Kavalenka File Added: heaptrc1.diff
2019-10-02 17:35 Anton Kavalenka File Added: heaptrc2.diff
2019-10-02 17:35 Anton Kavalenka Note Added: 0118256
2019-10-02 17:35 Anton Kavalenka Note Edited: 0118256 View Revisions
2019-10-07 16:36 Anton Kavalenka File Added: heaptrc3.diff
2019-10-07 16:36 Anton Kavalenka Note Added: 0118393
2019-12-22 23:52 Florian Assigned To => Florian
2019-12-22 23:52 Florian Status new => resolved
2019-12-22 23:52 Florian Resolution open => fixed
2019-12-22 23:52 Florian Fixed in Version => 3.3.1
2019-12-22 23:52 Florian Fixed in Revision => 43710
2019-12-22 23:52 Florian FPCTarget => -
2019-12-22 23:52 Florian Note Added: 0120032
2020-01-08 17:23 Anton Kavalenka Status resolved => closed