diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 8d5adf92e1..d8a11e2da1 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/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; diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index 1352316969..99c0356418 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/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.