mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 15:32:32 +02:00
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:
parent
69d200ec8d
commit
3e1d403bae
@ -364,12 +364,14 @@ type
|
||||
|
||||
FMainThread: TDbgThread;
|
||||
function GetHandle: THandle; virtual;
|
||||
procedure SetThreadId(AThreadId: Integer);
|
||||
procedure SetExitCode(AValue: DWord);
|
||||
function GetLastEventProcessIdentifier: THandle; virtual;
|
||||
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
|
||||
|
||||
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; //virtual;
|
||||
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; //virtual;
|
||||
procedure RemoveAllBreakPoints;
|
||||
procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr); virtual;
|
||||
procedure AfterChangingInstructionCode(const ALocation: TDBGPtr); virtual;
|
||||
|
||||
@ -380,6 +382,7 @@ type
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
|
||||
public
|
||||
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;
|
||||
destructor Destroy; override;
|
||||
function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
|
||||
@ -425,6 +428,7 @@ type
|
||||
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
|
||||
|
||||
procedure TerminateProcess; virtual; abstract;
|
||||
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;
|
||||
|
||||
property Handle: THandle read GetHandle;
|
||||
property Name: String read FFileName write SetFileName;
|
||||
@ -1432,21 +1436,31 @@ begin
|
||||
result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.SetThreadId(AThreadId: Integer);
|
||||
begin
|
||||
assert(FThreadID = 0, 'TDbgProcess.SetThreadId: FThreadID = 0');
|
||||
FThreadID := AThreadId;
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.SetExitCode(AValue: DWord);
|
||||
begin
|
||||
FExitCode:=AValue;
|
||||
end;
|
||||
|
||||
resourcestring
|
||||
sNoDebugSupport = 'Debug support is not available for this platform .';
|
||||
|
||||
class function TDbgProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
|
||||
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess;
|
||||
begin
|
||||
DebugLn(DBG_VERBOSE, sNoDebugSupport);
|
||||
DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
|
||||
result := nil;
|
||||
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);
|
||||
begin
|
||||
if AThread = FMainThread
|
||||
@ -1550,6 +1564,22 @@ begin
|
||||
AfterChangingInstructionCode(ALocation);
|
||||
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);
|
||||
begin
|
||||
//
|
||||
@ -1635,6 +1665,12 @@ begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
function TDbgProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
|
||||
): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TDbgThread }
|
||||
|
||||
function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;
|
||||
|
@ -147,6 +147,8 @@ type
|
||||
TDbgController = class
|
||||
private
|
||||
FRunning, FPauseRequest: cardinal;
|
||||
FAttachToPid: Integer;
|
||||
FDetaching: cardinal;
|
||||
FEnvironment: TStrings;
|
||||
FExecutableFilename: string;
|
||||
FForceNewConsoleWin: boolean;
|
||||
@ -186,10 +188,12 @@ type
|
||||
procedure Step;
|
||||
procedure StepOut;
|
||||
function Pause: boolean;
|
||||
function Detach: boolean;
|
||||
procedure ProcessLoop;
|
||||
procedure SendEvents(out continue: boolean);
|
||||
|
||||
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
|
||||
property AttachToPid: Integer read FAttachToPid write FAttachToPid;
|
||||
property CurrentProcess: TDbgProcess read FCurrentProcess;
|
||||
property CurrentThread: TDbgThread read FCurrentThread;
|
||||
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
|
||||
@ -770,7 +774,10 @@ begin
|
||||
Flags := [];
|
||||
if RedirectConsoleOutput then Include(Flags, siRediretOutput);
|
||||
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
|
||||
begin
|
||||
FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);
|
||||
@ -820,8 +827,26 @@ begin
|
||||
Result := FCurrentProcess.Pause;
|
||||
end;
|
||||
|
||||
function TDbgController.Detach: boolean;
|
||||
begin
|
||||
InterLockedExchange(FDetaching, 1);
|
||||
Result := Pause;
|
||||
end;
|
||||
|
||||
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
|
||||
AProcessIdentifier: THandle;
|
||||
AThreadIdentifier: THandle;
|
||||
@ -843,6 +868,9 @@ begin
|
||||
if FCommand <> nil then
|
||||
FCommand.DoBeforeLoopStart;
|
||||
|
||||
if MaybeDetach then
|
||||
exit;
|
||||
|
||||
repeat
|
||||
if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin
|
||||
// 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 InterLockedExchangeAdd(FPauseRequest, 0) = 1 then begin
|
||||
FPDEvent := deBreakpoint;
|
||||
InterLockedExchange(FRunning, 0);
|
||||
break; // no event handling. Keep Process/Thread from last run
|
||||
end
|
||||
else begin
|
||||
if not assigned(FCommand) then
|
||||
begin
|
||||
DebugLn(FPDBG_COMMANDS, 'Continue process without command.');
|
||||
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
|
||||
end
|
||||
else
|
||||
begin
|
||||
DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
|
||||
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
|
||||
end;
|
||||
if not assigned(FCommand) then
|
||||
begin
|
||||
DebugLn(FPDBG_COMMANDS, 'Continue process without command.');
|
||||
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
|
||||
end
|
||||
else
|
||||
begin
|
||||
DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
|
||||
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
|
||||
end;
|
||||
|
||||
// TODO: replace the dangling pointer with the next best value....
|
||||
// There is still a race condition, for another thread to access it...
|
||||
if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then
|
||||
FCurrentThread := nil;
|
||||
end;
|
||||
// TODO: replace the dangling pointer with the next best value....
|
||||
// There is still a race condition, for another thread to access it...
|
||||
if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then
|
||||
FCurrentThread := nil;
|
||||
end;
|
||||
end;
|
||||
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then
|
||||
Continue;
|
||||
@ -931,6 +960,7 @@ begin
|
||||
this will remove CurrentThread form the list of threads
|
||||
CurrentThread is then destroyed in the next call to continue....
|
||||
*)
|
||||
|
||||
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
|
||||
DebugLn(DBG_VERBOSE, 'Process stopped with event %s. IP=%s, SP=%s, BSP=%s. HasBreak: %s',
|
||||
[FPDEventNames[FPDEvent],
|
||||
@ -938,6 +968,10 @@ begin
|
||||
FCurrentProcess.FormatAddress(FCurrentThread.GetStackPointerRegisterValue),
|
||||
FCurrentProcess.FormatAddress(FCurrentThread.GetStackBasePointerRegisterValue),
|
||||
dbgs(CurrentProcess.CurrentBreakpoint<>nil)]);
|
||||
|
||||
if MaybeDetach then
|
||||
break;
|
||||
|
||||
IsHandled:=false;
|
||||
IsFinished:=false;
|
||||
if FPDEvent=deExitProcess then
|
||||
|
@ -293,6 +293,8 @@ type
|
||||
public
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
|
||||
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;
|
||||
destructor Destroy; override;
|
||||
|
||||
@ -305,6 +307,7 @@ type
|
||||
|
||||
procedure TerminateProcess; override;
|
||||
function Pause: boolean; override;
|
||||
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
|
||||
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
|
||||
@ -841,6 +844,17 @@ begin
|
||||
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;
|
||||
const ASize: Cardinal; out AData): Boolean;
|
||||
|
||||
@ -1008,6 +1022,14 @@ begin
|
||||
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 CheckNoError: Boolean;
|
||||
var
|
||||
@ -1234,6 +1256,16 @@ begin
|
||||
Exit;
|
||||
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
|
||||
SIGTRAP:
|
||||
begin
|
||||
|
@ -44,6 +44,8 @@ const
|
||||
PTRACE_O_TRACECLONE = 1 << PTRACE_EVENT_CLONE;
|
||||
{$endif linux}
|
||||
PTRACE_ATTACH = 16;
|
||||
PTRACE_DETACH = 17;
|
||||
PTRACE_SEIZE = $4206;
|
||||
|
||||
RIP = 16;
|
||||
|
||||
|
@ -187,7 +187,9 @@ type
|
||||
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
|
||||
|
||||
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 Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; 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;
|
||||
_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;
|
||||
_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;
|
||||
_Wow64GetThreadContext: function (hThread: THandle; var 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(_QueryFullProcessImageName) := GetProcAddress(hMod, 'QueryFullProcessImageNameW'); // requires Vista
|
||||
Pointer(_DebugActiveProcessStop) := GetProcAddress(hMod, 'DebugActiveProcessStop');
|
||||
Pointer(_DebugActiveProcess) := GetProcAddress(hMod, 'DebugActiveProcess');
|
||||
Pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleW');
|
||||
{$ifdef cpux86_64}
|
||||
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 (_CreateRemoteThread = nil), ['WARNING: Failed to get CreateRemoteThread']);
|
||||
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']);
|
||||
{$ifdef cpux86_64}
|
||||
DebugLn(DBG_WARNINGS and (_IsWow64Process = nil), ['WARNING: Failed to get IsWow64Process']);
|
||||
@ -599,6 +605,18 @@ begin
|
||||
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;
|
||||
SingleStep: boolean): boolean;
|
||||
@ -700,6 +718,58 @@ if AThread<>nil then debugln(['## ath.iss ',AThread.NextIsSingleStep]);
|
||||
result := true;
|
||||
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;
|
||||
var
|
||||
t: TDbgWinThread;
|
||||
@ -742,7 +812,7 @@ begin
|
||||
DebugLn([dbgs(MDebugEvent), ' ', Result]);
|
||||
for TDbgThread(t) in FThreadMap do begin
|
||||
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;
|
||||
{$ENDIF}
|
||||
|
||||
@ -1132,6 +1202,8 @@ var
|
||||
{$endif}
|
||||
begin
|
||||
FInfo := AInfo;
|
||||
if ThreadID = 0 then
|
||||
SetThreadId(AThreadID);
|
||||
{$ifdef cpui386}
|
||||
FBitness := b32; // only 32 bit supported
|
||||
{$else}
|
||||
|
@ -1839,7 +1839,7 @@ begin
|
||||
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
|
||||
|
||||
if (ACommand in [dcRun, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto,
|
||||
dcStepOverInstr, dcStepIntoInstr]) and
|
||||
dcStepOverInstr, dcStepIntoInstr, dcAttach]) and
|
||||
not assigned(FDbgController.MainProcess)
|
||||
then
|
||||
begin
|
||||
@ -1855,6 +1855,15 @@ begin
|
||||
{$ifdef windows}
|
||||
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
|
||||
{$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);
|
||||
RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent);
|
||||
RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent);
|
||||
@ -1947,6 +1956,12 @@ begin
|
||||
StartDebugLoop;
|
||||
result := true;
|
||||
end;
|
||||
dcDetach:
|
||||
begin
|
||||
Result := FDbgController.Detach;
|
||||
if Result and (State in [dsPause, dsInternalPause]) then
|
||||
StartDebugLoop;
|
||||
end;
|
||||
dcEvaluate:
|
||||
begin
|
||||
EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger);
|
||||
@ -2001,7 +2016,9 @@ begin
|
||||
because any callstack (never mind which to which IDE-thread object it belongs
|
||||
will always get the data for the current thread only
|
||||
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;
|
||||
|
||||
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
|
||||
@ -2300,7 +2317,10 @@ end;
|
||||
function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
|
||||
begin
|
||||
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
|
||||
Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr];
|
||||
end;
|
||||
|
Loading…
Reference in New Issue
Block a user