+ proper handling of lineinfo retrival for dyn. libs in unix

git-svn-id: trunk@11010 -

rtl/inc/exeinfo.pp

@@ -48,7 +48,6 @@ function ReadDebugLink(var e:TExeFile;var dbgfn:string):boolean;
 
 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
 
-
 implementation
 
 uses
@@ -56,21 +55,15 @@ uses
 
 {$ifdef unix}
 
-  var
-    dlinfo: dl_info;
-
   procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
     begin
-      baseaddr:= nil;
+      if assigned(UnixGetModuleByAddrHook) then
-      filename:=ParamStr(0);
+        UnixGetModuleByAddrHook(addr,baseaddr,filename)
-      {
+      else
-      FillChar(dlinfo, sizeof(dlinfo), 0);
+        begin
-      dladdr(addr, @dlinfo);
+          baseaddr:=nil;
-      baseaddr:= dlinfo.dli_fbase;
+          filename:=ParamStr(0);
-      filename:= String(dlinfo.dli_fname);
+        end;
-      if ExtractFileName(filename) = ExtractFileName(ParamStr(0)) then
-        baseaddr:= nil;
-      }
     end;
 
 {$else unix}

rtl/inc/lineinfo.pp

@@ -24,7 +24,6 @@ interface
 
 function GetLineInfo(addr:ptruint;var func,source:string;var line:longint) : boolean;
 
-
 implementation
 
 uses
@@ -85,11 +84,9 @@ begin
 
   GetModuleByAddr(addr,baseaddr,filename);
 {$ifdef DEBUG_LINEINFO}
-  writeln(stderr,filename);
+  writeln(stderr,filename,' Baseaddr: ',hexstr(ptruint(baseaddr),sizeof(baseaddr)*2));
 {$endif DEBUG_LINEINFO}
 
-  e.processaddress:=e.processaddress-dword(baseaddr);
-
   if not OpenExeFile(e,filename) then
     exit;
   if ReadDebugLink(e,dbgfn) then
@@ -98,6 +95,7 @@ begin
       if not OpenExeFile(e,dbgfn) then
         exit;
     end;
+  e.processaddress:=e.processaddress+dword(baseaddr);
   StabsFunctionRelative := E.FunctionRelative;
   if FindExeSection(e,'.stab',stabofs,stablen) and
      FindExeSection(e,'.stabstr',stabstrofs,stabstrlen) then
@@ -146,6 +144,10 @@ begin
   { processaddress is set in OpenStabs                   }
   addr := addr - e.processaddress;
 
+{$ifdef DEBUG_LINEINFO}
+  writeln(stderr,'Addr: ',hexstr(addr,sizeof(addr)*2));
+{$endif DEBUG_LINEINFO}
+
   fillchar(funcstab,sizeof(tstab),0);
   fillchar(filestab,sizeof(tstab),0);
   fillchar(dirstab,sizeof(tstab),0);

rtl/inc/lnfodwrf.pp

@@ -141,10 +141,9 @@ begin
 
   GetModuleByAddr(addr,baseaddr,filename);
 {$ifdef DEBUG_LINEINFO}
-  writeln(stderr,filename);
+  writeln(stderr,filename,' Baseaddr: ',hexstr(ptruint(baseaddr),sizeof(baseaddr)*2));
 {$endif DEBUG_LINEINFO}
 
-  e.processaddress:=e.processaddress-dword(baseaddr);
   if not OpenExeFile(e,filename) then
     exit;
   if ReadDebugLink(e,dbgfn) then
@@ -153,6 +152,9 @@ begin
       if not OpenExeFile(e,dbgfn) then
         exit;
     end;
+
+  e.processaddress:=e.processaddress+dword(baseaddr);
+
   if FindExeSection(e,'.debug_line',dwarfoffset,dwarfsize) then
     Opendwarf:=true
   else
@@ -694,6 +696,8 @@ begin
       exit;
    end;
 
+  addr := addr - e.processaddress;
+
   current_offset := DwarfOffset;
   end_offset := DwarfOffset + DwarfSize;
 

rtl/unix/dl.pp

@@ -1,11 +1,25 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2008 by the Free Pascal development team
+
+    This file implements dyn. lib calls calls for Unix
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 unit dl;
 
 interface
 
 const
- {$ifdef BSD}   // dlopen is in libc on FreeBSD.
+{$ifdef BSD}   // dlopen is in libc on FreeBSD.
   LibDL = 'c';
- {$else}
+{$else}
   LibDL = 'dl';
 {$endif}
 
@@ -19,18 +33,17 @@ const
   RTLD_BINDING_MASK = $003;
   RTLD_GLOBAL       = $100;
   RTLD_NEXT         = pointer(-1);
-  {$ifdef LINUX}
+{$ifdef LINUX}
   RTLD_DEFAULT      = nil;
-  {$endif}
+{$endif}
-  {$ifdef BSD}
+{$ifdef BSD}
   RTLD_DEFAULT      = pointer(-2);
   RTLD_MODEMASK     = RTLD_BINDING_MASK;
-  {$endif}
+{$endif}
 
 type
   Pdl_info = ^dl_info;
-  dl_info =
+  dl_info = record
-  record
     dli_fname      : Pchar;
     dli_fbase      : pointer;
     dli_sname      : Pchar;
@@ -48,4 +61,36 @@ function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; external;
 
 implementation
 
+  function PosLastSlash(const s : string) : longint;
+    var
+      i : longint;
+    begin 
+      PosLastSlash:=0;
+      for i:=1 to length(s) do
+        if s[i]='/' then
+          PosLastSlash:=i;
+    end;
+    
+    
+  function SimpleExtractFilename(const s : string) : string;
+    begin
+      SimpleExtractFilename:=Copy(s,PosLastSlash(s)+1,Length(s)-PosLastSlash(s));
+    end;
+      
+
+  procedure UnixGetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: openstring);
+    var
+      dlinfo: dl_info;
+    begin
+      baseaddr:=nil;
+      FillChar(dlinfo, sizeof(dlinfo), 0);
+      dladdr(addr, @dlinfo);
+      baseaddr:=dlinfo.dli_fbase;
+      filename:=String(dlinfo.dli_fname);
+      if SimpleExtractFilename(filename)=SimpleExtractFilename(ParamStr(0)) then
+        baseaddr:=nil;
+    end;
+
+begin
+  UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
 end.

rtl/unix/sysunixh.inc

@@ -62,3 +62,10 @@ var argc:longint;external name 'operatingsystem_parameter_argc';
 {$endif}
 {$endif}
 
+{$ifdef unix}
+const
+  { hook for lineinfo, to get the module name from an address,
+    unit dl sets it if it is used
+  }
+  UnixGetModuleByAddrHook : procedure (addr: pointer; var baseaddr: pointer; var filename: string) = nil;
+{$endif unix}