From 923fce0cb0a493203ffaa862535948ef5732f1d3 Mon Sep 17 00:00:00 2001 From: ccrause Date: Mon, 1 Nov 2021 12:39:09 +0200 Subject: [PATCH] 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. --- components/fpdebug/fpdbgavrclasses.pas | 84 ++++++------- components/fpdebug/fpdbgclasses.pp | 59 +++++---- components/fpdebug/fpdbgcontroller.pas | 32 +++-- components/fpdebug/fpdbgdarwinclasses.pas | 31 ++--- components/fpdebug/fpdbglinuxclasses.pas | 46 ++++--- components/fpdebug/fpdbgrsp.pas | 112 +++++++++++++----- components/fpdebug/fpdbgwinclasses.pas | 40 +++---- .../lazdebuggerfp/fpdebugdebugger.pas | 2 + 8 files changed, 234 insertions(+), 172 deletions(-) diff --git a/components/fpdebug/fpdbgavrclasses.pas b/components/fpdebug/fpdbgavrclasses.pas index 75a9b415b5..b46cb3848a 100644 --- a/components/fpdebug/fpdbgavrclasses.pas +++ b/components/fpdebug/fpdbgavrclasses.pas @@ -45,6 +45,7 @@ const RegArrayByteLength = 39; type + { TDbgAvrThread } TDbgAvrThread = class(TDbgThread) @@ -96,6 +97,7 @@ type FIsTerminating: boolean; // RSP communication FConnection: TRspConnection; + FRemoteConfig: TRemoteConfig; procedure OnForkEvent(Sender : TObject); protected @@ -104,23 +106,12 @@ type function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function CreateWatchPointData: TFpWatchPointData; override; 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; - - constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override; + constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig = nil); 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) // 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 function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; override; function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; override; + + property RspConfig: TRemoteConfig read FRemoteConfig; end; // Lets stick with points 4 for now @@ -166,12 +159,6 @@ type property Count: integer read DataCount; 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 uses @@ -667,10 +654,10 @@ function TDbgAvrProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThrea begin IsMainThread:=False; if AthreadIdentifier<>feInvalidHandle then - begin + begin IsMainThread := AthreadIdentifier=ProcessID; result := TDbgAvrThread.Create(Self, AthreadIdentifier, AthreadIdentifier) - end + end else result := nil; end; @@ -682,9 +669,15 @@ begin end; constructor TDbgAvrProcess.Create(const AFileName: string; const AProcessID, - AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager - ); + AThreadID: Integer; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig); begin + if Assigned(AProcessConfig) and (AProcessConfig is TRemoteConfig) then + begin + FRemoteConfig := TRemoteConfig.Create; + FRemoteConfig.Assign(AProcessConfig); + end; + inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager); end; @@ -692,19 +685,19 @@ destructor TDbgAvrProcess.Destroy; begin if Assigned(FConnection) then FreeAndNil(FConnection); + if Assigned(FRemoteConfig) then + FreeAndNil(FRemoteConfig); inherited Destroy; end; -class function TDbgAvrProcess.StartInstance(AFileName: string; AParams, +function TDbgAvrProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; - AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; + AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; var AnExecutabeFilename: string; - dbg: TDbgAvrProcess = nil; begin - result := nil; - + Result := false; AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); if DirectoryExists(AnExecutabeFilename) then begin @@ -718,42 +711,33 @@ begin Exit; 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 - dbg.FConnection := TRspConnection.Create(AFileName, dbg); - dbg.FConnection.Connect; + FConnection := TRspConnection.Create(AFileName, self, self.FRemoteConfig); + FConnection.Connect; try - dbg.FConnection.RegisterCacheSize := RegArrayLength; - result := dbg; - dbg.FStatus := dbg.FConnection.Init; - dbg := nil; + FConnection.RegisterCacheSize := RegArrayLength; + FStatus := FConnection.Init; + Result := true; except on E: Exception do begin - Result := nil; - if Assigned(dbg) then - dbg.Free; DebugLn(DBG_WARNINGS, Format('Failed to init remote connection. Errormessage: "%s".', [E.Message])); end; end; except on E: Exception do begin - Result := nil; - if Assigned(dbg) then - dbg.Free; DebugLn(DBG_WARNINGS, Format('Failed to start remote connection. Errormessage: "%s".', [E.Message])); 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; begin result := (target.OS = osEmbedded) and diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 2161862715..844bfc417a 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -436,6 +436,10 @@ type end; TFpInternalWatchpointClass = class of TFpInternalWatchpoint; + // Container to hold target specific process info + TDbgProcessConfig = class(TPersistent) + end; + { TDbgInstance } TDbgInstance = class(TObject) @@ -547,16 +551,16 @@ type FLastLibraryUnloaded: TDbgLibrary; FOnDebugOutputEvent: TDebugOutputEvent; FOSDbgClasses: TOSDbgClasses; - FProcessID: Integer; FThreadID: Integer; FWatchPointData: TFpWatchPointData; - + FProcessConfig: TDbgProcessConfig; function GetDisassembler: TDbgAsmDecoder; function GetLastLibraryLoaded: TDbgLibrary; function GetPauseRequested: boolean; procedure SetPauseRequested(AValue: boolean); procedure ThreadDestroyed(const AThread: TDbgThread); protected + FProcessID: Integer; FBreakpointList, FWatchPointList: TFpInternalBreakpointList; FCurrentBreakpoint: TFpInternalBreakpoint; // set if we are executing the code at the break // if the singlestep is done, set the break again @@ -596,13 +600,15 @@ type function CreateWatchPointData: TFpWatchPointData; virtual; 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; - 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; + + 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: TDBGPtrArray): TFpInternalBreakpoint; overload; function AddBreak(const ALocation: TDBGPtr; AnEnabled: Boolean = True): TFpInternalBreakpoint; overload; @@ -1736,8 +1742,8 @@ begin end; constructor TDbgProcess.Create(const AFileName: string; const AProcessID, - AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager - ); + AThreadID: Integer; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig); const {.$IFDEF CPU64} MAP_ID_SIZE = itu8; @@ -1749,6 +1755,7 @@ begin FProcessID := AProcessID; FThreadID := AThreadID; FOSDbgClasses := AnOsClasses; + FProcessConfig := AProcessConfig; FBreakpointList := TFpInternalBreakpointList.Create(False); FWatchPointList := TFpInternalBreakpointList.Create(False); @@ -1819,6 +1826,23 @@ begin inherited; 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; begin Result := AddBreak(ALocation); @@ -2184,23 +2208,6 @@ begin FExitCode:=AValue; 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; begin result := false; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index ee441d7f9a..968507f80e 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -280,6 +280,8 @@ type FConsoleTty: string; FRedirectConsoleOutput: boolean; FWorkingDirectory: string; + // This only holds a reference to the LazDebugger instance + FProcessConfig: TDbgProcessConfig; function GetCurrentThreadId: Integer; function GetDefaultContext: TFpDbgLocationContext; procedure SetCurrentThreadId(AValue: Integer); @@ -405,6 +407,9 @@ type property OnThreadBeforeProcessLoop: TNotifyEvent read FOnThreadBeforeProcessLoop write FOnThreadBeforeProcessLoop; property OnThreadProcessLoopCycleEvent: TOnProcessLoopCycleEvent read FOnThreadProcessLoopCycleEvent write FOnThreadProcessLoopCycleEvent; 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; implementation @@ -1472,24 +1477,37 @@ begin // Get exe info, load classes CheckExecutableAndLoadClasses; if not Assigned(OsDbgClasses) then - begin + begin result := false; DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target'); - exit; - end; + Exit; + end; Flags := []; if RedirectConsoleOutput then Include(Flags, siRediretOutput); 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 - FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager, FLastError) + Result := FCurrentProcess.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager, FLastError) else - FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager, FLastError); - if assigned(FCurrentProcess) then + Result := FCurrentProcess.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager, FLastError); + + if Result then begin FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess); DebugLn(DBG_VERBOSE, 'Got PID: %d, TID: %d', [FCurrentProcess.ProcessID, FCurrentProcess.ThreadID]); - result := true; + end + else + begin + Result := false; + FreeAndNil(FCurrentProcess); end; end; diff --git a/components/fpdebug/fpdbgdarwinclasses.pas b/components/fpdebug/fpdbgdarwinclasses.pas index 2b0ffac0f4..35dfe491f0 100644 --- a/components/fpdebug/fpdbgdarwinclasses.pas +++ b/components/fpdebug/fpdbgdarwinclasses.pas @@ -147,9 +147,11 @@ type function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function CreateWatchPointData: TFpWatchPointData; override; 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; - 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; function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; @@ -623,11 +625,12 @@ begin end; constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID, - AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); + AThreadID: Integer; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig); var aKernResult: kern_return_t; begin - inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager); + inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig); GetDebugAccessRights; aKernResult:=task_for_pid(mach_task_self, AProcessID, FTaskPort); @@ -643,17 +646,16 @@ begin inherited Destroy; end; -class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams, +function TDbgDarwinProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; - AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; - out AnError: TFpError): TDbgProcess; + AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; var - PID: TPid; AProcess: TProcessUTF8; AnExecutabeFilename: string; AMasterPtyFd: cint; begin - result := nil; + result := false; AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); if DirectoryExists(AnExecutabeFilename) then @@ -700,13 +702,12 @@ begin GConsoleTty := AConsoleTty; AProcess.Execute; - PID:=AProcess.ProcessID; - + FProcessID:=AProcess.ProcessID; + FExecutableFilename:=AnExecutabeFilename; + FMasterPtyFd := AMasterPtyFd; + FProcProcess := AProcess; sleep(100); - result := TDbgDarwinProcess.Create(AFileName, Pid, -1, AnOsClasses, AMemManager); - TDbgDarwinProcess(result).FMasterPtyFd := AMasterPtyFd; - TDbgDarwinProcess(result).FProcProcess := AProcess; - TDbgDarwinProcess(result).FExecutableFilename := AnExecutabeFilename; + Result:=FProcessID > 0; except on E: Exception do begin diff --git a/components/fpdebug/fpdbglinuxclasses.pas b/components/fpdebug/fpdbglinuxclasses.pas index a9cdf7bc22..4e9ec79527 100644 --- a/components/fpdebug/fpdbglinuxclasses.pas +++ b/components/fpdebug/fpdbglinuxclasses.pas @@ -302,14 +302,16 @@ type function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function CreateWatchPointData: TFpWatchPointData; override; 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; - 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; + 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 WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override; function CallParamDefaultLocation(AParamIdx: Integer): TFpDbgMemLocation; override; @@ -830,11 +832,12 @@ begin end; constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID, - AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); + AThreadID: Integer; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig); begin FMasterPtyFd:=-1; FPostponedSignals := TFpDbgLinuxSignalQueue.Create; - inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager); + inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig); end; destructor TDbgLinuxProcess.Destroy; @@ -844,17 +847,16 @@ begin inherited Destroy; end; -class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, +function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; - AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; - out AnError: TFpError): TDbgProcess; + AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; var - PID: TPid; AProcess: TProcessUTF8; AMasterPtyFd: cint; AnExecutabeFilename: string; begin - result := nil; + Result := false; AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName); if DirectoryExists(AnExecutabeFilename) then @@ -893,12 +895,11 @@ begin AProcess.CurrentDirectory:=AWorkingDirectory; AProcess.Execute; - PID:=AProcess.ProcessID; - + FProcessID:=AProcess.ProcessID; + FMasterPtyFd := AMasterPtyFd; + FProcProcess := AProcess; sleep(100); - result := TDbgLinuxProcess.Create(AFileName, Pid, -1, AnOsClasses, AMemManager); - TDbgLinuxProcess(result).FMasterPtyFd := AMasterPtyFd; - TDbgLinuxProcess(result).FProcProcess := AProcess; + Result:=FProcessID > 0; except on E: Exception do begin @@ -913,14 +914,11 @@ begin end; end; -class function TDbgLinuxProcess.AttachToInstance(AFileName: string; - APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; - out AnError: TFpError): TDbgProcess; +function TDbgLinuxProcess.AttachToInstance(AFileName: string; APid: Integer; + AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out + AnError: TFpError): boolean; begin - Result := nil; - fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE)); - - result := TDbgLinuxProcess.Create(AFileName, APid, 0, AnOsClasses, AMemManager); + Result := fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE)) = 0; // TODO: change the filename to the actual exe-filename. Load the correct dwarf info end; diff --git a/components/fpdebug/fpdbgrsp.pas b/components/fpdebug/fpdbgrsp.pas index 0ab31cd6dc..c2c415c850 100644 --- a/components/fpdebug/fpdbgrsp.pas +++ b/components/fpdebug/fpdbgrsp.pas @@ -44,6 +44,31 @@ const SIGUNUSED = 31; 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 Initialized: boolean; Value: qword; // sized to handle largest register, should truncate as required to smaller registers @@ -73,6 +98,7 @@ type FOwner: TDbgProcess; // Catch exceptions and store as socket errors FSockErr: boolean; + FConfig: TRemoteConfig; procedure SetRegisterCacheSize(sz: cardinal); function WaitForData(timeout_ms: integer): integer; overload; @@ -95,7 +121,7 @@ type function HexEncodeStr(s: string): string; function HexDecodeStr(hexcode: string): string; public - constructor Create(AFileName: string; AOwner: TDbgProcess); Overload; + constructor Create(AFileName: string; AOwner: TDbgProcess; AConfig: TRemoteConfig); Overload; destructor Destroy; override; // Wait for async signal - blocking function WaitForSignal(out msg: string; out registers: TInitializedRegisters): integer; @@ -131,15 +157,6 @@ type property SockErr: boolean read FSockErr; end; -var - AHost: string = 'localhost'; - APort: integer = 2345; - AUploadBinary: boolean = False; - AAfterConnectMonitorCmds: TStringList; - ASkipSectionsList: TStringList; - AAfterUploadBreakZero: boolean; - AAfterUploadMonitorCmds: TStringList; - implementation uses @@ -152,6 +169,43 @@ uses var 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); begin SetLength(FStatusEvent.registers, sz); @@ -491,15 +545,18 @@ begin result := not(SockErr) and (pos('OK', reply) = 1); end; -constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess); +constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess; + AConfig: TRemoteConfig); var FSocketHandler: TSocketHandler; begin + // Just copy reference to AConfig + FConfig := AConfig; { Create a socket handler, so that TInetSocket.Create call doesn't automatically connect. This can raise an exception when connection fails. The FSocketHandler instance will be managed by TInetSocket. } FSocketHandler := TSocketHandler.Create; - inherited Create(AHost, APort, FSocketHandler); + inherited Create(FConfig.Host, FConfig.Port, FSocketHandler); InitCriticalSection(fCS); FFileName := AFileName; FOwner := AOwner; @@ -960,27 +1017,29 @@ begin end; // 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 - for i := 0 to AAfterConnectMonitorCmds.Count-1 do - SendMonitorCmd(AAfterConnectMonitorCmds[i]); + for i := 0 to FConfig.AfterConnectMonitorCmds.Count-1 do + SendMonitorCmd(FConfig.AfterConnectMonitorCmds[i]); end; // Start with AVR logic // If more targets are supported, move this to target specific debugger class - if AUploadBinary and (FFileName <> '') then + if FConfig.UploadBinary and (FFileName <> '') then begin // Ensure loader is initialized - FOwner.InitializeLoaders; + if not Assigned(FOwner.DbgInfo) then + FOwner.LoadInfo; datastart := -1; i := -1; repeat inc(i); pSection := FOwner.LoaderList[0].SectionByID[i]; + if (pSection <> nil) and (pSection^.Size > 0) and (pSection^.IsLoadable) then begin - if Assigned(ASkipSectionsList) and - (ASkipSectionsList.IndexOf(pSection^.Name) < 0) then + if Assigned(FConfig.SkipSectionsList) and + (FConfig.SkipSectionsList.IndexOf(pSection^.Name) < 0) then begin // .data section should be programmed straight after .text for AVR // Require tracking because sections are sorted alphabetically, @@ -1015,13 +1074,13 @@ begin end; // Hack to finish initializing atbackend agent - if AAfterUploadBreakZero then + if FConfig.AfterUploadBreakZero then 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 - for i := 0 to AAfterUploadMonitorCmds.Count-1 do - SendMonitorCmd(AAfterUploadMonitorCmds[i]); + for i := 0 to FConfig.AfterUploadMonitorCmds.Count-1 do + SendMonitorCmd(FConfig.AfterUploadMonitorCmds[i]); end; // 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_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. diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 601f5647f9..7a683aa33c 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -184,7 +184,7 @@ type procedure InitializeLoaders; override; function CreateWatchPointData: TFpWatchPointData; override; 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; function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; @@ -196,11 +196,10 @@ type procedure Interrupt; // required by app/fpd function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean; - 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; + 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; class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override; @@ -489,16 +488,16 @@ begin Result := TFpIntelWatchPointData.Create; end; -constructor TDbgWinProcess.Create(const AFileName: string; const AProcessID, - AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager - ); +constructor TDbgWinProcess.Create(const AName: string; const AProcessID, + AThreadID: Integer; AnOsClasses: TOSDbgClasses; + AMemManager: TFpDbgMemManager; AProcessConfig: TDbgProcessConfig); begin {$ifdef cpui386} FBitness := b32; {$else} FBitness := b64; {$endif} - inherited Create(AFileName, AProcessID, AThreadID, AnOsClasses, AMemManager); + inherited Create(AName, AProcessID, AThreadID, AnOsClasses, AMemManager, AProcessConfig); end; destructor TDbgWinProcess.Destroy; @@ -658,15 +657,15 @@ begin end; end; -class function TDbgWinProcess.StartInstance(AFileName: string; AParams, +function TDbgWinProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; - AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; + AMemManager: TFpDbgMemManager; out AnError: TFpError): boolean; var AProcess: TProcessUTF8; LastErr: Integer; begin - result := nil; + result := false; AProcess := TProcessUTF8.Create(nil); try // To debug sub-processes, this needs to be poDebugProcess @@ -679,8 +678,8 @@ begin AProcess.CurrentDirectory:=AWorkingDirectory; AProcess.Execute; - result := TDbgWinProcess.Create(AFileName, AProcess.ProcessID, AProcess.ThreadID, AnOsClasses, AMemManager); - TDbgWinProcess(result).FProcProcess := AProcess; + FProcessID:=AProcess.ProcessID; + Result:=true; except on E: Exception do begin @@ -699,13 +698,13 @@ begin end; end; -class function TDbgWinProcess.AttachToInstance(AFileName: string; - APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out - AnError: TFpError): TDbgProcess; +function TDbgWinProcess.AttachToInstance(AFileName: string; APid: Integer; + AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out + AnError: TFpError): boolean; var LastErr: Integer; begin - Result := nil; + Result := false; if _DebugActiveProcess = nil then begin AnError := CreateError(fpErrAttachProcess, [AFileName, 0, 'API unavailable', '']); exit; @@ -716,7 +715,8 @@ begin exit; 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 end; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index d8263aa0f7..c86fd1d045 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -338,6 +338,7 @@ type procedure FDbgControllerLibraryUnloaded(var continue: boolean; ALib: TDbgLibrary); function GetDebugInfo: TDbgInfo; protected + FProcessConFig: TDbgProcessConfig; procedure GetCurrentThreadAndStackFrame(out AThreadId, AStackFrame: Integer); function GetContextForEvaluate(const ThreadId, StackFrame: Integer): TFpDbgSymbolScope; @@ -3778,6 +3779,7 @@ begin FMemManager.MemLimits.MaxArrayLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxArrayLen; FMemManager.MemLimits.MaxStringLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxStringLen; FMemManager.MemLimits.MaxNullStringSearchLen := TFpDebugDebuggerProperties(GetProperties).MemLimits.MaxNullStringSearchLen; + FProcessConFig := nil; FDbgController := TDbgController.Create(FMemManager); FDbgController.OnCreateProcessEvent:=@FDbgControllerCreateProcessEvent; FDbgController.OnHitBreakpointEvent:=@FDbgControllerHitBreakpointEvent;