View Issue Details

IDProjectCategoryView StatusLast Update
0038483FPCPatchpublic2021-04-11 22:16
ReporterC Western Assigned ToJonas Maebe  
PrioritynormalSeverityminorReproducibilityhave not tried
Status resolvedResolutionfixed 
Platformaarch64OSdarwin 
Product Version3.2.1 
Fixed in Version3.3.1 
Summary0038483: Intial implementation of line info information on AARCH64/Darwin
DescriptionThe Dump_Stack routines do not give line number information on Darwin. The attached stackdump.patch provides a partial implementation; it works provided a .dwarf info file has been generated with dsymutil -f <exename>.

Also provided is stackbottom.patch - this adjusts the stack bottom/stack top computation so that a complete stack dump is made on small programs. It is independent of stackdump.patch.
TagsNo tags attached.
Fixed in Revision49140
FPCOldBugId
FPCTarget-
Attached Files

Relationships

related to 0038739 new Patch: fallback stack trace information (mainly for Darwin) 

Activities

C Western

2021-02-13 17:51

reporter  

stackbottom.patch (2,540 bytes)   
Index: rtl/bsd/sysosh.inc
===================================================================
--- rtl/bsd/sysosh.inc	(revision 48665)
+++ rtl/bsd/sysosh.inc	(working copy)
@@ -34,6 +34,7 @@
     argv: ppchar;
     envp: ppchar;
     stklen: sizeuint;
+    stkptr: Pointer;
   end;
 {$endif}
 
Index: rtl/bsd/system.pp
===================================================================
--- rtl/bsd/system.pp	(revision 48665)
+++ rtl/bsd/system.pp	(working copy)
@@ -90,6 +90,7 @@
   argv := info.OS.argv;
   envp := info.OS.envp;
   initialstklen := info.OS.stklen;
+  initialstkptr := info.OS.stkptr;
 end;
 {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 
@@ -336,6 +337,7 @@
   argc:= argcparam;
   argv:= argvparam;
   envp:= envpparam;
+  initialstkptr:=Sptr;
 {$ifdef cpui386}
   Set8087CW(Default8087CW);
 {$endif cpui386}
@@ -366,7 +368,7 @@
 {$endif darwin}
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
-  StackBottom := Sptr - StackLength;
+  StackBottom := initialstkptr - StackLength;
 {$ifdef FPC_HAS_SETSYSNR_INC}
   { This procedure is needed for openbsd system which re-uses
     the same syscall numbers depending on OS version }
Index: rtl/darwin/sysinit.pas
===================================================================
--- rtl/darwin/sysinit.pas	(revision 48665)
+++ rtl/darwin/sysinit.pas	(working copy)
@@ -55,6 +55,7 @@
         argv: nil;
         envp: nil;
         stklen: 0;
+        stkptr: nil;
       );
     );
 
@@ -65,6 +66,7 @@
   SysInitEntryInformation.OS.argv := argvparam;
   SysInitEntryInformation.OS.envp := envpparam;
   SysInitEntryInformation.OS.stklen := StkLen;
+  SysInitEntryInformation.OS.stkptr := SPtr;
   SysEntry(SysInitEntryInformation);
 end;
 
Index: rtl/inc/system.inc
===================================================================
--- rtl/inc/system.inc	(revision 48665)
+++ rtl/inc/system.inc	(working copy)
@@ -64,8 +64,9 @@
 {$ifndef FPC_NO_GENERIC_STACK_CHECK}
   { if the OS does the stack checking, we don't need any stklen from the
     main program }
-  initialstklen : SizeUint{$ifndef FPC_HAS_INDIRECT_ENTRY_INFORMATION}; external name '__stklen';{$else} = 0;{$endif}
+    initialstklen : SizeUint{$ifndef FPC_HAS_INDIRECT_ENTRY_INFORMATION}; external name '__stklen';{$else} = 0;{$endif}
 {$endif FPC_NO_GENERIC_STACK_CHECK}
+  initialstkptr : Pointer{$ifndef FPC_HAS_INDIRECT_ENTRY_INFORMATION}; external name '__stkptr';{$else} = nil;{$endif}
 
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
   EntryInformation: TEntryInformation;
