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

Change StartInstance and AttachInstance to normal methods. TDbgController now calls OSDbgClasses.DbgProcessClass to create a process class instance with a TDbgProcessConfig parameter which can be subclassed and passed around for configuration. The remote configuration is now passed via this parameter as a subclass.

Browse Source
This commit is contained in:
ccrause 2021-11-01 12:39:09 +02:00 committed by Martin
parent 5dff088116
commit 923fce0cb0
8 changed files with 234 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
components/fpdebug/fpdbgavrclasses.pas
View File

@ -45,6 +45,7 @@ const
RegArrayByteLength = 39; RegArrayByteLength = 39;
type type
{ TDbgAvrThread } { TDbgAvrThread }
TDbgAvrThread = class(TDbgThread) TDbgAvrThread = class(TDbgThread)
@ -96,6 +97,7 @@ type
FIsTerminating: boolean; FIsTerminating: boolean;
// RSP communication // RSP communication
FConnection: TRspConnection; FConnection: TRspConnection;
FRemoteConfig: TRemoteConfig;
procedure OnForkEvent(Sender : TObject); procedure OnForkEvent(Sender : TObject);
protected protected
@ -104,23 +106,12 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override; function CreateWatchPointData: TFpWatchPointData; override;
public public
// TODO: Optional download to target as parameter DownloadExecutable=true
//class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
// AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
// Not supported, returns false
//class function AttachToInstance(AFileName: string; APid: Integer
// ): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(target: TTargetDescriptor): boolean; override; class function isSupported(target: TTargetDescriptor): boolean; override;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); override;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override;
destructor Destroy; override; destructor Destroy; override;
function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
// FOR AVR target AAddress could be program or data (SRAM) memory (or EEPROM) // FOR AVR target AAddress could be program or data (SRAM) memory (or EEPROM)
// Gnu tools masks data memory with $800000 // Gnu tools masks data memory with $800000
@ -140,6 +131,8 @@ type
// then debugger needs to manage insertion/deletion of break points in target memory // then debugger needs to manage insertion/deletion of break points in target memory
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; override; function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; override;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; override; function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; override;
property RspConfig: TRemoteConfig read FRemoteConfig;
end; end;
// Lets stick with points 4 for now // Lets stick with points 4 for now
@ -166,12 +159,6 @@ type
property Count: integer read DataCount; property Count: integer read DataCount;
end; end;
var
// Difficult to see how this can be encapsulated except if
// added methods are introduced that needs to be called after .Create
HostName: string = 'localhost';
Port: integer = 12345;
implementation implementation
uses uses
@ -667,10 +654,10 @@ function TDbgAvrProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThrea
begin begin
IsMainThread:=False; IsMainThread:=False;
if AthreadIdentifier<>feInvalidHandle then if AthreadIdentifier<>feInvalidHandle then
begin begin
IsMainThread := AthreadIdentifier=ProcessID; IsMainThread := AthreadIdentifier=ProcessID;
result := TDbgAvrThread.Create(Self, AthreadIdentifier, AthreadIdentifier) result := TDbgAvrThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
end end
else else
result := nil; result := nil;
end; end;
@ -682,9 +669,15 @@ begin
end; end;
constructor TDbgAvrProcess.Create(const AFileName: string; const AProcessID, constructor TDbgAvrProcess.Create(const AFileName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager AThreadID: Integer; AnOsClasses: TOSDbgClasses;
); AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
begin begin
if Assigned(AProcessConfig) and (AProcessConfig is TRemoteConfig) then
begin
FRemoteConfig := TRemoteConfig.Create;
FRemoteConfig.Assign(AProcessConfig);
end;
inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager); inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager);
end; end;
@ -692,19 +685,19 @@ destructor TDbgAvrProcess.Destroy;
begin begin
if Assigned(FConnection) then if Assigned(FConnection) then
FreeAndNil(FConnection); FreeAndNil(FConnection);
if Assigned(FRemoteConfig) then
FreeAndNil(FRemoteConfig);
inherited Destroy; inherited Destroy;
end; end;
class function TDbgAvrProcess.StartInstance(AFileName: string; AParams, function TDbgAvrProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean;
var var
AnExecutabeFilename: string; AnExecutabeFilename: string;
dbg: TDbgAvrProcess = nil;
begin begin
result := nil; Result := false;
AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
if DirectoryExists(AnExecutabeFilename) then if DirectoryExists(AnExecutabeFilename) then
begin begin
@ -718,42 +711,33 @@ begin
Exit; Exit;
end; end;
dbg := TDbgAvrProcess.Create(AFileName, 0, 0, AnOsClasses, AMemManager); if not Assigned(FRemoteConfig) then
begin
DebugLn(DBG_WARNINGS, 'TDbgAvrProcess only supports remote debugging and requires a valid TRemoteConfig class');
Exit;
end;
try try
dbg.FConnection := TRspConnection.Create(AFileName, dbg); FConnection := TRspConnection.Create(AFileName, self, self.FRemoteConfig);
dbg.FConnection.Connect; FConnection.Connect;
try try
dbg.FConnection.RegisterCacheSize := RegArrayLength; FConnection.RegisterCacheSize := RegArrayLength;
result := dbg; FStatus := FConnection.Init;
dbg.FStatus := dbg.FConnection.Init; Result := true;
dbg := nil;
except except
on E: Exception do on E: Exception do
begin begin
Result := nil;
if Assigned(dbg) then
dbg.Free;
DebugLn(DBG_WARNINGS, Format('Failed to init remote connection. Errormessage: "%s".', [E.Message])); DebugLn(DBG_WARNINGS, Format('Failed to init remote connection. Errormessage: "%s".', [E.Message]));
end; end;
end; end;
except except
on E: Exception do on E: Exception do
begin begin
Result := nil;
if Assigned(dbg) then
dbg.Free;
DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message])); DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message]));
end; end;
end; end;
end; end;
class function TDbgAvrProcess.AttachToInstance(AFileName: string;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
begin
result := nil;
end;
class function TDbgAvrProcess.isSupported(target: TTargetDescriptor): boolean; class function TDbgAvrProcess.isSupported(target: TTargetDescriptor): boolean;
begin begin
result := (target.OS = osEmbedded) and result := (target.OS = osEmbedded) and

59
components/fpdebug/fpdbgclasses.pp
View File

@ -436,6 +436,10 @@ type
end; end;
TFpInternalWatchpointClass = class of TFpInternalWatchpoint; TFpInternalWatchpointClass = class of TFpInternalWatchpoint;
// Container to hold target specific process info
TDbgProcessConfig = class(TPersistent)
end;
{ TDbgInstance } { TDbgInstance }
TDbgInstance = class(TObject) TDbgInstance = class(TObject)
@ -547,16 +551,16 @@ type
FLastLibraryUnloaded: TDbgLibrary; FLastLibraryUnloaded: TDbgLibrary;
FOnDebugOutputEvent: TDebugOutputEvent; FOnDebugOutputEvent: TDebugOutputEvent;
FOSDbgClasses: TOSDbgClasses; FOSDbgClasses: TOSDbgClasses;
FProcessID: Integer;
FThreadID: Integer; FThreadID: Integer;
FWatchPointData: TFpWatchPointData; FWatchPointData: TFpWatchPointData;
FProcessConfig: TDbgProcessConfig;
function GetDisassembler: TDbgAsmDecoder; function GetDisassembler: TDbgAsmDecoder;
function GetLastLibraryLoaded: TDbgLibrary; function GetLastLibraryLoaded: TDbgLibrary;
function GetPauseRequested: boolean; function GetPauseRequested: boolean;
procedure SetPauseRequested(AValue: boolean); procedure SetPauseRequested(AValue: boolean);
procedure ThreadDestroyed(const AThread: TDbgThread); procedure ThreadDestroyed(const AThread: TDbgThread);
protected protected
FProcessID: Integer;
FBreakpointList, FWatchPointList: TFpInternalBreakpointList; FBreakpointList, FWatchPointList: TFpInternalBreakpointList;
FCurrentBreakpoint: TFpInternalBreakpoint; // set if we are executing the code at the break FCurrentBreakpoint: TFpInternalBreakpoint; // set if we are executing the code at the break
// if the singlestep is done, set the break again // if the singlestep is done, set the break again
@ -596,13 +600,15 @@ type
function CreateWatchPointData: TFpWatchPointData; virtual; function CreateWatchPointData: TFpWatchPointData; virtual;
public public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; virtual;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; virtual; class function isSupported(ATargetInfo: TTargetDescriptor): boolean; virtual;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); virtual; constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); virtual;
destructor Destroy; override; destructor Destroy; override;
function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; virtual;
function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; virtual;
function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload; function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
function AddInternalBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload; function AddInternalBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
function AddBreak(const ALocation: TDBGPtr; AnEnabled: Boolean = True): TFpInternalBreakpoint; overload; function AddBreak(const ALocation: TDBGPtr; AnEnabled: Boolean = True): TFpInternalBreakpoint; overload;
@ -1736,8 +1742,8 @@ begin
end; end;
constructor TDbgProcess.Create(const AFileName: string; const AProcessID, constructor TDbgProcess.Create(const AFileName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager AThreadID: Integer; AnOsClasses: TOSDbgClasses;
); AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
const const
{.$IFDEF CPU64} {.$IFDEF CPU64}
MAP_ID_SIZE = itu8; MAP_ID_SIZE = itu8;
@ -1749,6 +1755,7 @@ begin
FProcessID := AProcessID; FProcessID := AProcessID;
FThreadID := AThreadID; FThreadID := AThreadID;
FOSDbgClasses := AnOsClasses; FOSDbgClasses := AnOsClasses;
FProcessConfig := AProcessConfig;
FBreakpointList := TFpInternalBreakpointList.Create(False); FBreakpointList := TFpInternalBreakpointList.Create(False);
FWatchPointList := TFpInternalBreakpointList.Create(False); FWatchPointList := TFpInternalBreakpointList.Create(False);
@ -1819,6 +1826,23 @@ begin
inherited; inherited;
end; end;
function TDbgProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean;
begin
DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
result := false;
end;
function TDbgProcess.AttachToInstance(AFileName: string; APid: Integer;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): boolean;
begin
DebugLn(DBG_VERBOSE, 'Attach not supported');
Result := false;
end;
function TDbgProcess.AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; function TDbgProcess.AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint;
begin begin
Result := AddBreak(ALocation); Result := AddBreak(ALocation);
@ -2184,23 +2208,6 @@ begin
FExitCode:=AValue; FExitCode:=AValue;
end; end;
class function TDbgProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
result := nil;
end;
class function TDbgProcess.AttachToInstance(AFileName: string; APid: Integer;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Attach not supported');
Result := nil;
end;
class function TDbgProcess.isSupported(ATargetInfo: TTargetDescriptor): boolean; class function TDbgProcess.isSupported(ATargetInfo: TTargetDescriptor): boolean;
begin begin
result := false; result := false;

32
components/fpdebug/fpdbgcontroller.pas
View File

@ -280,6 +280,8 @@ type
FConsoleTty: string; FConsoleTty: string;
FRedirectConsoleOutput: boolean; FRedirectConsoleOutput: boolean;
FWorkingDirectory: string; FWorkingDirectory: string;
// This only holds a reference to the LazDebugger instance
FProcessConfig: TDbgProcessConfig;
function GetCurrentThreadId: Integer; function GetCurrentThreadId: Integer;
function GetDefaultContext: TFpDbgLocationContext; function GetDefaultContext: TFpDbgLocationContext;
procedure SetCurrentThreadId(AValue: Integer); procedure SetCurrentThreadId(AValue: Integer);
@ -405,6 +407,9 @@ type
property OnThreadBeforeProcessLoop: TNotifyEvent read FOnThreadBeforeProcessLoop write FOnThreadBeforeProcessLoop; property OnThreadBeforeProcessLoop: TNotifyEvent read FOnThreadBeforeProcessLoop write FOnThreadBeforeProcessLoop;
property OnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent read FOnThreadProcessLoopCycleEvent write FOnThreadProcessLoopCycleEvent; property OnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent read FOnThreadProcessLoopCycleEvent write FOnThreadProcessLoopCycleEvent;
property OnThreadDebugOutputEvent: TDebugOutputEvent read FOnThreadDebugOutputEvent write SetOnThreadDebugOutputEvent; property OnThreadDebugOutputEvent: TDebugOutputEvent read FOnThreadDebugOutputEvent write SetOnThreadDebugOutputEvent;
// Intermediate between FpDebugger and TDbgProcess. Created by FPDebugger, so not owned by controller
property ProcessConfig: TDbgProcessConfig read FProcessConfig write FProcessConfig;
end; end;
implementation implementation
@ -1472,24 +1477,37 @@ begin
// Get exe info, load classes // Get exe info, load classes
CheckExecutableAndLoadClasses; CheckExecutableAndLoadClasses;
if not Assigned(OsDbgClasses) then if not Assigned(OsDbgClasses) then
begin begin
result := false; result := false;
DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target'); DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target');
exit; Exit;
end; end;
Flags := []; Flags := [];
if RedirectConsoleOutput then Include(Flags, siRediretOutput); if RedirectConsoleOutput then Include(Flags, siRediretOutput);
if ForceNewConsoleWin then Include(Flags, siForceNewConsole); if ForceNewConsoleWin then Include(Flags, siForceNewConsole);
FCurrentProcess := OSDbgClasses.DbgProcessClass.Create(FExecutableFilename, AttachToPid, 0, OsDbgClasses, MemManager, ProcessConfig);
if not Assigned(FCurrentProcess) then
begin
Result := false;
DebugLn(DBG_WARNINGS, 'Error - could not create TDbgProcess');
Exit;
end;
if AttachToPid <> 0 then if AttachToPid <> 0 then
FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager, FLastError) Result := FCurrentProcess.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager, FLastError)
else else
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager, FLastError); Result := FCurrentProcess.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager, FLastError);
if assigned(FCurrentProcess) then
if Result then
begin begin
FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess); FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);
DebugLn(DBG_VERBOSE, 'Got PID: %d, TID: %d', [FCurrentProcess.ProcessID, FCurrentProcess.ThreadID]); DebugLn(DBG_VERBOSE, 'Got PID: %d, TID: %d', [FCurrentProcess.ProcessID, FCurrentProcess.ThreadID]);
result := true; end
else
begin
Result := false;
FreeAndNil(FCurrentProcess);
end; end;
end; end;

