FPDebug: starting arrays

git-svn-id: trunk@44187 -

components/fpdebug/fpdbgdwarf.pas

@@ -600,6 +600,8 @@ type
     function MemManager: TFpDbgMemManager; inline;
     function AddressSize: Byte; inline;
   protected
+    function DataAddr: TFpDbgMemLocation;
+    function OrdOrDataAddr: TFpDbgMemLocation;
     function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean;
     procedure Reset; virtual;
     function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
@@ -630,8 +632,6 @@ type
   private
     FSize: Integer;
   protected
-    function OrdOrDataAddr: TFpDbgMemLocation;
-    function DataAddr: TFpDbgMemLocation;
     function CanUseTypeCastAddress: Boolean;
     function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
     function GetSize: Integer; override;
@@ -825,6 +825,8 @@ type
   protected
     function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
     function GetKind: TDbgSymbolKind; override;
+    function GetAsCardinal: QWord; override;
+    function GetDataAddress: TFpDbgMemLocation; override;
     function GetMember(AIndex: Integer): TDbgSymbolValue; override;
     function GetMemberEx(AIndex: array of Int64): TDbgSymbolValue; override;
     function GetMemberCount: Integer; override;
@@ -1868,6 +1870,8 @@ function TDbgDwarfArraySymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
 begin
   Result := inherited GetFieldFlags;
   Result := Result + [svfMembers];
+  if (TypeInfo <> nil) and (sfDynArray in TypeInfo.Flags) then
+    Result := Result + [svfOrdinal, svfDataAddress];
 end;
 
 function TDbgDwarfArraySymbolValue.GetKind: TDbgSymbolKind;
@@ -1875,6 +1879,17 @@ begin
   Result := skArray;
 end;
 
+function TDbgDwarfArraySymbolValue.GetAsCardinal: QWord;
+begin
+  Result := QWord(LocToAddrOrNil(DataAddress));
+end;
+
+function TDbgDwarfArraySymbolValue.GetDataAddress: TFpDbgMemLocation;
+begin
+  //Result := GetDwarfDataAddress;
+  Result := MemManager.ReadAddress(OrdOrDataAddr, AddressSize); // TODO: cache
+end;
+
 function TDbgDwarfArraySymbolValue.GetMember(AIndex: Integer): TDbgSymbolValue;
 begin
   Result := GetMemberEx([AIndex]);
@@ -1890,12 +1905,12 @@ begin
   if not IsReadableLoc(Addr) then exit;
 
   if (FAddrObj = nil) or (FAddrObj.RefCount > 1) then begin
-    FAddrObj.ReleaseReference;
+    FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
     FAddrObj := TDbgDwarfSymbolValueConstAddress.Create(Addr);
+    {$IFDEF WITH_REFCOUNT_DEBUG}FAddrObj.DbgRenameReference(@FAddrObj, 'TDbgDwarfArraySymbolValue');{$ENDIF}
   end
   else begin
     FAddrObj.Update(Addr);
-    FAddrObj.AddReference;
   end;
 
   if (FResVal = nil) or (FResVal.RefCount > 1) then begin
@@ -1903,25 +1918,36 @@ begin
     FResVal := FOwner.TypeInfo.TypeCastValue(FAddrObj);
   end
   else begin
-    TDbgDwarfSymbolValue(FResVal).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner), FAddrObj);
+    TDbgDwarfSymbolValue(FResVal).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner.TypeInfo), FAddrObj);
   end;
 
-  FAddrObj.ReleaseReference;
   Result := FResVal;
 end;
 
 function TDbgDwarfArraySymbolValue.GetMemberCount: Integer;
 var
-  t: TDbgSymbol;
+  t, t2: TDbgSymbol;
+  Addr: TFpDbgMemLocation;
+  i: Int64;
 begin
   Result := 0;
   t := TypeInfo;
   if t.MemberCount < 1 then
     exit;
-  t := t.Member[0];
+  t2 := t.Member[0];
-  if not t.HasBounds then
+  if not t2.HasBounds then begin
+    if (sfDynArray in t.Flags) and (AsCardinal <> 0) and
+       GetDwarfDataAddress(Addr, TDbgDwarfTypeIdentifier(FOwner))
+    then begin
+      Addr.Address := Addr.Address - 4;
+      if MemManager.ReadSignedInt(Addr, 4, i) then begin
+        Result := Integer(i);
+        exit;
+      end;
+    end;
     exit;
-  Result := t.OrdHighBound - t.OrdLowBound + 1;
+  end;
+  Result := t2.OrdHighBound - t2.OrdLowBound + 1;
 end;
 
 function TDbgDwarfArraySymbolValue.GetMemberCountEx(AIndex: array of Int64): Integer;
