paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 23:21:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix lineinfo problems for BeOS/Haiku

Browse Source 
git-svn-id: trunk@19760 -
This commit is contained in:
pierre 2011-12-05 16:29:43 +00:00
parent 040c846fa1
commit ceffd8b8cc
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/inc/exeinfo.pp
View File

@ -815,7 +815,8 @@ const
B_LIBRARY_IMAGE = 2;
B_ADD_ON_IMAGE = 3;
B_SYSTEM_IMAGE = 4;
B_OK = 0;
type
image_info = packed record
id : image_id;
@ -848,13 +849,20 @@ var
begin
// The only BeOS specific part is setting the processaddress
cookie := 0;
OpenElf32Beos:=false;
fillchar(info, sizeof(image_info), 0);
get_next_image_info(0,cookie,info,sizeof(info));
if (info._type = B_APP_IMAGE) then
e.processaddress := cardinal(info.text)
else
e.processaddress := 0;
OpenElf32Beos := OpenElf(e);
while get_next_image_info(0,cookie,info,sizeof(info))=B_OK do
begin
if e.filename=String(pchar(@info.name)) then
begin
if (info._type = B_APP_IMAGE) then
e.processaddress := cardinal(info.text)
else
e.processaddress := 0;
OpenElf32Beos := OpenElf(e);
exit;
end;
end;
end;
{$endif beos}

7
rtl/inc/lineinfo.pp
View File

@ -96,7 +96,12 @@ begin
if not OpenExeFile(e,dbgfn) then
exit;
end;
e.processaddress:=ptruint(baseaddr)-e.processaddress;
{$ifdef BeOS}
{ Do not change ProcessAddress field for BeOS/Haiku
if baseAddr is lower than ProcessAdress }
if ptruint(baseaddr)>ptruint(e.processaddress) then
{$endif BeOS}
e.processaddress:=ptruint(baseaddr)-e.processaddress;
StabsFunctionRelative := E.FunctionRelative;
if FindExeSection(e,'.stab',stabofs,stablen) and
FindExeSection(e,'.stabstr',stabstrofs,stabstrlen) then