--- Merging r33007 into '.':

U    rtl/inc/exeinfo.pp
--- Recording mergeinfo for merge of r33007 into '.':
 U   .
--- Merging r33008 into '.':
G    rtl/inc/exeinfo.pp
--- Recording mergeinfo for merge of r33008 into '.':
 G   .
--- Merging r33561 into '.':
G    rtl/inc/exeinfo.pp
--- Recording mergeinfo for merge of r33561 into '.':
 G   .
--- Merging r34384 into '.':
G    rtl/inc/exeinfo.pp
--- Recording mergeinfo for merge of r34384 into '.':
 G   .

# revisions: 33007,33008,33561,34384

git-svn-id: branches/fixes_3_0@35906 -

rtl/inc/exeinfo.pp

@@ -16,6 +16,15 @@
   This unit should not be compiled in objfpc mode, since this would make it
   dependent on objpas unit.
 }
+
+{ Disable checks of pointers explictly,
+  as we are dealing here with special pointer that
+  might be seen as invalid by heaptrc unit CheckPointer function }
+
+{$checkpointer off}
+
+{$mode objfpc}
+
 unit exeinfo;
 interface
 
@@ -112,8 +121,10 @@ uses
 {$if defined(freebsd) or defined(netbsd) or defined (openbsd) or defined(linux) or defined(sunos) or defined(android) or defined(dragonfly)}
   {$ifdef cpu64}
     {$define ELF64}
+    {$define FIND_BASEADDR_ELF}
   {$else}
     {$define ELF32}
+    {$define FIND_BASEADDR_ELF}
   {$endif}
 {$endif}
 
@@ -789,6 +800,119 @@ type
 
 
 {$if defined(ELF32) or defined(ELF64) or defined(BEOS)}
+
+{$ifdef FIND_BASEADDR_ELF}
+{$ifndef SOLARIS}
+  { Solaris has envp variable in system unit interface,
+    so we directly use system envp variable in that case }
+var
+  envp : ppchar external name 'operatingsystem_parameter_envp';
+{$endif not SOLARIS}
+var
+  LocalJmpBuf : Jmp_Buf;  
+procedure LocalError;
+begin
+  Longjmp(LocalJmpBuf,1);
+end;
+
+procedure GetExeInMemoryBaseAddr(addr : pointer; var BaseAddr : pointer;
+                                 var filename : openstring);
+type
+  AT_HDR = record
+    typ : ptruint;
+    value : ptruint;
+  end;
+  P_AT_HDR = ^AT_HDR;
+
+{ Values taken from /usr/include/linux/auxvec.h }
+const
+  AT_HDR_COUNT = 5;{ AT_PHNUM }
+  AT_HDR_SIZE = 4; { AT_PHENT }
+  AT_HDR_Addr = 3; { AT_PHDR }
+  AT_EXE_FN = 31;  {AT_EXECFN }
+
+var
+  pc : ppchar;
+  pat_hdr : P_AT_HDR;
+  i, phdr_count : ptrint;
+  phdr_size : ptruint;
+  phdr :  ^telfproghdr;
+  found_addr : ptruint;
+  SavedExitProc : pointer;
+begin
+  filename:=ParamStr(0);
+  SavedExitProc:=ExitProc;
+  ExitProc:=@LocalError;
+  if SetJmp(LocalJmpBuf)=0 then
+  begin
+  { Try, avoided in order to remove exception installation }
+    pc:=envp;
+    phdr_count:=-1;
+    phdr_size:=0;
+    phdr:=nil;
+    found_addr:=ptruint(-1);
+    while (assigned(pc^)) do
+      inc (pointer(pc), sizeof(ptruint));
+    inc(pointer(pc), sizeof(ptruint));
+    pat_hdr:=P_AT_HDR(pc);
+    while assigned(pat_hdr) do
+      begin
+        if (pat_hdr^.typ=0) and (pat_hdr^.value=0) then
+          break;
+        if pat_hdr^.typ = AT_HDR_COUNT then
+          phdr_count:=pat_hdr^.value;
+        if pat_hdr^.typ = AT_HDR_SIZE then
+          phdr_size:=pat_hdr^.value;
+        if pat_hdr^.typ = AT_HDR_Addr then
+          phdr := pointer(pat_hdr^.value);
+        if pat_hdr^.typ = AT_EXE_FN then
+          filename:=strpas(pchar(pat_hdr^.value));
+        inc (pointer(pat_hdr),sizeof(AT_HDR));
+      end;
+    if (phdr_count>0) and (phdr_size = sizeof (telfproghdr))
+       and  assigned(phdr) then
+      begin
+        for i:=0 to phdr_count -1 do
+          begin
+            if (phdr^.p_type = 1 {PT_LOAD}) and (ptruint(phdr^.p_vaddr) < found_addr) then
+              found_addr:=phdr^.p_vaddr;
+            inc(pointer(phdr), phdr_size);
+          end;
+      {$ifdef DEBUG}
+      end
+    else
+      begin
+        if (phdr_count=-1) then
+           writeln(stderr,'AUX entry AT_PHNUM not found');
+        if (phdr_size=0) then
+           writeln(stderr,'AUX entry AT_PHENT not found');
+        if (phdr=nil) then
+           writeln(stderr,'AUX entry AT_PHDR not found');
+      {$endif DEBUG}
+      end;
+
+     if found_addr<>ptruint(-1) then
+       begin
+          {$ifdef DEBUG}
+          Writeln(stderr,'Found addr = $',hexstr(found_addr,2 * sizeof(ptruint)));
+          {$endif}
+          BaseAddr:=pointer(found_addr);
+       end
+  {$ifdef DEBUG}
+     else
+    writeln(stderr,'Error parsing stack');
+  {$endif DEBUG}
+  end
+  else
+  begin
+  {$ifdef DEBUG}
+    writeln(stderr,'Exception parsing stack');
+  {$endif DEBUG}
+  end;
+  ExitProc:=SavedExitProc;
+end;
+{$endif FIND_BASEADDR_ELF}
+
 function OpenElf(var e:TExeFile):boolean;
 var
   elfheader : telfheader;
@@ -1236,4 +1360,8 @@ begin
 end;
 
 
+begin
+{$ifdef FIND_BASEADDR_ELF}
+  UnixGetModuleByAddrHook:=@GetExeInMemoryBaseAddr;
+{$endif FIND_BASEADDR_ELF}
 end.