LazDebuggerFp, FpDebug: Attach and Detach (Windows/Linux)

Attach on Linux does not work for apps started with "run without debugging". (Maybe/Probably because the IDE does a separate waitpid on those, and interferes with the waitpid of the debugger?)

git-svn-id: trunk@61967 -
This commit is contained in:
martin 2019-10-03 18:38:10 +00:00
parent 69d200ec8d
commit 3e1d403bae
6 changed files with 221 additions and 25 deletions

View File

@ -364,12 +364,14 @@ type
FMainThread: TDbgThread; FMainThread: TDbgThread;
function GetHandle: THandle; virtual; function GetHandle: THandle; virtual;
procedure SetThreadId(AThreadId: Integer);
procedure SetExitCode(AValue: DWord); procedure SetExitCode(AValue: DWord);
function GetLastEventProcessIdentifier: THandle; virtual; function GetLastEventProcessIdentifier: THandle; virtual;
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean; function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; //virtual; function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; //virtual;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; //virtual; function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; //virtual;
procedure RemoveAllBreakPoints;
procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr); virtual; procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr); virtual;
procedure AfterChangingInstructionCode(const ALocation: TDBGPtr); virtual; procedure AfterChangingInstructionCode(const ALocation: TDBGPtr); virtual;
@ -380,6 +382,7 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
public public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; virtual; class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer): TDbgProcess; virtual;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer); virtual; constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer); virtual;
destructor Destroy; override; destructor Destroy; override;
function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload; function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
@ -425,6 +428,7 @@ type
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual; function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
procedure TerminateProcess; virtual; abstract; procedure TerminateProcess; virtual; abstract;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;
property Handle: THandle read GetHandle; property Handle: THandle read GetHandle;
property Name: String read FFileName write SetFileName; property Name: String read FFileName write SetFileName;
@ -1432,21 +1436,31 @@ begin
result := 0; result := 0;
end; end;
procedure TDbgProcess.SetThreadId(AThreadId: Integer);
begin
assert(FThreadID = 0, 'TDbgProcess.SetThreadId: FThreadID = 0');
FThreadID := AThreadId;
end;
procedure TDbgProcess.SetExitCode(AValue: DWord); procedure TDbgProcess.SetExitCode(AValue: DWord);
begin begin
FExitCode:=AValue; FExitCode:=AValue;
end; end;
resourcestring
sNoDebugSupport = 'Debug support is not available for this platform .';
class function TDbgProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; class function TDbgProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess;
begin begin
DebugLn(DBG_VERBOSE, sNoDebugSupport); DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
result := nil; result := nil;
end; end;
class function TDbgProcess.AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Attach not supported');
Result := nil;
end;
procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread); procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
begin begin
if AThread = FMainThread if AThread = FMainThread
@ -1550,6 +1564,22 @@ begin
AfterChangingInstructionCode(ALocation); AfterChangingInstructionCode(ALocation);
end; end;
procedure TDbgProcess.RemoveAllBreakPoints;
var
b: TFpInternalBreakpoint;
i: LongInt;
begin
i := FBreakpointList.Count - 1;
while i >= 0 do begin
b := FBreakpointList[i];
b.ResetBreak;
b.FProcess := nil;
FBreakpointList.Delete(i);
dec(i);
end;
assert(FBreakMap.Count = 0, 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0');
end;
procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr); procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr);
begin begin
// //
@ -1635,6 +1665,12 @@ begin
result := false; result := false;
end; end;
function TDbgProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
): boolean;
begin
Result := False;
end;
{ TDbgThread } { TDbgThread }
function TDbgThread.GetRegisterValueList: TDbgRegisterValueList; function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;

View File

