paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 22:16:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Refactor storing/comparing stack-pointer/frame for step-out detection. Allow different architectures to provide sub-classes

Browse Source 
git-svn-id: trunk@63060 -
This commit is contained in:
martin 2020-04-24 20:08:09 +00:00
parent 35706ffaa6
commit f2d5fd797b
3 changed files with 152 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
components/fpdebug/fpdbgclasses.pp
View File

@ -88,6 +88,7 @@ type
TFPDThreadArray = array of TDbgThread;
TDbgLibrary = class;
TOSDbgClasses = class;
TDbgAsmInstruction = class;
TDbgCallstackEntry = class
private
@ -134,6 +135,29 @@ type
function RegisterSize(ARegNum: Cardinal): Integer; override;
end;
{ TDbgStackFrameInfo
This can be overridden by each OS dependen class. Or it could be gotten from the Disassemble, if it is CPU specific
This default assumes an Intel like stack, with StackPointer and FrameBase.
This default assumes the stack grows by decreasing addresses.
}
TDbgStackFrameInfo = class
private
FThread: TDbgThread;
FStoredStackFrame, FStoredStackPointer: TDBGPtr;
FHasSteppedOut: Boolean;
protected
procedure DoCheckNextInstruction(ANextInstruction: TDbgAsmInstruction); virtual;
function CalculateHasSteppedOut: Boolean; virtual;
public
constructor Create(AThread: TDbgThread);
procedure CheckNextInstruction(ANextInstruction: TDbgAsmInstruction); inline;
function HasSteppedOut: Boolean; inline;
procedure FlagAsSteppedOut; inline;
// only for FpLldbDebugger
property StoredStackFrame: TDBGPtr read FStoredStackFrame;
end;
{ TDbgThread }
TFpInternalBreakpoint = class;
@ -171,6 +195,7 @@ type
function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract;
function GetStackPointerRegisterValue: TDbgPtr; virtual; abstract;
function GetCurrentStackFrameInfo: TDbgStackFrameInfo;
procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual;
procedure ClearCallStack;
@ -2196,6 +2221,62 @@ begin
Result := False;
end;
{ TDbgStackFrameInfo }
procedure TDbgStackFrameInfo.DoCheckNextInstruction(
ANextInstruction: TDbgAsmInstruction);
begin
if ANextInstruction.IsReturnInstruction then
FHasSteppedOut := True;
end;
function TDbgStackFrameInfo.CalculateHasSteppedOut: Boolean;
var
CurBp, CurSp: TDBGPtr;
begin
Result := False;
CurBp := FThread.GetStackBasePointerRegisterValue;
if FStoredStackFrame < CurBp then begin
CurSp := FThread.GetStackPointerRegisterValue;
if FStoredStackPointer >= CurSp then // this happens, if current was recorded before the BP frame was set up // a finally handle may then fake an outer frame
exit;
{$PUSH}{$Q-}{$R-}
// if CurSp = FStoredStackPointer + FThread.Process.PointerSize then
// exit; // Still in proc, but passed asm "leave" (BP has been popped, but IP not yet)
{$POP}
Result := True;
debugln(FPDBG_COMMANDS, ['BreakStepBaseCmd.GetIsSteppedOut: Has stepped out Stored-BP=', FStoredStackFrame, ' < BP=', CurBp, ' / SP', CurSp]);
end;
end;
constructor TDbgStackFrameInfo.Create(AThread: TDbgThread);
begin
FThread := AThread;
FStoredStackFrame := AThread.GetStackBasePointerRegisterValue;
FStoredStackPointer := AThread.GetStackPointerRegisterValue;
end;
procedure TDbgStackFrameInfo.CheckNextInstruction(
ANextInstruction: TDbgAsmInstruction);
begin
if not FHasSteppedOut then
DoCheckNextInstruction(ANextInstruction);
end;
function TDbgStackFrameInfo.HasSteppedOut: Boolean;
begin
Result := FHasSteppedOut;
if Result then
exit;
FHasSteppedOut := CalculateHasSteppedOut;
Result := FHasSteppedOut;
end;
procedure TDbgStackFrameInfo.FlagAsSteppedOut;
begin
FHasSteppedOut := True;
end;
{ TDbgThread }
function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;
@ -2396,6 +2477,11 @@ begin
result := nil;
end;
function TDbgThread.GetCurrentStackFrameInfo: TDbgStackFrameInfo;
begin
Result := TDbgStackFrameInfo.Create(Self);
end;
procedure TDbgThread.PrepareCallStackEntryList(AFrameRequired: Integer);
const
MAX_FRAMES = 50000; // safety net

