FpDebug: Move getting FrameBase to Context.

components/fpdebug/fpdbgclasses.pp

@@ -862,7 +862,8 @@ type
     FWatchPointData: TFpWatchPointData;
     FProcessConfig: TDbgProcessConfig;
     FConfig: TDbgConfig;
-    function DoGetCfiFrameBase(AScope: TFpDbgLocationContext; AnAddr: TDBGPtr): TDBGPtr;
+    function DoGetCfiFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError): TDBGPtr;
+    function DoGetFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError): TDBGPtr;
     function GetDisassembler: TDbgAsmDecoder;
     function GetLastLibrariesLoaded: TDbgLibraryArr;
     function GetLastLibrariesUnloaded: TDbgLibraryArr;
@@ -2622,7 +2623,8 @@ begin
       if Frame <> nil then begin
         Addr := Frame.AnAddress;
         Ctx := TFpDbgSimpleLocationContext.Create(MemManager, Addr, DBGPTRSIZE[Mode], AThreadId, AStackFrame);
-        Ctx.SetCfiFrameBaseCallback(@DoGetCfiFrameBase);
+        Ctx.SetFrameBaseCallback(@DoGetFrameBase);
+        Ctx.SetCfaFrameBaseCallback(@DoGetCfiFrameBase);
         sym := Frame.ProcSymbol;
         if sym <> nil then
           Result := sym.CreateSymbolScope(Ctx);
@@ -3097,29 +3099,56 @@ begin
   Result := FDisassembler;
 end;
 
-function TDbgProcess.DoGetCfiFrameBase(AScope: TFpDbgLocationContext; AnAddr: TDBGPtr): TDBGPtr;
+function TDbgProcess.DoGetCfiFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError
+  ): TDBGPtr;
 var
-  CIE: TDwarfCIE;
-  ROW: TDwarfCallFrameInformationRow;
   Thrd: TDbgThread;
   CStck: TDbgCallstackEntry;
+  CIE: TDwarfCIE;
+  ROW: TDwarfCallFrameInformationRow;
 begin
   Result := 0;
-  if (not GetThread(AScope.ThreadId, Thrd)) or (Thrd = nil) then
+  AnError := nil;
+  if (not GetThread(AContext.ThreadId, Thrd)) or (Thrd = nil) then
     exit;
-  if AScope.StackFrame >= Thrd.CallStackEntryList.Count then
+  if AContext.StackFrame >= Thrd.CallStackEntryList.Count then
     exit;
-  CStck := Thrd.CallStackEntryList[AScope.StackFrame];
+  CStck := Thrd.CallStackEntryList[AContext.StackFrame];
   if CStck = nil then
     exit;
 
-  if not FindCallFrameInfo(AnAddr, CIE, ROW) then
+  if not FindCallFrameInfo(AContext.Address, CIE, ROW) then
     exit;
 
   if not GetCanonicalFrameAddress(CStck.RegisterValueList ,ROW, Result) then
     Result := 0;
 end;
 
+function TDbgProcess.DoGetFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError
+  ): TDBGPtr;
+var
+  Thrd: TDbgThread;
+  CStck: TDbgCallstackEntry;
+  p: TFpSymbol;
+begin
+  Result := 0;
+  AnError := nil;
+  if (not GetThread(AContext.ThreadId, Thrd)) or (Thrd = nil) then
+    exit;
+  if AContext.StackFrame >= Thrd.CallStackEntryList.Count then
+    exit;
+  CStck := Thrd.CallStackEntryList[AContext.StackFrame];
+  if CStck = nil then
+    exit;
+
+  p := CStck.ProcSymbol;
+  if p =nil then
+    exit;
+
+  if p is TFpSymbolDwarfDataProc then
+    Result := TFpSymbolDwarfDataProc(p).GetFrameBase(AContext, AnError);
+end;
+
 function TDbgProcess.GetLastLibrariesLoaded: TDbgLibraryArr;
 begin
   Result := FLibMap.FLibrariesAdded;

components/fpdebug/fpdbgdwarf.pas