stackbottom.patch (2,540 bytes)   
stackdump.patch (5,262 bytes)   
Index: rtl/inc/exeinfo.pp
===================================================================
--- rtl/inc/exeinfo.pp	(revision 48665)
+++ rtl/inc/exeinfo.pp	(working copy)
@@ -1102,33 +1102,58 @@
   MachoFatHeader= packed record
     magic: longint;
     nfatarch: longint;
-  end;
+  end;     
   MachoHeader=packed record
     magic: longword;
-    cpu_type_t: longint;
-    cpu_subtype_t: longint;
-    filetype: longint;
-    ncmds: longint;
-    sizeofcmds: longint;
-    flags: longint;
+    cpu_type_t: longword;
+    cpu_subtype_t: longword;
+    filetype: longword;
+    ncmds: longword;
+    sizeofcmds: longword;
+    flags: longword;
   end;
   cmdblock=packed record
-    cmd: longint;
-    cmdsize: longint;
+    cmd: longword;
+    cmdsize: longword;
   end;
   symbSeg=packed record
-    symoff :      longint;
-    nsyms  :      longint;
-    stroff :      longint;
-    strsize:      longint;
+    symoff :      longword;
+    nsyms  :      longword;
+    stroff :      longword;
+    strsize:      longword;
   end;
   tstab=packed record
-    strpos  : longint;
+    strpos  : longword;
     ntype   : byte;
     nother  : byte;
     ndesc   : word;
-    nvalue  : dword;
+    nvalue  : longword;
   end;
+  segment_command_64 = packed record
+    segname : array [0..15] of Char;
+    vmaddr  : QWord;
+    vmsize  : QWord;
+    fileoff : QWord;
+    filesize: QWord;
+    maxprot : LongInt;
+    initptot: LongInt;
+    nsects  : longword;
+    flags   : longword;
+  end;
+  section_64 = packed record
+    sectname : array [0..15] of Char;
+    segname  : array [0..15] of Char;
+    addr     : QWord;
+    size     : QWord;
+    offset   : longword;
+    align    : longword;
+    reloff   : longword;
+    nreloc   : longword;
+    flags    : longword;
+    reserved1: longword;
+    reserved2: longword;
+    reserved3: longword;
+  end;
 
 
 function OpenMachO32PPC(var e:TExeFile):boolean;
@@ -1140,7 +1165,12 @@
   if e.size<sizeof(mh) then
     exit;
   blockread (e.f, mh, sizeof(mh));
+  if not ( (mh.magic = $feedface { 32 bit })
+           or (mh.magic = $feedfacf { 64 bit})) then
+    exit;                   
   e.sechdrofs:=filepos(e.f);
+  { Needs to be aligned }
+  e.sechdrofs:=(e.sechdrofs + 15) and not 15;
   e.nsects:=mh.ncmds;
   OpenMachO32PPC:=true;
 end;
