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

FpDebug: New TTargetDescriptor type used to store target specific information. All target specific classes are automatically registered in the respective initialization sections. TDbgController.Run modified to call CheckExecutableAndLoadClasses which loads target info from specified file, loads global disassembler instance and DbgProcess class. Patch/Contributed by ccrause

Browse Source 
git-svn-id: trunk@62748 -
This commit is contained in:
martin 2020-03-12 14:20:33 +00:00
parent 2e1bd02f2d
commit 2ee9c0fe84
20 changed files with 366 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1417,6 +1417,7 @@ components/fpdebug/app/fpdserver/fpdserver.lpi svneol=native#text/plain
components/fpdebug/app/fpdserver/fpdserver.lpr svneol=native#text/plain
components/fpdebug/app/fpdserver/readme.txt svneol=native#text/plain
components/fpdebug/fpdbgclasses.pp svneol=native#text/pascal
components/fpdebug/fpdbgcommon.pas svneol=native#text/pascal
components/fpdebug/fpdbgcontroller.pas svneol=native#text/plain
components/fpdebug/fpdbgdarwinclasses.pas svneol=native#text/plain
components/fpdebug/fpdbgdisasx86.pp svneol=native#text/plain

8
components/fpdebug/app/fpd/fpd.lpr
View File

@ -48,12 +48,12 @@ uses
FPDLoop,
FpDbgClasses,
FpDbgDwarfConst,
FpDbgDwarf
FpDbgDwarf,
// The debug classes auto register with initialization, so include them somewhere
// The $ifdef below will not work for cross debugging of a remote target
{$ifdef DARWIN}, FpDbgDarwinClasses,{$endif}
{$ifdef LINUX}, FpDbgLinuxClasses,{$endif}
;
{$ifdef DARWIN}FpDbgDarwinClasses,{$endif}
{$ifdef LINUX}FpDbgLinuxClasses,{$endif}
FpDbgCommon;
{$ifdef windows}
function CtrlCHandler(CtrlType: Cardinal): BOOL; stdcall;

37
components/fpdebug/fpdbgclasses.pp
View File

@ -43,7 +43,7 @@ uses
DbgIntfDebuggerBase,
FpPascalBuilder,
fpDbgSymTableContext,
FpDbgDwarfDataClasses;
FpDbgDwarfDataClasses, FpDbgCommon;
type
TFPDEvent = (deExitProcess, deFinishedStep, deBreakpoint, deException, deCreateProcess, deLoadLibrary, deUnloadLibrary, deInternalContinue);
@ -489,6 +489,7 @@ public
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses): TDbgProcess; virtual;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; virtual;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses); virtual;
destructor Destroy; override;
function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
@ -632,7 +633,7 @@ const
DBGPTRSIZE: array[TFPDMode] of Integer = (4, 8);
FPDEventNames: array[TFPDEvent] of string = ('deExitProcess', 'deFinishedStep', 'deBreakpoint', 'deException', 'deCreateProcess', 'deLoadLibrary', 'deUnloadLibrary', 'deInternalContinue');
function GetDbgProcessClass: TOSDbgClasses;
function GetDbgProcessClass(ATargetInfo: TTargetDescriptor): TOSDbgClasses;
procedure RegisterDbgOsClasses(ADbgOsClasses: TOSDbgClasses);
@ -660,11 +661,24 @@ var
DBG_VERBOSE, DBG_WARNINGS, DBG_BREAKPOINTS, FPDBG_COMMANDS: PLazLoggerLogGroup;
RegisteredDbgProcessClasses: TOSDbgClassesList;
function GetDbgProcessClass: TOSDbgClasses;
function GetDbgProcessClass(ATargetInfo: TTargetDescriptor): TOSDbgClasses;
var
i : Integer;
begin
for i := 0 to RegisteredDbgProcessClasses.Count - 1 do
begin
Result := RegisteredDbgProcessClasses[i];
try
if Result.DbgProcessClass.isSupported(ATargetInfo) then
Exit;
except
on e: exception do
begin
//writeln('exception! WHY? ', e.Message);
end;
end;
end;
Result := nil;
if RegisteredDbgProcessClasses.Count = 1 then
Result := RegisteredDbgProcessClasses[0];
end;
procedure RegisterDbgOsClasses(ADbgOsClasses: TOSDbgClasses);
@ -1364,7 +1378,7 @@ end;
procedure TDbgInstance.LoadInfo;
begin
InitializeLoaders;
if FLoaderList.Image64Bit then
if FLoaderList.TargetInfo.bitness = b64 then //Image64Bit then
FMode:=dm64
else
FMode:=dm32;
@ -1878,6 +1892,11 @@ begin
Result := nil;
end;
class function TDbgProcess.isSupported(ATargetInfo: TTargetDescriptor): boolean;
begin
result := false;
end;
procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
begin
if AThread = FMainThread
@ -2407,10 +2426,10 @@ begin
begin
if not Process.Disassembler.GetFunctionFrameInfo(Address, OutSideFrame) then begin
if Process.Disassembler.LastErrorWasMemReadErr then begin
inc(CodeReadErrCnt);
if CodeReadErrCnt > 5 then break; // If the code cannot be read the stack pointer is wrong.
inc(CodeReadErrCnt);
if CodeReadErrCnt > 5 then break; // If the code cannot be read the stack pointer is wrong.
end;
OutSideFrame := False;
OutSideFrame := False;
end;
LastFrameBase := FrameBase;
if OutSideFrame then begin