@@ -558,14 +558,10 @@ type
   TFpSymbolDwarf = class(TDbgDwarfSymbolBase)
   private
     FNestedTypeInfo: TFpSymbolDwarfType;
-    (* FLocalProcInfo: the procedure in which a local symbol is defined/used *)
-    FLocalProcInfo: TFpSymbolDwarf;
     FDwarfReadFlags: set of (didtNameRead, didtTypeRead, didtArtificialRead, didtIsArtifical);
     function GetNestedTypeInfo: TFpSymbolDwarfType;
     function GetTypeInfo: TFpSymbolDwarfType; inline;
   protected
-    procedure SetLocalProcInfo(AValue: TFpSymbolDwarf); virtual;
-
     function  DoGetNestedTypeInfo: TFpSymbolDwarfType; virtual;
     function  ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
     function  IsArtificial: Boolean; // usud by formal param and subprogram
@@ -573,9 +569,6 @@ type
     procedure TypeInfoNeeded; override;
     property NestedTypeInfo: TFpSymbolDwarfType read GetNestedTypeInfo;
 
-    // LocalProcInfo: funtion for local var / param
-    property LocalProcInfo: TFpSymbolDwarf read FLocalProcInfo write SetLocalProcInfo;
-
     function DoForwardReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline;
     function DoReadDataSize(const AValueObj: TFpValue; out ADataSize: TFpDbgValueSize): Boolean; virtual;
   protected
@@ -650,12 +643,8 @@ type
   { TFpSymbolDwarfDataWithLocation }
 
   TFpSymbolDwarfDataWithLocation = class(TFpSymbolDwarfData)
-  private
-    procedure FrameBaseNeeded(ASender: TObject); // Sender = TDwarfLocationExpression
   protected
     function GetValueObject: TFpValue; override;
-    function InitLocationParser(const ALocationParser: TDwarfLocationExpression;
-                                AnInitLocParserData: PInitLocParserData): Boolean; override;
   end;
 
   TFpSymbolDwarfThirdPartyExtension = class(TFpSymbolDwarf)
@@ -1091,7 +1080,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     procedure DoReferenceReleased; override;
     function GetLineEndAddress: TDBGPtr; override;
     function GetLineStartAddress: TDBGPtr; override;
-    function GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
     function GetFlags: TDbgSymbolFlags; override;
     procedure TypeInfoNeeded; override;
 
@@ -1115,6 +1103,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
     // TODO members = locals ?
     function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf;
+    function GetFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError): TDbgPtr;
 
     function ResolveInternalFinallySymbol(Process: Pointer): TFpSymbol; virtual; // so it can be overriden by the fpc classes
 
@@ -1719,8 +1708,6 @@ begin
     exit;
   if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
     ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
-    if ADbgValue <> nil then
-      TFpSymbolDwarf(ADbgValue.DbgSymbol).LocalProcInfo := TFpSymbolDwarfDataProc(FSymbol);
   end;
   Result := ADbgValue <> nil;
 end;
@@ -4265,18 +4252,6 @@ begin
   Result := TFpSymbolDwarfType(inherited TypeInfo);
 end;
 
-procedure TFpSymbolDwarf.SetLocalProcInfo(AValue: TFpSymbolDwarf);
-begin
-  if FLocalProcInfo = AValue then exit;
-
-  FLocalProcInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
-
-  FLocalProcInfo := AValue;
-
-  if (FLocalProcInfo <> nil) then
-    FLocalProcInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
-end;
-
 function TFpSymbolDwarf.DoGetNestedTypeInfo: TFpSymbolDwarfType;
 var
   FwdInfoPtr: Pointer;
@@ -4945,7 +4920,6 @@ destructor TFpSymbolDwarf.Destroy;
 begin
   inherited Destroy;
   FNestedTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FNestedTypeInfo, ClassName+'.FNestedTypeInfo'){$ENDIF};
-  FLocalProcInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
 end;
 
 function TFpSymbolDwarf.StartScope: TDbgPtr;
@@ -5046,39 +5020,6 @@ end;
 
 { TFpSymbolDwarfDataWithLocation }
 