@@ -1972,6 +1998,7 @@ end;
 
 destructor TDbgDwarfArraySymbolValue.Destroy;
 begin
+  FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
   FResVal.ReleaseReference;
   inherited Destroy;
 end;
@@ -2135,25 +2162,6 @@ end;
 
 { TDbgDwarfSizedSymbolValue }
 
-function TDbgDwarfSizedSymbolValue.OrdOrDataAddr: TFpDbgMemLocation;
-begin
-  if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
-    Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
-  else
-    Result := DataAddr;
-end;
-
-function TDbgDwarfSizedSymbolValue.DataAddr: TFpDbgMemLocation;
-begin
-  if FValueSymbol <> nil then
-    Result := FValueSymbol.Address
-  else
-  if HasTypeCastInfo then
-    Result := FTypeCastSourceValue.Address
-  else
-    Result := InvalidLoc;
-end;
-
 function TDbgDwarfSizedSymbolValue.CanUseTypeCastAddress: Boolean;
 begin
   Result := True;
@@ -2750,6 +2758,25 @@ begin
   Result := FOwner.FCU.FAddressSize;
 end;
 
+function TDbgDwarfSymbolValue.DataAddr: TFpDbgMemLocation;
+begin
+  if FValueSymbol <> nil then
+    Result := FValueSymbol.Address
+  else
+  if HasTypeCastInfo then
+    Result := FTypeCastSourceValue.Address
+  else
+    Result := InvalidLoc;
+end;
+
+function TDbgDwarfSymbolValue.OrdOrDataAddr: TFpDbgMemLocation;
+begin
+  if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
+    Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
+  else
+    Result := DataAddr;
+end;
+
 function TDbgDwarfSymbolValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
   ATargetType: TDbgDwarfTypeIdentifier): Boolean;
 var

components/fpdebug/fpdbginfo.pas

@@ -403,7 +403,7 @@ end;
 
 function TDbgSymbolValueConstAddress.GetFieldFlags: TDbgSymbolValueFieldFlags;
 begin
-  Result := [svfAddress, svfSizeOfPointer]
+  Result := [svfAddress]
 end;
 
 function TDbgSymbolValueConstAddress.GetAddress: TFpDbgMemLocation;

components/fpdebug/fppascalbuilder.pas

@@ -552,6 +552,33 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
     Result := True;
   end;
 
+  procedure DoArray;
+  var
+    s: String;
+    i: Integer;
+    m: TDbgSymbolValue;
+    c: Integer;
+  begin
+    APrintedValue := '';
+    c := AResValue.MemberCount;
+    if c > 500 then c := 500;
+// TODO: low-ord to high ord
+    for i := 0 to c - 1 do begin
+      m := AResValue.Member[i];
+      if m <> nil then
+        PrintPasValue(s, m, AnAddrSize, AFlags)
+      else
+        s := '{error}';
+      if APrintedValue = ''
+      then APrintedValue := s
+      else APrintedValue := APrintedValue + ', ' + s;
+    end;
+    if c < AResValue.MemberCount then
+      APrintedValue := APrintedValue + ', ...';
+    APrintedValue := '(' + APrintedValue + ')';
+    Result := True;
+  end;
+
 begin
   Result := False;
   case AResValue.Kind of
@@ -576,7 +603,7 @@ begin
     skObject:    DoStructure;
     skClass:     DoStructure;
     skInterface: ;
-    skArray: ;
+    skArray:     DoArray;
   end;
 
 end;

components/lazdebuggerfp/fpgdbmidebugger.pp

@@ -1290,8 +1290,8 @@ var
     if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
       exit;
     ATypeInfo := TDBGType.Create(skPointer, ResTypeName);
+    ATypeInfo.Value.AsPointer := Pointer(ResValue.AsCardinal); // TODO: no cut off
     ATypeInfo.Value.AsString := AResText;
-    //ATypeInfo.Value.AsPointer := ; // ???
   end;
 
   procedure DoSimple;
@@ -1427,6 +1427,17 @@ var
     end;
   end;
 
+  procedure DoArray;
+  begin
+    if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
+      exit;
+    ATypeInfo := TDBGType.Create(skArray, ResTypeName);
+    ATypeInfo.Value.AsString := AResText;
+    //ATypeInfo.Len;
+    //ATypeInfo.BoundLow;
+    //ATypeInfo.BoundHigh;
+  end;
+
 begin
   Result := False;
   ATypeInfo := nil;
@@ -1472,7 +1483,7 @@ begin
       skObject:    DoClass;
       skClass:     DoClass;
       skInterface: ;
-      skArray: ;
+      skArray:     DoArray;
     end;
     if not IsWatchValueAlive then exit;