31
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -147,9 +147,11 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override; function CreateWatchPointData: TFpWatchPointData; override;
public public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override; function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override; class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override; constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); override;
destructor Destroy; override; destructor Destroy; override;
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
@ -623,11 +625,12 @@ begin
end; end;
constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID, constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); AThreadID: Integer; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
var var
aKernResult: kern_return_t; aKernResult: kern_return_t;
begin begin
inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager); inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig);
GetDebugAccessRights; GetDebugAccessRights;
aKernResult:=task_for_pid(mach_task_self, AProcessID, FTaskPort); aKernResult:=task_for_pid(mach_task_self, AProcessID, FTaskPort);
@ -643,17 +646,16 @@ begin
inherited Destroy; inherited Destroy;
end; end;
class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams, function TDbgDarwinProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
out AnError: TFpError): TDbgProcess; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean;
var var
PID: TPid;
AProcess: TProcessUTF8; AProcess: TProcessUTF8;
AnExecutabeFilename: string; AnExecutabeFilename: string;
AMasterPtyFd: cint; AMasterPtyFd: cint;
begin begin
result := nil; result := false;
AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
if DirectoryExists(AnExecutabeFilename) then if DirectoryExists(AnExecutabeFilename) then
@ -700,13 +702,12 @@ begin
GConsoleTty := AConsoleTty; GConsoleTty := AConsoleTty;
AProcess.Execute; AProcess.Execute;
PID:=AProcess.ProcessID; FProcessID:=AProcess.ProcessID;
FExecutableFilename:=AnExecutabeFilename;
FMasterPtyFd := AMasterPtyFd;
FProcProcess := AProcess;
sleep(100); sleep(100);
result := TDbgDarwinProcess.Create(AFileName, Pid, -1, AnOsClasses, AMemManager); Result:=FProcessID > 0;
TDbgDarwinProcess(result).FMasterPtyFd := AMasterPtyFd;
TDbgDarwinProcess(result).FProcProcess := AProcess;
TDbgDarwinProcess(result).FExecutableFilename := AnExecutabeFilename;
except except
on E: Exception do on E: Exception do
begin begin

