From c84d9e5bfee5dd52be0c8969ddfd4d61d6bb419f Mon Sep 17 00:00:00 2001
From: martin <laz.git@mfriebe.de>
Date: Wed, 8 Jul 2020 22:39:00 +0000
Subject: [PATCH] LazDebugFp, FpDebug: TestAssert does not set exception frame.
 Search by IP address

git-svn-id: trunk@63535 -
---
 components/fpdebug/fpdbgclasses.pp            | 37 +++++++++++++++++++
 .../lazdebuggerfp/fpdebugdebugger.pas         | 15 ++++++--
 2 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp
index be9fa9b96a..e2583377d6 100644
--- a/components/fpdebug/fpdbgclasses.pp
+++ b/components/fpdebug/fpdbgclasses.pp
@@ -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
diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
index e1fd424c8b..274de9b9cb 100644
--- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
+++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
@@ -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