49
components/fpdebug/fpdbgcommon.pas Normal file
View File

@ -0,0 +1,49 @@
unit FpDbgCommon;
{$mode objfpc}{$H+}
interface
type
// Target information, could be different from host debugger
TMachineType = (mtNone, mtSPARC, mt386, mt68K, mtPPC, mtPPC64, mtARM,
mtOLD_ALPHA, mtIA_64, mtX86_64, mtAVR8, mtALPHA);
TBitness = (bNone, b32, b64);
TByteOrder = (boNone, boLSB, boMSB);
TOperatingSystem = (osNone, osBSD, osDarwin, osEmbedded, osLinux, osMac, osWindows);
TTargetDescriptor = record
machineType: TMachineType;
bitness: TBitness;
byteOrder: TByteOrder;
OS: TOperatingSystem;
end;
// This function returns the host descriptor
// Use when target information not yet loaded - assumes that debug target is the same as host
function hostDescriptor: TTargetDescriptor;
implementation
function hostDescriptor: TTargetDescriptor;
begin
with Result do
begin
// TODO: Expand list when debugger support updated for other targets
machineType := {$if defined(CPU386) or defined(CPUI386)} mt386
{$elseif defined(CPUX86_64) or defined(CPUAMD64) or defined(CPUX64)} mtX86_64
{$elseif defined(CPUARM)} mtARM
{$elseif defined(CPUPOWERPC)} mtPPC
{$endif};
bitness := {$if defined(CPU64)} b64 {$elseif defined(CPU32)} b32 {$else} bNone {$endif};
byteorder := {$ifdef ENDIAN_LITTLE} boLSB {$else} boMSB {$endif};
OS := {$if defined(DARWIN)} osDarwin
{$elseif defined(LINUX)} osLinux
{$elseif defined(MSWINDOWS)} osWindows {$endif};
end;
end;
end.

93
components/fpdebug/fpdbgcontroller.pas
View File

