From f2d5fd797b237ee6dc86b3a369756eb9fda58dae Mon Sep 17 00:00:00 2001 From: martin Date: Fri, 24 Apr 2020 20:08:09 +0000 Subject: [PATCH] FpDebug: Refactor storing/comparing stack-pointer/frame for step-out detection. Allow different architectures to provide sub-classes git-svn-id: trunk@63060 - --- components/fpdebug/fpdbgclasses.pp | 86 +++++++++++++++++++ components/fpdebug/fpdbgcontroller.pas | 76 +++++++--------- .../lazdebuggerfp/fpdebugdebugger.pas | 39 ++++++++- 3 files changed, 152 insertions(+), 49 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index d2ec94132d..128fa47371 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -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 diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 4c2030a330..8f74e1feea 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -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; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index c38fbd8fb7..f1b642b4b0 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -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