FpDebug: detect ShortString under dwarf-2

git-svn-id: trunk@59780 -

components/fpdebug/fpdbgdwarf.pas

@@ -151,13 +151,13 @@ type
     FDataAddressCache: array of TFpDbgMemLocation;
     FStructureValue: TFpDwarfValue;
     FLastMember: TFpDwarfValue;
-    FLastError: TFpError;
     function GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation;
-    function MemManager: TFpDbgMemManager; inline;
     function AddressSize: Byte; inline;
     procedure SetDataAddressCache(AIndex: Integer; AValue: TFpDbgMemLocation);
     procedure SetStructureValue(AValue: TFpDwarfValue);
   protected
+    FLastError: TFpError;
+    function MemManager: TFpDbgMemManager; inline;
     procedure DoReferenceAdded; override;
     procedure DoReferenceReleased; override;
     procedure CircleBackRefActiveChanged(NewActive: Boolean); override;

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -5,8 +5,8 @@ unit FpDbgDwarfFreePascal;
 interface
 
 uses
-  Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil, DbgIntfBaseTypes,
-  LazLoggerBase;
+  Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil,
+  FpDbgDwarfConst, FpErrorMessages, DbgIntfBaseTypes, LazLoggerBase;
 
 type
 
@@ -22,6 +22,30 @@ type
     //  AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
   end;
 
+  { TFpDwarfFreePascalSymbolClassMapDwarf2 }
+
+  TFpDwarfFreePascalSymbolClassMapDwarf2 = class(TFpDwarfFreePascalSymbolClassMap)
+  public
+    class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
+    class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
+    //class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
+    //  ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
+    //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
+    //  AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
+  end;
+
+  { TFpDwarfFreePascalSymbolClassMapDwarf3 }
+
+  TFpDwarfFreePascalSymbolClassMapDwarf3 = class(TFpDwarfFreePascalSymbolClassMap)
+  public
+    class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
+    //class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
+    //class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
+    //  ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
+    //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
+    //  AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
+  end;
+
   { TFpDwarfFreePascalAddressContext }
 
   TFpDwarfFreePascalAddressContext = class(TFpDwarfInfoAddressContext)
@@ -35,6 +59,31 @@ type
     destructor Destroy; override;
   end;
 
+  { TFpDwarf2FreePascalSymbolTypeStructure }
+
+  TFpDwarf2FreePascalSymbolTypeStructure = class(TFpDwarfSymbolTypeStructure)
+  private
+    FIsShortString: (issUnknown, issShortString, issStructure);
+    function IsShortString: Boolean;
+  protected
+    function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override;
+    procedure KindNeeded; override;
+    function GetMemberCount: Integer; override;
+    //function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
+  end;
+
+  { TFpDwarfValue2FreePascalShortString }
+
+  TFpDwarfValue2FreePascalShortString = class(TFpDwarfValue)
+  private
+    FValue: String;
+    FValueDone: Boolean;
+  protected
+    function GetFieldFlags: TFpDbgValueFieldFlags; override;
+    function GetAsString: AnsiString; override;
+    function GetAsWideString: WideString; override;
+  end;
+
 implementation
 
 { TFpDwarfFreePascalSymbolClassMap }
@@ -53,6 +102,48 @@ begin
   Result := TFpDwarfFreePascalAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf);
 end;
 
+{ TFpDwarfFreePascalSymbolClassMapDwarf2 }
+
+class function TFpDwarfFreePascalSymbolClassMapDwarf2.HandleCompUnit(
+  ACU: TDwarfCompilationUnit): Boolean;
+begin
+  Result := inherited HandleCompUnit(ACU);
+  Result := Result and (ACU.Version < 3);
+end;
+
+class function TFpDwarfFreePascalSymbolClassMapDwarf2.GetDwarfSymbolClass(
+  ATag: Cardinal): TDbgDwarfSymbolBaseClass;
+begin
+  case ATag of
+    DW_TAG_structure_type:
+      Result := TFpDwarf2FreePascalSymbolTypeStructure; // maybe record
+  //  // TODO:
+  //  //DW_TAG_reference_type:   Result := TFpDwarfSymbolTypeRef;
+  //  //DW_TAG_typedef:          Result := TFpDwarfSymbolTypeDeclaration;
+  //  //DW_TAG_pointer_type:     Result := TFpDwarfSymbolTypePointer;
+  //  //
+  //  //DW_TAG_base_type:        Result := TFpDwarfSymbolTypeBasic;
+  //  //DW_TAG_subrange_type:    Result := TFpDwarfSymbolTypeSubRange;
+  //  //DW_TAG_enumeration_type: Result := TFpDwarfSymbolTypeEnum;
+  //  //DW_TAG_enumerator:       Result := TFpDwarfSymbolValueEnumMember;
+  //  //DW_TAG_array_type:       Result := TFpDwarfSymbolTypeArray;
+  //  ////
+  //  //DW_TAG_compile_unit:     Result := TFpDwarfSymbolUnit;
+  //
+    else
+      Result := inherited GetDwarfSymbolClass(ATag);
+  end;
+end;
+
+{ TFpDwarfFreePascalSymbolClassMapDwarf3 }
+
+class function TFpDwarfFreePascalSymbolClassMapDwarf3.HandleCompUnit(
+  ACU: TDwarfCompilationUnit): Boolean;
+begin
+  Result := inherited HandleCompUnit(ACU);
+  Result := Result and (ACU.Version >= 3);
+end;
+
 { TFpDwarfFreePascalAddressContext }
 
 function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