@ -276,6 +276,9 @@ type
implementation
uses
FpImgReaderBase, FpDbgCommon;
var
DBG_VERBOSE, DBG_WARNINGS, FPDBG_COMMANDS: PLazLoggerLogGroup;
@ -510,7 +513,7 @@ procedure TDbgControllerStepOverInstructionCmd.InternalContinue(
begin
assert(FProcess=AProcess, 'TDbgControllerStepOverInstructionCmd.DoContinue: FProcess=AProcess');
if (AThread = FThread) then
CheckForCallAndSetBreak;
CheckForCallAndSetBreak;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
end;
@ -685,7 +688,7 @@ procedure TDbgControllerStepOverLineCmd.InternalContinue(AProcess: TDbgProcess;
begin
assert(FProcess=AProcess, 'TDbgControllerStepOverLineCmd.DoContinue: FProcess=AProcess');
if (AThread = FThread) then
CheckForCallAndSetBreak;
CheckForCallAndSetBreak;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
end;
@ -758,40 +761,40 @@ begin
assert(FProcess=AProcess, 'TDbgControllerStepOutCmd.DoContinue: FProcess=AProcess');
if (AThread = FThread) then begin
if IsSteppedOut then begin
CheckForCallAndSetBreak;
if IsSteppedOut then begin
CheckForCallAndSetBreak;
end
else
if not assigned(FHiddenBreakpoint) then begin
if GetOutsideFrame(Outside) then begin
SetReturnAdressBreakpoint(AProcess, Outside);
end
else
if not assigned(FHiddenBreakpoint) then begin
if GetOutsideFrame(Outside) then begin
SetReturnAdressBreakpoint(AProcess, Outside);
end
else
if FStepCount < 12 then
begin
// During the prologue and epiloge of a procedure the call-stack might not been
// setup already. To avoid problems in these cases, start with a few (max
// 12) single steps.
Inc(FStepCount);
if FStepCount < 12 then
begin
// During the prologue and epiloge of a procedure the call-stack might not been
// setup already. To avoid problems in these cases, start with a few (max
// 12) single steps.
Inc(FStepCount);
if NextInstruction.IsCallInstruction or NextInstruction.IsLeaveStackFrame then // asm "call" // set break before "leave" or the frame becomes unavail
begin
SetReturnAdressBreakpoint(AProcess, False);
end
else
if NextInstruction.IsReturnInstruction then // asm "ret"
begin
FStepCount := MaxInt; // Do one more single-step, and we're finished.
FProcess.Continue(FProcess, FThread, True);
exit;
end;
begin
SetReturnAdressBreakpoint(AProcess, False);
end
else
if NextInstruction.IsReturnInstruction then // asm "ret"
begin
// Enough with the single-stepping
SetReturnAdressBreakpoint(AProcess, False);
FStepCount := MaxInt; // Do one more single-step, and we're finished.
FProcess.Continue(FProcess, FThread, True);
exit;
end;
end
else
begin
// Enough with the single-stepping
SetReturnAdressBreakpoint(AProcess, False);
end;
end;
end;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
end;
@ -874,8 +877,28 @@ begin
end;
procedure TDbgController.CheckExecutableAndLoadClasses;
var
source: TDbgFileLoader;
imgReader: TDbgImageReader;
ATargetInfo: TTargetDescriptor;
begin
FOsDbgClasses := FpDbgClasses.GetDbgProcessClass;
if (FExecutableFilename <> '') and FileExists(FExecutableFilename) then
begin
DebugLn(DBG_VERBOSE, 'TDbgController.CheckExecutableAndLoadClasses');
try
source := TDbgFileLoader.Create(FExecutableFilename);
imgReader := GetImageReader(source, nil, false);
ATargetInfo := imgReader.TargetInfo;
finally
FreeAndNil(imgReader); // TODO: Store object reference, it will be needed again
FreeAndNil(source);
end;
end
else
ATargetInfo := hostDescriptor;
FOsDbgClasses := FpDbgClasses.GetDbgProcessClass(ATargetInfo);
end;
procedure TDbgController.SetExecutableFilename(AValue: string);
@ -1273,10 +1296,16 @@ begin
case FPDEvent of
deCreateProcess:
begin
(* Only events for the main process get here / See ProcessLoop *)
FCurrentProcess.LoadInfo;
if not FCurrentProcess.DbgInfo.HasInfo then
DebugLn(DBG_WARNINGS, 'No Dwarf-debug information available. The debugger will not function properly. [CurrentProcess='+dbgsname(FCurrentProcess)+',DbgInfo='+dbgsname(FCurrentProcess.DbgInfo)+']');
(* Only events for the main process get here / See ProcessLoop *)
if not Assigned(FCurrentProcess.DbgInfo) then
FCurrentProcess.LoadInfo;
DebugLn(DBG_WARNINGS and (not Assigned(FCurrentProcess.DbgInfo) or not(FCurrentProcess.DbgInfo.HasInfo)),
['TDbgController.SendEvents called - deCreateProcess - No debug info. [CurrentProcess=',dbgsname(FCurrentProcess),',DbgInfo=',dbgsname(FCurrentProcess.DbgInfo),']']);
DebugLn(DBG_VERBOSE, Format(' Target.MachineType = %d', [FCurrentProcess.DbgInfo.TargetInfo.machineType]));
DebugLn(DBG_VERBOSE, Format(' Target.Bitness = %d', [FCurrentProcess.DbgInfo.TargetInfo.bitness]));
DebugLn(DBG_VERBOSE, Format(' Target.byteOrder = %d', [FCurrentProcess.DbgInfo.TargetInfo.byteOrder]));
DebugLn(DBG_VERBOSE, Format(' Target.OS = %d', [FCurrentProcess.DbgInfo.TargetInfo.OS]));
DoOnDebugInfoLoaded(self);

17
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -21,7 +21,8 @@ uses
MacOSAll,
FpDbgUtil,
UTF8Process,
LazLoggerBase;
LazLoggerBase,
FpDbgCommon;
type
x86_thread_state32_t = record
@ -146,6 +147,7 @@ type
function CreateWatchPointData: TFpWatchPointData; override;
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses); override;
destructor Destroy; override;
@ -162,6 +164,7 @@ type
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
function Pause: boolean; override;
end;
TDbgDarwinProcessClass = class of TDbgDarwinProcess;
implementation
@ -712,6 +715,18 @@ begin
end;
end;
class function TDbgDarwinProcess.isSupported(ATargetInfo: TTargetDescriptor
): boolean;
begin
Result := inherited isSupported(ATargetInfo);
end;
class function TDbgLinuxProcess.isSupported(target: TTargetDescriptor): boolean;
begin
result := (target.OS = osDarwin) and
(target.machineType = mtX86_64);
end;
function TDbgDarwinProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean;
var

7
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -43,7 +43,8 @@ interface
uses
Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math,
FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages,
LazLoggerBase, LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes;
LazLoggerBase, LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes,
FpDbgCommon;
type
TDwarfSection = (dsAbbrev, dsARanges, dsFrame, dsInfo, dsLine, dsLoc, dsMacinfo, dsPubNames, dsPubTypes, dsRanges, dsStr);
@ -644,7 +645,6 @@ type
private
FCompilationUnits: TList;
FImageBase: QWord;
FImage64Bit: Boolean;
FMemManager: TFpDbgMemManager;
FFiles: array of TDwarfDebugFile;
function GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit;
@ -669,7 +669,6 @@ type
property MemManager: TFpDbgMemManager read FMemManager write FMemManager;
property ImageBase: QWord read FImageBase;
property Image64Bit: Boolean read FImage64Bit;
end;
TDwarfLocationExpression = class;
@ -3169,7 +3168,7 @@ var
i: Integer;
begin
inherited Create(ALoaderList);
FImage64Bit := ALoaderList.Image64Bit;
FTargetInfo := ALoaderList.TargetInfo;
FCompilationUnits := TList.Create;
FImageBase := ALoaderList.ImageBase;

5
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -215,6 +215,9 @@ type
implementation
uses
FpDbgCommon;
var
FPDBG_DWARF_VERBOSE: PLazLoggerLogGroup;
@ -412,7 +415,7 @@ var
d, i: Integer;
ParentFpSym: TFpSymbolDwarf;
begin
if Dwarf.Image64Bit then begin
if Dwarf.TargetInfo.bitness = b64 then begin
RegFP := RegFp64;
RegPc := RegPc64;
end

4
components/fpdebug/fpdbginfo.pas
View File

@ -33,7 +33,7 @@ interface
uses
Classes, SysUtils, DbgIntfBaseTypes, FpDbgLoader, FpdMemoryTools, FpErrorMessages,
LazLoggerBase, LazClasses;
LazLoggerBase, LazClasses, FpDbgCommon;
type
@ -478,6 +478,7 @@ type
private
FHasInfo: Boolean;
protected
FTargetInfo: TTargetDescriptor;
procedure SetHasInfo;
public
constructor Create({%H-}ALoaderList: TDbgImageLoaderList); virtual;
@ -494,6 +495,7 @@ type
property HasInfo: Boolean read FHasInfo;
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; virtual;
//property MemManager: TFpDbgMemReaderBase read GetMemManager write SetMemManager;
property TargetInfo: TTargetDescriptor read FTargetInfo write FTargetInfo;
end;
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String; overload;

12
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -20,7 +20,8 @@ uses
FpDbgInfo,
FpDbgUtil,
UTF8Process,
LazLoggerBase, Maps;
LazLoggerBase, Maps,
FpDbgCommon;
type
user_regs_struct64 = record
@ -295,6 +296,7 @@ type
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses
): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses); override;
destructor Destroy; override;
@ -312,6 +314,7 @@ type
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
end;
TDbgLinuxProcessClass = class of TDbgLinuxProcess;
implementation
@ -819,6 +822,13 @@ begin
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
class function TDbgLinuxProcess.isSupported(ATargetInfo: TTargetDescriptor
): boolean;
begin
result := (ATargetInfo.OS = osLinux) and
(ATargetInfo.machineType in [mt386, mtX86_64]);
end;
function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean;

