mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-07 21:41:34 +02:00
FPDebug: refactor / more ptype for gdb
git-svn-id: trunk@43305 -
This commit is contained in:
martin
parent
03718c93d9
commit
649eb4e059
@ -108,7 +108,14 @@ type
|
||||
//--------------------------------------------------------------------------
|
||||
);
|
||||
|
||||
TDbgSymbolMemberVisibility =(
|
||||
svPrivate,
|
||||
svProtected,
|
||||
svPublic
|
||||
);
|
||||
|
||||
TDbgSymbolFlag =(
|
||||
sfInternalRef, // Internal ref/pointer e.g. var/constref parameters
|
||||
//sfPointer, // The sym is a pointer to the reference
|
||||
sfConst, // The sym is a constant and cannot be modified
|
||||
sfVar,
|
||||
@ -120,7 +127,8 @@ type
|
||||
TDbgSymbolFlags = set of TDbgSymbolFlag;
|
||||
|
||||
TDbgSymbolField = (
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize, sfiTypeInfo
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize,
|
||||
sfiTypeInfo, sfiMemberVisibility
|
||||
);
|
||||
TDbgSymbolFields = set of TDbgSymbolField;
|
||||
|
||||
@ -137,6 +145,7 @@ type
|
||||
FAddress: TDbgPtr;
|
||||
FSize: Integer;
|
||||
FTypeInfo: TDbgSymbol;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
|
||||
function GetSymbolType: TDbgSymbolType; //inline;
|
||||
function GetKind: TDbgSymbolKind; //inline;
|
||||
@ -144,6 +153,7 @@ type
|
||||
function GetSize: Integer;
|
||||
function GetAddress: TDbgPtr;
|
||||
function GetTypeInfo: TDbgSymbol;
|
||||
function GetMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
protected
|
||||
// NOT cached fields
|
||||
function GetChild(AIndex: Integer): TDbgSymbol; virtual;
|
||||
@ -167,6 +177,7 @@ type
|
||||
procedure SetAddress(AValue: TDbgPtr);
|
||||
procedure SetSize(AValue: Integer);
|
||||
procedure SetTypeInfo(AValue: TDbgSymbol);
|
||||
procedure SetMemberVisibility(AValue: TDbgSymbolMemberVisibility);
|
||||
|
||||
procedure KindNeeded; virtual;
|
||||
procedure NameNeeded; virtual;
|
||||
@ -174,6 +185,7 @@ type
|
||||
procedure AddressNeeded; virtual;
|
||||
procedure SizeNeeded; virtual;
|
||||
procedure TypeInfoNeeded; virtual;
|
||||
procedure MemberVisibilityNeeded; virtual;
|
||||
//procedure Needed; virtual;
|
||||
public
|
||||
constructor Create(const AName: String);
|
||||
@ -186,14 +198,15 @@ type
|
||||
// Memory; Size is also part of type (byte vs word vs ...)
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property Size: Integer read GetSize; // In Bytes
|
||||
// Location
|
||||
property FileName: String read GetFile;
|
||||
property Line: Cardinal read GetLine;
|
||||
property Column: Cardinal read GetColumn;
|
||||
// TypeInfo used by
|
||||
// stValue (Variable): Type
|
||||
// stType: Pointer: type pointed to / Array: Element Type / Func: Result / Class: itheritance
|
||||
property TypeInfo: TDbgSymbol read GetTypeInfo;
|
||||
property MemberVisibility: TDbgSymbolMemberVisibility read GetMemberVisibility;
|
||||
// Location
|
||||
property FileName: String read GetFile;
|
||||
property Line: Cardinal read GetLine;
|
||||
property Column: Cardinal read GetColumn;
|
||||
// Methods for structures (record / class)
|
||||
property MemberCount: Integer read GetMemberCount; // inherited NOT included
|
||||
property Member[AIndex: Integer]: TDbgSymbol read GetMember;
|
||||
@ -956,6 +969,13 @@ begin
|
||||
Result := FTypeInfo;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
begin
|
||||
if not(sfiMemberVisibility in FEvaluatedFields) then
|
||||
MemberVisibilityNeeded;
|
||||
Result := FMemberVisibility;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
if not(sfiKind in FEvaluatedFields) then
|
||||
@ -1032,6 +1052,12 @@ begin
|
||||
FTypeInfo.AddReference;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetMemberVisibility(AValue: TDbgSymbolMemberVisibility);
|
||||
begin
|
||||
FMemberVisibility := AValue;
|
||||
Include(FEvaluatedFields, sfiMemberVisibility);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetName(AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
@ -1108,6 +1134,11 @@ begin
|
||||
SetTypeInfo(nil);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.MemberVisibilityNeeded;
|
||||
begin
|
||||
SetMemberVisibility(svPrivate);
|
||||
end;
|
||||
|
||||
{$ifdef windows}
|
||||
{ TDbgBreak }
|
||||
|
||||
|
||||
@ -514,6 +514,7 @@ type
|
||||
function GetNestedTypeInfo: TDbgDwarfTypeIdentifier;
|
||||
protected
|
||||
function ReadName(out AName:String): Boolean;
|
||||
function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
|
||||
procedure NameNeeded; override;
|
||||
procedure TypeInfoNeeded; override;
|
||||
|
||||
@ -543,6 +544,7 @@ type
|
||||
TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
procedure Init; override;
|
||||
end;
|
||||
|
||||
@ -594,6 +596,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier)
|
||||
protected
|
||||
procedure Init; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
public
|
||||
class function CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
|
||||
end;
|
||||
@ -614,16 +617,31 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
procedure KindNeeded; override;
|
||||
procedure NameNeeded; override;
|
||||
procedure TypeInfoNeeded; override; // forward
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierRef }
|
||||
|
||||
TDbgDwarfTypeIdentifierRef = class(TDbgDwarfTypeIdentifierModifier)
|
||||
protected
|
||||
function GetFlags: TDbgSymbolFlags; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierDeclaration }
|
||||
|
||||
TDbgDwarfTypeIdentifierDeclaration = class(TDbgDwarfTypeIdentifierModifier)
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
// typedef > pointer > srtuct
|
||||
// while a pointer to class/object: pointer > typedef > ....
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierPointer }
|
||||
@ -631,10 +649,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
TDbgDwarfTypeIdentifierPointer = class(TDbgDwarfTypeIdentifier)
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
TDbgDwarfIdentifierMember = class(TDbgDwarfValueIdentifier)
|
||||
@ -673,7 +687,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
|
||||
{ TDbgDwarfProcSymbol }
|
||||
|
||||
TDbgDwarfProcSymbol = class(TDbgDwarfIdentifier)
|
||||
TDbgDwarfProcSymbol = class(TDbgDwarfValueIdentifier)
|
||||
private
|
||||
//FCU: TDwarfCompilationUnit;
|
||||
FAddress: TDbgPtr;
|
||||
@ -1203,6 +1217,80 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierRef }
|
||||
|
||||
function TDbgDwarfTypeIdentifierRef.GetFlags: TDbgSymbolFlags;
|
||||
begin
|
||||
Result := (inherited GetFlags) + [sfInternalRef];
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierPointer }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierPointer.KindNeeded;
|
||||
begin
|
||||
SetKind(skPointer);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierDeclaration }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierDeclaration.KindNeeded;
|
||||
var
|
||||
ti: TDbgDwarfTypeIdentifier;
|
||||
ti2: TDbgSymbol;
|
||||
begin
|
||||
ti := NestedTypeInfo;
|
||||
if (ti <> nil) and (ti.Kind = skPointer) then begin
|
||||
// maybe a class
|
||||
ti2 := TypeInfo;
|
||||
// only if ti2 is NOT a declaration
|
||||
if (ti2 <> nil) and (ti2 is TDbgDwarfIdentifierStructure) then begin
|
||||
SetKind(skClass);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
inherited KindNeeded;
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierDeclaration.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then // this has a nested pointer, to a class
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.Member[AIndex]
|
||||
else
|
||||
Result := inherited GetMember(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierDeclaration.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then // this has a nested pointer, to a class
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberByName[AIndex]
|
||||
else
|
||||
Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierDeclaration.GetMemberCount: Integer;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then // this has a nested pointer, to a class
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberCount
|
||||
else
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfValueIdentifier }
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.KindNeeded;
|
||||
@ -1216,6 +1304,19 @@ begin
|
||||
SetKind(t.Kind);
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.MemberVisibilityNeeded;
|
||||
var
|
||||
Val: TDbgSymbolMemberVisibility;
|
||||
begin
|
||||
if ReadMemberVisibility(Val) then
|
||||
SetMemberVisibility(Val)
|
||||
else
|
||||
if TypeInfo <> nil then
|
||||
SetMemberVisibility(TypeInfo.MemberVisibility)
|
||||
else
|
||||
inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
@ -1317,6 +1418,7 @@ procedure TDbgDwarfIdentifierStructure.CreateMembers;
|
||||
var
|
||||
Info: TDwarfInformationEntry;
|
||||
Info2: TDwarfInformationEntry;
|
||||
sym: TDbgDwarfIdentifier;
|
||||
begin
|
||||
if FMembers <> nil then
|
||||
exit;
|
||||
@ -1325,9 +1427,13 @@ begin
|
||||
Info.GoChild;
|
||||
|
||||
while Info.HasValidScope do begin
|
||||
Info2 := Info.Clone;
|
||||
FMembers.Add(TDbgDwarfIdentifier.CreateSubClass('', Info2));
|
||||
Info2.ReleaseReference;
|
||||
if (Info.Abbrev.tag = DW_TAG_member) or (Info.Abbrev.tag = DW_TAG_subprogram) then begin
|
||||
Info2 := Info.Clone;
|
||||
sym := TDbgDwarfIdentifier.CreateSubClass('', Info2);
|
||||
FMembers.Add(sym);
|
||||
sym.ReleaseReference;
|
||||
Info2.ReleaseReference;
|
||||
end;
|
||||
Info.GoNext;
|
||||
end;
|
||||
|
||||
@ -1339,7 +1445,15 @@ begin
|
||||
if (FInformationEntry.Abbrev.tag = DW_TAG_class_type) then
|
||||
SetKind(skClass)
|
||||
else
|
||||
SetKind(skRecord);
|
||||
begin
|
||||
if TypeInfo <> nil then
|
||||
SetKind(skClass)
|
||||
else
|
||||
if MemberByName['_vptr$OBJECT'] <> nil then
|
||||
SetKind(skClass)
|
||||
else
|
||||
SetKind(skRecord);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierStructure.TypeInfoNeeded;
|
||||
@ -1358,7 +1472,9 @@ begin
|
||||
ti.SearchScope;
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ti.FScope, FwdCompUint) ]);
|
||||
end;
|
||||
SetTypeInfo(TDbgDwarfIdentifier.CreateSubClass('', ti));
|
||||
if ti = nil
|
||||
then SetTypeInfo(nil)
|
||||
else SetTypeInfo(TDbgDwarfIdentifier.CreateSubClass('', ti));
|
||||
ReleaseRefAndNil(NewInfo);
|
||||
ReleaseRefAndNil(ti);
|
||||
end;
|
||||
@ -1400,6 +1516,19 @@ begin
|
||||
else SetTypeInfo(nil);
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierModifier.MemberVisibilityNeeded;
|
||||
var
|
||||
Val: TDbgSymbolMemberVisibility;
|
||||
begin
|
||||
if ReadMemberVisibility(Val) then
|
||||
SetMemberVisibility(Val)
|
||||
else
|
||||
if NestedTypeInfo <> nil then
|
||||
SetMemberVisibility(NestedTypeInfo.MemberVisibility)
|
||||
else
|
||||
inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierModifier.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
@ -1439,62 +1568,6 @@ begin
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierPointer }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierPointer.KindNeeded;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
// todo if ti.kind = skclass.... but not if it is another pointer.
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure)
|
||||
// and (TDbgDwarfTypeIdentifier(ti).InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
then
|
||||
SetKind(skClass)
|
||||
else
|
||||
SetKind(skPointer);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.Member[AIndex]
|
||||
else
|
||||
Result := inherited GetMember(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberByName[AIndex]
|
||||
else
|
||||
Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetMemberCount: Integer;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := nil;
|
||||
if (Kind = skClass) then
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberCount
|
||||
else
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfBaseTypeIdentifier }
|
||||
|
||||
procedure TDbgDwarfBaseIdentifierBase.KindNeeded;
|
||||
@ -1541,6 +1614,16 @@ begin
|
||||
SetSymbolType(stType);
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfTypeIdentifier.MemberVisibilityNeeded;
|
||||
var
|
||||
Val: TDbgSymbolMemberVisibility;
|
||||
begin
|
||||
if ReadMemberVisibility(Val) then
|
||||
SetMemberVisibility(Val)
|
||||
else
|
||||
inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
class function TDbgDwarfTypeIdentifier.CreateTybeSubClass(AName: String;
|
||||
AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
|
||||
var
|
||||
@ -1916,6 +1999,27 @@ begin
|
||||
Result := FInformationEntry.ReadValue(DW_AT_name, AName);
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifier.ReadMemberVisibility(out
|
||||
AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
|
||||
var
|
||||
Val: Integer;
|
||||
begin
|
||||
Result := FInformationEntry.ReadValue(DW_AT_external, Val);
|
||||
if Result and (Val <> 0) then begin
|
||||
AMemberVisibility := svPublic;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := FInformationEntry.ReadValue(DW_AT_accessibility, Val);
|
||||
if not Result then exit;
|
||||
case Val of
|
||||
DW_ACCESS_private: AMemberVisibility := svPrivate;
|
||||
DW_ACCESS_protected: AMemberVisibility := svProtected;
|
||||
DW_ACCESS_public: AMemberVisibility := svPublic;
|
||||
else AMemberVisibility := svPrivate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifier.NameNeeded;
|
||||
var
|
||||
AName: String;
|
||||
@ -1943,18 +2047,20 @@ begin
|
||||
DW_TAG_base_type: Result := TDbgDwarfBaseIdentifierBase;
|
||||
DW_TAG_typedef: Result := TDbgDwarfTypeIdentifierDeclaration;
|
||||
DW_TAG_pointer_type: Result := TDbgDwarfTypeIdentifierPointer;
|
||||
DW_TAG_reference_type: Result := TDbgDwarfTypeIdentifierRef;
|
||||
DW_TAG_packed_type,
|
||||
DW_TAG_const_type,
|
||||
DW_TAG_volatile_type: Result := TDbgDwarfTypeIdentifierModifier;
|
||||
DW_TAG_reference_type,
|
||||
DW_TAG_string_type,
|
||||
DW_TAG_enumeration_type, DW_TAG_subroutine_type,
|
||||
DW_TAG_enumeration_type,
|
||||
DW_TAG_union_type, DW_TAG_ptr_to_member_type,
|
||||
DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type,
|
||||
DW_TAG_thrown_type: Result := TDbgDwarfTypeIdentifier;
|
||||
DW_TAG_structure_type,
|
||||
DW_TAG_class_type: Result := TDbgDwarfIdentifierStructure;
|
||||
DW_TAG_array_type: Result := TDbgDwarfIdentifierArray;
|
||||
DW_TAG_subroutine_type: Result := TDbgDwarfTypeIdentifier;
|
||||
DW_TAG_subprogram: Result := TDbgDwarfProcSymbol;
|
||||
|
||||
else
|
||||
Result := TDbgDwarfIdentifier;
|
||||
@ -2786,17 +2892,15 @@ begin
|
||||
|
||||
inherited Create(
|
||||
String(FAddressInfo^.Name),
|
||||
InfoEntry,
|
||||
skProcedure, //todo: skFunction
|
||||
FAddressInfo^.StartPC
|
||||
InfoEntry
|
||||
);
|
||||
|
||||
SetAddress(FAddressInfo^.StartPC);
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
//BuildLineInfo(
|
||||
|
||||
// AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfProcSymbol.Destroy;
|
||||
@ -2886,7 +2990,7 @@ end;
|
||||
|
||||
procedure TDbgDwarfProcSymbol.KindNeeded;
|
||||
begin
|
||||
if NestedTypeInfo <> nil then
|
||||
if TypeInfo <> nil then
|
||||
SetKind(skFunction)
|
||||
else
|
||||
SetKind(skProcedure);
|
||||
@ -3009,7 +3113,7 @@ begin
|
||||
|
||||
if InfoEntry.GoNamedChild(AName) then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier faund ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
|
||||
break;
|
||||
end;
|
||||
|
||||
|
||||
@ -1442,6 +1442,7 @@ begin
|
||||
if Count <> 2 then exit;
|
||||
|
||||
tmp := Items[0].ResultType;
|
||||
if tmp = nil then exit;
|
||||
// Todo unit
|
||||
if (tmp.Kind = skClass) or (tmp.Kind = skRecord) then begin
|
||||
tmp := tmp.MemberByName[Items[1].GetText];
|
||||
|
||||
@ -148,6 +148,76 @@ const
|
||||
GdbCmdPType = 'ptype ';
|
||||
GdbCmdWhatIs = 'whatis ';
|
||||
|
||||
Function MembersAsGdbText(AStructType: TDbgSymbol; WithVisibilty: Boolean; out AText: String): Boolean;
|
||||
var
|
||||
CurVis: TDbgSymbolMemberVisibility;
|
||||
|
||||
procedure AddVisibility(AVis: TDbgSymbolMemberVisibility);
|
||||
begin
|
||||
CurVis := AVis;
|
||||
if not WithVisibilty then
|
||||
exit;
|
||||
case AVis of
|
||||
svPrivate: AText := AText + ' private' + LineEnding;
|
||||
svProtected: AText := AText + ' protected' + LineEnding;
|
||||
svPublic: AText := AText + ' public' + LineEnding;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddMember(AMember: TDbgSymbol);
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
s: String;
|
||||
begin
|
||||
//todo: functions / virtual / array ...
|
||||
if AMember.Kind = FpDbgClasses.skProcedure then begin
|
||||
AText := AText + ' procedure ' + AMember.Name + ' ();' + LineEnding;
|
||||
exit
|
||||
end;
|
||||
|
||||
ti := AMember.TypeInfo;
|
||||
if ti = nil then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
s := ti.Name;
|
||||
if s = '' then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if AMember.Kind = FpDbgClasses.skFunction then begin
|
||||
AText := AText + ' function ' + AMember.Name + ' () : '+s+';' + LineEnding;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AText := AText + ' ' + AMember.Name + ' : ' + s + LineEnding;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
c: Integer;
|
||||
i: Integer;
|
||||
m: TDbgSymbol;
|
||||
begin
|
||||
Result := True;
|
||||
AText := '';
|
||||
c := AStructType.MemberCount;
|
||||
if c = 0 then
|
||||
exit;
|
||||
i := 0;
|
||||
m := AStructType.Member[i];
|
||||
AddVisibility(m.MemberVisibility);
|
||||
while true do begin
|
||||
if m.MemberVisibility <> CurVis then
|
||||
AddVisibility(m.MemberVisibility);
|
||||
AddMember(m);
|
||||
inc(i);
|
||||
if (i >= c) or (not Result) then break;
|
||||
m := AStructType.Member[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String);
|
||||
var
|
||||
AReq: TGDBPTypeRequest;
|
||||
@ -161,54 +231,123 @@ const
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddClassType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean;
|
||||
ABaseTypeName, ASrcTypeName, ADeRefTypeName: String;
|
||||
ASrcType, ABaseType: TDbgSymbol);
|
||||
var
|
||||
s, ParentName, RefToken: String;
|
||||
s2: String;
|
||||
begin
|
||||
if not AIsPointerType then begin
|
||||
ABaseType := ASrcType;
|
||||
ABaseTypeName := ASrcTypeName;
|
||||
ADeRefTypeName := ASrcTypeName;
|
||||
end;
|
||||
if (ABaseType = nil) or (ABaseType.TypeInfo = nil) then
|
||||
exit;
|
||||
ParentName := ABaseType.TypeInfo.Name;
|
||||
if not MembersAsGdbText(ABaseType, True, s2) then
|
||||
exit;
|
||||
|
||||
s := Format('type = ^%s = class : public %s %s%send%s', [ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
||||
|
||||
s := Format('type = %s%s', [ASrcTypeName, LineEnding]);
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
||||
|
||||
|
||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
|
||||
if AIsPointerType
|
||||
then RefToken := '^'
|
||||
else RefToken := '';
|
||||
s := Format('type = %s%s = class : public %s %s%send%s', [RefToken, ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
||||
|
||||
s := Format('type = %s%s', [ADeRefTypeName, LineEnding]);
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
||||
end;
|
||||
|
||||
procedure AddRecordType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean;
|
||||
ABaseTypeName, ASrcTypeName, ADeRefTypeName: String;
|
||||
ASrcType, ABaseType: TDbgSymbol);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure AddBaseType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean;
|
||||
ABaseTypeName, ASrcTypeName, ADeRefTypeName: String;
|
||||
ASrcType, ABaseType: TDbgSymbol
|
||||
);
|
||||
begin
|
||||
if AIsPointerType then begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [ABaseTypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ASrcTypeName]));
|
||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr);
|
||||
if AIsPointerPointer then begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [ABaseTypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ADeRefTypeName]));
|
||||
end
|
||||
else begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [ABaseTypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ABaseTypeName]));
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [ABaseTypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ABaseTypeName]));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgSymbol);
|
||||
var
|
||||
TypeName, PointedName, PointedName2: String;
|
||||
SrcTypeName, // The expressions own type name
|
||||
DeRefTypeName, // one levvel of pointer followed
|
||||
BaseTypeName: String; // all poiters followed
|
||||
IsPointerPointer: Boolean;
|
||||
IsPointerType: Boolean;
|
||||
SrcType: TDbgSymbol;
|
||||
begin
|
||||
if (ASourceExpr = '') or (ATypeIdent = nil) then exit;
|
||||
|
||||
IsPointerType := ATypeIdent.Kind = FpDbgClasses.skPointer;
|
||||
PointedName := ATypeIdent.Name;
|
||||
IsPointerPointer := False;
|
||||
SrcTypeName := ATypeIdent.Name;
|
||||
SrcType := ATypeIdent;
|
||||
if IsPointerType and (ATypeIdent.TypeInfo <> nil) then begin
|
||||
ATypeIdent := ATypeIdent.TypeInfo;
|
||||
if ATypeIdent = nil then exit;
|
||||
|
||||
// resolved 1st pointer
|
||||
if PointedName = '' then
|
||||
PointedName := '^'+ATypeIdent.Name;
|
||||
if SrcTypeName = '' then
|
||||
SrcTypeName := '^'+ATypeIdent.Name;
|
||||
IsPointerPointer := ATypeIdent.Kind = FpDbgClasses.skPointer;
|
||||
PointedName2 := ATypeIdent.Name;
|
||||
DeRefTypeName := ATypeIdent.Name;
|
||||
|
||||
while (ATypeIdent.Kind = FpDbgClasses.skPointer) and (ATypeIdent.TypeInfo <> nil) do begin
|
||||
ATypeIdent := ATypeIdent.TypeInfo;
|
||||
if PointedName = '' then PointedName := '^'+ATypeIdent.Name;
|
||||
if PointedName2 = '' then PointedName2 := '^'+ATypeIdent.Name;
|
||||
if SrcTypeName = '' then SrcTypeName := '^'+ATypeIdent.Name;
|
||||
if DeRefTypeName = '' then DeRefTypeName := '^'+ATypeIdent.Name;
|
||||
end;
|
||||
if ATypeIdent = nil then exit;
|
||||
end;
|
||||
TypeName := ATypeIdent.Name;
|
||||
BaseTypeName := ATypeIdent.Name;
|
||||
|
||||
DebugLn(['--------------'+dbgs(ATypeIdent.Kind), ' ', dbgs(IsPointerType)]);
|
||||
if ATypeIdent.Kind in [skInteger, skCardinal, skBoolean, skChar, skFloat]
|
||||
then begin
|
||||
if IsPointerType then begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [TypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [PointedName]));
|
||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr);
|
||||
if IsPointerPointer then begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [TypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [PointedName2]));
|
||||
end
|
||||
else begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [TypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [TypeName]));
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [TypeName]));
|
||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [TypeName]));
|
||||
end;
|
||||
AddBaseType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
|
||||
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
|
||||
end
|
||||
else
|
||||
if ATypeIdent.Kind in [FpDbgClasses.skClass]
|
||||
then begin
|
||||
AddClassType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
|
||||
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
|
||||
end
|
||||
else
|
||||
if ATypeIdent.Kind in [FpDbgClasses.skRecord]
|
||||
then begin
|
||||
AddRecordType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
|
||||
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user