76
components/fpdebug/fpdbgcontroller.pas
View File

@ -75,8 +75,7 @@ type
TDbgControllerHiddenBreakStepBaseCmd = class(TDbgControllerCmd)
private
FStoredStackFrame, FStoredStackPointer: TDBGPtr; // In case of IsSteppedOut, those are kept to the original values
FIsSteppedOut: Boolean;
FStackFrameInfo: TDbgStackFrameInfo;
FHiddenBreakpoint: TFpInternalBreakpoint;
FHiddenBreakAddr, FHiddenBreakInstrPtr, FHiddenBreakFrameAddr, FHiddenBreakStackPtrAddr: TDBGPtr;
function GetIsSteppedOut: Boolean;
@ -89,13 +88,15 @@ type
procedure RemoveHiddenBreak;
function CheckForCallAndSetBreak: boolean; // True, if break is newly set
procedure Init; override;
procedure InitStackFrameInfo; inline;
procedure CallProcessContinue(ASingleStep: boolean);
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract;
public
destructor Destroy; override;
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
property StoredStackFrame: TDBGPtr read FStoredStackFrame;
property StoredStackFrameInfo: TDbgStackFrameInfo read FStackFrameInfo;
property IsSteppedOut: Boolean read GetIsSteppedOut;
end;
@ -399,27 +400,8 @@ end;
{ TDbgControllerHiddenBreakStepBaseCmd }
function TDbgControllerHiddenBreakStepBaseCmd.GetIsSteppedOut: Boolean;
var
CurBp, CurSp: TDBGPtr;
begin
Result := FIsSteppedOut;
if Result then
exit;
CurBp := FController.CurrentThread.GetStackBasePointerRegisterValue;
if FStoredStackFrame < CurBp then begin
CurSp := FController.CurrentThread.GetStackPointerRegisterValue;
if FStoredStackPointer >= CurSp then // this happens, if current was recorded before the BP frame was set up // a finally handle may then fake an outer frame
exit;
{$PUSH}{$Q-}{$R-}
if CurSp = FStoredStackPointer + FProcess.PointerSize then
exit; // Still in proc, but passed asm "leave" (BP has been popped, but IP not yet)
{$POP}
FIsSteppedOut := True;
debugln(FPDBG_COMMANDS, ['BreakStepBaseCmd.GetIsSteppedOut: Has stepped out Stored-BP=', FStoredStackFrame, ' < BP=', CurBp, ' / SP', CurSp]);
end;
Result := FIsSteppedOut;
Result := (FStackFrameInfo <> nil) and FStackFrameInfo.HasSteppedOut;
end;
function TDbgControllerHiddenBreakStepBaseCmd.IsAtHiddenBreak: Boolean;
@ -485,36 +467,36 @@ begin
{$POP}
end;
procedure TDbgControllerHiddenBreakStepBaseCmd.Init;
procedure TDbgControllerHiddenBreakStepBaseCmd.InitStackFrameInfo;
begin
FStoredStackPointer := FThread.GetStackPointerRegisterValue;
FStoredStackFrame := FThread.GetStackBasePointerRegisterValue;
inherited Init;
FStackFrameInfo := FThread.GetCurrentStackFrameInfo;
end;
procedure TDbgControllerHiddenBreakStepBaseCmd.CallProcessContinue(
ASingleStep: boolean);
begin
if (FStackFrameInfo <> nil) and ASingleStep and (FHiddenBreakpoint = nil) then // TODO: not check FHiddenBreakAddr;
FStackFrameInfo.CheckNextInstruction(NextInstruction);
FProcess.Continue(FProcess, FThread, ASingleStep);
end;
destructor TDbgControllerHiddenBreakStepBaseCmd.Destroy;
begin
RemoveHiddenBreak;
FreeAndNil(FStackFrameInfo);
inherited Destroy;
end;
procedure TDbgControllerHiddenBreakStepBaseCmd.DoContinue(AProcess: TDbgProcess;
AThread: TDbgThread);
var
r: Boolean;
begin
if (AThread <> FThread) then begin
FProcess.Continue(FProcess, AThread, False);
exit;
end;
r := NextInstruction.IsReturnInstruction;
InternalContinue(AProcess, AThread);
if r and
(FHiddenBreakpoint = nil)
then
FIsSteppedOut := True;
end;
{ TDbgControllerStepOverInstructionCmd }
@ -524,7 +506,7 @@ procedure TDbgControllerStepOverInstructionCmd.InternalContinue(
begin
assert(FProcess=AProcess, 'TDbgControllerStepOverInstructionCmd.DoContinue: FProcess=AProcess');
CheckForCallAndSetBreak;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
CallProcessContinue(FHiddenBreakpoint = nil);
end;
procedure TDbgControllerStepOverInstructionCmd.DoResolveEvent(
@ -548,6 +530,8 @@ end;
procedure TDbgControllerLineStepBaseCmd.Init;
begin
InitStackFrameInfo;
if FStoreStepInfoAtInit then begin
FThread.StoreStepInfo;
FStartedInFuncName := FThread.StoreStepFuncName;
@ -602,7 +586,7 @@ begin
FThread.GetInstructionPointerRegisterValue - 1);
{$POP}
Result := not(CompRes in [dcsiNewLine, dcsiSameLine]); // Step once more, maybe we do a jmp....
DebugLn(DBG_VERBOSE or FPDBG_COMMANDS, ['UNEXPECTED absence of debug info @',FThread.GetInstructionPointerRegisterValue, ' Out:', FIsSteppedOut, ' Res:', Result]);
DebugLn(DBG_VERBOSE or FPDBG_COMMANDS, ['UNEXPECTED absence of debug info @',FThread.GetInstructionPointerRegisterValue, ' Res:', Result]);
exit;
end;
@ -646,14 +630,14 @@ begin
begin
if CheckForCallAndSetBreak then begin
FState := siSteppingIn;
FProcess.Continue(FProcess, FThread, true);
CallProcessContinue(true);
exit;
end;
end;
if FState <> siRunningStepOut then
if (FState <> siRunningStepOut) then
StoreWasAtJumpInstruction;
FProcess.Continue(FProcess, FThread, FState <> siRunningStepOut);
CallProcessContinue(FState <> siRunningStepOut);
end;
constructor TDbgControllerStepIntoLineCmd.Create(AController: TDbgController);
@ -725,7 +709,7 @@ begin
if FHiddenBreakpoint = nil then
StoreWasAtJumpInstruction;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
CallProcessContinue(FHiddenBreakpoint = nil);
end;
constructor TDbgControllerStepOverLineCmd.Create(AController: TDbgController);
@ -824,7 +808,7 @@ begin
if NextInstruction.IsReturnInstruction then // asm "ret"
begin
FStepCount := MaxInt; // Do one more single-step, and we're finished.
FProcess.Continue(FProcess, FThread, True);
CallProcessContinue(True);
exit;
end;
end
@ -836,7 +820,7 @@ begin
end;
end;
FProcess.Continue(FProcess, FThread, FHiddenBreakpoint = nil);
CallProcessContinue(FHiddenBreakpoint = nil);
end;
procedure TDbgControllerStepOutCmd.DoResolveEvent(var AnEvent: TFPDEvent;
@ -849,7 +833,7 @@ begin
if FWasOutsideFrame and (not IsSteppedOut) and
(FHiddenBreakStackPtrAddr < FThread.GetStackPointerRegisterValue)
then
FIsSteppedOut := True;
FStackFrameInfo.FlagAsSteppedOut;
if IsSteppedOut or IsAtHiddenBreak then begin
UpdateThreadStepInfoAfterStepOut;
@ -882,7 +866,7 @@ procedure TDbgControllerRunToCmd.InternalContinue(AProcess: TDbgProcess;
AThread: TDbgThread);
begin
assert(FProcess=AProcess, 'TDbgControllerRunToCmd.DoContinue: FProcess=AProcess');
FProcess.Continue(FProcess, FThread, False);
CallProcessContinue(False);
end;
procedure TDbgControllerRunToCmd.Init;

39
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -102,6 +102,7 @@ type
protected
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
procedure Init; override;
public
constructor Create(AController: TDbgController; AnAfterFinCallAddr: TDbgPtr); reintroduce;
end;
@ -154,6 +155,9 @@ type
function GetCurrentProcess: TDbgProcess; inline;
function GetCurrentThread: TDbgThread; inline;
function GetDbgController: TDbgController; inline;
function dbgs(st: TExceptStepState): string;
function dbgs(loc: TBreakPointLoc): string;
function dbgs(locs: TBreakPointLocs): string;
protected
property DbgController: TDbgController read GetDbgController;
property CurrentProcess: TDbgProcess read GetCurrentProcess;
@ -613,6 +617,12 @@ begin
inherited InternalContinue(AProcess, AThread);
end;
procedure TDbgControllerStepThroughFpcSpecialHandler.Init;
begin
InitStackFrameInfo;
inherited Init;
end;
constructor TDbgControllerStepThroughFpcSpecialHandler.Create(
AController: TDbgController; AnAfterFinCallAddr: TDbgPtr);
begin
@ -1708,6 +1718,24 @@ begin
Result := FDebugger.FDbgController;
end;
function TFpDebugExceptionStepping.dbgs(st: TExceptStepState): string;
begin
writestr(Result, st);
end;
function TFpDebugExceptionStepping.dbgs(loc: TBreakPointLoc): string;
begin
writestr(Result, loc);
end;
function TFpDebugExceptionStepping.dbgs(locs: TBreakPointLocs): string;
var
a: TBreakPointLoc;
begin
Result := '';
for a in locs do Result := Result + dbgs(a) +',';
end;
function TFpDebugExceptionStepping.GetCurrentProcess: TDbgProcess;
begin
Result := FDebugger.FDbgController.CurrentProcess;
@ -1737,6 +1765,7 @@ var
a: TBreakPointLoc;
begin
// Running in debug thread
//debugln(['EnableBreaksDirect ', dbgs(ALocs)]);
for a in ALocs do
if FBreakPoints[a] <> nil then begin
if not(a in FBreakEnabled) then
@ -1751,6 +1780,7 @@ var
a: TBreakPointLoc;
begin
// Not in thread => only flag desired changes
//debugln(['DisableBreaks ', dbgs(ALocs)]);
for a in ALocs do
Exclude(FBreakNewEnabled, a);
end;
@ -1760,6 +1790,7 @@ var
a: TBreakPointLoc;
begin
// Running in debug thread
//debugln(['DisableBreaksDirect ', dbgs(ALocs)]);
for a in ALocs do
if FBreakPoints[a] <> nil then begin
if (a in FBreakEnabled) then
@ -1872,13 +1903,14 @@ procedure TFpDebugExceptionStepping.ThreadProcessLoopCycle(
function CheckCommandFinishesInFrame(AFrameAddr: TDBGPtr): Boolean;
begin
Result := ACurCommand is TDbgControllerHiddenBreakStepBaseCmd;
Result := (ACurCommand is TDbgControllerHiddenBreakStepBaseCmd) and
(TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo <> nil);
if not Result then
exit; // none stepping command, does not stop
if ACurCommand is TDbgControllerStepOutCmd then
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrame < AFrameAddr
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo.StoredStackFrame < AFrameAddr
else
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrame <= AFrameAddr;
Result := TDbgControllerHiddenBreakStepBaseCmd(CurrentCommand).StoredStackFrameInfo.StoredStackFrame <= AFrameAddr;
end;
procedure CheckSteppedOutFromW64SehFinally;
@ -1964,6 +1996,7 @@ begin
if (CurrentCommand <> nil) and (CurrentCommand.Thread <> CurrentThread) then
exit;
//DebugLn(['THreadProcLoop ', dbgs(FState), ' ', DbgSName(CurrentCommand)]);
DisableBreaksDirect([bplPopExcept, bplCatches, bplFpcSpecific]); // FpcSpecific was not needed -> not SEH based code
case FState of
esIgnoredRaise: begin