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

FpDebug: Fix stepping over an breakpoint that continues (condition/auto-continue/...) / Fix stepping over recursive calls

Browse Source 
git-svn-id: trunk@61882 -
This commit is contained in:
martin 2019-09-15 13:22:00 +00:00
parent 533670667b
commit 618ad4ba32
1 changed files with 43 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
components/fpdebug/fpdbgcontroller.pas
View File

@ -62,6 +62,9 @@ type
TDbgControllerHiddenBreakStepCmd = class(TDbgControllerCmd) TDbgControllerHiddenBreakStepCmd = class(TDbgControllerCmd)
protected protected
FHiddenBreakpoint: TFpInternalBreakpoint; FHiddenBreakpoint: TFpInternalBreakpoint;
FHiddenBreakAddr, FHiddenBreakStackPtrAddr: TDBGPtr;
function IsAtHiddenBreak: Boolean;
procedure SetHiddenBreak(AnAddr: TDBGPtr);
procedure RemoveHiddenBreak; procedure RemoveHiddenBreak;
public public
destructor Destroy; override; destructor Destroy; override;
@ -165,7 +168,7 @@ type
FMainProcess: TDbgProcess; FMainProcess: TDbgProcess;
FCurrentProcess: TDbgProcess; FCurrentProcess: TDbgProcess;
FCurrentThread: TDbgThread; FCurrentThread: TDbgThread;
FCommand: TDbgControllerCmd; FCommand, FCommandToBeFreed: TDbgControllerCmd;
function GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean; function GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean;
public public
constructor Create; virtual; constructor Create; virtual;
@ -298,6 +301,21 @@ end;
{ TDbgControllerHiddenBreakStepCmd } { TDbgControllerHiddenBreakStepCmd }
function TDbgControllerHiddenBreakStepCmd.IsAtHiddenBreak: Boolean;
begin
Result := (FThread.GetInstructionPointerRegisterValue = FHiddenBreakAddr) and
(FThread.GetStackPointerRegisterValue >= FHiddenBreakStackPtrAddr);
// if SP > FStackPtrRegVal >> then the brk was hit stepped out (should not happen)
end;
procedure TDbgControllerHiddenBreakStepCmd.SetHiddenBreak(AnAddr: TDBGPtr);
begin
// The callee may not setup a stackfram (StackBasePtr unchanged). So we use SP to detect recursive hits
FHiddenBreakStackPtrAddr := FThread.GetStackPointerRegisterValue;
FHiddenBreakAddr := AnAddr;
FHiddenBreakpoint := FProcess.AddInternalBreak(AnAddr);
end;
procedure TDbgControllerHiddenBreakStepCmd.RemoveHiddenBreak; procedure TDbgControllerHiddenBreakStepCmd.RemoveHiddenBreak;
begin begin
if assigned(FHiddenBreakpoint) then if assigned(FHiddenBreakpoint) then
@ -320,7 +338,7 @@ begin
if FHiddenBreakpoint = nil then begin if FHiddenBreakpoint = nil then begin
l := IsAtCallInstruction; l := IsAtCallInstruction;
if l > 0 then if l > 0 then
FHiddenBreakpoint := AProcess.AddInternalBreak(FThread.GetInstructionPointerRegisterValue + l); SetHiddenBreak(FThread.GetInstructionPointerRegisterValue + l);
end; end;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil); FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
end; end;
@ -329,7 +347,10 @@ procedure TDbgControllerStepOverInstructionCmd.DoResolveEvent(
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled,
Finished: boolean); Finished: boolean);
begin begin
Finished := not (AnEvent in [deInternalContinue, deLoadLibrary]); if FHiddenBreakpoint <> nil then
Finished := IsAtHiddenBreak
else
Finished := not (AnEvent in [deInternalContinue, deLoadLibrary]);
Handled := Finished; Handled := Finished;
if Finished then if Finished then
begin begin
@ -485,15 +506,13 @@ begin
EventCopy := AnEvent; EventCopy := AnEvent;
inherited DoResolveEvent(EventCopy, AnEventThread, Handled, Finished); inherited DoResolveEvent(EventCopy, AnEventThread, Handled, Finished);
// todo: check FHiddenBreakpoint.HasLocation(); // todo: check FHiddenBreakpoint.HasLocation();
if (AnEvent=deBreakpoint) and not assigned(FController.CurrentProcess.CurrentBreakpoint) if Finished then
then
begin begin
if (FController.FCurrentThread.CompareStepInfo<>dcsiNewLine) or if (FController.FCurrentThread.CompareStepInfo<>dcsiNewLine) or
(not FController.FCurrentThread.IsAtStartOfLine and (not FController.FCurrentThread.IsAtStartOfLine and
(FController.NextOnlyStopOnStartLine or (FStoredStackFrame < FController.CurrentThread.GetStackBasePointerRegisterValue))) then (FController.NextOnlyStopOnStartLine or (FStoredStackFrame < FController.CurrentThread.GetStackBasePointerRegisterValue))) then
begin begin
AnEvent:=deInternalContinue; AnEvent:=deInternalContinue;
RemoveHiddenBreak;
Finished:=false; Finished:=false;
end; end;
end; end;
@ -677,6 +696,17 @@ var
it: TMapIterator; it: TMapIterator;
p: TDbgProcess; p: TDbgProcess;
begin begin
if FCommand <> nil then begin
FCommand.FProcess := nil;
FCommand.FThread := nil;
FCommand.Free;
end;
if FCommandToBeFreed <> nil then begin
FCommandToBeFreed.FProcess := nil;
FCommandToBeFreed.FThread := nil;
FCommandToBeFreed.Free;
end;
if Assigned(FMainProcess) then begin if Assigned(FMainProcess) then begin
FProcessMap.Delete(FMainProcess.ProcessID); FProcessMap.Delete(FMainProcess.ProcessID);
FMainProcess.Free; FMainProcess.Free;
@ -796,6 +826,8 @@ begin
exit; exit;
end; end;
FCommandToBeFreed.Free;
repeat repeat
if assigned(FCurrentProcess) and not assigned(FMainProcess) then if assigned(FCurrentProcess) and not assigned(FMainProcess) then
FMainProcess:=FCurrentProcess FMainProcess:=FCurrentProcess
@ -984,6 +1016,11 @@ begin
else else
raise exception.create('Unknown debug controler state'); raise exception.create('Unknown debug controler state');
end; end;
if not &continue then begin
FCommandToBeFreed := FCommand;
FCommand := nil;
end;
end; end;
function TDbgController.GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean; function TDbgController.GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean;