paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 18:56:12 +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;
function FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
function FindCallStackEntryByInstructionPointer(AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
procedure ClearCallStack;
destructor Destroy; override;
function CompareStepInfo(AnAddr: TDBGPtr = 0; ASubLine: Boolean = False): TFPDCompareStepInfo;
@ -2758,6 +2759,42 @@ begin
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;
begin
if FCallStackEntryList <> nil then

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

@ -279,7 +279,7 @@ type
FCacheFileName: string;
FCacheLib: TDbgLibrary;
FCacheBreakpoint: TFpDbgBreakpoint;
FCacheLocation: TDBGPtr;
FCacheLocation, FCacheLocation2: TDBGPtr;
FCacheBoolean: boolean;
FCachePointer: pointer;
FCacheReadWrite: TDBGWatchPointKind;
@ -3539,7 +3539,10 @@ end;
procedure TFpDebugDebugger.DoSetStackFrameForBasePtr;
begin
FDbgController.CurrentThread.PrepareCallStackEntryList(7);
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(FCacheLocation, 30, 1);
if (FCacheLocation = 0) and (FCacheLocation2 <> 0) then
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByInstructionPointer(FCacheLocation2, 15, 1)
else
FCacheStackFrame := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(FCacheLocation, 30, 1);
end;
function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr; AnEnabled: Boolean
@ -3713,15 +3716,19 @@ begin
if FDbgController.CurrentProcess.RequiresExecutionInDebuggerThread then
begin
FCacheLocation:=ABasePtr;
FCacheLocation2:=CurAddr;
ExecuteInDebugThread(@DoSetStackFrameForBasePtr);
f := FCacheStackFrame;
end
else begin
FDbgController.CurrentThread.PrepareCallStackEntryList(7);
f := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(ABasePtr, 30, 1);
if (ABasePtr = 0) and (CurAddr <> 0) then
f := FDbgController.CurrentThread.FindCallStackEntryByInstructionPointer(CurAddr, 15, 1)
else
f := FDbgController.CurrentThread.FindCallStackEntryByBasePointer(ABasePtr, 30, 1);
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
CList := FDbgController.CurrentThread.CallStackEntryList;
if (CList[f].AnAddress = CurAddr) then begin