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

FpDebug: Implemented StepOverTo

Browse Source 
git-svn-id: trunk@63304 -
This commit is contained in:
martin 2020-06-06 00:53:46 +00:00
parent 5bcddd28fb
commit 3aff869045
1 changed files with 135 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
components/fpdebug/fpdbgcontroller.pas
View File

@ -12,7 +12,7 @@ uses
LazLoggerBase, LazClasses,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
FpDbgDisasX86,
FpDbgClasses, FpDbgInfo;
FpDbgClasses, FpDbgInfo, FpDbgDwarf;
type
@ -120,7 +120,8 @@ type
protected
procedure Init; override;
procedure UpdateThreadStepInfoAfterStepOut(ANextOnlyStopOnStartLine: Boolean);
function HasSteppedAwayFromOriginLine(ANextOnlyStopOnStartLine: Boolean): boolean; // Call only, if in original frame (or updated frame)
function HasReachedEndLineForStep: boolean; virtual;
function HasReachedEndLineOrSteppedOut(ANextOnlyStopOnStartLine: Boolean): boolean; // Call only, if in original frame (or updated frame)
procedure StoreWasAtJumpInstruction;
function IsAtJumpPad: Boolean;
@ -184,6 +185,23 @@ type
constructor Create(AController: TDbgController; ALocation: TDBGPtrArray);
end;
{ TDbgControllerStepToCmd }
TDbgControllerStepToCmd = class(TDbgControllerLineStepBaseCmd)
private
FTargetFilename: String;
FTargetLineNumber: Integer;
FTargetExists: Boolean;
FStoreStepStartAddr, FStoreStepEndAddr: TDBGPtr;
protected
procedure Init; override;
function HasReachedEndLineForStep: boolean; override;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
public
constructor Create(AController: TDbgController; ATargetFilename: String; ATargetLineNumber: Integer);
end;
{ TDbgController }
TDbgController = class
@ -556,28 +574,10 @@ begin
FStepInfoUpdatedForStepOut := True;
end;
function TDbgControllerLineStepBaseCmd.HasSteppedAwayFromOriginLine(
ANextOnlyStopOnStartLine: Boolean): boolean;
function TDbgControllerLineStepBaseCmd.HasReachedEndLineForStep: boolean;
var
CompRes: TFPDCompareStepInfo;
begin
Result := IsSteppedOut;
if Result then begin
Result := (not ANextOnlyStopOnStartLine);
if Result then
exit;
// If stepped out, do not step out again
Result := NextInstruction.IsLeaveStackFrame or NextInstruction.IsReturnInstruction;
if Result then
exit;
if FStepInfoUnavailAfterStepOut then begin
Result := FController.FCurrentThread.IsAtStartOfLine;
exit;
end;
end;
CompRes := FThread.CompareStepInfo;
if CompRes in [dcsiSameLine, dcsiZeroLine] then begin
@ -601,6 +601,29 @@ begin
Result := True;
end;
function TDbgControllerLineStepBaseCmd.HasReachedEndLineOrSteppedOut(
ANextOnlyStopOnStartLine: Boolean): boolean;
begin
Result := IsSteppedOut;
if Result then begin
Result := (not ANextOnlyStopOnStartLine);
if Result then
exit;
// If stepped out, do not step out again
Result := NextInstruction.IsLeaveStackFrame or NextInstruction.IsReturnInstruction;
if Result then
exit;
if FStepInfoUnavailAfterStepOut then begin
Result := FController.FCurrentThread.IsAtStartOfLine;
exit;
end;
end;
Result := HasReachedEndLineForStep;
end;
procedure TDbgControllerLineStepBaseCmd.StoreWasAtJumpInstruction;
begin
FWasAtJumpInstruction := NextInstruction.IsJumpInstruction;
@ -667,7 +690,7 @@ begin
assert((FHiddenBreakpoint<>nil) xor (FState=siSteppingCurrent), 'TDbgControllerStepIntoLineCmd.DoResolveEvent: (FHiddenBreakpoint<>nil) xor (FState=siSteppingCurrent)');
if (FState = siSteppingCurrent) then begin
Finished := HasSteppedAwayFromOriginLine(True);
Finished := HasReachedEndLineOrSteppedOut(True);
if Finished then
Finished := not IsAtJumpPad;
end
@ -742,7 +765,7 @@ begin
Finished := False;
end
else begin
Finished := HasSteppedAwayFromOriginLine(True);
Finished := HasReachedEndLineOrSteppedOut(True);
if Finished then
Finished := not IsAtJumpPad;
end;
@ -852,7 +875,7 @@ begin
if FHiddenBreakpoint <> nil then
Finished := False
else
Finished := HasSteppedAwayFromOriginLine(FController.NextOnlyStopOnStartLine);
Finished := HasReachedEndLineOrSteppedOut(FController.NextOnlyStopOnStartLine);
end;
if Finished then
@ -886,13 +909,100 @@ end;
procedure TDbgControllerRunToCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Finished: boolean);
begin
Finished := (AnEvent<>deInternalContinue);
Finished := (FHiddenBreakpoint = nil) or FHiddenBreakpoint.HasLocation(FThread.GetInstructionPointerRegisterValue);
if Finished then begin
RemoveHiddenBreak;
AnEvent := deFinishedStep;
end;
end;
{ TDbgControllerStepToCmd }
procedure TDbgControllerStepToCmd.Init;
var
r: TDBGPtrArray;
begin
// FThread.StoreStepInfo;
FTargetExists := FProcess.DbgInfo.GetLineAddresses(FTargetFilename, FTargetLineNumber, r);
FTargetExists := FTargetExists and (Length(r) > 0);
FStepInfoUnavailAfterStepOut := True; // always check for IsAtStartOfLine
inherited Init;
end;
function TDbgControllerStepToCmd.HasReachedEndLineForStep: boolean;
var
AnAddr: TDBGPtr;
sym: TFpSymbol;
begin
Result := False;
AnAddr := FThread.GetInstructionPointerRegisterValue;
if (AnAddr >= FStoreStepStartAddr) and (AnAddr < FStoreStepEndAddr) then
exit;
sym := FProcess.FindProcSymbol(AnAddr);
if not assigned(sym) then
exit;
if sym is TFpSymbolDwarfDataProc then begin
FStoreStepStartAddr := TFpSymbolDwarfDataProc(sym).LineStartAddress;
FStoreStepEndAddr := TFpSymbolDwarfDataProc(sym).LineEndAddress;
end
else begin
FStoreStepStartAddr := AnAddr;
FStoreStepEndAddr := AnAddr;
end;
Result := (sym.Line = FTargetLineNumber) and (ExtractFileName(sym.FileName) = FTargetFilename);
sym.ReleaseReference;
end;
procedure TDbgControllerStepToCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Finished: boolean);
begin
// UpdateThreadStepInfoAfterStepOut(True);
if IsAtOrOutOfHiddenBreakFrame then
RemoveHiddenBreak;
if not FTargetExists then begin
Finished := True; // should not even have been started
end
else
if FHiddenBreakpoint <> nil then begin
Finished := False;
end
else begin
Finished := HasReachedEndLineOrSteppedOut(True);
//if Finished then
// Finished := not IsAtJumpPad;
end;
if Finished then
AnEvent := deFinishedStep
else
if AnEvent in [deFinishedStep] then
AnEvent:=deInternalContinue;
end;
procedure TDbgControllerStepToCmd.InternalContinue(AProcess: TDbgProcess;
AThread: TDbgThread);
begin
assert(FProcess=AProcess, 'TDbgControllerStepToCmd.DoContinue: FProcess=AProcess');
CheckForCallAndSetBreak;
if FHiddenBreakpoint = nil then
StoreWasAtJumpInstruction;
CallProcessContinue(FHiddenBreakpoint = nil);
end;
constructor TDbgControllerStepToCmd.Create(AController: TDbgController;
ATargetFilename: String; ATargetLineNumber: Integer);
begin
FTargetFilename := ExtractFileName(ATargetFilename);
FTargetLineNumber := ATargetLineNumber;
inherited Create(AController, False);
end;
{ TDbgController }