@ -147,6 +147,8 @@ type
TDbgController = class TDbgController = class
private private
FRunning, FPauseRequest: cardinal; FRunning, FPauseRequest: cardinal;
FAttachToPid: Integer;
FDetaching: cardinal;
FEnvironment: TStrings; FEnvironment: TStrings;
FExecutableFilename: string; FExecutableFilename: string;
FForceNewConsoleWin: boolean; FForceNewConsoleWin: boolean;
@ -186,10 +188,12 @@ type
procedure Step; procedure Step;
procedure StepOut; procedure StepOut;
function Pause: boolean; function Pause: boolean;
function Detach: boolean;
procedure ProcessLoop; procedure ProcessLoop;
procedure SendEvents(out continue: boolean); procedure SendEvents(out continue: boolean);
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename; property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
property AttachToPid: Integer read FAttachToPid write FAttachToPid;
property CurrentProcess: TDbgProcess read FCurrentProcess; property CurrentProcess: TDbgProcess read FCurrentProcess;
property CurrentThread: TDbgThread read FCurrentThread; property CurrentThread: TDbgThread read FCurrentThread;
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId; property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
@ -770,7 +774,10 @@ begin
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.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags); if AttachToPid <> 0 then
FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid)
else
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags);
if assigned(FCurrentProcess) then if assigned(FCurrentProcess) then
begin begin
FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess); FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);
@ -820,8 +827,26 @@ begin
Result := FCurrentProcess.Pause; Result := FCurrentProcess.Pause;
end; end;
function TDbgController.Detach: boolean;
begin
InterLockedExchange(FDetaching, 1);
Result := Pause;
end;
procedure TDbgController.ProcessLoop; procedure TDbgController.ProcessLoop;
function MaybeDetach: boolean;
begin
Result := InterLockedExchange(FDetaching, 0) <> 0;
if not Result then
exit;
if Assigned(FCommand) then
FreeAndNil(FCommand);
FPDEvent := deFinishedStep; // go to pause, if detach fails
if FCurrentProcess.Detach(FCurrentProcess, FCurrentThread) then
FPDEvent := deExitProcess;
end;
var var
AProcessIdentifier: THandle; AProcessIdentifier: THandle;
AThreadIdentifier: THandle; AThreadIdentifier: THandle;
@ -843,6 +868,9 @@ begin
if FCommand <> nil then if FCommand <> nil then
FCommand.DoBeforeLoopStart; FCommand.DoBeforeLoopStart;
if MaybeDetach then
exit;
repeat repeat
if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin
// IF there is a pause-request, we will hit a deCreateProcess. // IF there is a pause-request, we will hit a deCreateProcess.
@ -858,25 +886,26 @@ begin
// if Pause() is called right here, an Interrupt-Event is scheduled, even though we do not run (yet) // if Pause() is called right here, an Interrupt-Event is scheduled, even though we do not run (yet)
if InterLockedExchangeAdd(FPauseRequest, 0) = 1 then begin if InterLockedExchangeAdd(FPauseRequest, 0) = 1 then begin
FPDEvent := deBreakpoint; FPDEvent := deBreakpoint;
InterLockedExchange(FRunning, 0);
break; // no event handling. Keep Process/Thread from last run break; // no event handling. Keep Process/Thread from last run
end end
else begin else begin
if not assigned(FCommand) then if not assigned(FCommand) then
begin begin
DebugLn(FPDBG_COMMANDS, 'Continue process without command.'); DebugLn(FPDBG_COMMANDS, 'Continue process without command.');
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False) FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
end end
else else
begin begin
DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName); DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
FCommand.DoContinue(FCurrentProcess, FCurrentThread); FCommand.DoContinue(FCurrentProcess, FCurrentThread);
end; end;
// TODO: replace the dangling pointer with the next best value.... // TODO: replace the dangling pointer with the next best value....
// There is still a race condition, for another thread to access it... // There is still a race condition, for another thread to access it...
if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then
FCurrentThread := nil; FCurrentThread := nil;
end; end;
end; end;
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then
Continue; Continue;
@ -931,6 +960,7 @@ begin
this will remove CurrentThread form the list of threads this will remove CurrentThread form the list of threads
CurrentThread is then destroyed in the next call to continue.... CurrentThread is then destroyed in the next call to continue....
*) *)
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread); FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
DebugLn(DBG_VERBOSE, 'Process stopped with event %s. IP=%s, SP=%s, BSP=%s. HasBreak: %s', DebugLn(DBG_VERBOSE, 'Process stopped with event %s. IP=%s, SP=%s, BSP=%s. HasBreak: %s',
[FPDEventNames[FPDEvent], [FPDEventNames[FPDEvent],
@ -938,6 +968,10 @@ begin
FCurrentProcess.FormatAddress(FCurrentThread.GetStackPointerRegisterValue), FCurrentProcess.FormatAddress(FCurrentThread.GetStackPointerRegisterValue),
FCurrentProcess.FormatAddress(FCurrentThread.GetStackBasePointerRegisterValue), FCurrentProcess.FormatAddress(FCurrentThread.GetStackBasePointerRegisterValue),
dbgs(CurrentProcess.CurrentBreakpoint<>nil)]); dbgs(CurrentProcess.CurrentBreakpoint<>nil)]);
if MaybeDetach then
break;
IsHandled:=false; IsHandled:=false;
IsFinished:=false; IsFinished:=false;
if FPDEvent=deExitProcess then if FPDEvent=deExitProcess then