@@ -1148,12 +1178,21 @@
 
 function FindSectionMachO32PPC(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean;
 var
-   i: longint;
+   i, j: longint;
    block:cmdblock;
    symbolsSeg: symbSeg;
+   seg: segment_command_64;
+   sect: section_64;
+   adjname: string;
 begin
   FindSectionMachO32PPC:=false;
   seek(e.f,e.sechdrofs);
+  {$IFDEF CPUAARCH64}
+    if asecname[1] = '.' then
+      adjname := '__' + copy(asecname,2,Length(asecname))
+    else
+      adjname := asecname;
+  {$ENDIF}
   for i:= 1 to e.nsects do
     begin
       {$I-}
@@ -1161,6 +1200,26 @@
       {$I+}
       if IOResult <> 0 then
         Exit;
+      {$IFDEF CPUAARCH64}
+      if block.cmd = $19 then
+      begin { 64 bit segment }
+        BlockRead(e.f, seg, Sizeof(seg));
+        if strpas(seg.segname) = '__DWARF' then begin
+          { Loop through sections }
+          for j := 1 to seg.nsects do begin
+            BlockRead(e.f, sect, Sizeof(sect));
+            Dec(block.cmdsize, SizeOf(sect));
+            if adjname = strpas(sect.sectname) then begin
+              secofs := sect.offset;
+              seclen := sect.size;
+              FindSectionMachO32PPC:=true;
+              exit;
+            end;
+          end;
+        end else
+          Dec(block.cmdsize, SizeOf(seg)); { adjust for partial read }
+      end;
+      {$ELSE}
       if block.cmd = $2   then
       begin
           blockread (e.f, symbolsSeg, sizeof(symbolsSeg));
@@ -1179,6 +1238,7 @@
             end;
           exit;
       end;
+      {$ENDIF}
       Seek(e.f, FilePos (e.f) + block.cmdsize - sizeof(block));
     end;
 end;
Index: rtl/inc/lnfodwrf.pp
===================================================================
--- rtl/inc/lnfodwrf.pp	(revision 48665)
+++ rtl/inc/lnfodwrf.pp	(working copy)
@@ -267,6 +267,10 @@
 {$endif cpui8086}
 
 function OpenDwarf(addr : codepointer) : boolean;
+{$IFDEF DARWIN}
+var
+  SymbolFileName: string;
+{$ENDIF}
 begin
   // False by default
   OpenDwarf:=false;
@@ -304,15 +308,24 @@
   lastfilename := filename;
 
   // Open exe file or debug link
-  if not OpenExeFile(e,filename) then
-    exit;
-  if ReadDebugLink(e,dbgfn) then
-    begin
-      CloseExeFile(e);
-      if not OpenExeFile(e,dbgfn) then
-        exit;
+  {$IFDEF DARWIN}
+    SymbolFileName := filename + '.dwarf';
+    {$ifdef DEBUG_LINEINFO}
+      writeln(stderr,'Trying ',SymbolFileName);
+    {$endif DEBUG_LINEINFO}
+    if not OpenExeFile(e,SymbolFileName) then begin
+      writeln(stderr,'Failed');
     end;
-
+  {$ELSE}
+    if not OpenExeFile(e,filename) then
+      exit;
+    if ReadDebugLink(e,dbgfn) then
+      begin
+        CloseExeFile(e);
+        if not OpenExeFile(e,dbgfn) then
+          exit;
+      end;
+  {$ENDIF}
   // Find debug data section
   e.processaddress:=ptruint(baseaddr)-e.processaddress;
   if FindExeSection(e,'.debug_line',Dwarf_Debug_Line_Section_offset,dwarf_Debug_Line_Section_size) and
stackdump.patch (5,262 bytes)   

C Western

2021-02-14 17:46

reporter   ~0128937

Updated stackdump.patch that also works on x86_64 - a correction to dl.pp is required.
stackdump-2.patch (5,545 bytes)   
Index: rtl/inc/exeinfo.pp
===================================================================
--- rtl/inc/exeinfo.pp	(revision 48672)
+++ rtl/inc/exeinfo.pp	(working copy)
@@ -1105,30 +1105,55 @@
   end;
   MachoHeader=packed record
     magic: longword;
-    cpu_type_t: longint;
-    cpu_subtype_t: longint;
-    filetype: longint;
-    ncmds: longint;
-    sizeofcmds: longint;
-    flags: longint;
+    cpu_type_t: longword;
+    cpu_subtype_t: longword;
+    filetype: longword;
+    ncmds: longword;
+    sizeofcmds: longword;
+    flags: longword;
   end;
   cmdblock=packed record
-    cmd: longint;
-    cmdsize: longint;
+    cmd: longword;
+    cmdsize: longword;
   end;
   symbSeg=packed record
-    symoff :      longint;
-    nsyms  :      longint;
-    stroff :      longint;
-    strsize:      longint;
+    symoff :      longword;
+    nsyms  :      longword;
+    stroff :      longword;
+    strsize:      longword;
   end;
   tstab=packed record
-    strpos  : longint;
+    strpos  : longword;
     ntype   : byte;
     nother  : byte;
     ndesc   : word;
-    nvalue  : dword;
+    nvalue  : longword;
   end;
+  segment_command_64 = packed record
+    segname : array [0..15] of Char;
+    vmaddr  : QWord;
+    vmsize  : QWord;
+    fileoff : QWord;
+    filesize: QWord;
+    maxprot : LongInt;
+    initptot: LongInt;
+    nsects  : longword;
+    flags   : longword;
+  end;
+  section_64 = packed record
+    sectname : array [0..15] of Char;
+    segname  : array [0..15] of Char;
+    addr     : QWord;
+    size     : QWord;
+    offset   : longword;
+    align    : longword;
+    reloff   : longword;
+    nreloc   : longword;
+    flags    : longword;
+    reserved1: longword;
+    reserved2: longword;
+    reserved3: longword;
+  end;
 
 
 function OpenMachO32PPC(var e:TExeFile):boolean;
@@ -1140,7 +1165,12 @@
   if e.size<sizeof(mh) then
     exit;
   blockread (e.f, mh, sizeof(mh));
+  if not ( (mh.magic = $feedface { 32 bit })
+           or (mh.magic = $feedfacf { 64 bit})) then
+    exit;
   e.sechdrofs:=filepos(e.f);
+  { Needs to be aligned }
+  e.sechdrofs:=(e.sechdrofs + 15) and not 15;
   e.nsects:=mh.ncmds;
   OpenMachO32PPC:=true;
 end;
@@ -1148,12 +1178,21 @@
 
 function FindSectionMachO32PPC(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean;
 var
-   i: longint;
+   i, j: longint;
    block:cmdblock;
    symbolsSeg: symbSeg;
+   seg: segment_command_64;
+   sect: section_64;
+   adjname: string;
 begin
   FindSectionMachO32PPC:=false;
   seek(e.f,e.sechdrofs);
+  {$IFDEF CPU64}
+    if asecname[1] = '.' then
+      adjname := '__' + copy(asecname,2,Length(asecname))
+    else
+      adjname := asecname;
+  {$ENDIF}
   for i:= 1 to e.nsects do
     begin
       {$I-}
@@ -1161,6 +1200,26 @@
       {$I+}
       if IOResult <> 0 then
         Exit;
+      {$IFDEF CPU64}
+      if block.cmd = $19 then
+      begin { 64 bit segment }
+        BlockRead(e.f, seg, Sizeof(seg));
+        if strpas(seg.segname) = '__DWARF' then begin
+          { Loop through sections }
+          for j := 1 to seg.nsects do begin
+            BlockRead(e.f, sect, Sizeof(sect));
+            Dec(block.cmdsize, SizeOf(sect));
+            if adjname = strpas(sect.sectname) then begin
+              secofs := sect.offset;
+              seclen := sect.size;
+              FindSectionMachO32PPC:=true;
+              exit;
+            end;
+          end;
+        end else
+          Dec(block.cmdsize, SizeOf(seg)); { adjust for partial read }
+      end;
+      {$ELSE}
       if block.cmd = $2   then
       begin
           blockread (e.f, symbolsSeg, sizeof(symbolsSeg));
@@ -1179,6 +1238,7 @@
             end;
           exit;
       end;
+      {$ENDIF}
       Seek(e.f, FilePos (e.f) + block.cmdsize - sizeof(block));
     end;
 end;
Index: rtl/inc/lnfodwrf.pp
===================================================================
--- rtl/inc/lnfodwrf.pp	(revision 48672)
+++ rtl/inc/lnfodwrf.pp	(working copy)
@@ -267,6 +267,10 @@
 {$endif cpui8086}
 
 function OpenDwarf(addr : codepointer) : boolean;
+{$IFDEF DARWIN}
+var
+  SymbolFileName: string;
+{$ENDIF}
 begin
   // False by default
   OpenDwarf:=false;
@@ -304,15 +308,24 @@
   lastfilename := filename;
 
   // Open exe file or debug link
-  if not OpenExeFile(e,filename) then
-    exit;
-  if ReadDebugLink(e,dbgfn) then
-    begin
-      CloseExeFile(e);
-      if not OpenExeFile(e,dbgfn) then
-        exit;
+  {$IFDEF DARWIN}
+    SymbolFileName := filename + '.dwarf';
+    {$ifdef DEBUG_LINEINFO}
+      writeln(stderr,'Trying ',SymbolFileName);
+    {$endif DEBUG_LINEINFO}
+    if not OpenExeFile(e,SymbolFileName) then begin
+      exit;
     end;
-
+  {$ELSE}
+    if not OpenExeFile(e,filename) then
+      exit;
+    if ReadDebugLink(e,dbgfn) then
+      begin
+        CloseExeFile(e);
+        if not OpenExeFile(e,dbgfn) then
+          exit;
+      end;
+  {$ENDIF}
   // Find debug data section
   e.processaddress:=ptruint(baseaddr)-e.processaddress;
   if FindExeSection(e,'.debug_line',Dwarf_Debug_Line_Section_offset,dwarf_Debug_Line_Section_size) and
Index: rtl/unix/dl.pp
===================================================================
--- rtl/unix/dl.pp	(revision 48672)
+++ rtl/unix/dl.pp	(working copy)
@@ -149,7 +149,7 @@
       filename:=String(dlinfo.dli_fname);
     {$ifdef darwin}
       if SimpleExtractFilename(filename)=SimpleExtractFilename(ParamStr(0)) then
-        baseaddr:=nil;
+        baseaddr:=baseaddr-$100000000;
     {$endif darwin}
     end;
 
stackdump-2.patch (5,545 bytes)   

C Western

2021-04-04 15:24

reporter   ~0130077

Updated version with 32 bit support
stackdump-3.patch (6,915 bytes)   
Index: rtl/inc/exeinfo.pp
===================================================================
--- rtl/inc/exeinfo.pp	(revision 48683)
+++ rtl/inc/exeinfo.pp	(working copy)
@@ -1105,30 +1105,57 @@
   end;
   MachoHeader=packed record
     magic: longword;
-    cpu_type_t: longint;
-    cpu_subtype_t: longint;
-    filetype: longint;
-    ncmds: longint;
-    sizeofcmds: longint;
-    flags: longint;
+    cpu_type_t: longword;
+    cpu_subtype_t: longword;
+    filetype: longword;
+    ncmds: longword;
+    sizeofcmds: longword;
+    flags: longword;
   end;
   cmdblock=packed record
-    cmd: longint;
-    cmdsize: longint;
+    cmd: longword;
+    cmdsize: longword;
   end;
   symbSeg=packed record
-    symoff :      longint;
-    nsyms  :      longint;
-    stroff :      longint;
-    strsize:      longint;
+    symoff :      longword;
+    nsyms  :      longword;
+    stroff :      longword;
+    strsize:      longword;
   end;
   tstab=packed record
-    strpos  : longint;
+    strpos  : longword;
     ntype   : byte;
     nother  : byte;
     ndesc   : word;
-    nvalue  : dword;
+    nvalue  : longword;
   end;
+  segment_command = packed record
+    segname : array [0..15] of Char;
+    vmaddr  : {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    vmsize  : {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    fileoff : {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    filesize: {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    maxprot : LongInt;
+    initptot: LongInt;
+    nsects  : longword;
+    flags   : longword;
+  end;
+  section = packed record
+    sectname : array [0..15] of Char;
+    segname  : array [0..15] of Char;
+    addr     : {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    size     : {$IFDEF CPU64}QWord{$ELSE}longword{$ENDIF};
+    offset   : longword;
+    align    : longword;
+    reloff   : longword;
+    nreloc   : longword;
+    flags    : longword;
+    reserved1: longword;
+    reserved2: longword;
+    {$IFDEF CPU64}
+    reserved3: longword;
+    {$ENDIF}
+  end;
 
 
 function OpenMachO32PPC(var e:TExeFile):boolean;
@@ -1140,7 +1167,14 @@
   if e.size<sizeof(mh) then
     exit;
   blockread (e.f, mh, sizeof(mh));
+  if not ( (mh.magic = $feedface { 32 bit })
+           or (mh.magic = $feedfacf { 64 bit})) then
+    exit;
   e.sechdrofs:=filepos(e.f);
+  {$IFDEF CPU64}
+    { Needs to be aligned }
+    e.sechdrofs:=(e.sechdrofs + 15) and not 15;
+  {$ENDIF}
   e.nsects:=mh.ncmds;
   OpenMachO32PPC:=true;
 end;
@@ -1148,12 +1182,21 @@
 
 function FindSectionMachO32PPC(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean;
 var
-   i: longint;
+   i, j: longint;
    block:cmdblock;
    symbolsSeg: symbSeg;
+   seg: segment_command;
+   sect: section;
+   adjname: string;
 begin
   FindSectionMachO32PPC:=false;
   seek(e.f,e.sechdrofs);
+  {$IF defined(CPU64) or defined(CPU386)}
+    if asecname[1] = '.' then
+      adjname := '__' + copy(asecname,2,Length(asecname))
+    else
+      adjname := asecname;
+  {$ENDIF}
   for i:= 1 to e.nsects do
     begin
       {$I-}
@@ -1161,6 +1204,26 @@
       {$I+}
       if IOResult <> 0 then
         Exit;
+      {$IF defined(CPU64) or defined(CPU386)}
+      if block.cmd = {$IFDEF CPU64}$19{$ELSE}$1{$ENDIF} then
+      begin { 32/64 bit segment }
+        BlockRead(e.f, seg, Sizeof(seg));
+        if strpas(seg.segname) = '__DWARF' then begin
+          { Loop through sections }
+          for j := 1 to seg.nsects do begin
+            BlockRead(e.f, sect, Sizeof(sect));
+            Dec(block.cmdsize, SizeOf(sect));
+            if adjname = strpas(sect.sectname) then begin
+              secofs := sect.offset;
+              seclen := sect.size;
+              FindSectionMachO32PPC:=true;
+              exit;
+            end;
+          end;
+        end else
+          Dec(block.cmdsize, SizeOf(seg)); { adjust for partial read }
+      end;
+      {$ELSE}
       if block.cmd = $2   then
       begin
           blockread (e.f, symbolsSeg, sizeof(symbolsSeg));
@@ -1179,6 +1242,7 @@
             end;
           exit;
       end;
+      {$ENDIF}
       Seek(e.f, FilePos (e.f) + block.cmdsize - sizeof(block));
     end;
 end;
Index: rtl/inc/lnfodwrf.pp
===================================================================
--- rtl/inc/lnfodwrf.pp	(revision 48683)
+++ rtl/inc/lnfodwrf.pp	(working copy)
@@ -46,7 +46,7 @@
 implementation
 
 uses
-  exeinfo;
+  {$IFDEF DARWIN} dl, {$ENDIF} exeinfo;
 
 { Current issues:
 
@@ -267,6 +267,10 @@
 {$endif cpui8086}
 
 function OpenDwarf(addr : codepointer) : boolean;
+{$IFDEF DARWIN}
+var
+  SymbolFileName: string;
+{$ENDIF}
 begin
   // False by default
   OpenDwarf:=false;
@@ -304,15 +308,24 @@
   lastfilename := filename;
 
   // Open exe file or debug link
-  if not OpenExeFile(e,filename) then
-    exit;
-  if ReadDebugLink(e,dbgfn) then
-    begin
-      CloseExeFile(e);
-      if not OpenExeFile(e,dbgfn) then
-        exit;
+  {$IFDEF DARWIN}
+    SymbolFileName := filename + '.dwarf';
+    {$ifdef DEBUG_LINEINFO}
+      writeln(stderr,'Trying ',SymbolFileName);
+    {$endif DEBUG_LINEINFO}
+    if not OpenExeFile(e,SymbolFileName) then begin
+      exit;
     end;
-
+  {$ELSE}
+    if not OpenExeFile(e,filename) then
+      exit;
+    if ReadDebugLink(e,dbgfn) then
+      begin
+        CloseExeFile(e);
+        if not OpenExeFile(e,dbgfn) then
+          exit;
+      end;
+  {$ENDIF}
   // Find debug data section
   e.processaddress:=ptruint(baseaddr)-e.processaddress;
   if FindExeSection(e,'.debug_line',Dwarf_Debug_Line_Section_offset,dwarf_Debug_Line_Section_size) and
@@ -1375,6 +1388,9 @@
   line   : longint;
   Store  : TBackTraceStrFunc;
   Success : boolean;
+  {$IFDEF DARWIN}
+  dlinfo: dl_info;
+  {$ENDIF}
 begin
   {$ifdef DEBUG_LINEINFO}
   writeln(stderr,'DwarfBackTraceStr called');
@@ -1401,7 +1417,21 @@
       end;
       DwarfBackTraceStr := DwarfBackTraceStr + ' of ' + source;
     end;
-  end;
+  end
+  {$IFDEF DARWIN}
+  else
+    { Fall back on dlinfo - gives mangled names, but better than nothing }
+    if dladdr(addr, @dlinfo) <> 0 then
+    begin
+      if dlinfo.dli_sname <> nil then
+        DwarfBackTraceStr := DwarfBackTraceStr + '  ' + StrPas(dlinfo.dli_sname);
+      if dlinfo.dli_saddr <> nil then begin
+        Str(addr-dlinfo.dli_saddr, hs);
+        DwarfBackTraceStr := DwarfBackTraceStr + ' + ' + hs;
+      end;
+    end
+  {$ENDIF}
+    ;
   BackTraceStrFunc := Store;
 end;
 
Index: rtl/unix/dl.pp
===================================================================
--- rtl/unix/dl.pp	(revision 48683)
+++ rtl/unix/dl.pp	(working copy)
@@ -149,7 +149,7 @@
       filename:=String(dlinfo.dli_fname);
     {$ifdef darwin}
       if SimpleExtractFilename(filename)=SimpleExtractFilename(ParamStr(0)) then
-        baseaddr:=nil;
+        baseaddr:=baseaddr-{$IFDEF CPU64}$100000000{$ELSE}$10000{$ENDIF};
     {$endif darwin}
     end;
 
stackdump-3.patch (6,915 bytes)   

Jonas Maebe

2021-04-05 23:10

manager   ~0130120

Thanks for the patches. I'm cleaning up and optimizing the existing implementation (no hardcoded constants, use mmap instead reading the file byte by byte), and integrating your changes.

Jonas Maebe

2021-04-08 21:52

manager   ~0130184

I fixed everything, except for the change to use dladdr when no lineinfo is available. While I agree this would be useful, it should be implemented in a more generic way and not just for Darwin.

Jonas Maebe

2021-04-08 21:57

manager   ~0130185

Also: I changed it so you don't have to call dsymutil -f, but instead can use the compiler's -Xg option.

Issue History

Date Modified Username Field Change
2021-02-13 17:51 C Western New Issue
2021-02-13 17:51 C Western File Added: stackbottom.patch
2021-02-13 17:51 C Western File Added: stackdump.patch
2021-02-14 17:46 C Western Note Added: 0128937
2021-02-14 17:46 C Western File Added: stackdump-2.patch
2021-04-04 15:24 C Western Note Added: 0130077
2021-04-04 15:24 C Western File Added: stackdump-3.patch
2021-04-05 23:10 Jonas Maebe Note Added: 0130120
2021-04-08 21:52 Jonas Maebe Assigned To => Jonas Maebe
2021-04-08 21:52 Jonas Maebe Status new => resolved
2021-04-08 21:52 Jonas Maebe Resolution open => fixed
2021-04-08 21:52 Jonas Maebe Fixed in Version => 3.3.1
2021-04-08 21:52 Jonas Maebe Fixed in Revision => 49140
2021-04-08 21:52 Jonas Maebe FPCTarget => -
2021-04-08 21:52 Jonas Maebe Note Added: 0130184
2021-04-08 21:57 Jonas Maebe Note Added: 0130185
2021-04-11 22:16 Jonas Maebe Relationship added related to 0038739