{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Borland MAP file parser. To Find symbol      | }
{ |                names of binary code.                        | }
{ |                                                             | }
{ |   Copyright (C) - 2004 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMMapParser;

interface

uses {$IFNDEF JEDIAPI}Windows,{$ELSE}jwaWinType,{$ENDIF}
     GMActiveX, GMStrDef, GMIntf, GMCollections, GMCommon;

type

  TGMMapFileEntry = class(TGMRefCountedObj)
   protected        
    FName: TGMString;                          
    FPath: TGMString;
    FAddress: LongWord;
    FSegNo: LongWord;
    FLineNo: LongWord;
    FSegLen: LongWord;

   public
    constructor Create(const AAddress, ASegNo, ALineNo, ASegLen: LongWord; const AName, APath: TGMString; const ARefLifeTime: Boolean = False); reintroduce;
  end;


  TGMNamedList = class(TGMObjArrayCollection, IGMGetName)
   protected
    FName, FPath: TGMString;

   public
    constructor Create(const AName, APath: TGMString;
                       const AFreeItems: Boolean = False;
                       const AAcceptDuplicates: Boolean = True;
                       const ASorted: Boolean = False;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False);
    function GetName: TGMString; stdcall;
  end;


  TGMMapFileParser = class(TGMRefCountedObj, IGMGetName)
   protected
    FModuleHandle: THandle;
    FModuleFileName: TGMString;
    FCodeSegmentList : IGMObjArrayCollection;
    FSymbolList: IGMObjArrayCollection;
    FSourceFileList: IGMObjArrayCollection;

    procedure ParseMapData(const AStream: IStream);
    procedure ReadMapData(const AModuleFileName: TGMString; var AStackTrace: TGMStringArray);

   public
    constructor Create(const ARefLifeTime: Boolean = False); overload; override;
    constructor Create(const AModuleHandle: THandle; const AModuleFileName: TGMString; var AStackTrace: TGMStringArray; const ARefLifeTime: Boolean = False); reintroduce; overload;
//  constructor Create(const AMapFileContents: IStream; var AStackTrace: TGMStringArray; const ARefLifeTime: Boolean = False); reintroduce; overload;
    function SymbolFromMAPFile(const AAddress: DWORD): TGMString;
    function GetName: TGMString; stdcall;
  end;


  TGMMapFileManager = class;

  IGMMapFileManager = interface(IUnknown)
    ['{665D7A34-F41C-4103-ACE5-E0E30CD053F6}']
    function Obj: TGMMapFileManager;
  end;

  TGMMapFileManager = class(TGMRefCountedObj, IGMMapFileManager)
   protected
    FMapFileList: IGMObjArrayCollection;
   public
    constructor Create(const ARefLifeTime: Boolean = True); reintroduce;
    function Obj: TGMMapFileManager;
    function SymbolFromMapFile(const AModuleHandle: THandle; const AModuleFileName: TGMString; const AAddress: DWORD; var AStackTrace: TGMStringArray): TGMString;
  end;


procedure GMTraceCallStackNames(var DestTrace: TGMStringArray; const StackAddresses: TGMPtrIntArray);


const

  cStrMapDataResName = 'ModuleMapData';
  cStrMapDataResTypeName = 'SymbolMapData';                                            


implementation

uses GMZStrm {$IFDEF JEDIAPI},jwaWinBase, jwaWinNT, jwaWinError, jwaImageHlp{$ELSE},GMDbgHlp{$ENDIF};


resourcestring

  RStrInvalidMapDataChar = 'Invalid Symbol-MAP data character';


{ ------------------------- }
{ ---- Helper Routines ---- }
{ ------------------------- }

function GMGetEnvironmentVariable(const VariableName: TGMString): TGMString;
begin
  SetLength(Result, LongInt(GetEnvironmentVariable(PGMChar(VariableName), nil, 0))-1);
  if Length(Result) > 0 then GetEnvironmentVariable(PGMChar(VariableName), PGMChar(Result), Length(Result) + 1);
end;

function GetSymbolSearchPath(const ModulePath: TGMString): TGMString;
begin
  Result := GMStringJoin(GMGetEnvironmentVariable('_NT_SYMBOL_PATH'), ';',
            GMStringJoin(GMGetEnvironmentVariable('_NT_ALT_SYMBOL_PATH'), ';',
            //GMStringJoin(GMGetEnvironmentVariable('SystemRoot'), ';',
            GMStringJoin(GMStripRight(GMExtractPath(ModulePath), cDirSep), ';',
            GMStringJoin(GMStripRight(GMExtractPath(GMThisModuleFileName), cDirSep), ';',
            GMStringJoin(GMWindowsDir, ';', GMWinSystemDir)))));
            //GMStringJoin(GMCurrentDir, ';', GMStringJoin(GMWindowsDir, ';', GMWinSystemDir))))));

  if IsLibrary then Result := GMStringJoin(Result, ';', GMStripRight(GMExtractPath(GMModuleFileName(0)), cDirSep));
end;

function CompareByMapEntryAddr(const ItemA, ItemB: IUnknown): TGMCompareResult;
var EntryA, EntryB: TGMMapFileEntry;
begin
  EntryA := GMObjFromIntf(ItemA) as TGMMapFileEntry;
  EntryB := GMObjFromIntf(ItemB) as TGMMapFileEntry;
  if EntryA.FAddress > EntryB.FAddress then Result := crAGreaterThanB else
  if EntryA.FAddress = EntryB.FAddress then Result := crAEqualToB else
  Result := crALessThanB;
end;


{ ------------------------- }
{ ---- TGMMapFileEntry ---- }
{ ------------------------- }

constructor TGMMapFileEntry.Create(const AAddress, ASegNo, ALineNo, ASegLen: LongWord; const AName, APath: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FName := AName;
  FPath := APath;
  FAddress := AAddress;
  FSegNo := ASegNo;
  FLineNo := ALineNo;
  FSegLen := ASegLen;
end;


{ ---------------------- }
{ ---- TGMNamedList ---- }
{ ---------------------- }

constructor TGMNamedList.Create(const AName, APath: TGMString; const AFreeItems,
  AAcceptDuplicates, ASorted: Boolean; const ACompareFunc: TGMIntfCompareFunc;
  const ARefLifeTime: Boolean);
begin
  inherited Create(AFreeItems, AAcceptDuplicates, ASorted, ACompareFunc, ARefLifeTime);
  FName := AName;
  FPath := APath;
end;

function TGMNamedList.GetName: TGMString;
begin
  Result := FName;
end;


{ -------------------------- }
{ ---- TGMMapFileParser ---- }
{ -------------------------- }

constructor TGMMapFileParser.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCodeSegmentList := TGMObjArrayCollection.Create(True, True, True, CompareByMapEntryAddr, True);
  FSymbolList := TGMObjArrayCollection.Create(True, True, True, CompareByMapEntryAddr, True);
  FSourceFileList := TGMObjArrayCollection.Create(True, True, True, GMCompareByName, True);
end;

constructor TGMMapFileParser.Create(const AModuleHandle: THandle; const AModuleFileName: TGMString; var AStackTrace: TGMStringArray; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FModuleHandle := AModuleHandle;
  FModuleFileName := AModuleFileName;
  ReadMapData(AModuleFileName, AStackTrace);
end;

function TGMMapFileParser.GetName: TGMString;
begin
  Result := FModuleFileName;
end;

procedure TGMMapFileParser.ReadMapData(const AModuleFileName: TGMString; var AStackTrace: TGMStringArray);
const cOneMinte = 1 / (24 * 60);
var mapFileName: TGMString; mapDataStrm: IStream;

  function FileLastMod(const FileName: TGMString): TDateTime;
  var Handle: THandle; FindData: TWin32FindData;
  begin
    Result := 0;
    try
     Handle := FindFirstFile(PGMChar(FileName), FindData);
     if Handle = INVALID_HANDLE_VALUE then Exit;
     FindClose(Handle);
     Result := GMFileTimeToDateTime(FindData.ftLastWriteTime, Self);
    except end;
  end;

  function AbsDateTime(const Value: TDateTime): TDateTime;
  begin
    if Value < 0 then Result := -Value else Result := Value;
  end;
begin
  try
   mapFileName := GMChangeFileExt(AModuleFileName, 'map');

   if FindResource(FModuleHandle, cStrMapDataResName, cStrMapDataResTypeName) <> 0 then
    begin
     mapDataStrm := TGMZipDecompressorIStream.Create(TGMResourceIStream.Create(cStrMapDataResName, cStrMapDataResTypeName, FModuleHandle));
    end else
   if GMFileExists(mapFileName) then //not IsTextFile(mapFileName) then Exit;
    begin
     if AbsDateTime(FileLastMod(AModuleFileName) - FileLastMod(mapFileName)) > cOneMinte then
      GMAddStrToArray(GMFormat('WARNING: MAP File out of Date. Module File: %s - %s,  MAP File: %s - %s.',
                [AModuleFileName, GMFixedEncodeDateTime(FileLastMod(AModuleFileName)),
                 mapFileName, GMFixedEncodeDateTime(FileLastMod(mapFileName))]), AStackTrace);
     mapDataStrm := TGMFileIStream.CreateRead(mapFileName);
    end;

   if mapDataStrm <> nil then ParseMapData(mapDataStrm);
  except end;
end;

procedure TGMMapFileParser.ParseMapData(const AStream: IStream);
type TMapFilePart = (mfpNone, mfpSegments, mfpSymByName, mfpSymByAddr, mfpLinNumbers, mfpResFiles);
var mapFilePart: TMapFilePart; buf: AnsiString; line: TGMString; List: TGMObjArrayCollection; bufChPos, testedLen: LongInt; //StartTickCount: DWORD;

  procedure CheckIsText(const AValue: AnsiString);
  const cTestLen = 1024;
  var i, len: LongInt;
  begin
    if testedLen >= cTestLen then Exit;
    len := Min(Length(AValue), cTestLen - testedLen);
    for i:=1 to len do
     if ((AValue[i] < #32) and not (AValue[i] in [#9, #10, #13])) or (AValue[i] > #128) then
      raise EGMException.ObjError(RStrInvalidMapDataChar+': '''+AValue[i]+''' ('+GMIntToStr(Ord(AValue[i]))+')', Self, {$I %CurrentRoutine%});
    Inc(testedLen, len);
  end;

  function ReadNextLine(var ALine: TGMString; var ABufChPos: LongInt): Boolean;
  const cCacheSize = $10000; // <- 64 KB
  var startChPos: LongInt; leaveLoop: Boolean; ln: AnsiString;
    procedure ReadMore;
    var n: LongInt;
    begin
      SetLength(Buf, cCacheSize);
      GMHrCheckObj(AStream.Read(PAnsiChar(buf), Length(buf), Pointer(@n)), Self, {$I %CurrentRoutine%}); // RStrStreamRead + ': '
      SetLength(Buf, n);
      ABufChPos := 1;
    end;
  begin
    ln := ''; leaveLoop := True;
    repeat
     if leaveLoop then while (ABufChPos <= Length(buf)) and (buf[ABufChPos] in [#10, #13]) do Inc(ABufChPos);
     startChPos := ABufChPos;
     while (ABufChPos <= Length(buf)) and not (buf[ABufChPos] in [#10, #13]) do Inc(ABufChPos);
     if ABufChPos <= Length(buf) then leaveLoop := True else
      begin
       ln := ln + Copy(buf, startChPos, Length(Buf) - startChPos + 1);
       ReadMore;
       if Length(buf) > 0 then leaveLoop := False;
      end;
    until leaveLoop;
    ln := ln + Copy(buf, startChPos, ABufChPos - startChPos);
    Result := Length(buf) > 0;
    ALine := ln;
  end;

  function MakeHexInt(const Value: TGMString; const DefaultValue: LongInt = 0): TGMString;
  begin
    {Result := GMDeleteChars(Value, '0123456789abcdefABCDEF', True);
    if Result = '' then Result := GMFormat('%x', [DefaultValue]);
    Result := '$' + Result;}
    Result := '$' + Value;
  end;

  procedure ParseSegmentLine(const ALine: TGMString);
  var Token: TGMString; ChPos: LongInt; SegNo, SegLen, Addr: DWORD; UnitName: TGMString;
  begin
    ChPos := 1;
    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;
    SegNo := GMStrToInt64(MakeHexInt(Copy(Token, 1, 4)));
    Addr := GMStrToInt64(MakeHexInt(Copy(Token, 6, 8)));

    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;
    SegLen := GMStrToInt64(MakeHexInt(Token));

    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    //if Token = '' then Exit;
    if {(Token = '') or} not GMHasToken(Token, 'CODE', '', False) then Exit;

    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;

    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;

    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;
    UnitName := Copy(Token, 3, Length(Token) - 2);

    FCodeSegmentList.Add(TGMMapFileEntry.Create(Addr, SegNo, 0, SegLen, UnitName, ''));
  end;

  procedure ParseSymbolLine(const ALine: TGMString);
  var Token: TGMString; ChPos: LongInt; SegNo, Addr: DWORD; SymbolName: TGMString;
  begin
    ChPos := 1;
    Token := GMNextWord(ChPos, ALine, cWhiteSpace);
    if Token = '' then Exit;
    SegNo := GMStrToInt64(MakeHexInt(Copy(Token, 1, 4)));
    Addr := GMStrToInt64(MakeHexInt(Copy(Token, 6, 8)));

    SymbolName := GMNextWord(ChPos, ALine, cWhiteSpace);
    if SymbolName = '' then Exit;

    FSymbolList.Add(TGMMapFileEntry.Create(Addr, SegNo, 0, 0, SymbolName, ''));
  end;

  procedure ParseLineNoEntry(const List: IGMObjArrayCollection; const Entry: TGMString);
  var Token: TGMString; ChPos: LongInt; LineNo, SegNo, Addr: DWORD;
  begin
    if List = nil then Exit;
    ChPos := 1;
    Token := GMNextWord(ChPos, Entry, cWhiteSpace);
    if Token = '' then Exit;
    LineNo := GMStrToInt64(Token);

    Token := GMNextWord(ChPos, Entry, cWhiteSpace);
    if Token = '' then Exit;
    SegNo := GMStrToInt64(MakeHexInt(Copy(Token, 1, 4)));
    Addr := GMStrToInt64(MakeHexInt(Copy(Token, 6, 8)));

    List.Add(TGMMapFileEntry.Create(Addr, SegNo, LineNo, 0, '', ''));
  end;

  procedure ParseLineNoLine(const List: IGMObjArrayCollection; const line: TGMString);
  var Token1, Token2: TGMString; ChPos: LongInt;
  begin
    if List = nil then Exit;
    ChPos := 1;
    repeat
     Token1 := GMNextWord(ChPos, line, cWhiteSpace);
     if Token1 = '' then Exit;

     Token2 := GMNextWord(ChPos, line, cWhiteSpace);
     if Token2 = '' then Exit;

     ParseLineNoEntry(List, Token1 + ' ' + Token2);
    until False;
  end;

  function HandleLineNoSection(const ALine: TGMString): TGMObjArrayCollection;
  const cFor = 'for';
  var Token, UnitName, UnitPath: TGMString; Pos1, Pos2: LongInt; PIName: IUnknown;
  begin
    //Token := GMFindTextPart(ALine, cWhiteSpace, ['for'], ['segment']);
    Result := nil;
    Pos1 := 1;
    if not GMFindtoken(ALine, cFor, Pos1, cWhiteSpace) then Exit;
    Inc(Pos1, Length(cFor));
    Pos2 := Pos1;
    if not GMFindtoken(ALine, 'segment', Pos2, cWhiteSpace) then Exit;
    Token := GMStrip(Copy(ALine, Pos1, Pos2 - Pos1));
    Pos1 := 1;
    UnitName := GMNextWord(Pos1, Token, '()');
    UnitPath := GMNextWord(Pos1, Token, '()');
    PIName := TGMNameObj.Create(UnitName);

    if not FSourceFileList.Find(PIName, Result) then
     Result := FSourceFileList.Add(TGMNamedList.Create(UnitName, UnitPath, True, True, True, CompareByMapEntryAddr, False)) as TGMObjArrayCollection;
  end;

begin
  try
   if AStream = nil then Exit;
   //StartTickCount := GetTickcount;
   FCodeSegmentList.Clear;
   FSymbolList.Clear;
   FSourceFileList.Clear;
   List := nil;
   bufChPos := 1; testedLen := 0; Buf := '';
   mapFilePart := mfpNone;
   while ReadNextLine(line, bufChPos) do
    begin
     line := GMStrip(line);
     if Length(line) <= 0 then Continue;
//   if GMStrip(line) = '' then Continue;
     CheckIsText(line);

     case mapFilePart of
      mfpNone: if GMHasToken(line, 'map of segments', cWhiteSpace) then begin Inc(mapFilePart); Continue; end;
      mfpSegments: if GMHasToken(line, 'Publics by Name', cWhiteSpace) then begin Inc(mapFilePart); Continue; end;
      mfpSymByName: if GMHasToken(line, 'Publics by Value', cWhiteSpace) then begin Inc(mapFilePart); Continue; end;
      mfpSymByAddr, mfpLinNumbers:
       if GMHasToken(line, 'line numbers for', cWhiteSpace) then
        begin
         if mapFilePart = mfpSymByAddr then Inc(mapFilePart);
         List := HandleLineNoSection(line);
         Continue;
        end else
       if GMHasToken(line, 'Bound resource files', cWhiteSpace) then begin Inc(mapFilePart); Continue; end;
     end;

     case mapFilePart of
      mfpSegments: ParseSegmentLine(line);
      //mfpSymByName: ParseSymbolLine(line);
      mfpSymByAddr: ParseSymbolLine(line); // <- already sorted by address, fastest to add
      mfpLinNumbers: ParseLineNoLine(List, line);
     end;
    end;
  //vfGMMessageBox('ParseMapData: ' + IntToStr(GetTickCount - StartTickCount) + ' ms');
  except end;
end;

function TGMMapFileParser.SymbolFromMAPFile(const AAddress: DWORD): TGMString;
var UnitName, SymbolName: TGMString;
  function FindAddress(const List: IGMObjArrayCollection; const AAddress: DWORD; var Idx: LongInt): Boolean;
  var PISearch: IUNknown;
  begin
    Result := False;
    if (List = nil) or List.IsEmpty then Exit;
    PISearch := TGMMapFileEntry.Create(AAddress, 0, 0, 0, '', '', True);
    Idx := List.IndexOfNearest(PISearch);
    if not List.IsValidIndex(Idx) then Exit;
    if AAddress < (List[Idx] as TGMMapFileEntry).FAddress then Dec(Idx);
    Result := Idx >= 0;
  end;

  function FindName(const List: IGMObjArrayCollection; const AAddress: DWORD): TGMString;
  var Idx: LongInt;
  begin
    Result := '';
    if not FindAddress(List, AAddress, Idx) then Exit;
    with List[Idx] as TGMMapFileEntry do
     if (FSegLen = 0) or ((AAddress >= FAddress) and (AAddress < FAddress + FSegLen)) then Result := FName;
    if Result = '' then Result := '?';
  end;

  function FindLine(const UnitName: TGMString; const AAddress: DWORD): TGMString;
  var PIName: IUnknown; AddrIdx, LineNo: LongInt; SrcFile: TObject;
  begin
    Result := '';
    PIName := TGMNameObj.Create(UnitName);
    if not FSourceFileList.Find(PIName, SrcFile) then Exit;
    //with FSourceFileList[Idx] as TGMNamedList do
     //begin
      if not FindAddress(SrcFile as TGMObjArrayCollection, AAddress, AddrIdx) then Exit;
      LineNo := ((SrcFile as TGMObjArrayCollection)[Max(0, AddrIdx-1)] as TGMMapFileEntry).FLineNo;
      Result := GMFormat('line %d (%s)', [LineNo, (SrcFile as TGMNamedList).FPath]);
     //end;
  end;
begin
  UnitName := FindName(FCodeSegmentList, AAddress);
  SymbolName := FindName(FSymbolList, AAddress);
  //if (SymbolName <> '') and (SymbolName <> '?') then SymbolName := SymbolName + '( ... )';
  Result := GMStringJoin(GMStringJoin(SymbolName, ' - in Unit ', GMQuote(UnitName, '"', '"')), ' ', FindLine(UnitName, AAddress));
end;


{ --------------------------- }
{ ---- TGMMapFileManager ---- }
{ --------------------------- }

constructor TGMMapFileManager.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FMapFileList := TGMObjArrayCollection.Create(True, False, True, GMComparebyName, True);
end;

function TGMMapFileManager.Obj: TGMMapFileManager;
begin
  Result := Self;
end;

function TGMMapFileManager.SymbolFromMAPFile(const AModuleHandle: THandle; const AModuleFileName: TGMString; const AAddress: DWORD; var AStackTrace: TGMStringArray): TGMString;
var PIName: IUnknown; MapParser: TObject;
begin
  Result := '';
  PIName := TGMNameObj.Create(AModuleFileName);
  if FMapFileList.Find(PIName, MapParser) then
   Result := (MapParser as TGMMapFileParser).SymbolFromMAPFile(AAddress)
  else
   Result := (FMapFileList.Add(TGMMapFileParser.Create(AModuleHandle, AModuleFileName, AStackTrace)) as TGMMapFileParser).SymbolFromMAPFile(AAddress);
end;


{ ---------------------------------- }
{ ---- Callstack name resolving ---- }
{ ---------------------------------- }

procedure GMTraceCallStackNames(var DestTrace: TGMStringArray; const StackAddresses: TGMPtrIntArray);
var memInfo: MEMORY_BASIC_INFORMATION; symDataBuf, symSearchPath: AnsiString; moduleFileName, symbolName: TGMString;
    moduleHandle: THandle; symInitialized: BOOL; displacement: DWORD; mapFileMgr: IGMMapFileManager; i: LongInt;

  function AddStackError2(const ApiCode: LongWord; const RoutineName: TGMString): LongWord;
  begin
    Result := ApiCode;
    if ApiCode <> NOERROR then GMAddStrToArray(GMFormat('%s: %s', [RoutineName, GMSysErrorMsg(LongInt(ApiCode), [])]), DestTrace);
  end;

  function AddStackError(const ApiRet: BOOL; const RoutineName: TGMString): Boolean;
  begin
    Result := ApiRet;
    if not Result then AddStackError2(GetLastError, RoutineName);
  end;

begin
  symSearchPath := GetSymbolSearchPath('');
  SymSetOptions(SYMOPT_UNDNAME or SYMOPT_DEFERRED_LOADS or SYMOPT_LOAD_LINES);
  symInitialized := AddStackError(SymInitialize(GetCurrentProcess, PAnsiChar(symSearchPath), True), 'SymInitialize');
  try
   SymSetOptions(SYMOPT_UNDNAME or SYMOPT_LOAD_LINES);
   mapFileMgr := TGMMapFileManager.Create(True);

   for i:=Low(StackAddresses) to High(StackAddresses) do
    begin
     if not AddStackError((VirtualQuery(Pointer(StackAddresses[i]), memInfo, sizeof(memInfo)) = SizeOf(memInfo)), 'VirtualQuery')
        or (memInfo.State <> MEM_COMMIT) then Continue;

     moduleHandle := THandle(memInfo.AllocationBase);

     SetLength(moduleFileName, 1024);
     SetLength(moduleFileName, GetModuleFileName(moduleHandle, PGMChar(moduleFileName), Length(moduleFileName)));
     if Length(moduleFileName) = 0 then Continue;
     moduleFileName := GMLongPathName(moduleFileName);

     if DWORD(StackAddresses[i]) < DWORD(memInfo.AllocationBase) + $1000 then Continue; // <- should not happen ..

     symbolName := mapFileMgr.Obj.SymbolFromMAPFile(moduleHandle, moduleFileName,
                          DWORD(StackAddresses[i]) - DWORD(memInfo.AllocationBase) - $1000, DestTrace);

     if (Length(symbolName) <= 0) and symInitialized then
      begin
       SetLength(symDataBuf, 1024);
       with PIMAGEHLP_SYMBOL(PAnsiChar(symDataBuf))^ do
        begin
         SizeOfStruct := SizeOf(IMAGEHLP_SYMBOL);
         MaxNameLength := DWORD(Length(symDataBuf) - LongInt(SizeOfStruct) + 1);
        end;

       if SymGetSymFromAddr(GetCurrentProcess, PtrUInt(StackAddresses[i]), @displacement, PIMAGEHLP_SYMBOL(PAnsiChar(symDataBuf))) then
          symbolName := PAnsiChar(@PIMAGEHLP_SYMBOL(PAnsiChar(symDataBuf)).Name);
      end;

     GMAddStrToArray(GMStringJoin(moduleFileName, ' - ', symbolName), DestTrace);
    end;
  finally
   if symInitialized then SymCleanup(GetCurrentProcess);
  end;
end;


end.