View File

@ -293,6 +293,8 @@ type
public public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer); override; constructor Create(const AName: string; const AProcessID, AThreadID: Integer); override;
destructor Destroy; override; destructor Destroy; override;
@ -305,6 +307,7 @@ type
procedure TerminateProcess; override; procedure TerminateProcess; override;
function Pause: boolean; override; function Pause: boolean; override;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override; function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override; function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
@ -841,6 +844,17 @@ begin
end; end;
end; end;
class function TDbgLinuxProcess.AttachToInstance(AFileName: string;
APid: Integer): TDbgProcess;
begin
Result := nil;
fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE));
result := TDbgLinuxProcess.Create(AFileName, APid, 0);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr; function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean; const ASize: Cardinal; out AData): Boolean;
@ -1008,6 +1022,14 @@ begin
end; end;
end; end;
function TDbgLinuxProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
begin
RemoveAllBreakPoints;
fpPTrace(PTRACE_DETACH, AThread.ID, nil, pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)));
Result := True;
end;
function TDbgLinuxProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; function TDbgLinuxProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
function CheckNoError: Boolean; function CheckNoError: Boolean;
var var
@ -1234,6 +1256,16 @@ begin
Exit; Exit;
end; end;
if (not FProcessStarted) and (wstopsig(FStatus) <> SIGTRAP) then begin
// attached, should be SigStop, but may be out of order
debugln(DBG_VERBOSE, ['Attached ', wstopsig(FStatus)]);
result := deCreateProcess;
FProcessStarted:=true;
if not wstopsig(FStatus) = SIGSTOP then
FPostponedSignals.AddSignal(AThread.Id, FStatus);
end
else
case wstopsig(FStatus) of case wstopsig(FStatus) of
SIGTRAP: SIGTRAP:
begin begin

View File

@ -44,6 +44,8 @@ const
PTRACE_O_TRACECLONE = 1 << PTRACE_EVENT_CLONE; PTRACE_O_TRACECLONE = 1 << PTRACE_EVENT_CLONE;
{$endif linux} {$endif linux}
PTRACE_ATTACH = 16; PTRACE_ATTACH = 16;
PTRACE_DETACH = 17;
PTRACE_SEIZE = $4206;
RIP = 16; RIP = 16;

View File