-function TFpSymbolDwarfDataWithLocation.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
-  AnInitLocParserData: PInitLocParserData): Boolean;
-begin
-  Result := inherited InitLocationParser(ALocationParser, AnInitLocParserData);
-  ALocationParser.OnFrameBaseNeeded := @FrameBaseNeeded;
-end;
-
-procedure TFpSymbolDwarfDataWithLocation.FrameBaseNeeded(ASender: TObject);
-var
-  p: TFpSymbolDwarf;
-  fb: TDBGPtr;
-begin
-  debugln(FPDBG_DWARF_SEARCH, ['TFpSymbolDwarfDataVariable.FrameBaseNeeded ']);
-  p := LocalProcInfo;
-  // TODO: what if parent is declaration?
-  if p is TFpSymbolDwarfDataProc then begin
-    fb := TFpSymbolDwarfDataProc(p).GetFrameBase(ASender as TDwarfLocationExpression);
-    (ASender as TDwarfLocationExpression).FrameBase := fb;
-    if fb = 0 then begin
-      debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataWithLocation.FrameBaseNeeded result is 0']);
-    end;
-    exit;
-  end;
-
-{$warning TODO}
-  //else
-  //if ParentTypeInfo <> nil then
-  //  ParentTypeInfo.fr;
-  // TODO: check owner
-  debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataWithLocation.FrameBaseNeeded no parent type info']);
-  (ASender as TDwarfLocationExpression).FrameBase := 0;
-end;
-
 function TFpSymbolDwarfDataWithLocation.GetValueObject: TFpValue;
 var
   ti: TFpSymbol;
@@ -7005,12 +6946,14 @@ begin
     NilThenReleaseRef(TFpSymbolDwarfTypeProc(TypeInfo).FLastMember {$IFDEF WITH_REFCOUNT_DEBUG}, 'TFpSymbolDwarfDataProc.FLastMember'{$ENDIF});
 end;
 
-function TFpSymbolDwarfDataProc.GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
+function TFpSymbolDwarfDataProc.GetFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError
+  ): TDbgPtr;
 var
   Val: TByteDynArray;
   rd: TFpDbgMemLocation;
 begin
   Result := 0;
+  AnError := nil;
   if FFrameBaseParser = nil then begin
     //TODO: avoid copying data
     if not  InformationEntry.ReadValue(DW_AT_frame_base, Val) then begin
@@ -7024,15 +6967,14 @@ begin
       exit;
     end;
 
-    FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit,
+    FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit, AContext);
-      ASender.Context);
     FFrameBaseParser.IsDwAtFrameBase := True;
     FFrameBaseParser.Evaluate;
   end;
 
   if IsError(FFrameBaseParser.LastError) then begin
-    ASender.SetLastError(FFrameBaseParser.LastError);
+    AnError := FFrameBaseParser.LastError;
-    debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(ASender.LastError)]);
+    debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(AnError)]);
   end
   else begin
     rd := FFrameBaseParser.ResultData;
@@ -7129,7 +7071,6 @@ begin
         Result := TFpValueDwarf(TFpSymbolDwarfData.CreateValueSubClass('self', InfoEntry).Value);
         if Result <> nil then begin
           Result.FDataSymbol.ReleaseReference;
-          Result.FDataSymbol.LocalProcInfo := Self;
         end;
         debugln(FPDBG_DWARF_SEARCH, ['TFpSymbolDwarfDataProc.GetSelfParameter ', InfoEntry.ScopeDebugText, DbgSName(Result)]);
       end;