@@ -185,8 +276,121 @@ begin
   inherited Destroy;
 end;
 
+{ TFpDwarf2FreePascalSymbolTypeStructure }
+
+function TFpDwarf2FreePascalSymbolTypeStructure.IsShortString: Boolean;
+var
+  LenSym, StSym, StSymType: TFpDbgSymbol;
+begin
+  if FIsShortString <> issUnknown then
+    exit(FIsShortString = issShortString);
+
+  Result := False;
+  FIsShortString := issStructure;
+  if (inherited MemberCount <> 2) then
+    exit;
+
+  LenSym := inherited MemberByName['length'];
+  if (LenSym = nil) or (LenSym.Kind <> skCardinal) // or (LenSym.Size <> 1) // not implemented yet
+  then
+    exit;
+
+  StSym := inherited MemberByName['st'];
+  if (StSym = nil) then
+    exit;
+  StSymType := StSym.TypeInfo;
+  if (StSymType = nil) or (StSymType.Kind <> skArray) or not (StSymType is TFpDwarfSymbolTypeArray) then
+    exit;
+
+  // If it were a user declared array, fpc puts the stride in the subrange
+  if not TFpDwarfSymbolTypeArray(StSymType).InformationEntry.HasAttrib(DW_AT_byte_stride) then
+    exit;
+  // check the subrange?
+
+  FIsShortString := issShortString;
+  Result := True;
+end;
+
+function TFpDwarf2FreePascalSymbolTypeStructure.GetTypedValueObject(
+  ATypeCast: Boolean): TFpDwarfValue;
+begin
+  if not IsShortString then
+    Result := inherited GetTypedValueObject(ATypeCast)
+  else
+    Result := TFpDwarfValue2FreePascalShortString.Create(Self);
+end;
+
+procedure TFpDwarf2FreePascalSymbolTypeStructure.KindNeeded;
+begin
+  if not IsShortString then
+    inherited KindNeeded
+  else
+    SetKind(skString);
+end;
+
+function TFpDwarf2FreePascalSymbolTypeStructure.GetMemberCount: Integer;
+begin
+  if IsShortString then
+    Result := 0
+  else
+    Result := inherited GetMemberCount;
+end;
+
+{ TFpDwarfValue2FreePascalShortString }
+
+function TFpDwarfValue2FreePascalShortString.GetFieldFlags: TFpDbgValueFieldFlags;
+begin
+  Result := inherited GetFieldFlags;
+  Result := Result + [svfString];
+end;
+
+function TFpDwarfValue2FreePascalShortString.GetAsString: AnsiString;
+var
+  len: QWord;
+  LenSym, StSym: TFpDwarfValue;
+begin
+  if FValueDone then
+    exit(FValue);
+
+  if HasTypeCastInfo then begin
+    FLastError := CreateError(fpErrAnyError);
+    exit('');
+  end;
+
+  LenSym := TFpDwarfValue(inherited MemberByName['length']);
+  assert(LenSym is TFpDwarfValue, 'LenSym is TFpDwarfValue');
+  len := LenSym.AsCardinal;
+
+  if (TypeInfo.Size < 0) or (len > TypeInfo.Size) then begin
+    FLastError := CreateError(fpErrAnyError);
+    exit('');
+  end;
+
+  StSym := TFpDwarfValue(inherited MemberByName['st']);
+  assert(StSym is TFpDwarfValue, 'StSym is TFpDwarfValue');
+
+
+
+  SetLength(Result, len);
+  if len > 0 then
+    if not MemManager.ReadMemory(StSym.DataAddress, len, @Result[1]) then begin
+      Result := ''; // TODO: error
+      FLastError := MemManager.LastError;
+      exit;
+    end;
+
+  FValue := Result;
+  FValueDone := True;
+end;
+
+function TFpDwarfValue2FreePascalShortString.GetAsWideString: WideString;
+begin
+  Result := GetAsString;
+end;
+
 initialization
-  DwarfSymbolClassMapList.AddMap(TFpDwarfFreePascalSymbolClassMap);
+  DwarfSymbolClassMapList.AddMap(TFpDwarfFreePascalSymbolClassMapDwarf2);
+  DwarfSymbolClassMapList.AddMap(TFpDwarfFreePascalSymbolClassMapDwarf3);
 
 end.