@ -187,7 +187,9 @@ type
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean; function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
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): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer): TDbgProcess; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): 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; function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override; function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
@ -290,7 +292,8 @@ var
_CreateRemoteThread: function(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall = nil; _CreateRemoteThread: function(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall = nil;
_GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPWSTR; cchFilePath, dwFlags: DWORD):DWORD; stdcall = nil; _GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPWSTR; cchFilePath, dwFlags: DWORD):DWORD; stdcall = nil;
_QueryFullProcessImageName: function (hProcess:HANDLE; dwFlags: DWord; lpExeName:LPWSTR; var lpdwSize:DWORD):BOOL; stdcall = nil; _QueryFullProcessImageName: function (hProcess:HANDLE; dwFlags: DWord; lpExeName:LPWSTR; var lpdwSize:DWORD):BOOL; stdcall = nil;
_DebugActiveProcessStop : function (ProcessId:DWORD):BOOL; stdcall = nil; _DebugActiveProcessStop: function (ProcessId:DWORD):BOOL; stdcall = nil;
_DebugActiveProcess: function (ProcessId:DWORD):BOOL; stdcall = nil;
_IsWow64Process: function (hProcess:HANDLE; WoW64Process: PBOOL):BOOL; stdcall = nil; _IsWow64Process: function (hProcess:HANDLE; WoW64Process: PBOOL):BOOL; stdcall = nil;
_Wow64GetThreadContext: function (hThread: THandle; var lpContext: WOW64_CONTEXT): BOOL; stdcall = nil; _Wow64GetThreadContext: function (hThread: THandle; var lpContext: WOW64_CONTEXT): BOOL; stdcall = nil;
_Wow64SetThreadContext: function (hThread: THandle; const lpContext: WOW64_CONTEXT): BOOL; stdcall = nil; _Wow64SetThreadContext: function (hThread: THandle; const lpContext: WOW64_CONTEXT): BOOL; stdcall = nil;
@ -310,6 +313,7 @@ begin
Pointer(_CreateRemoteThread) := GetProcAddress(hMod, 'CreateRemoteThread'); Pointer(_CreateRemoteThread) := GetProcAddress(hMod, 'CreateRemoteThread');
Pointer(_QueryFullProcessImageName) := GetProcAddress(hMod, 'QueryFullProcessImageNameW'); // requires Vista Pointer(_QueryFullProcessImageName) := GetProcAddress(hMod, 'QueryFullProcessImageNameW'); // requires Vista
Pointer(_DebugActiveProcessStop) := GetProcAddress(hMod, 'DebugActiveProcessStop'); Pointer(_DebugActiveProcessStop) := GetProcAddress(hMod, 'DebugActiveProcessStop');
Pointer(_DebugActiveProcess) := GetProcAddress(hMod, 'DebugActiveProcess');
Pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleW'); Pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleW');
{$ifdef cpux86_64} {$ifdef cpux86_64}
Pointer(_IsWow64Process) := GetProcAddress(hMod, 'IsWow64Process'); Pointer(_IsWow64Process) := GetProcAddress(hMod, 'IsWow64Process');
@ -320,6 +324,8 @@ begin
DebugLn(DBG_WARNINGS and (DebugBreakAddr = nil), ['WARNING: Failed to get DebugBreakAddr']); DebugLn(DBG_WARNINGS and (DebugBreakAddr = nil), ['WARNING: Failed to get DebugBreakAddr']);
DebugLn(DBG_WARNINGS and (_CreateRemoteThread = nil), ['WARNING: Failed to get CreateRemoteThread']); DebugLn(DBG_WARNINGS and (_CreateRemoteThread = nil), ['WARNING: Failed to get CreateRemoteThread']);
DebugLn(DBG_WARNINGS and (_QueryFullProcessImageName = nil), ['WARNING: Failed to get QueryFullProcessImageName']); DebugLn(DBG_WARNINGS and (_QueryFullProcessImageName = nil), ['WARNING: Failed to get QueryFullProcessImageName']);
DebugLn(DBG_WARNINGS and (_DebugActiveProcessStop = nil), ['WARNING: Failed to get DebugActiveProcessStop']);
DebugLn(DBG_WARNINGS and (_DebugActiveProcess = nil), ['WARNING: Failed to get DebugActiveProcess']);
DebugLn(DBG_WARNINGS and (_GetFinalPathNameByHandle = nil), ['WARNING: Failed to get GetFinalPathNameByHandle']); DebugLn(DBG_WARNINGS and (_GetFinalPathNameByHandle = nil), ['WARNING: Failed to get GetFinalPathNameByHandle']);
{$ifdef cpux86_64} {$ifdef cpux86_64}
DebugLn(DBG_WARNINGS and (_IsWow64Process = nil), ['WARNING: Failed to get IsWow64Process']); DebugLn(DBG_WARNINGS and (_IsWow64Process = nil), ['WARNING: Failed to get IsWow64Process']);
@ -599,6 +605,18 @@ begin
end; end;
end; end;
class function TDbgWinProcess.AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess;
begin
Result := nil;
if _DebugActiveProcess = nil then
exit;
if not _DebugActiveProcess(APid) then
exit;
result := TDbgWinProcess.Create(AFileName, APid, 0);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
SingleStep: boolean): boolean; SingleStep: boolean): boolean;
@ -700,6 +718,58 @@ if AThread<>nil then debugln(['## ath.iss ',AThread.NextIsSingleStep]);
result := true; result := true;
end; end;
function TDbgWinProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
): boolean;
var
t: TDbgWinThread;
PendingDebugEvent: TDebugEvent;
begin
Result := _DebugActiveProcessStop <> nil;
if not Result then
exit;
RemoveAllBreakPoints;
// Collect all pending events // Deal with any breakpoint/int3 hit
if not GetThread(MDebugEvent.dwThreadId, TDbgThread(AThread)) then begin
assert(False, 'TDbgWinProcess.Detach: Missing thread');
TDbgThread(AThread) := AddThread(MDebugEvent.dwThreadId);
end;
for TDbgThread(t) in FThreadMap do
if not t.ID = MDebugEvent.dwThreadId then
t.Suspend;
TDbgWinThread(AThread).SetSingleStep;
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
while Windows.WaitForDebugEvent(PendingDebugEvent, 1) do begin
if PendingDebugEvent.dwThreadId = MDebugEvent.dwThreadId then
break;
case PendingDebugEvent.dwDebugEventCode of
CREATE_PROCESS_DEBUG_EVENT: begin
if PendingDebugEvent.CreateProcessInfo.hFile <> 0 then
CloseHandle(PendingDebugEvent.CreateProcessInfo.hFile);
_DebugActiveProcessStop(PendingDebugEvent.dwProcessId);
end;
EXCEPTION_DEBUG_EVENT:
case PendingDebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT, STATUS_WX86_BREAKPOINT: begin
if not GetThread(PendingDebugEvent.dwThreadId, TDbgThread(t)) then
TDbgThread(t) := AddThread(PendingDebugEvent.dwThreadId);
t.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end;
end;
Windows.ContinueDebugEvent(PendingDebugEvent.dwProcessId, PendingDebugEvent.dwThreadId, DBG_CONTINUE);
end;
for TDbgThread(t) in FThreadMap do
t.Resume;
Result := _DebugActiveProcessStop(ProcessID);
// Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
end;
function TDbgWinProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; function TDbgWinProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
var var
t: TDbgWinThread; t: TDbgWinThread;
@ -742,7 +812,7 @@ begin
DebugLn([dbgs(MDebugEvent), ' ', Result]); DebugLn([dbgs(MDebugEvent), ' ', Result]);
for TDbgThread(t) in FThreadMap do begin for TDbgThread(t) in FThreadMap do begin
if t.ReadThreadState then if t.ReadThreadState then
DebugLn('Thr.Id:%d SSTep %s EF %s DR6:%x WP:%x RegAcc: %d, SStep: %d Task: %d, ExcBrk: %d', [t.ID, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]); DebugLn('Thr.Id:%d %x SSTep %s EF %s DR6:%x WP:%x RegAcc: %d, SStep: %d Task: %d, ExcBrk: %d', [t.ID, t.GetInstructionPointerRegisterValue, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]);
end; end;
{$ENDIF} {$ENDIF}
@ -1132,6 +1202,8 @@ var
{$endif} {$endif}
begin begin
FInfo := AInfo; FInfo := AInfo;
if ThreadID = 0 then
SetThreadId(AThreadID);
{$ifdef cpui386} {$ifdef cpui386}
FBitness := b32; // only 32 bit supported FBitness := b32; // only 32 bit supported
{$else} {$else}

