paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 12:49:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpdebug: implemented step-out

Browse Source 
git-svn-id: trunk@58218 -
This commit is contained in:
joost 2018-06-10 21:03:29 +00:00
parent a3e61cf56e
commit abe6b86bb0
1 changed files with 113 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
components/fpdebug/fpdbgcontroller.pas
View File

@ -60,6 +60,23 @@ type
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
end;
{ TDbgControllerStepOutInstructionCmd }
TDbgControllerStepOutInstructionCmd = class(TDbgControllerCmd)
private
FHiddenBreakpoint: TFpInternalBreakpoint;
FIsSet: boolean;
FProcess: TDbgProcess;
FThread: TDbgThread;
FStepCount: Integer;
FStepOut: Boolean;
protected
procedure SetReturnAdressBreakpoint(AProcess: TDbgProcess);
public
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override;
end;
{ TDbgControllerStepOverLineCmd }
TDbgControllerStepOverLineCmd = class(TDbgControllerStepOverInstructionCmd)
@ -180,6 +197,101 @@ type
implementation
{ TDbgControllerStepOutInstructionCmd }
procedure TDbgControllerStepOutInstructionCmd.SetReturnAdressBreakpoint(AProcess: TDbgProcess);
var
AStackPointerValue, StepOutStackPos, ReturnAddress: TDBGPtr;
begin
AStackPointerValue:=FController.CurrentThread.GetStackBasePointerRegisterValue;
StepOutStackPos:=AStackPointerValue+DBGPTRSIZE[FController.FCurrentProcess.Mode];
if AProcess.ReadAddress(StepOutStackPos, ReturnAddress) then
begin
FProcess := AProcess;
if not AProcess.HasBreak(ReturnAddress) then
FHiddenBreakpoint := AProcess.AddBreak(ReturnAddress)
end
else
begin
AProcess.Log('Failed to read return-address from stack');
end;
FIsSet:=true;
end;
procedure TDbgControllerStepOutInstructionCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
var
CodeBin: array[0..20] of byte;
p: pointer;
ADump,
AStatement: string;
begin
FThread := AThread;
FProcess := AProcess;
if FIsSet then
// When a breanpoint has already been set on the return-adress, just continue
AProcess.Continue(AProcess, AThread, false)
else if FStepCount < 12 then
begin
// During the prologue and epiloge of a procedure the call-stack might not been
// setup already. To avoid problems in these cases, start with a few (max
// 12) single steps.
Inc(FStepCount);
if AProcess.ReadData(AThread.GetInstructionPointerRegisterValue,sizeof(CodeBin),CodeBin) then
begin
p := @CodeBin;
Disassemble(p, AProcess.Mode=dm64, ADump, AStatement);
if (copy(AStatement,1,4)='call') then
begin
// Stop with the single-steps, set an hidden breakpoint at the return
// address and continue.
SetReturnAdressBreakpoint(AProcess);
AProcess.Continue(AProcess, AThread, False);
end
else if (copy(AStatement,1,3)='ret') then
begin
// Do one more single-step, and we're finished.
FStepOut := True;
AProcess.Continue(AProcess, AThread, True);
end
else
AProcess.Continue(AProcess, AThread, True);
end
else
AProcess.Continue(AProcess, AThread, True);
end
else
begin
// Enough with the single-stepping, set an hidden breakpoint at the return
// address, and continue.
SetReturnAdressBreakpoint(AProcess);
AProcess.Continue(AProcess, AThread, False);
end;
end;
procedure TDbgControllerStepOutInstructionCmd.ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean);
begin
Handled := false;
Finished := false;
if FStepOut then
// During single-stepping a 'ret' instruction was encountered. So we're just
// finished.
Finished := true
else if FIsSet then
Finished := not (AnEvent in [deInternalContinue, deLoadLibrary])
else if (AnEvent in [deBreakpoint]) and not FProcess.HasBreak(FThread.GetInstructionPointerRegisterValue) then
// Single-stepping, so continue silently.
AnEvent := deInternalContinue;
if Finished and Assigned(FHiddenBreakpoint) then
begin
FProcess.RemoveBreak(FHiddenBreakpoint);
FHiddenBreakpoint.Free;
end;
end;
{ TDbgControllerRunToCmd }
constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtrArray);
@ -588,7 +700,7 @@ end;
procedure TDbgController.StepOut;
begin
//FCurrentThread.StepOut;
InitializeCommand(TDbgControllerStepOutInstructionCmd.Create(self));
end;
function TDbgController.Pause: boolean;