44
components/fpdebug/fpdbgloader.pp
View File

@ -43,7 +43,7 @@ uses
LCLType,
FpImgReaderBase, FpImgReaderWinPE, FpImgReaderElf, FpImgReaderMacho,
fpDbgSymTable, DbgIntfBaseTypes,
Classes, SysUtils, contnrs;
Classes, SysUtils, contnrs, FpDbgCommon;
type
@ -63,12 +63,11 @@ type
function GetAddressMapList: TDbgAddressMapList;
function GetReaderErrors: String;
function GetSubFiles: TStrings;
function GetImage64Bit: Boolean;
function GetTargetInfo: TTargetDescriptor;
function GetUUID: TGuid;
protected
FImageBase: QWord unimplemented;
function GetSection(const AName: String): PDbgImageSection; virtual;
//procedure SetImageBase(ABase: QWord);
property ImgReader: TDbgImageReader read FImgReader write FImgReader;
public
constructor Create; virtual;
@ -85,7 +84,8 @@ type
function IsValid: Boolean;
property FileName: String read FFileName; // Empty if using USE_WIN_FILE_MAPPING
property ImageBase: QWord read FImageBase; unimplemented;
Property Image64Bit: Boolean read GetImage64Bit;
property TargetInfo: TTargetDescriptor read GetTargetInfo;
property UUID: TGuid read GetUUID;
property Section[const AName: String]: PDbgImageSection read GetSection;
// On Darwin, the Dwarf-debuginfo is not linked into the main
@ -108,32 +108,20 @@ type
TDbgImageLoaderList = class(TFPObjectList)
private
function GetImage64Bit: Boolean;
function GetImageBase: QWord;
function GetTargetInfo: TTargetDescriptor;
function GetItem(Index: Integer): TDbgImageLoader;
procedure SetItem(Index: Integer; AValue: TDbgImageLoader);
public
property Items[Index: Integer]: TDbgImageLoader read GetItem write SetItem; default;
property ImageBase: QWord read GetImageBase;
Property Image64Bit: Boolean read GetImage64Bit;
property TargetInfo: TTargetDescriptor read GetTargetInfo;
end;
implementation
{ TDbgImageLoaderList }
function TDbgImageLoaderList.GetImage64Bit: Boolean;
begin
if Count>0 then
result := Items[0].Image64Bit
else
{$ifdef CPU64}
result := true
{$else}
result := false;
{$endif}
end;
function TDbgImageLoaderList.GetImageBase: QWord;
begin
if Count>0 then
@ -142,6 +130,14 @@ begin
result := 0;
end;
function TDbgImageLoaderList.GetTargetInfo: TTargetDescriptor;
begin
if Count>0 then
result := Items[0].TargetInfo
else
Result := hostDescriptor;
end;
function TDbgImageLoaderList.GetItem(Index: Integer): TDbgImageLoader;
begin
result := TDbgImageLoader(inherited GetItem(Index));
@ -163,16 +159,12 @@ end;
{ TDbgImageLoader }
function TDbgImageLoader.GetImage64Bit: Boolean;
function TDbgImageLoader.GetTargetInfo: TTargetDescriptor;
begin
if not assigned(ImgReader) then
{$ifdef cpui386}
result := false
{$else}
result := true
{$endif}
if assigned(ImgReader) then
result := ImgReader.TargetInfo
else
result := ImgReader.Image64Bit;
result := hostDescriptor;
end;
function TDbgImageLoader.GetAddressMapList: TDbgAddressMapList;

9
components/fpdebug/fpdbgsymtablecontext.pas
View File