View File

@ -1839,7 +1839,7 @@ begin
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine; FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
if (ACommand in [dcRun, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto, if (ACommand in [dcRun, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto,
dcStepOverInstr, dcStepIntoInstr]) and dcStepOverInstr, dcStepIntoInstr, dcAttach]) and
not assigned(FDbgController.MainProcess) not assigned(FDbgController.MainProcess)
then then
begin begin
@ -1855,6 +1855,15 @@ begin
{$ifdef windows} {$ifdef windows}
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole; FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
{$endif windows} {$endif windows}
//FDbgController.AttachToPid := 0;
if ACommand = dcAttach then begin
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
Result := FDbgController.AttachToPid <> 0;
if not Result then begin
FileName := '';
Exit;
end;
end;
FFpDebugThread := TFpDebugThread.Create(Self); FFpDebugThread := TFpDebugThread.Create(Self);
RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent); RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent);
RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent); RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent);
@ -1947,6 +1956,12 @@ begin
StartDebugLoop; StartDebugLoop;
result := true; result := true;
end; end;
dcDetach:
begin
Result := FDbgController.Detach;
if Result and (State in [dsPause, dsInternalPause]) then
StartDebugLoop;
end;
dcEvaluate: dcEvaluate:
begin begin
EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger); EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger);
@ -2001,7 +2016,9 @@ begin
because any callstack (never mind which to which IDE-thread object it belongs because any callstack (never mind which to which IDE-thread object it belongs
will always get the data for the current thread only will always get the data for the current thread only
TODO: callstacks need a field with the thread-id to which they belong *) TODO: callstacks need a field with the thread-id to which they belong *)
if (Threads <> nil) and (Threads.CurrentThreads <> nil) then if (Threads <> nil) and (Threads.CurrentThreads <> nil) and
(FDbgController.CurrentThread <> nil)
then
Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId; Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId;
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self) FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
@ -2300,7 +2317,10 @@ end;
function TFpDebugDebugger.GetSupportedCommands: TDBGCommands; function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
begin begin
Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver, Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver,
dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcSendConsoleInput]; dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcSendConsoleInput
{$IFDEF windows} , dcAttach, dcDetach {$ENDIF}
{$IFDEF linux} , dcAttach, dcDetach {$ENDIF}
];
if State = dsStop then if State = dsStop then
Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr]; Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr];
end; end;