View Issue Details

IDProjectCategoryView StatusLast Update
0036130FPCPatchpublic2019-10-07 16:36
ReporterAnton KavalenkaAssigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version3.3.1Product Build 
Target VersionFixed in Version 
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 Revision
FPCOldBugId
FPCTarget
Attached Files
  • 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)
  • 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)
  • 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)
  • 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)

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)

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