paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 04:09:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Start external dbg file support for Win

Browse Source 
git-svn-id: trunk@65390 -
This commit is contained in:
martin 2021-07-06 21:39:38 +00:00
parent 9f896e3f00
commit 686e81d6e3
2 changed files with 114 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
components/fpdebug/fpimgreaderbase.pas
View File

@ -68,10 +68,12 @@ type
FMapHandle: THandle;
FModulePtr: Pointer;
{$else}
FFileName: String;
FStream: TStream;
FList: TList;
{$endif}
FFileName: String;
function GetFileName: String;
public
constructor Create(AFileName: String);
{$ifdef USE_WIN_FILE_MAPPING}
@ -82,6 +84,7 @@ type
function Read(AOffset, ASize: QWord; AMem: Pointer): QWord;
function LoadMemory(AOffset, ASize: QWord; out AMem: Pointer): QWord;
procedure UnloadMemory({%H-}AMem: Pointer);
property FileName: String read GetFileName;
end;
{ TDbgImageReader }
@ -195,12 +198,53 @@ begin
end;
{$ifdef USE_WIN_FILE_MAPPING}
type
TGetFinalPathNameByHandle = function(hFile: THandle; lpszFilePath: PWideChar; cchFilePath, dwFlags: DWORD): DWORD; stdcall;
var
GetFinalPathNameByHandle: TGetFinalPathNameByHandle = nil;
function GetFinalPathNameByHandleDummy(hFile: THandle; lpszFilePath: PWideChar; cchFilePath, dwFlags: DWORD): DWORD; stdcall;
begin
Result := 0;
end;
function FileHandleToFileName(Handle : THandle): string;
var
U: WideString;
hmod: HMODULE;
begin
if not Assigned(GetFinalPathNameByHandle) then
begin
hmod := GetModuleHandle('kernel32');
if hmod <> 0 then
Pointer(GetFinalPathNameByHandle) := GetProcAddress(hmod,'GetFinalPathNameByHandleW');
if not Assigned(GetFinalPathNameByHandle) then
GetFinalPathNameByHandle := @GetFinalPathNameByHandleDummy;
end;
SetLength(U, MAX_PATH+1);
SetLength(U, GetFinalPathNameByHandle(Handle, @U[1], Length(U), 0));
if Copy(U, 1, 4)='\\?\' then
Delete(U, 1, 4);
Result := U;
end;
{$endif}
{ TDbgFileLoader }
{$ifdef USE_WIN_FILE_MAPPING}
function CreateFileW(lpFileName:LPCWSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; stdcall; external 'kernel32' name 'CreateFileW';
{$ENDIF}
function TDbgFileLoader.GetFileName: String;
begin
{$ifdef USE_WIN_FILE_MAPPING}
if (FFileName = '') and (FFileHandle <> 0) then begin
FFileName := FileHandleToFileName(FFileHandle);
end;
{$endif}
Result := FFileName;
end;
constructor TDbgFileLoader.Create(AFileName: String);
{$IFDEF MacOS}
var
@ -212,6 +256,7 @@ var
{$ENDIF}
begin
{$ifdef USE_WIN_FILE_MAPPING}
FFileName := AFileName;
s := UTF8Decode(AFileName);
FFileHandle := CreateFileW(PWideChar(s), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Create(FFileHandle);

73
components/fpdebug/fpimgreaderwinpe.pas
View File

@ -41,7 +41,7 @@ interface
uses
Classes, {$ifdef windows}windows,{$endif} SysUtils, math,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazUTF8,
DbgIntfBaseTypes,
DbgIntfBaseTypes, LazFileUtils, crc,
FpImgReaderBase, FpImgReaderWinPETypes, fpDbgSymTable;
type
@ -60,6 +60,7 @@ type
function MapVirtAddressToSection(AVirtAddr: Pointer): Pointer;
procedure LoadSections;
procedure ClearSections;
public
class function isValid(ASource: TDbgFileLoader): Boolean; override;
class function UserName: AnsiString; override;
@ -101,6 +102,13 @@ begin
end;
constructor TPEFileSource.Create(ASource: TDbgFileLoader; ADebugMap: TObject; OwnSource: Boolean);
var
p: PDbgImageSectionEx;
crc, c: cardinal;
DbgFileName, SourceFileName: String;
i, j: Integer;
mem: Pointer;
NewFileLoader: TDbgFileLoader;
begin
FSections := TStringListUTF8Fast.Create;
FSections.Sorted := False; // need sections in original order / Symbols use "SectionNumber"
@ -110,16 +118,71 @@ begin
FFileLoader:=ASource;
FOwnLoader:=OwnSource;
LoadSections;
// check external debug file
p := PDbgImageSectionEx(Section['.gnu_debuglink']);
if p <> nil then
begin
if IndexByte(p^.Sect.RawData^, p^.Sect.Size-4, 0) < p^.Sect.Size then
begin
DbgFileName := StrPas(PChar(PDbgImageSectionEx(p)^.Sect.RawData));
i := align(length(DbgFileName)+1, 4);
if (i+4) <= p^.Sect.Size then begin
move((p^.Sect.RawData+i)^, crc, 4);
SourceFileName := ASource.FileName;
if SourceFileName<>'' then
DbgFileName := ExtractFilePath(SourceFileName)+DbgFileName;
if FileExists(DbgFileName) then
begin
NewFileLoader := TDbgFileLoader.Create(DbgFileName);
i := FileSizeUtf8(DbgFileName) - 4096;
j := 0;
c:=0;
while j < i do begin
NewFileLoader.LoadMemory(j, 4096, mem);
c:=Crc32(c, mem, 4096);
NewFileLoader.UnloadMemory(mem);
inc(j, 4096)
end;
i := i - j + 4096;
NewFileLoader.LoadMemory(j, i, mem);
c:=Crc32(c, mem, i);
NewFileLoader.UnloadMemory(mem);
debugln(crc <> c, ['Invalid CRC for ext debug info']);
if crc = c then begin
if FOwnLoader then
FFileLoader.Free;
FFileLoader := NewFileLoader;
FOwnLoader := True;
ClearSections;
LoadSections;
end
else
NewFileLoader.Free;
end;
end;
end;
end;
inherited Create(ASource, ADebugMap, OwnSource);
end;
procedure TPEFileSource.ClearSections;
var
i: Integer;
begin
for i := 0 to FSections.Count-1 do
Freemem(FSections.Objects[i]);
FSections.Clear;
end;
destructor TPEFileSource.Destroy;
begin
if FOwnLoader then FFileLoader.Free;
while FSections.Count > 0 do begin
Freemem(FSections.Objects[0]);
FSections.Delete(0);
end;
ClearSections;
FSections.Free;
inherited Destroy;
end;