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

LazDebugFp, FpDebug: TestAssert does not set exception frame. Search by IP address

Browse Source 
git-svn-id: trunk@63535 -
This commit is contained in:
martin 2020-07-08 22:39:00 +00:00
parent af13ce4b2d
commit c84d9e5bfe
2 changed files with 48 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/fpdebug/fpdbgclasses.pp
View File

@ -216,6 +216,7 @@ type
procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual; procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual;
function FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual; function FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
function FindCallStackEntryByInstructionPointer(AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
procedure ClearCallStack; procedure ClearCallStack;
destructor Destroy; override; destructor Destroy; override;
function CompareStepInfo(AnAddr: TDBGPtr = 0; ASubLine: Boolean = False): TFPDCompareStepInfo; function CompareStepInfo(AnAddr: TDBGPtr = 0; ASubLine: Boolean = False): TFPDCompareStepInfo;
@ -2758,6 +2759,42 @@ begin
end; end;
end; end;
function TDbgThread.FindCallStackEntryByInstructionPointer(
AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer
): Integer;
var
RegIP: Integer;
AFrame: TDbgCallstackEntry;
ARegister: TDbgRegisterValue;
ip: TDBGPtr;
begin
if Process.Mode = dm64 then
RegIP := 16
else
RegIP := 8;
Result := AStartFrame;
while Result <= AMaxFrameToSearch do begin
PrepareCallStackEntryList(Result+1);
if CallStackEntryList.Count <= Result then
exit(-1);
AFrame := CallStackEntryList[Result];
if AFrame = nil then
exit(-1);
ARegister := AFrame.RegisterValueList.FindRegisterByDwarfIndex(RegIP);
if ARegister = nil then
exit(-1);
ip := ARegister.NumValue;
if ip = AInstructionPointer then
exit;
inc(Result);
end;
end;
procedure TDbgThread.ClearCallStack; procedure TDbgThread.ClearCallStack;
begin begin
if FCallStackEntryList <> nil then if FCallStackEntryList <> nil then

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

@ -279,7 +279,7 @@ type
FCacheFileName: string; FCacheFileName: string;
FCacheLib: TDbgLibrary; FCacheLib: TDbgLibrary;
FCacheBreakpoint: TFpDbgBreakpoint; FCacheBreakpoint: TFpDbgBreakpoint;
FCacheLocation: TDBGPtr; FCacheLocation, FCacheLocation2: TDBGPtr;
FCacheBoolean: boolean; FCacheBoolean: boolean;
FCachePointer: pointer; FCachePointer: pointer;
FCacheReadWrite: TDBGWatchPointKind; FCacheReadWrite: TDBGWatchPointKind;
@ -3539,6 +3539,9 @@ end;
procedure TFpDebugDebugger.DoSetStackFrameForBasePtr; procedure TFpDebugDebugger.DoSetStackFrameForBasePtr;
begin begin
FDbgController.CurrentThread.PrepareCallStackEntryList(7); FDbgController.CurrentThread.PrepareCallStackEntryList(7);
if (FCacheLocation = 0) and (FCacheLocation2 <> 0) then
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByInstructionPointer(FCacheLocation2, 15, 1)
else
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(FCacheLocation, 30, 1); FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(FCacheLocation, 30, 1);
end; end;
@ -3713,15 +3716,19 @@ begin
if FDbgController.CurrentProcess.RequiresExecutionInDebuggerThread then if FDbgController.CurrentProcess.RequiresExecutionInDebuggerThread then
begin begin
FCacheLocation:=ABasePtr; FCacheLocation:=ABasePtr;
FCacheLocation2:=CurAddr;
ExecuteInDebugThread(@DoSetStackFrameForBasePtr); ExecuteInDebugThread(@DoSetStackFrameForBasePtr);
f := FCacheStackFrame; f := FCacheStackFrame;
end end
else begin else begin
FDbgController.CurrentThread.PrepareCallStackEntryList(7); FDbgController.CurrentThread.PrepareCallStackEntryList(7);
if (ABasePtr = 0) and (CurAddr <> 0) then
f := FDbgController.CurrentThread.FindCallStackEntryByInstructionPointer(CurAddr, 15, 1)
else
f := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(ABasePtr, 30, 1); f := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(ABasePtr, 30, 1);
end; end;
if (f >= 2) and ASearchAssert then begin if (f >= 2) and ASearchAssert and (ABasePtr <> 0) then begin
// stack is already prepared / exe in thread not needed // stack is already prepared / exe in thread not needed
CList := FDbgController.CurrentThread.CallStackEntryList; CList := FDbgController.CurrentThread.CallStackEntryList;
if (CList[f].AnAddress = CurAddr) then begin if (CList[f].AnAddress = CurAddr) then begin