@ -12,7 +12,8 @@ uses
DbgIntfBaseTypes,
fpDbgSymTable,
FpdMemoryTools,
FpDbgInfo;
FpDbgInfo,
FpDbgCommon;
type
@ -47,7 +48,6 @@ type
private
FSymbolList: TfpSymbolList;
FContext: TFpSymbolContext;
FImage64Bit: boolean;
public
constructor Create(ALoaderList: TDbgImageLoaderList); override;
destructor Destroy; override;
@ -55,7 +55,6 @@ type
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override;
function FindProcSymbol(const AName: String): TFpSymbol; override; overload;
function FindProcSymbol(AnAdress: TDbgPtr): TFpSymbol; overload;
property Image64Bit: boolean read FImage64Bit;
end;
implementation
@ -96,7 +95,7 @@ constructor TFpSymbolContext.Create(AFpSymbolInfo: TFpSymbolInfo);
begin
inherited create;
FFpSymbolInfo:=AFpSymbolInfo;
if AFpSymbolInfo.Image64Bit then
if AFpSymbolInfo.TargetInfo.bitness = b64 then
FSizeOfAddress:=8
else
FSizeOfAddress:=4;
@ -132,7 +131,7 @@ begin
FSymbolList := TfpSymbolList.Create;
for i := 0 to ALoaderList.Count-1 do
ALoaderList[i].ParseSymbolTable(FSymbolList);
FImage64Bit := ALoaderList.Image64Bit;
FTargetInfo := ALoaderList.TargetInfo;
if FSymbolList.Count > 0 then
SetHasInfo;
end;

17
components/fpdebug/fpdbgwinclasses.pas
View File

@ -118,11 +118,11 @@ uses
FpDbgInfo,
FpDbgLoader, FpDbgDisasX86,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
LazLoggerBase, UTF8Process;
LazLoggerBase, UTF8Process,
FpDbgCommon;
type
TWinBitness = (b32, b64);
TFpWinCtxFlags = (cfSkip, cfControl, cfFull);
{ TDbgWinThread }
@ -165,7 +165,7 @@ type
FInfo: TCreateProcessDebugInfo;
FProcProcess: TProcessUTF8;
FJustStarted, FTerminated: boolean;
FBitness: TWinBitness;
FBitness: TBitness;
function GetFullProcessImageName(AProcessHandle: THandle): string;
function GetModuleFileName(AModuleHandle: THandle): string;
function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string;
@ -190,6 +190,9 @@ type
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
@ -206,6 +209,7 @@ type
function AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
end;
TDbgWinProcessClass = class of TDbgWinProcess;
{ tDbgWinLibrary }
@ -656,6 +660,13 @@ begin
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
class function TDbgWinProcess.isSupported(ATargetInfo: TTargetDescriptor
): boolean;
begin
result := (ATargetInfo.OS = osWindows) and
(ATargetInfo.machineType in [mt386, mtX86_64]);
end;
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
SingleStep: boolean): boolean;

15
components/fpdebug/fpimgreaderbase.pas
View File

@ -13,7 +13,8 @@ uses
{$endif}
fgl, lazfglhash,
fpDbgSymTable,
Classes, SysUtils, LazUTF8Classes, DbgIntfBaseTypes, contnrs;
Classes, SysUtils, LazUTF8Classes, DbgIntfBaseTypes, contnrs,
FpDbgCommon;
type
TDbgImageSection = record
@ -87,18 +88,17 @@ type
TDbgImageReader = class(TObject) // executable parser
private
FImage64Bit: Boolean;
FImageBase: QWord;
FLoadedTargetImageAddr: TDBGPtr;
FReaderErrors: String;
FUUID: TGuid;
protected
FTargetInfo: TTargetDescriptor;
function GetSubFiles: TStrings; virtual;
function GetAddressMapList: TDbgAddressMapList; virtual;
function GetSection(const AName: String): PDbgImageSection; virtual; abstract;
procedure SetUUID(AGuid: TGuid);
procedure SetImageBase(ABase: QWord);
procedure SetImage64Bit(AValue: Boolean);
procedure AddReaderError(AnError: String);
public
class function isValid(ASource: TDbgFileLoader): Boolean; virtual; abstract;
@ -109,7 +109,9 @@ type
procedure AddSubFilesToLoaderList(ALoaderList: TObject; PrimaryLoader: TObject); virtual;
property ImageBase: QWord read FImageBase;
Property Image64Bit: Boolean read FImage64Bit;
property TargetInfo: TTargetDescriptor read FTargetInfo;
property UUID: TGuid read FUUID;
property Section[const AName: String]: PDbgImageSection read GetSection;
property SubFiles: TStrings read GetSubFiles;
@ -333,11 +335,6 @@ begin
FImageBase := ABase;
end;
procedure TDbgImageReader.SetImage64Bit(AValue: Boolean);
begin
FImage64Bit := AValue;
end;
procedure TDbgImageReader.AddReaderError(AnError: String);
begin
if FReaderErrors <> '' then

70
components/fpdebug/fpimgreaderelf.pas
View File

