paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 10:48:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ensure that the heaptrc unit can be used on Linux and BSD without linking against the C library

Browse Source
This commit is contained in:
Sven/Sarah Barth 2022-06-15 22:55:13 +02:00
parent c3f27a2f1c
commit ae346a87a1
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
rtl/inc/heaptrc.pp
View File

@ -1260,7 +1260,7 @@ type
dli_saddr : pointer;
end;
function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; external LibDL name 'dladdr';
function _dladdr(Lib:pointer; info: Pdl_info): Longint; cdecl; weakexternal LibDL name 'dladdr';
{$elseif defined(MSWINDOWS)}
function _GetModuleFileNameA(hModule:HModule;lpFilename:PAnsiChar;nSize:cardinal):cardinal;stdcall; external 'kernel32' name 'GetModuleFileNameA';
{$endif}
@ -1279,11 +1279,16 @@ var
begin
GetModuleName:='';
{$if defined(LINUX) or defined(BSD)}
res:=_dladdr(@ParamStr,@dli); { get any non-eliminated address in SO space }
if res<=0 then
exit;
if Assigned(dli.dli_fname) then
GetModuleName:=PAnsiChar(dli.dli_fname);
if assigned(@_dladdr) then
begin
res:=_dladdr(@ParamStr,@dli); { get any non-eliminated address in SO space }
if res<=0 then
exit;
if Assigned(dli.dli_fname) then
GetModuleName:=PAnsiChar(dli.dli_fname);
end
else
GetModuleName:=ParamStr(0);
{$elseif defined(MSWINDOWS)}
sz:=_GetModuleFileNameA(hInstance,PChar(@buf),sizeof(buf));
if sz>0 then