@@ -7207,8 +7148,6 @@ begin
   FLastMember := TFpSymbolDwarf.CreateSubClass('', TDwarfInformationEntry(FProcMembers[AIndex]));
   {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpSymbolDwarfDataProc.FLastMember');{$ENDIF}
   Result := FLastMember;
-  //if Result <> nil then
-  //  TFpSymbolDwarf(Result).LocalProcInfo := FProcValue;
 end;
 
 function TFpSymbolDwarfTypeProc.GetNestedSymbolExByName(const AIndex: String;
@@ -7231,8 +7170,6 @@ begin
     end;
   end;
   Result := FLastMember;
-  //if Result <> nil then
-  //  TFpSymbolDwarf(Result).LocalProcInfo := FProcValue;
 end;
 
 function TFpSymbolDwarfTypeProc.GetNestedSymbolCount: Integer;

components/fpdebug/fpdbgdwarfdataclasses.pas

@@ -872,7 +872,6 @@ type
     FFrameBase: TDbgPtr;
     FIsDwAtFrameBase: Boolean;
     FLastError: TFpError;
-    FOnFrameBaseNeeded: TNotifyEvent;
     FStack: TDwarfLocationStack;
     FCU: TDwarfCompilationUnit;
     FData: PByte;
@@ -885,8 +884,7 @@ type
     procedure Evaluate;
     function ResultData: TFpDbgMemLocation;
     procedure Push(const AValue: TFpDbgMemLocation);
-    property  FrameBase: TDbgPtr read FFrameBase write FFrameBase;
+    //property  FrameBase: TDbgPtr read FFrameBase write FFrameBase;
-    property  OnFrameBaseNeeded: TNotifyEvent read FOnFrameBaseNeeded write FOnFrameBaseNeeded;
     property LastError: TFpError read FLastError;
     property Context: TFpDbgLocationContext read FContext write FContext;
     // for DW_OP_push_object_address
@@ -2170,6 +2168,17 @@ var
   CurInstr, CurData: PByte;
   AddrSize: Byte;
 
+  procedure SetError(AnError: TFpError);
+  begin
+    FStack.Push(InvalidLoc); // Mark as failed
+    FLastError := AnError;
+    debugln(FPDBG_DWARF_ERRORS,
+            ['DWARF ERROR in TDwarfLocationExpression: Failed at Pos=', CurInstr-FData,
+             ' OpCode=', IntToHex(CurInstr^, 2), ' Depth=', FStack.Count,
+             ' Data: ', dbgMemRange(FData, FMaxData-FData),
+             ' Extra: ', ErrorHandler.ErrorAsString(AnError) ]);
+  end;
+
   procedure SetError(AnInternalErrorCode: TFpErrorCode = fpErrNoError);
   begin
     FStack.Push(InvalidLoc); // Mark as failed
@@ -2345,12 +2354,13 @@ begin
         end;
 
       DW_OP_fbreg: begin
-          if (FFrameBase = 0) and (FOnFrameBaseNeeded <> nil) then FOnFrameBaseNeeded(Self);
+          if (FFrameBase = 0) then begin
-          if FFrameBase = 0 then begin
+            FFrameBase := FContext.FrameBase;
-            if not IsError(FLastError) then
+            if FFrameBase = 0 then
-              SetError;
+              SetError(FContext.FrameBaseError);
-            exit;
           end;
+          if FFrameBase = 0 then
+            exit;
           {$PUSH}{$R-}{$Q-}
           FStack.PushTargetMem(FFrameBase+SLEB128toOrdinal(CurData));
           {$POP}
@@ -2626,9 +2636,9 @@ begin
       end;
 
       DW_OP_call_frame_cfa: begin
-          NewValue := Context.CfiFrameBase;
+          NewValue := Context.CfaFrameBase;
           if NewValue = 0 then begin
-            SetError(fpErrLocationParser);
+            SetError(Context.FCfarameBaseError);
             exit;
           end;
           FStack.PushTargetMem(NewValue);

components/fpdebug/fpdmemorytools.pas

@@ -82,14 +82,18 @@ type
 
   TFpDbgLocationContext = class;
 
-  TGetCfiFrameBaseCallback = function(AScope: TFpDbgLocationContext; AnAddr: TDBGPtr): TDBGPtr of object;
+  TGetFrameBaseCallback = function(AContext: TFpDbgLocationContext; out AnError: TFpError): TDBGPtr of object;
 
   TFpDbgLocationContext = class(TRefCountedObject)
   private
-    FCfiFrameBaseCallback: TGetCfiFrameBaseCallback;
+    FCfaFrameBaseError: TFpError;
-    FCfiFrameBase: TDBGPtr;
+    FFrameBaseCallback: TGetFrameBaseCallback;
+    FCfaFrameBaseCallback: TGetFrameBaseCallback;
+    FFrameBaseError: TFpError;
+    FFrameBase, FCfaFrameBase: TDBGPtr;
 
-    function GetCfiFrameBase: TDBGPtr;
+    function GetFrameBase: TDBGPtr;
+    function GetCfaFrameBase: TDBGPtr;
     function GetLastMemError: TFpError;
     function GetPartialReadResultLenght: QWord;
   protected
@@ -101,14 +105,19 @@ type
     function GetMemModel: TFpDbgMemModel; virtual; abstract;
   public
     property Address: TDbgPtr read GetAddress;
-    property CfiFrameBase: TDBGPtr read GetCfiFrameBase;
     property ThreadId: Integer read GetThreadId;
     property StackFrame: Integer read GetStackFrame;
     property SizeOfAddress: Integer read GetSizeOfAddress;
     property MemManager: TFpDbgMemManager read GetMemManager;
     property MemModel: TFpDbgMemModel read GetMemModel;
   public
-    procedure SetCfiFrameBaseCallback(ACallback: TGetCfiFrameBaseCallback);
+    procedure SetFrameBaseCallback(ACallback: TGetFrameBaseCallback);
+    procedure SetCfaFrameBaseCallback(ACallback: TGetFrameBaseCallback);
+    property FrameBase: TDBGPtr read GetFrameBase;        // as requested by DW_OP_fbreg
+    property FrameBaseError: TFpError read FFrameBaseError;
+    property CfaFrameBase: TDBGPtr read GetCfaFrameBase;  // as requested by DW_OP_call_frame_cfa
+    property FCfarameBaseError: TFpError read FCfaFrameBaseError;
+  public
     procedure ClearLastMemError;
     property LastMemError: TFpError read GetLastMemError;
     property PartialReadResultLenght: QWord read GetPartialReadResultLenght;
@@ -987,12 +996,26 @@ begin
   Result := MemManager.LastError;
 end;
 
-function TFpDbgLocationContext.GetCfiFrameBase: TDBGPtr;
+function TFpDbgLocationContext.GetFrameBase: TDBGPtr;
 begin
-  if FCfiFrameBaseCallback <> nil then
+  if FFrameBaseCallback <> nil then begin
-    FCfiFrameBase := FCfiFrameBaseCallback(Self, Address);
+    FFrameBase := FFrameBaseCallback(Self, FFrameBaseError);
-  FCfiFrameBaseCallback := nil; // Only call once
+    if (FFrameBase = 0) and not IsError(FFrameBaseError) then
-  Result := FCfiFrameBase;
+      FFrameBaseError := CreateError(fpErrAnyError, []);
+    FFrameBaseCallback := nil;
+  end;
+  Result := FFrameBase;
+end;
+
+function TFpDbgLocationContext.GetCfaFrameBase: TDBGPtr;
+begin
+  if FCfaFrameBaseCallback <> nil then begin
+    FCfaFrameBase := FCfaFrameBaseCallback(Self, FCfaFrameBaseError);
+    if (FCfaFrameBase = 0) and not IsError(FCfaFrameBaseError) then
+      FCfaFrameBaseError := CreateError(fpErrAnyError, []);
+    FCfaFrameBaseCallback := nil;
+  end;
+  Result := FCfaFrameBase;
 end;
 
 function TFpDbgLocationContext.GetPartialReadResultLenght: QWord;
@@ -1000,9 +1023,14 @@ begin
   Result := MemManager.PartialReadResultLenght;
 end;
 
-procedure TFpDbgLocationContext.SetCfiFrameBaseCallback(ACallback: TGetCfiFrameBaseCallback);
+procedure TFpDbgLocationContext.SetFrameBaseCallback(ACallback: TGetFrameBaseCallback);
 begin
-  FCfiFrameBaseCallback := ACallback;
+  FFrameBaseCallback := ACallback;
+end;
+
+procedure TFpDbgLocationContext.SetCfaFrameBaseCallback(ACallback: TGetFrameBaseCallback);
+begin
+  FCfaFrameBaseCallback := ACallback;
 end;
 
 procedure TFpDbgLocationContext.ClearLastMemError;