FPDebug: cache data address

git-svn-id: trunk@44239 -

components/fpdebug/fpdbgdwarf.pas

@@ -994,6 +994,12 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
 
   TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier)
   protected
+    // FCachedDataAddress is used by
+    // TDbgDwarfSymbolValue.GetDwarfDataAddress
+    // TDbgDwarfValueIdentifier.GetDataAddress
+    //TODO: maybe introduce a lightweight wrapper, so types can be re-used.
+    FCachedDataAddress: TFpDbgMemLocation;
+
     procedure Init; override;
     procedure MemberVisibilityNeeded; override;
     procedure SizeNeeded; override;
@@ -2825,6 +2831,13 @@ function TDbgDwarfSymbolValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocati
 var
   fields: TDbgSymbolValueFieldFlags;
 begin
+  // TODO: also cache none valid address
+  Result := IsValidLoc(ATargetType.FCachedDataAddress);
+  if Result then begin
+    AnAddress := ATargetType.FCachedDataAddress;
+    exit;
+  end;
+
   if FValueSymbol <> nil then begin
     Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
     Assert(TypeInfo is TDbgDwarfTypeIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
@@ -2856,6 +2869,8 @@ begin
     if IsError(FTypeCastTargetType.LastError) then
       FLastError := FTypeCastTargetType.LastError;
   end;
+
+  ATargetType.FCachedDataAddress := AnAddress;
 end;
 
 procedure TDbgDwarfSymbolValue.Reset;
@@ -5638,11 +5653,19 @@ begin
   Result := TypeInfo <> nil;
   if not Result then
     exit;
+  // TODO: also cache none valid address
+  Result := IsValidLoc(ATargetType.FCachedDataAddress);
+  if Result then begin
+    AnAddress := ATargetType.FCachedDataAddress;
+    exit;
+  end;
+
   Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress');
   AnAddress := Address;
   Result := IsReadableLoc(AnAddress);
   if Result then
     Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType);
+  ATargetType.FCachedDataAddress := AnAddress;
 end;
 
 procedure TDbgDwarfValueIdentifier.KindNeeded;

components/fpdebug/fpdmemorytools.pas

@@ -164,6 +164,7 @@ type
     * TODO: allow to pre-read and cache Target mem (e.g. before reading all fields of a record
   *)
   TFpDbgMemLocationType = (
+    mflUninitialized := 0,   // like invalid, but not known // 0 means objet fields will start wint this
     mlfInvalid,
     mlfTargetMem,            // an address in the target (debuggee) process
     mlfSelfMem,              // an address in this(the debuggers) process memory; the data is  in TARGET format (endian, ...)
@@ -314,12 +315,12 @@ end;
 
 function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean;
 begin
-  Result := (ALocation.MType <> mlfInvalid);
+  Result := not(ALocation.MType in [mlfInvalid, mflUninitialized]);
 end;
 
 function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean;
 begin
-  Result := (ALocation.MType <> mlfInvalid) and
+  Result := (not(ALocation.MType in [mlfInvalid, mflUninitialized])) and
             ( (not(ALocation.MType in [mlfTargetMem, mlfSelfMem])) or
               (ALocation.Address <> 0)
             );
@@ -492,7 +493,7 @@ begin
   FLastError := NoError;
   Result := False;
   case ALocation.MType of
-    mlfInvalid:
+    mlfInvalid, mflUninitialized:
       FLastError := CreateError(fpErrCanNotReadInvalidMem);
     mlfTargetMem, mlfSelfMem: begin
       Result := TargetMemConvertor.PrepareTargetRead(AReadDataType, ALocation.Address,
@@ -589,7 +590,7 @@ begin
   FLastError := NoError;
   Result := False;
   case ALocation.MType of
-    mlfInvalid: ;
+    mlfInvalid, mflUninitialized: ;
     mlfTargetMem:
       begin
         Result := FMemReader.ReadMemory(ALocation.Address, ASize, ADest);

components/fpdebug/fppascalparser.pas

@@ -924,6 +924,7 @@ begin
     tmp2 := Items[1].ResultValue;
     if not (svfOrdinal in tmp2.FieldFlags) then
       exit;
+    if tmp2.AsCardinal > high(Integer) then exit; // TODO max member range
     Result := tmp.Member[tmp2.AsCardinal]; // todo negative ?
     if Result <> nil then
       Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};

components/fpdebug/test/testhelperclasses.pas

@@ -402,7 +402,8 @@ end;
 function TTestMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
   ADest: Pointer): Boolean;
 begin
-  Result := True;
+  Result := AnAddress > 1000; // avoid reading at 0x0000
+  if not Result then exit;
   Move(Pointer(AnAddress)^, ADest^, ASize);
 end;
 

components/fpdebug/test/testtypeinfo.pas

@@ -5,9 +5,9 @@ unit TestTypeInfo;
 interface
 
 uses
-  FpPascalParser, FpDbgDwarf, FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazUTF8, sysutils,
-  fpcunit, testregistry, TestHelperClasses, TestDwarfSetup1, TestDwarfSetupBasic,
-  DbgIntfBaseTypes, TestDwarfSetupArray;
+  FpPascalParser, FpDbgDwarf, FpDbgInfo, FpdMemoryTools, FpErrorMessages, LazLoggerBase,
+  LazUTF8, sysutils, fpcunit, testregistry, TestHelperClasses, TestDwarfSetup1,
+  TestDwarfSetupBasic, DbgIntfBaseTypes, TestDwarfSetupArray;
 
 
 type
@@ -305,8 +305,14 @@ end;
 procedure TTestTypeInfo.StartInvalTest(Expr: String; ExpError: String; ExtraName: String);
 begin
   InitTest(Expr, ExtraName);
-  FExpression.ResultValue;
-  AssertTrue(FCurrentTestName + 'invalid', (not FExpression.Valid) or (FExpression.ResultValue = nil));
+  if FExpression.ResultValue <> nil then begin // some value are only invalid after accessing the data
+    FExpression.ResultValue.AsInteger;
+    FExpression.ResultValue.AsCardinal;
+  end;
+  AssertTrue(FCurrentTestName + 'invalid',
+             (not FExpression.Valid) or (FExpression.ResultValue = nil) or
+             (IsError(FExpression.ResultValue.LastError))
+            );
   //AssertTrue(CurrentTestName + 'invalid', (not Expression.Valid));
   //ExpError
 end;