46
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -302,14 +302,16 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override; function CreateWatchPointData: TFpWatchPointData; override;
public public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError
): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override; class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override; constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); override;
destructor Destroy; override; destructor Destroy; override;
function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override; function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override;
function CallParamDefaultLocation(AParamIdx: Integer): TFpDbgMemLocation; override; function CallParamDefaultLocation(AParamIdx: Integer): TFpDbgMemLocation; override;
@ -830,11 +832,12 @@ begin
end; end;
constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID, constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); AThreadID: Integer; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
begin begin
FMasterPtyFd:=-1; FMasterPtyFd:=-1;
FPostponedSignals := TFpDbgLinuxSignalQueue.Create; FPostponedSignals := TFpDbgLinuxSignalQueue.Create;
inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager); inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig);
end; end;
destructor TDbgLinuxProcess.Destroy; destructor TDbgLinuxProcess.Destroy;
@ -844,17 +847,16 @@ begin
inherited Destroy; inherited Destroy;
end; end;
class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, function TDbgLinuxProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
out AnError: TFpError): TDbgProcess; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean;
var var
PID: TPid;
AProcess: TProcessUTF8; AProcess: TProcessUTF8;
AMasterPtyFd: cint; AMasterPtyFd: cint;
AnExecutabeFilename: string; AnExecutabeFilename: string;
begin begin
result := nil; Result := false;
AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
if DirectoryExists(AnExecutabeFilename) then if DirectoryExists(AnExecutabeFilename) then
@ -893,12 +895,11 @@ begin
AProcess.CurrentDirectory:=AWorkingDirectory; AProcess.CurrentDirectory:=AWorkingDirectory;
AProcess.Execute; AProcess.Execute;
PID:=AProcess.ProcessID; FProcessID:=AProcess.ProcessID;
FMasterPtyFd := AMasterPtyFd;
FProcProcess := AProcess;
sleep(100); sleep(100);
result := TDbgLinuxProcess.Create(AFileName, Pid, -1, AnOsClasses, AMemManager); Result:=FProcessID > 0;
TDbgLinuxProcess(result).FMasterPtyFd := AMasterPtyFd;
TDbgLinuxProcess(result).FProcProcess := AProcess;
except except
on E: Exception do on E: Exception do
begin begin
@ -913,14 +914,11 @@ begin
end; end;
end; end;
class function TDbgLinuxProcess.AttachToInstance(AFileName: string; function TDbgLinuxProcess.AttachToInstance(AFileName: string; APid: Integer;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
out AnError: TFpError): TDbgProcess; AnError: TFpError): boolean;
begin begin
Result := nil; Result := fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE)) = 0;
fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE));
result := TDbgLinuxProcess.Create(AFileName, APid, 0, AnOsClasses, AMemManager);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info // TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end; end;