@ -34,8 +34,8 @@ uses
Classes, SysUtils,
FpImgReaderBase,
fpDbgSymTable, DbgIntfBaseTypes,
FpImgReaderElfTypes, LCLProc; // these files are part of
FpImgReaderElfTypes, LCLProc, // these files are part of
FpDbgCommon;
type
TElfSection = packed record
@ -49,7 +49,8 @@ type
TElfFile = class(TObject)
private
FIs64Bit: boolean;
FTargetInfo: TTargetDescriptor;
function FElfToMachineType(machinetype: word): TMachineType;
protected
function Load32BitFile(ALoader: TDbgFileLoader): Boolean;
function Load64BitFile(ALoader: TDbgFileLoader): Boolean;
@ -59,7 +60,6 @@ type
seccount : Integer;
function LoadFromFile(ALoader: TDbgFileLoader): Boolean;
function FindSection(const Name: String): Integer;
property Is64Bit: boolean read FIs64Bit;
end;
{ TElfDbgSource }
@ -117,6 +117,36 @@ const
{ TElfFile }
function TElfFile.FElfToMachineType(machinetype: word): TMachineType;
begin
case machinetype of
EM_386: result := mt386;
EM_68K: result := mt68K;
EM_PPC: result := mtPPC;
EM_PPC64: result := mtPPC64;
EM_ARM: result := mtARM;
EM_OLD_ALPHA: result := mtOLD_ALPHA;
EM_IA_64: result := mtIA_64;
EM_X86_64: result := mtX86_64;
EM_AVR: result := mtAVR8;
EM_ALPHA: result := mtALPHA;
else
result := mtNone;
end;
// If OS is not encoded in header, take some guess based on machine type
if FTargetInfo.OS = osNone then
begin
if result = mtAVR8 then
FTargetInfo.OS := osEmbedded
else
// Default to the same as host...
FTargetInfo.OS := {$if defined(Linux)}osLinux
{$elseif defined(Darwin)}osDarwin
{$else}osWindows{$endif};
end;
end;
function TElfFile.Load32BitFile(ALoader: TDbgFileLoader): Boolean;
var
hdr : Elf32_Ehdr;
@ -129,12 +159,14 @@ begin
Result := ALoader.Read(0, sizeof(hdr), @hdr) = sizeof(hdr);
if not Result then Exit;
FTargetInfo.machineType := FElfToMachineType(hdr.e_machine);
SetLength(sect, hdr.e_shnum);
//ALoader.Position := hdr.e_shoff;
sz := hdr.e_shetsize * hdr.e_shnum;
if sz > LongWord(length(sect)*sizeof(Elf32_shdr)) then begin
debugln(['TElfFile.Load64BitFile Size of SectHdrs is ', sz, ' expected ', LongWord(length(sect)*sizeof(Elf32_shdr))]);
debugln(['TElfFile.Load32BitFile Size of SectHdrs is ', sz, ' expected ', LongWord(length(sect)*sizeof(Elf32_shdr))]);
sz := LongWord(length(sect)*sizeof(Elf32_shdr));
end;
//ALoader.Read(sect[0], sz);
@ -152,7 +184,6 @@ begin
nm := PChar( @strs[sh_name] );
AddSection(nm, sh_offset, sh_addr, sh_size );
end;
end;
function TElfFile.Load64BitFile(ALoader: TDbgFileLoader): Boolean;
@ -166,7 +197,9 @@ var
begin
Result := ALoader.Read(0, sizeof(hdr), @hdr) = sizeof(hdr);
if not Result then Exit;
FIs64Bit:=true;
FTargetInfo.machineType := FElfToMachineType(hdr.e_machine);
SetLength(sect, hdr.e_shnum);
//ALoader.Position := hdr.e_shoff;
@ -190,8 +223,6 @@ begin
nm := PChar( @strs[sh_name] );
AddSection(nm, sh_offset, sh_address, sh_size );
end;
Result := False;
end;
procedure TElfFile.AddSection(const name: AnsiString; FileOffset, Address,
@ -223,13 +254,28 @@ begin
if not Result then Exit;
Result := False;
case ident[EI_DATA] of
ELFDATA2LSB: FTargetInfo.ByteOrder := boLSB;
ELFDATA2MSB: FTargetInfo.ByteOrder := boMSB;
else
FTargetInfo.byteOrder := boNone;
end;
case ident[EI_OSABI] of
ELFOSABI_LINUX: FTargetInfo.OS := osLinux;
ELFOSABI_STANDALONE: FTargetInfo.OS := osEmbedded;
else
FTargetInfo.OS := osNone; // Will take a guess after machine type is available
end;
if ident[EI_CLASS] = ELFCLASS32 then begin
FTargetInfo.bitness := b32;
Result := Load32BitFile(ALoader);
exit;
end;
if ident[EI_CLASS] = ELFCLASS64 then begin
FTargetInfo.bitness := b64;
Result := Load64BitFile(ALoader);
exit;
end;
@ -319,7 +365,9 @@ begin
p^.Loaded := False;
FSections.Objects[idx] := TObject(p);
end;
SetImage64Bit(fElfFile.Is64Bit);
FTargetInfo := fElfFile.FTargetInfo;
inherited Create(ASource, ADebugMap, OwnSource);
end;
@ -351,7 +399,7 @@ begin
if assigned(p) and assigned(ps) then
begin
SymbolStr:=PDbgImageSectionEx(ps)^.Sect.RawData;
if Image64Bit then
if FTargetInfo.Bitness = b64 then
begin
SymbolArr64:=PDbgImageSectionEx(p)^.Sect.RawData;
SymbolCount := PDbgImageSectionEx(p)^.Sect.Size div sizeof(TElf64symbol);

15
components/fpdebug/fpimgreaderelftypes.pas
View File

@ -67,11 +67,11 @@ const
EI_MAG2 = 2; // L
EI_MAG3 = 3; // F
EI_CLASS = 4;
EI_DATA = 1;
EI_VERSION = 1;
EI_OSABI = 1;
EI_ABIVERSION = 1;
EI_DATA = 5;
EI_VERSION = 6;
EI_OSABI = 7;
EI_ABIVERSION = 8;
ELFMAGIC = chr($7f)+'ELF';
//elf class
@ -86,7 +86,9 @@ const
// Operating System and ABI Identifiers, e_ident[EI_OSABI]
ELFOSABI_SYSV = 0; // System V ABI
ELFOSABI_HPUX = 1; // HP-UX operating system
ELFOSABI_HPUX = 1; // HP-UX operating system
ELFOSABI_NETBSD = 2;
ELFOSABI_LINUX = 3;
ELFOSABI_STANDALONE = 255; // Standalone (embedded) application
@ -151,6 +153,7 @@ const
EM_OLD_ALPHA = 41;
EM_IA_64 = 50;
EM_X86_64 = 62;
EM_AVR = 83;
EM_ALPHA = $9026; //unofficial, but used by gnu toolchain
//elf version {Elf32_Hdr.e_version}

18
components/fpdebug/fpimgreadermacho.pas
View File

@ -52,7 +52,7 @@ type
implementation
uses
FpDbgLoader;
FpDbgLoader, FpDbgCommon;
var
DBG_VERBOSE, DBG_WARNINGS: PLazLoggerLogGroup;
@ -213,7 +213,7 @@ begin
if assigned(p) and assigned(ps) then
begin
SymbolStr:=PDbgImageSectionEx(ps)^.Sect.RawData;
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolArr64:=PDbgImageSectionEx(p)^.Sect.RawData;
SymbolCount := PDbgImageSectionEx(p)^.Sect.Size div sizeof(nlist_64);
@ -225,7 +225,7 @@ begin
end;
for i := 0 to SymbolCount-1 do
begin
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolType := SymbolArr64[i].n_type;
StringOffset := SymbolArr64[i].n_un.n_strx;
@ -264,7 +264,7 @@ begin
Break;
end;
end;
SetImage64Bit((fFile.header.cputype and CPU_ARCH_ABI64)=CPU_ARCH_ABI64);
FTargetInfo := fFile.TargetInfo;
SetUUID(fFile.UUID);
fileRead := true;
end;
@ -298,7 +298,7 @@ begin
SectionSize := StabsCmd.strsize;
end else begin
SectionOffset := StabsCmd.symoff;
if Image64Bit then
if TargetInfo.Bitness = b64 then
SectionSize := Int64(StabsCmd.nsyms * sizeof(nlist_64))
else
SectionSize := Int64(StabsCmd.nsyms * sizeof(nlist));
@ -624,7 +624,7 @@ begin
if assigned(p) and assigned(ps) then
begin
SymbolStr:=PDbgImageSectionEx(ps)^.Sect.RawData;
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolArr64:=PDbgImageSectionEx(p)^.Sect.RawData;
SymbolCount := PDbgImageSectionEx(p)^.Sect.Size div sizeof(nlist_64);
@ -637,7 +637,7 @@ begin
state := dtsEnd;
for i := 0 to SymbolCount-1 do
begin
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolType := SymbolArr64[i].n_type;
StringOffset := SymbolArr64[i].n_un.n_strx;
@ -768,7 +768,7 @@ begin
if assigned(p) and assigned(ps) then
begin
SymbolStr:=PDbgImageSectionEx(ps)^.Sect.RawData;
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolArr64:=PDbgImageSectionEx(p)^.Sect.RawData;
SymbolCount := PDbgImageSectionEx(p)^.Sect.Size div sizeof(nlist_64);
@ -780,7 +780,7 @@ begin
end;
for i := 0 to SymbolCount-1 do
begin
if Image64Bit then
if TargetInfo.Bitness = b64 then
begin
SymbolType := SymbolArr64[i].n_type;
StringOffset := SymbolArr64[i].n_un.n_strx;

26
components/fpdebug/fpimgreadermachofile.pas
View File

@ -7,7 +7,8 @@ interface
//todo: powerpc, x86_64
uses
Classes, SysUtils, macho, FpImgReaderBase;
Classes, SysUtils, macho, FpImgReaderBase,
FpDbgCommon;
type
TMachOsection = class(TObject)
@ -21,6 +22,7 @@ type
TMachOFile = class(TObject)
private
cmdbuf : array of byte;
FTargetInfo : TTargetDescriptor;
public
header : mach_header;
commands : array of pload_command;
@ -29,6 +31,7 @@ type
constructor Create;
destructor Destroy; override;
function LoadFromFile(ALoader: TDbgFileLoader): Boolean;
property TargetInfo: TTargetDescriptor read FTargetInfo;
end;
@ -69,9 +72,28 @@ begin
Result := (header.magic = MH_MAGIC) or (header.magic = MH_CIGAM) or i64;
if i64 then
hs := sizeof(mach_header_64)
begin
hs := sizeof(mach_header_64);
FTargetInfo.bitness := b64;
end
else
begin
hs := SizeOf(mach_header);
FTargetInfo.bitness := b32;
end;
case header.cputype of
CPU_TYPE_I386 : FTargetInfo.MachineType := mt386;
CPU_TYPE_ARM : FTargetInfo.MachineType := mtARM;
CPU_TYPE_SPARC : FTargetInfo.MachineType := mtSPARC;
//CPU_TYPE_ALPHA : FTargetInfo.MachineType := mtALPHA;
CPU_TYPE_POWERPC : FTargetInfo.MachineType := mtPPC;
CPU_TYPE_POWERPC64 : FTargetInfo.MachineType := mtPPC;
CPU_TYPE_X86_64 : FTargetInfo.MachineType := mtX86_64;
CPU_TYPE_ARM64 : FTargetInfo.MachineType := mtARM;
else
FTargetInfo.machineType := mtNone;
end;
SetLength(cmdbuf, header.sizeofcmds);
ALoader.Read(hs, header.sizeofcmds, @cmdbuf[0]);

40
components/fpdebug/fpimgreaderwinpe.pas
View File

@ -70,6 +70,9 @@ type
implementation
uses
FpDbgCommon;
const
// Symbol-map section name
_symbol = '.symbols';
@ -188,7 +191,7 @@ begin
if (hBase = nil) or (hBase^.e_magic <> IMAGE_DOS_SIGNATURE) then
exit;
if Image64Bit then begin
if TargetInfo.bitness = b64 then begin
header64 := PImageNtHeaders64(PByte(hBase) + hBase^.e_lfanew);
if (header64^.Signature <> IMAGE_NT_SIGNATURE) or
(header64^.OptionalHeader.NumberOfRvaAndSizes = 0)
@ -330,6 +333,11 @@ var
StringTableLen: DWord;
StringTableStart: QWord;
begin
FTargetInfo.machineType := mtNONE;
FTargetInfo.bitness := bNone;
FTargetInfo.byteOrder := boNone;
FTargetInfo.OS := osNone;
FFileLoader.Read(0, sizeof(DosHeader), @DosHeader);
if (DosHeader.e_magic <> IMAGE_DOS_SIGNATURE)
or (DosHeader.e_lfanew = 0)
@ -344,10 +352,36 @@ begin
//WriteLn('Invalid NT header: ', IntToHex(NtHeaders^.Signature, 8));
Exit;
end;
FTargetInfo.OS := osWindows;
SetImage64Bit(NtHeaders.Sys.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC);
case NtHeaders.Sys.FileHeader.Machine of
IMAGE_FILE_MACHINE_I386:
begin
FTargetInfo.machineType := mt386;
FTargetInfo.byteOrder := boLSB;
end;
IMAGE_FILE_MACHINE_ARM:
begin
FTargetInfo.machineType := mtARM;
FTargetInfo.byteOrder := boLSB;
end;
IMAGE_FILE_MACHINE_IA64, IMAGE_FILE_MACHINE_AMD64:
begin
FTargetInfo.machineType := mtX86_64;
FTargetInfo.byteOrder := boLSB;
end;
else
FTargetInfo.OS := osNone;
end;
if Image64Bit
case NtHeaders.Sys.OptionalHeader.Magic of
IMAGE_NT_OPTIONAL_HDR32_MAGIC: FTargetInfo.Bitness := b32;
IMAGE_NT_OPTIONAL_HDR64_MAGIC: FTargetInfo.Bitness := b64;
else
FTargetInfo.Bitness := bNone;
end;
if FTargetInfo.Bitness = b64
then SetImageBase(NtHeaders.W64.OptionalHeader.ImageBase)
else SetImageBase(NtHeaders.W32.OptionalHeader.ImageBase);
FCodeBase := NtHeaders.W32.OptionalHeader.BaseOfCode;

11
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -28,7 +28,8 @@ uses
Classes, sysutils, math, FpdMemoryTools, FpDbgInfo, LldbDebugger,
LldbInstructions, LldbHelper, DbgIntfBaseTypes, DbgIntfDebuggerBase, LCLProc,
Forms, FpDbgLoader, FpDbgDwarf, LazLoggerBase, LazClasses, FpPascalParser,
FpPascalBuilder, FpErrorMessages, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal;
FpPascalBuilder, FpErrorMessages, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal,
FpDbgCommon;
type
@ -638,7 +639,7 @@ begin
// WINDOWS gdb dwarf names
if FDebugger.FDwarfInfo.Image64Bit then begin
if FDebugger.FDwarfInfo.TargetInfo.bitness = b64 then begin
case ARegNum of
0: rname := 'RAX'; // RAX
1: rname := 'RDX'; // RDX
@ -723,7 +724,7 @@ end;
function TFpLldbDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;
begin
if FDebugger.FDwarfInfo.Image64Bit then
if FDebugger.FDwarfInfo.TargetInfo.bitness = b64 then
Result := 8 // for the very few supported...
else
Result := 4; // for the very few supported...
@ -1165,7 +1166,7 @@ begin
FDwarfInfo := Loader.DwarfInfo;
Loader.Free;
if FDwarfInfo.Image64Bit then
if FDwarfInfo.TargetInfo.bitness = b64 then
FPrettyPrinter := TFpPascalPrettyPrinter.Create(8)
else
FPrettyPrinter := TFpPascalPrettyPrinter.Create(4);
@ -1194,7 +1195,7 @@ begin
FDwarfInfo.MemManager := FMemManager;
FDwarfInfo.LoadCompilationUnits;
if FDwarfInfo.Image64Bit then
if FDwarfInfo.TargetInfo.bitness = b64 then
FPrettyPrinter := TFpPascalPrettyPrinter.Create(8)
else
FPrettyPrinter := TFpPascalPrettyPrinter.Create(4);