StackTrace-Ausgabe unter MacOS

[philipp.hofmann]

Hier ist mein Code, ein paar kleinere Anpassungen sind sicherlich notwendig. MyLog ist bei mir ein Wrapper zu TMSLogging.
FileUtils liest einfach nur eine TStringList ein, das sollte einfach zu ersetzen sein. Voraussetzung ist aber, dass du das Map-File erzeugst und mit deployst.

Delphi-Quellcode:

unit MyMacOSExceptionHandler;

interface

var
  mapFilename:String;
function getFunctionNameExt(hexException:String):String;

implementation

uses Posix.Base, SysUtils,
   MyLog, System.Generics.Collections, FileUtils, System.Classes, IntegerStringList;

function backtrace(result: PNativeUInt; size: Integer): Integer; cdecl; external libc name '_backtrace';
function _NSGetExecutablePath(buf: PAnsiChar; BufSize: PCardinal): Integer; cdecl; external libc name '__NSGetExecutablePath';

var
  PrevRaiseException: function(Exc: Pointer): LongBool; cdecl;
  mapDict: TIntegerStringList;

const
  MaxDepth = 20;
  SkipFrames = 3;

procedure LoadMapFile();
var
  //FileName: array[0..255] of AnsiChar;
  //Len: Integer;
  mapFile:TStringList;
  i,firstEntry:integer;
  start1,start2,start3,start4:Int64;
  key:Int64;
  add,value:String;
begin
  if (MapDict = nil) then
  begin
    mapDict:=TIntegerStringList.create();
    //Len := Length(FileName);
    //_NSGetExecutablePath(@FileName[0], @Len);
    //if FileExists(ChangeFileExt(FileName, '.map')) then
    start1:=0;
    start2:=0;
    start3:=0;
    start4:=0;
    //start5:=0;
    if (FileExists(mapFilename)) then
    begin
      //mapFile:=TFileUtils.readFile(ChangeFileExt(FileName, '.map'));
      mapFile:=TFileUtils.readFile(mapFileName);
      firstEntry:=-1;
      for i:=0 to mapFile.count-1 do
      begin
        if (pos('Start',mapFile[i])>0) then
        begin
          start1:=StrToInt('$'+copy(mapFile[i+1],7,8));
          start2:=StrToInt('$'+copy(mapFile[i+2],7,8));
          start3:=StrToInt('$'+copy(mapFile[i+3],7,8));
          start4:=StrToInt('$'+copy(mapFile[i+4],7,8));
          //start5:=StrToInt('$'+copy(mapFile[i+5],7,8));
          break;
        end;
      end;
      for i:=0 to mapFile.count-1 do
      begin
        if (pos('Address',mapFile[i])>0) and (pos('Publics by Name',mapFile[i])>0) then
        begin
          firstEntry:=i+2;
          break;
        end;
      end;
      if (firstEntry>-1) then
      begin
        for i:=firstEntry to mapFile.count-1 do
        begin
          if (mapFile[i]='') then
            break;
          add:=copy(mapFile[i],2,4);
          key:=StrToInt64('$'+copy(mapFile[i],7,8));
          value:=copy(mapFile[i],22);
          if (add='0001') then
            key:=start1+key
          else if (add='0002') then
            key:=start2+key
          else if (add='0003') then
            key:=start3+key
          else if (add='0004') then
            key:=start4+key;
          //else if (add='0005') then
          //  key:=IntToHex(start5+StrToInt64('$'+key),8);
          mapDict.add(TIntegerStringEntry.create(key,value));
        end;
        mapDict.sort(mapDict.comparer);
      end;
    end else
      log.info('Can''t find Map-File: '+mapFilename);
  end;
end;

function getFunctionName(exceptionInt:Int64):String;
var i:integer;
begin
  Result:='???';
  for i:=1 to mapDict.count-1 do
  begin
    if (mapDict[i].key>exceptionInt) then
    begin
      Result:=mapDict[i-1].value;
      break;
    end;
  end;
end;

function getFunctionNameExt(hexException:String):String;
begin
  Result:=getFunctionName(StrToInt64('$'+hexException));
end;

procedure ShowCurrentStack;
var
  StackLog: PNativeUInt; //array[0..10] of Pointer;
  Cnt: Integer;
  I: Integer;
begin
  {$POINTERMATH ON}
  if (mapDict=nil) then
    loadMapFile();
  GetMem(StackLog, SizeOf(Pointer) * MaxDepth);
  try
    Cnt := backtrace(StackLog, MaxDepth);

    for I := SkipFrames to Cnt - 1 do
    begin
      if StackLog[I] = $BE00EF00 then
      begin
        WriteLn('---');
        Break;
      end;
      log.error(IntToHex(StackLog[I],8)+' '+getFunctionName(StackLog[I]));
    end;

   finally
    FreeMem(StackLog);
   end;
  {$POINTERMATH OFF}
end;

procedure InstallExceptionHandler; forward;
procedure UnInstallExceptionHandler; forward;

var
  InRaiseException: Boolean;

function RaiseException(Exc: Pointer): LongBool; cdecl;
begin
  InRaiseException := True;
  ShowCurrentStack;

  Result := PrevRaiseException(Exc);
  InRaiseException := False;
end;

procedure InstallExceptionHandler;
var
  U: TUnwinder;
begin
  GetUnwinder(U);
  Assert(Assigned(U.RaiseException));
  PrevRaiseException := U.RaiseException;
  U.RaiseException := RaiseException;
  SetUnwinder(U);
  mapDict:=nil;
end;

procedure UnInstallExceptionHandler;
var
  U: TUnwinder;
begin
  GetUnwinder(U);
  U.RaiseException := PrevRaiseException;
  SetUnwinder(U);
end;

initialization
  InstallExceptionHandler;
end.

Delphi-Quellcode:

unit IntegerStringList;

interface

uses Generics.Collections,System.SysUtils,System.Classes,
  System.Generics.Defaults, System.Math;

type

  TIntegerStringEntry = class(TObject)
  public
    key:Int64;
    value:String;
    constructor create(key:Int64;value:String);
  end;

  TIntegerStringList = class(TObjectList<TIntegerStringEntry>)
  public
    Comparer: IComparer<TIntegerStringEntry>;
    constructor create(); overload;
  end;

implementation

constructor TIntegerStringEntry.create(key:Int64;value:String);
begin
  self.key:=key;
  self.value:=value;
end;

constructor TIntegerStringList.create();
begin
  Comparer := TDelegatedComparer<TIntegerStringEntry>.Create(
  function(const Left, Right: TIntegerStringEntry): Integer
  begin
    if (left.key<right.key) then
      Result:=-1
    else if (left.key>right.key) then
      Result:=1
    else
      Result := 0;
  end);
  inherited create(true);
end;

end.