112
components/fpdebug/fpdbgrsp.pas
View File

@ -44,6 +44,31 @@ const
SIGUNUSED = 31; SIGUNUSED = 31;
type type
{ TRemoteConfig }
TRemoteConfig = class(TDbgProcessConfig)
private
FHost: string;
FPort: integer;
FUploadBinary: boolean;
FAfterConnectMonitorCmds: TStringList;
FSkipSectionsList: TStringList;
FAfterUploadBreakZero: boolean;
FAfterUploadMonitorCmds: TStringList;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property Host: string read FHost write FHost;
property Port: integer read FPort write FPort;
property UploadBinary: boolean read FUploadBinary write FUploadBinary;
property AfterConnectMonitorCmds: TStringList read FAfterConnectMonitorCmds write FAfterConnectMonitorCmds;
property SkipSectionsList: TStringList read FSkipSectionsList write FSkipSectionsList;
property AfterUploadBreakZero: boolean read FAfterUploadBreakZero write FAfterUploadBreakZero;
property AfterUploadMonitorCmds: TStringList read FAfterUploadMonitorCmds write FAfterUploadMonitorCmds;
end;
TInitializedRegister = record TInitializedRegister = record
Initialized: boolean; Initialized: boolean;
Value: qword; // sized to handle largest register, should truncate as required to smaller registers Value: qword; // sized to handle largest register, should truncate as required to smaller registers
@ -73,6 +98,7 @@ type
FOwner: TDbgProcess; FOwner: TDbgProcess;
// Catch exceptions and store as socket errors // Catch exceptions and store as socket errors
FSockErr: boolean; FSockErr: boolean;
FConfig: TRemoteConfig;
procedure SetRegisterCacheSize(sz: cardinal); procedure SetRegisterCacheSize(sz: cardinal);
function WaitForData(timeout_ms: integer): integer; overload; function WaitForData(timeout_ms: integer): integer; overload;
@ -95,7 +121,7 @@ type
function HexEncodeStr(s: string): string; function HexEncodeStr(s: string): string;
function HexDecodeStr(hexcode: string): string; function HexDecodeStr(hexcode: string): string;
public public
constructor Create(AFileName: string; AOwner: TDbgProcess); Overload; constructor Create(AFileName: string; AOwner: TDbgProcess; AConfig: TRemoteConfig); Overload;
destructor Destroy; override; destructor Destroy; override;
// Wait for async signal - blocking // Wait for async signal - blocking
function WaitForSignal(out msg: string; out registers: TInitializedRegisters): integer; function WaitForSignal(out msg: string; out registers: TInitializedRegisters): integer;
@ -131,15 +157,6 @@ type
property SockErr: boolean read FSockErr; property SockErr: boolean read FSockErr;
end; end;
var
AHost: string = 'localhost';
APort: integer = 2345;
AUploadBinary: boolean = False;
AAfterConnectMonitorCmds: TStringList;
ASkipSectionsList: TStringList;
AAfterUploadBreakZero: boolean;
AAfterUploadMonitorCmds: TStringList;
implementation implementation
uses uses
@ -152,6 +169,43 @@ uses
var var
DBG_VERBOSE, DBG_WARNINGS, DBG_RSP: PLazLoggerLogGroup; DBG_VERBOSE, DBG_WARNINGS, DBG_RSP: PLazLoggerLogGroup;
{ TRemoteConfig }
constructor TRemoteConfig.Create;
begin
FHost := 'localhost';
FPort := 1234; // default port for qemu
FUploadBinary := false;
FAfterConnectMonitorCmds := TStringList.Create;
FSkipSectionsList := TStringList.Create;
FAfterUploadBreakZero := false;
FAfterUploadMonitorCmds := TStringList.Create;
end;
destructor TRemoteConfig.Destroy;
begin
FreeAndNil(FAfterConnectMonitorCmds);
FreeAndNil(FSkipSectionsList);
FreeAndNil(FAfterUploadMonitorCmds);
end;
procedure TRemoteConfig.Assign(Source: TPersistent);
var
ASource: TRemoteConfig;
begin
if Assigned(Source) and (Source is TRemoteConfig) then
begin
ASource := TRemoteConfig(Source);
FHost := ASource.Host;
FPort := ASource.Port;
FUploadBinary := ASource.UploadBinary;
FAfterUploadBreakZero := ASource.AfterUploadBreakZero;
FAfterConnectMonitorCmds.Assign(ASource.AfterConnectMonitorCmds);
FSkipSectionsList.Assign(ASource.SkipSectionsList);
FAfterUploadMonitorCmds.Assign(ASource.AfterUploadMonitorCmds);
end;
end;
procedure TRspConnection.SetRegisterCacheSize(sz: cardinal); procedure TRspConnection.SetRegisterCacheSize(sz: cardinal);
begin begin
SetLength(FStatusEvent.registers, sz); SetLength(FStatusEvent.registers, sz);
@ -491,15 +545,18 @@ begin
result := not(SockErr) and (pos('OK', reply) = 1); result := not(SockErr) and (pos('OK', reply) = 1);
end; end;
constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess); constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess;
AConfig: TRemoteConfig);
var var
FSocketHandler: TSocketHandler; FSocketHandler: TSocketHandler;
begin begin
// Just copy reference to AConfig
FConfig := AConfig;
{ Create a socket handler, so that TInetSocket.Create call doesn't automatically connect. { Create a socket handler, so that TInetSocket.Create call doesn't automatically connect.
This can raise an exception when connection fails. This can raise an exception when connection fails.
The FSocketHandler instance will be managed by TInetSocket. } The FSocketHandler instance will be managed by TInetSocket. }
FSocketHandler := TSocketHandler.Create; FSocketHandler := TSocketHandler.Create;
inherited Create(AHost, APort, FSocketHandler); inherited Create(FConfig.Host, FConfig.Port, FSocketHandler);
InitCriticalSection(fCS); InitCriticalSection(fCS);
FFileName := AFileName; FFileName := AFileName;
FOwner := AOwner; FOwner := AOwner;
@ -960,27 +1017,29 @@ begin
end; end;
// Fancy stuff - load exe & sections, run monitor cmds etc // Fancy stuff - load exe & sections, run monitor cmds etc
if assigned(AAfterConnectMonitorCmds) and (AAfterConnectMonitorCmds.Count > 0) then if assigned(FConfig.AfterConnectMonitorCmds) and (FConfig.AfterConnectMonitorCmds.Count > 0) then
begin begin
for i := 0 to AAfterConnectMonitorCmds.Count-1 do for i := 0 to FConfig.AfterConnectMonitorCmds.Count-1 do
SendMonitorCmd(AAfterConnectMonitorCmds[i]); SendMonitorCmd(FConfig.AfterConnectMonitorCmds[i]);
end; end;
// Start with AVR logic // Start with AVR logic
// If more targets are supported, move this to target specific debugger class // If more targets are supported, move this to target specific debugger class
if AUploadBinary and (FFileName <> '') then if FConfig.UploadBinary and (FFileName <> '') then
begin begin
// Ensure loader is initialized // Ensure loader is initialized
FOwner.InitializeLoaders; if not Assigned(FOwner.DbgInfo) then
FOwner.LoadInfo;
datastart := -1; datastart := -1;
i := -1; i := -1;
repeat repeat
inc(i); inc(i);
pSection := FOwner.LoaderList[0].SectionByID[i]; pSection := FOwner.LoaderList[0].SectionByID[i];
if (pSection <> nil) and (pSection^.Size > 0) and (pSection^.IsLoadable) then if (pSection <> nil) and (pSection^.Size > 0) and (pSection^.IsLoadable) then
begin begin
if Assigned(ASkipSectionsList) and if Assigned(FConfig.SkipSectionsList) and
(ASkipSectionsList.IndexOf(pSection^.Name) < 0) then (FConfig.SkipSectionsList.IndexOf(pSection^.Name) < 0) then
begin begin
// .data section should be programmed straight after .text for AVR // .data section should be programmed straight after .text for AVR
// Require tracking because sections are sorted alphabetically, // Require tracking because sections are sorted alphabetically,
@ -1015,13 +1074,13 @@ begin
end; end;
// Hack to finish initializing atbackend agent // Hack to finish initializing atbackend agent
if AAfterUploadBreakZero then if FConfig.AfterUploadBreakZero then
SetBreakWatchPoint(0, wkpExec); // Todo: check if different address is required SetBreakWatchPoint(0, wkpExec); // Todo: check if different address is required
if assigned(AAfterUploadMonitorCmds) and (AAfterUploadMonitorCmds.Count > 0) then if assigned(FConfig.AfterUploadMonitorCmds) and (FConfig.AfterUploadMonitorCmds.Count > 0) then
begin begin
for i := 0 to AAfterUploadMonitorCmds.Count-1 do for i := 0 to FConfig.AfterUploadMonitorCmds.Count-1 do
SendMonitorCmd(AAfterUploadMonitorCmds[i]); SendMonitorCmd(FConfig.AfterUploadMonitorCmds[i]);
end; end;
// Must be last init command, after init the debug loop waits for the response in WaitForSignal // Must be last init command, after init the debug loop waits for the response in WaitForSignal
@ -1042,12 +1101,5 @@ initialization
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} ); DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
DBG_RSP := DebugLogger.FindOrRegisterLogGroup('DBG_RSP' {$IFDEF DBG_RSP} , True {$ENDIF} ); DBG_RSP := DebugLogger.FindOrRegisterLogGroup('DBG_RSP' {$IFDEF DBG_RSP} , True {$ENDIF} );
finalization
if Assigned(AAfterConnectMonitorCmds) then
FreeAndNil(AAfterConnectMonitorCmds);
if Assigned(ASkipSectionsList) then
FreeAndNil(ASkipSectionsList);
if Assigned(AAfterUploadMonitorCmds) then
FreeAndNil(AAfterUploadMonitorCmds);
end. end.

40
components/fpdebug/fpdbgwinclasses.pas
View File

@ -184,7 +184,7 @@ type
procedure InitializeLoaders; override; procedure InitializeLoaders; override;
function CreateWatchPointData: TFpWatchPointData; override; function CreateWatchPointData: TFpWatchPointData; override;
public public
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override; constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); override;
destructor Destroy; override; destructor Destroy; override;
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
@ -196,11 +196,10 @@ type
procedure Interrupt; // required by app/fpd procedure Interrupt; // required by app/fpd
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean; function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
class function AttachToInstance(AFileName: string; APid: Integer; function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; override;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override; class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
@ -489,16 +488,16 @@ begin
Result := TFpIntelWatchPointData.Create; Result := TFpIntelWatchPointData.Create;
end; end;
constructor TDbgWinProcess.Create(const AFileName: string; const AProcessID, constructor TDbgWinProcess.Create(const AName: string; const AProcessID,
AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager AThreadID: Integer; AnOsClasses: TOSDbgClasses;
); AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig);
begin begin
{$ifdef cpui386} {$ifdef cpui386}
FBitness := b32; FBitness := b32;
{$else} {$else}
FBitness := b64; FBitness := b64;
{$endif} {$endif}
inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager); inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig);
end; end;
destructor TDbgWinProcess.Destroy; destructor TDbgWinProcess.Destroy;
@ -658,15 +657,15 @@ begin
end; end;
end; end;
class function TDbgWinProcess.StartInstance(AFileName: string; AParams, function TDbgWinProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean;
var var
AProcess: TProcessUTF8; AProcess: TProcessUTF8;
LastErr: Integer; LastErr: Integer;
begin begin
result := nil; result := false;
AProcess := TProcessUTF8.Create(nil); AProcess := TProcessUTF8.Create(nil);
try try
// To debug sub-processes, this needs to be poDebugProcess // To debug sub-processes, this needs to be poDebugProcess
@ -679,8 +678,8 @@ begin
AProcess.CurrentDirectory:=AWorkingDirectory; AProcess.CurrentDirectory:=AWorkingDirectory;
AProcess.Execute; AProcess.Execute;
result := TDbgWinProcess.Create(AFileName, AProcess.ProcessID, AProcess.ThreadID, AnOsClasses, AMemManager); FProcessID:=AProcess.ProcessID;
TDbgWinProcess(result).FProcProcess := AProcess; Result:=true;
except except
on E: Exception do on E: Exception do
begin begin
@ -699,13 +698,13 @@ begin
end; end;
end; end;
class function TDbgWinProcess.AttachToInstance(AFileName: string; function TDbgWinProcess.AttachToInstance(AFileName: string; APid: Integer;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess; AnError: TFpError): boolean;
var var
LastErr: Integer; LastErr: Integer;
begin begin
Result := nil; Result := false;
if _DebugActiveProcess = nil then begin if _DebugActiveProcess = nil then begin
AnError := CreateError(fpErrAttachProcess, [AFileName, 0, 'API unavailable', '']); AnError := CreateError(fpErrAttachProcess, [AFileName, 0, 'API unavailable', '']);
exit; exit;
@ -716,7 +715,8 @@ begin
exit; exit;
end; end;
result := TDbgWinProcess.Create(AFileName, APid, 0, AnOsClasses, AMemManager); FProcessID := APid;
Result := true;
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info // TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end; end;

2
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -338,6 +338,7 @@ type
procedure FDbgControllerLibraryUnloaded(var continue: boolean; ALib: TDbgLibrary); procedure FDbgControllerLibraryUnloaded(var continue: boolean; ALib: TDbgLibrary);
function GetDebugInfo: TDbgInfo; function GetDebugInfo: TDbgInfo;
protected protected
FProcessConFig: TDbgProcessConfig;
procedure GetCurrentThreadAndStackFrame(out AThreadId, AStackFrame: Integer); procedure GetCurrentThreadAndStackFrame(out AThreadId, AStackFrame: Integer);
function GetContextForEvaluate(const ThreadId, StackFrame: Integer): TFpDbgSymbolScope; function GetContextForEvaluate(const ThreadId, StackFrame: Integer): TFpDbgSymbolScope;
@ -3778,6 +3779,7 @@ begin
FMemManager.MemLimits.MaxArrayLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxArrayLen; FMemManager.MemLimits.MaxArrayLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxArrayLen;
FMemManager.MemLimits.MaxStringLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxStringLen; FMemManager.MemLimits.MaxStringLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxStringLen;
FMemManager.MemLimits.MaxNullStringSearchLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxNullStringSearchLen; FMemManager.MemLimits.MaxNullStringSearchLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxNullStringSearchLen;
FProcessConFig := nil;
FDbgController := TDbgController.Create(FMemManager); FDbgController := TDbgController.Create(FMemManager);
FDbgController.OnCreateProcessEvent:=@FDbgControllerCreateProcessEvent; FDbgController.OnCreateProcessEvent:=@FDbgControllerCreateProcessEvent;
FDbgController.OnHitBreakpointEvent:=@FDbgControllerHitBreakpointEvent; FDbgController.OnHitBreakpointEvent:=@FDbgControllerHitBreakpointEvent;