mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 09:19:40 +02:00
FPDebug: refactor
git-svn-id: trunk@43276 -
This commit is contained in:
martin
parent
9fb861018a
commit
2c8bcdec98
@ -70,7 +70,7 @@ type
|
||||
|
||||
TDbgSymbolKind = (
|
||||
skNone, // undefined type
|
||||
skUser, // userdefined type, this sym refers to another sym defined elswhere
|
||||
// skUser, // userdefined type, this sym refers to another sym defined elswhere
|
||||
skInstance, // the main exe/dll, containing all other syms
|
||||
skUnit, // contains syms defined in this unit
|
||||
//--------------------------------------------------------------------------
|
||||
@ -83,6 +83,7 @@ type
|
||||
//--------------------------------------------------------------------------
|
||||
skArray,
|
||||
//--------------------------------------------------------------------------
|
||||
skPointer,
|
||||
skInteger, // Basic types, these cannot have references or children
|
||||
skCardinal, // only size matters ( char(1) = Char, char(2) = WideChar
|
||||
skBoolean, // cardinal(1) = Byte etc.
|
||||
@ -101,8 +102,8 @@ type
|
||||
);
|
||||
|
||||
TDbgSymbolFlag =(
|
||||
sfPointer, // The sym is a pointer to the reference
|
||||
sfConst, // The sym is a constan and cannot be modified
|
||||
//sfPointer, // The sym is a pointer to the reference
|
||||
sfConst, // The sym is a constant and cannot be modified
|
||||
sfVar,
|
||||
sfOut,
|
||||
sfpropGet,
|
||||
@ -111,6 +112,11 @@ type
|
||||
);
|
||||
TDbgSymbolFlags = set of TDbgSymbolFlag;
|
||||
|
||||
TDbgSymbolField = (
|
||||
sfName, sfKind
|
||||
);
|
||||
TDbgSymbolFields = set of TDbgSymbolField;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
TDbgSymbol = class(TRefCountedObject)
|
||||
@ -118,7 +124,13 @@ type
|
||||
FName: String;
|
||||
FKind: TDbgSymbolKind;
|
||||
FAddress: TDbgPtr;
|
||||
|
||||
FEvaluatedFields: TDbgSymbolFields;
|
||||
function GetKind: TDbgSymbolKind;
|
||||
function GetName: String;
|
||||
protected
|
||||
function GetPointedToType: TDbgSymbol; virtual;
|
||||
|
||||
function GetChild(AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetColumn: Cardinal; virtual;
|
||||
function GetCount: Integer; virtual;
|
||||
@ -128,23 +140,36 @@ type
|
||||
function GetParent: TDbgSymbol; virtual;
|
||||
function GetReference: TDbgSymbol; virtual;
|
||||
function GetSize: Integer; virtual;
|
||||
|
||||
procedure SetName(AValue: String);
|
||||
procedure SetKind(AValue: TDbgSymbolKind);
|
||||
|
||||
procedure KindNeeded; virtual;
|
||||
procedure NameNeeded; virtual;
|
||||
public
|
||||
constructor Create(const AName: String);
|
||||
constructor Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
destructor Destroy; override;
|
||||
property Count: Integer read GetCount;
|
||||
property Name: String read FName;
|
||||
property Kind: TDbgSymbolKind read FKind;
|
||||
// Basic info
|
||||
property Name: String read GetName;
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
// Memory; Size is also part of type (byte vs word vs ...)
|
||||
property Address: TDbgPtr read FAddress;
|
||||
property Size: Integer read GetSize;
|
||||
// Location
|
||||
property FileName: String read GetFile;
|
||||
property Line: Cardinal read GetLine;
|
||||
property Column: Cardinal read GetColumn;
|
||||
property Flags: TDbgSymbolFlags read GetFlags;
|
||||
property Reference: TDbgSymbol read GetReference;
|
||||
property Parent: TDbgSymbol read GetParent;
|
||||
property Children[AIndex: Integer]: TDbgSymbol read GetChild;
|
||||
end;
|
||||
//
|
||||
property Flags: TDbgSymbolFlags read GetFlags; deprecated;
|
||||
property Count: Integer read GetCount; deprecated;
|
||||
property Reference: TDbgSymbol read GetReference; deprecated;
|
||||
property Parent: TDbgSymbol read GetParent; deprecated;
|
||||
//property Children[AIndex: Integer]: TDbgSymbol read GetChild;
|
||||
|
||||
// For pointers only
|
||||
property PointedToType: TDbgSymbol read GetPointedToType;
|
||||
end;
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
@ -276,7 +301,7 @@ type
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String; overload;
|
||||
|
||||
implementation
|
||||
|
||||
@ -288,6 +313,12 @@ begin
|
||||
DebugLn('FpDbg-ERROR: ', GetLastErrorText);
|
||||
end;
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String;
|
||||
begin
|
||||
Result := '';
|
||||
WriteStr(Result, ADbgSymbolKind);
|
||||
end;
|
||||
|
||||
{$ifdef windows}
|
||||
{ TDbgInstance }
|
||||
|
||||
@ -854,13 +885,18 @@ end;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
constructor TDbgSymbol.Create(const AName: String);
|
||||
begin
|
||||
inherited Create;
|
||||
AddReference;
|
||||
if AName <> '' then
|
||||
SetName(AName);
|
||||
end;
|
||||
|
||||
FName := AName;
|
||||
FKind := AKind;
|
||||
constructor TDbgSymbol.Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
begin
|
||||
Create(AName);
|
||||
SetKind(AKind);
|
||||
FAddress := AAddress;
|
||||
end;
|
||||
|
||||
@ -869,6 +905,37 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
if not(sfKind in FEvaluatedFields) then
|
||||
KindNeeded;
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetName: String;
|
||||
begin
|
||||
if not(sfName in FEvaluatedFields) then
|
||||
NameNeeded;
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetPointedToType: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetKind(AValue: TDbgSymbolKind);
|
||||
begin
|
||||
FKind := AValue;
|
||||
Include(FEvaluatedFields, sfKind);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetName(AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
Include(FEvaluatedFields, sfName);
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetChild(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
result := nil;
|
||||
@ -914,6 +981,16 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.KindNeeded;
|
||||
begin
|
||||
SetKind(skNone);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.NameNeeded;
|
||||
begin
|
||||
SetName('');
|
||||
end;
|
||||
|
||||
{$ifdef windows}
|
||||
{ TDbgBreak }
|
||||
|
||||
|
||||
@ -269,6 +269,8 @@ type
|
||||
|
||||
function FindNamedChild(AName: String): TDwarfInformationEntry;
|
||||
function FindChildByTag(ATag: Cardinal): TDwarfInformationEntry;
|
||||
function FirstChild: TDwarfInformationEntry;
|
||||
function Clone: TDwarfInformationEntry;
|
||||
|
||||
property Abbrev: TDwarfAbbrev read GetAbbrev write SetAbbrev;
|
||||
property AbbrevData: PDwarfAbbrevEntry read FAbbrevData; // only valid if Abbrev is available
|
||||
@ -506,13 +508,13 @@ type
|
||||
TDbgDwarfIdentifier = class(TDbgSymbol)
|
||||
private
|
||||
FCU: TDwarfCompilationUnit;
|
||||
FIdentifierName: String;
|
||||
FInformationEntry: TDwarfInformationEntry;
|
||||
FTypeInfo: TDbgDwarfTypeIdentifier;
|
||||
FFlags: set of (didtNameRead, didtTypeRead);
|
||||
function GetIdentifierName: String;
|
||||
function GetTypeInfo: TDbgDwarfTypeIdentifier;
|
||||
protected
|
||||
procedure NameNeeded; override;
|
||||
|
||||
//function GetChild(AIndex: Integer): TDbgSymbol; override;
|
||||
//function GetColumn: Cardinal; override;
|
||||
//function GetCount: Integer; override;
|
||||
@ -527,19 +529,17 @@ type
|
||||
class function GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
|
||||
public
|
||||
class function CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier;
|
||||
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry); virtual;
|
||||
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry);
|
||||
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry;
|
||||
AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
destructor Destroy; override;
|
||||
//constructor Create(AName: String; AAddress: TDbgPtr; ACompilationUnit: TDwarfCompilationUnit;
|
||||
// AScope: TDwarfScopeInfo);
|
||||
//destructor Destroy; override;
|
||||
property IdentifierName: String read GetIdentifierName;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfValueIdentifier }
|
||||
|
||||
TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
public
|
||||
property TypeInfo;
|
||||
end;
|
||||
@ -594,7 +594,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
function GetIsBaseType: Boolean; virtual;
|
||||
function GetIsPointerType: Boolean; virtual;
|
||||
function GetIsStructType: Boolean; virtual;
|
||||
function GetPointedToType: TDbgDwarfTypeIdentifier; virtual;
|
||||
function GetStructTypeInfo: TDbgDwarfIdentifierStructure; virtual;
|
||||
public
|
||||
class function CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
|
||||
@ -603,24 +602,27 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
property IsPointerType: Boolean read GetIsPointerType;
|
||||
property IsStructType: Boolean read GetIsStructType;
|
||||
|
||||
property PointedToType: TDbgDwarfTypeIdentifier read GetPointedToType;
|
||||
property StructTypeInfo: TDbgDwarfIdentifierStructure read GetStructTypeInfo;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfBaseTypeIdentifier }
|
||||
|
||||
{ TDbgDwarfBaseIdentifierBase }
|
||||
|
||||
TDbgDwarfBaseIdentifierBase = class(TDbgDwarfTypeIdentifier)
|
||||
protected
|
||||
function GetIsBaseType: Boolean; override;
|
||||
procedure KindNeeded; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierModifier }
|
||||
|
||||
TDbgDwarfTypeIdentifierModifier = class(TDbgDwarfTypeIdentifier)
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
function GetIsBaseType: Boolean; override;
|
||||
function GetIsPointerType: Boolean; override;
|
||||
function GetPointedToType: TDbgDwarfTypeIdentifier; override;
|
||||
function GetPointedToType: TDbgSymbol; override;
|
||||
function GetIsStructType: Boolean; override;
|
||||
function GetStructTypeInfo: TDbgDwarfIdentifierStructure; override;
|
||||
end;
|
||||
@ -635,8 +637,9 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
|
||||
TDbgDwarfTypeIdentifierPointer = class(TDbgDwarfTypeIdentifier)
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
function GetIsPointerType: Boolean; override;
|
||||
function GetPointedToType: TDbgDwarfTypeIdentifier; override;
|
||||
function GetPointedToType: TDbgSymbol; override;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
function GetIsStructType: Boolean; override;
|
||||
function GetStructTypeInfo: TDbgDwarfIdentifierStructure; override;
|
||||
@ -652,12 +655,25 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
private
|
||||
function GetMemberByName(AName: String): TDbgDwarfIdentifierMember;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
function GetIsStructType: Boolean; override;
|
||||
function GetStructTypeInfo: TDbgDwarfIdentifierStructure; override;
|
||||
public
|
||||
property MemberByName[AName: String]: TDbgDwarfIdentifierMember read GetMemberByName;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifierArray }
|
||||
|
||||
TDbgDwarfIdentifierArray = class(TDbgDwarfTypeIdentifier)
|
||||
private
|
||||
FDimensionInfo: array of TDwarfInformationEntry;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
function DimensionCount: Integer;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfProcSymbol }
|
||||
|
||||
TDbgDwarfProcSymbol = class(TDbgDwarfIdentifier)
|
||||
@ -668,6 +684,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
FStateMachine: TDwarfLineInfoStateMachine;
|
||||
function StateMachineValid: Boolean;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
function GetChild(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetColumn: Cardinal; override;
|
||||
function GetCount: Integer; override;
|
||||
@ -1188,6 +1205,63 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfValueIdentifier }
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.KindNeeded;
|
||||
var
|
||||
t: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
t := TypeInfo;
|
||||
if t = nil then
|
||||
inherited KindNeeded
|
||||
else
|
||||
SetKind(t.Kind);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifierArray }
|
||||
|
||||
procedure TDbgDwarfIdentifierArray.KindNeeded;
|
||||
begin
|
||||
SetKind(skArray); // Todo: static/dynamic?
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfIdentifierArray.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Destroy;
|
||||
for i := 0 to Length(FDimensionInfo) - 1 do
|
||||
FDimensionInfo[i].ReleaseReference;
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierArray.DimensionCount: Integer;
|
||||
var
|
||||
Info: TDwarfInformationEntry;
|
||||
t: Cardinal;
|
||||
begin
|
||||
Result := length(FDimensionInfo);
|
||||
if Result > 0 then
|
||||
exit;
|
||||
|
||||
Info := FInformationEntry.FirstChild;
|
||||
Result := 0;
|
||||
if Info = nil then exit;
|
||||
|
||||
while Info.HasValidScope do begin
|
||||
t := Info.Abbrev.tag;
|
||||
if (t = DW_TAG_enumeration_type) or (t = DW_TAG_subrange_type) then begin
|
||||
inc(Result);
|
||||
SetLength(FDimensionInfo, Result);
|
||||
FDimensionInfo[Result-1] := Info;
|
||||
Info := Info.Clone;
|
||||
end;
|
||||
|
||||
Info.GoNext;
|
||||
end;
|
||||
|
||||
ReleaseRefAndNil(Info)
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifierStructure }
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetMemberByName(AName: String): TDbgDwarfIdentifierMember;
|
||||
@ -1225,6 +1299,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierStructure.KindNeeded;
|
||||
begin
|
||||
if (FInformationEntry.Abbrev.tag = DW_TAG_class_type) then
|
||||
SetKind(skClass)
|
||||
else
|
||||
SetKind(skRecord);
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetIsStructType: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
@ -1237,6 +1319,17 @@ end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierModifier }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierModifier.KindNeeded;
|
||||
var
|
||||
t: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
t := TypeInfo;
|
||||
if t = nil then
|
||||
inherited KindNeeded
|
||||
else
|
||||
SetKind(t.Kind);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierModifier.GetIsBaseType: Boolean;
|
||||
var
|
||||
ti: TDbgDwarfTypeIdentifier;
|
||||
@ -1257,7 +1350,7 @@ begin
|
||||
else Result := False;
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierModifier.GetPointedToType: TDbgDwarfTypeIdentifier;
|
||||
function TDbgDwarfTypeIdentifierModifier.GetPointedToType: TDbgSymbol;
|
||||
begin
|
||||
Result := TypeInfo;
|
||||
if Result <> nil then
|
||||
@ -1285,12 +1378,26 @@ end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierPointer }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierPointer.KindNeeded;
|
||||
var
|
||||
ti: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure) and
|
||||
(ti.InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
then
|
||||
SetKind(skClass)
|
||||
else
|
||||
SetKind(skPointer);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetIsPointerType: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetPointedToType: TDbgDwarfTypeIdentifier;
|
||||
function TDbgDwarfTypeIdentifierPointer.GetPointedToType: TDbgSymbol;
|
||||
begin
|
||||
Result := TypeInfo;
|
||||
end;
|
||||
@ -1302,8 +1409,8 @@ begin
|
||||
Result := False;
|
||||
ti := TypeInfo;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure) and
|
||||
(ti.InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure)
|
||||
//and (ti.InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
then
|
||||
Result := True;
|
||||
end;
|
||||
@ -1315,8 +1422,8 @@ begin
|
||||
Result := nil;
|
||||
ti := TypeInfo;
|
||||
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure) and
|
||||
(ti.InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure)
|
||||
//and (ti.InformationEntry.Abbrev.tag = DW_TAG_class_type)
|
||||
then
|
||||
Result := TDbgDwarfIdentifierStructure(ti);
|
||||
end;
|
||||
@ -1328,13 +1435,39 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifier }
|
||||
|
||||
function TDbgDwarfTypeIdentifier.GetPointedToType: TDbgDwarfTypeIdentifier;
|
||||
procedure TDbgDwarfBaseIdentifierBase.KindNeeded;
|
||||
var
|
||||
Encoding, ByteSize: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if not FInformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin
|
||||
DebugLn(['Failed reading Encoding']);
|
||||
inherited KindNeeded;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if FInformationEntry.ReadValue(DW_AT_byte_size, ByteSize) then
|
||||
//SetSize(ByteSize);
|
||||
;
|
||||
|
||||
case Encoding of
|
||||
DW_ATE_address : SetKind(skPointer);
|
||||
DW_ATE_boolean: SetKind(skBoolean);
|
||||
//DW_ATE_complex_float:
|
||||
DW_ATE_float: SetKind(skFloat);
|
||||
DW_ATE_signed: SetKind(skInteger);
|
||||
DW_ATE_signed_char: SetKind(skChar);
|
||||
DW_ATE_unsigned: SetKind(skCardinal);
|
||||
DW_ATE_unsigned_char: SetKind(skChar);
|
||||
else
|
||||
begin
|
||||
DebugLn(['Unknown Encoding']);
|
||||
inherited KindNeeded;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifier }
|
||||
|
||||
function TDbgDwarfTypeIdentifier.GetStructTypeInfo: TDbgDwarfIdentifierStructure;
|
||||
begin
|
||||
Result := nil;
|
||||
@ -1363,7 +1496,7 @@ begin
|
||||
c := GetSubClass(AnInformationEntry.Abbrev.tag);
|
||||
|
||||
if c.InheritsFrom(TDbgDwarfTypeIdentifier) then
|
||||
Result := TDbgDwarfTypeIdentifierClass(c).Create(AName, AnInformationEntry, skNone, 0)
|
||||
Result := TDbgDwarfTypeIdentifierClass(c).Create(AName, AnInformationEntry)
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
@ -1543,6 +1676,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDwarfInformationEntry.FirstChild: TDwarfInformationEntry;
|
||||
var
|
||||
Scope: TDwarfScopeInfo;
|
||||
begin
|
||||
Result := nil;
|
||||
if (not FScope.IsValid) and (FInformationEntry <> nil) then
|
||||
if not SearchScope then
|
||||
exit;
|
||||
|
||||
Scope := FScope.Child;
|
||||
if Scope.IsValid then
|
||||
Result := TDwarfInformationEntry.Create(FCompUnit, Scope);
|
||||
end;
|
||||
|
||||
function TDwarfInformationEntry.Clone: TDwarfInformationEntry;
|
||||
begin
|
||||
if FScope.IsValid then
|
||||
Result := TDwarfInformationEntry.Create(FCompUnit, FScope)
|
||||
else
|
||||
Result := TDwarfInformationEntry.Create(FCompUnit, FInformationEntry);
|
||||
end;
|
||||
|
||||
function TDwarfInformationEntry.HasAttrib(AnAttrib: Cardinal): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
@ -1685,16 +1840,6 @@ end;
|
||||
|
||||
{ TDbgDwarfIdentifier }
|
||||
|
||||
function TDbgDwarfIdentifier.GetIdentifierName: String;
|
||||
begin
|
||||
Result := FIdentifierName;
|
||||
if (Result <> '') or (didtNameRead in FFlags) then
|
||||
exit;
|
||||
include(FFlags, didtNameRead);
|
||||
FInformationEntry.ReadValue(DW_AT_name, FIdentifierName);
|
||||
Result := FIdentifierName;
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifier.GetTypeInfo: TDbgDwarfTypeIdentifier;
|
||||
var
|
||||
FwdInfoPtr: Pointer;
|
||||
@ -1717,6 +1862,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifier.NameNeeded;
|
||||
var
|
||||
AName: String;
|
||||
begin
|
||||
FInformationEntry.ReadValue(DW_AT_name, AName);
|
||||
SetName(AName);
|
||||
end;
|
||||
|
||||
class function TDbgDwarfIdentifier.GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
|
||||
begin
|
||||
case ATag of
|
||||
@ -1730,13 +1883,14 @@ begin
|
||||
DW_TAG_const_type,
|
||||
DW_TAG_volatile_type: Result := TDbgDwarfTypeIdentifierModifier;
|
||||
DW_TAG_reference_type,
|
||||
DW_TAG_string_type, DW_TAG_array_type,
|
||||
DW_TAG_string_type,
|
||||
DW_TAG_enumeration_type, DW_TAG_subroutine_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;
|
||||
|
||||
else
|
||||
Result := TDbgDwarfIdentifier;
|
||||
@ -1746,22 +1900,22 @@ end;
|
||||
class function TDbgDwarfIdentifier.CreateSubClass(AName: String;
|
||||
AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier;
|
||||
begin
|
||||
Result := GetSubClass(AnInformationEntry.Abbrev.tag).Create(AName, AnInformationEntry, skNone, 0);
|
||||
Result := GetSubClass(AnInformationEntry.Abbrev.tag).Create(AName, AnInformationEntry);
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfIdentifier.Create(AName: String;
|
||||
AnInformationEntry: TDwarfInformationEntry);
|
||||
begin
|
||||
Create(AName, AnInformationEntry, skNone, 0);
|
||||
FCU := AnInformationEntry.CompUnit;
|
||||
FInformationEntry := AnInformationEntry;
|
||||
FInformationEntry.AddReference;
|
||||
|
||||
inherited Create(AName);
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfIdentifier.Create(AName: String;
|
||||
AnInformationEntry: TDwarfInformationEntry; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
begin
|
||||
if AName = '' then
|
||||
AnInformationEntry.ReadValue(DW_AT_name, AName);
|
||||
|
||||
FIdentifierName := AName;
|
||||
FCU := AnInformationEntry.CompUnit;
|
||||
FInformationEntry := AnInformationEntry;
|
||||
FInformationEntry.AddReference;
|
||||
@ -2469,7 +2623,7 @@ begin
|
||||
if not Result then exit;
|
||||
l := FScopeList^.List[FIndex].Link;
|
||||
assert(l <= FScopeList^.HighestKnown);
|
||||
Result := (l >= 0) and (l < FIndex);
|
||||
Result := (l >= 0);
|
||||
end;
|
||||
|
||||
function TDwarfScopeInfo.HasNext: Boolean;
|
||||
@ -2669,6 +2823,14 @@ begin
|
||||
SM2.Free;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfProcSymbol.KindNeeded;
|
||||
begin
|
||||
if TypeInfo <> nil then
|
||||
SetKind(skFunction)
|
||||
else
|
||||
SetKind(skProcedure);
|
||||
end;
|
||||
|
||||
{ TDbgDwarf }
|
||||
|
||||
constructor TDbgDwarf.Create(ALoader: TDbgImageLoader);
|
||||
@ -3202,6 +3364,9 @@ var
|
||||
begin
|
||||
if FAddressMapBuild then Exit;
|
||||
|
||||
// scan to end
|
||||
LocateEntry(0, FScope, [lefContinuable, lefSearchChild], ResultScope, AttribList);
|
||||
|
||||
Scope := FScope;
|
||||
while Scope.IsValid do
|
||||
begin
|
||||
|
||||
@ -144,20 +144,20 @@ begin
|
||||
FFileHandle := AFileHandle;
|
||||
if FFileHandle = INVALID_HANDLE_VALUE
|
||||
then begin
|
||||
WriteLN('Invalid file handle');
|
||||
raise Exception.Create('Invalid file handle');
|
||||
end;
|
||||
|
||||
FMapHandle := CreateFileMapping(FFileHandle, nil, PAGE_READONLY{ or SEC_IMAGE}, 0, 0, nil);
|
||||
if FMapHandle = 0
|
||||
then begin
|
||||
WriteLn('Could not create module mapping');
|
||||
raise Exception.Create('Could not create module mapping');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
FModulePtr := MapViewOfFile(FMapHandle, FILE_MAP_READ, 0, 0, 0);
|
||||
if FModulePtr = nil
|
||||
then begin
|
||||
WriteLn('Could not map view');
|
||||
raise Exception.Create('Could not map view');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
|
||||
@ -33,7 +33,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
FpImgReaderBase,
|
||||
FpImgReaderElfTypes; // these files are part of
|
||||
FpImgReaderElfTypes, LCLProc; // these files are part of
|
||||
|
||||
|
||||
type
|
||||
@ -231,7 +231,7 @@ begin
|
||||
New(p);
|
||||
P^.Offs := fs.FileOfs;
|
||||
p^.Sect.Size := fs.Size;
|
||||
p^.Sect.VirtualAdress := 0; // Todo?
|
||||
p^.Sect.VirtualAdress := 0; // Todo? fs.Address - ImageBase
|
||||
p^.Loaded := False;
|
||||
FSections.Objects[idx] := TObject(p);
|
||||
end;
|
||||
|
||||
@ -65,8 +65,7 @@ type
|
||||
FTextExpression: String;
|
||||
FExpressionPart: TFpPascalExpressionPart;
|
||||
FValid: Boolean;
|
||||
FResultType: TFpPasExprType;
|
||||
function GetResultType: TFpPasExprType;
|
||||
function GetResultType: TDbgSymbol;
|
||||
procedure Parse;
|
||||
procedure SetError(AMsg: String);
|
||||
function PosFromPChar(APChar: PChar): Integer;
|
||||
@ -79,7 +78,7 @@ type
|
||||
function DebugDump: String;
|
||||
property Error: String read FError;
|
||||
property Valid: Boolean read FValid;
|
||||
property ResultType: TFpPasExprType read GetResultType;
|
||||
property ResultType: TDbgSymbol read GetResultType;
|
||||
end;
|
||||
|
||||
|
||||
@ -91,9 +90,9 @@ type
|
||||
FParent: TFpPascalExpressionPartContainer;
|
||||
FStartChar: PChar;
|
||||
FExpression: TFpPascalExpression;
|
||||
FResultType: TFpPasExprType;
|
||||
FResultType: TDbgSymbol;
|
||||
function GetResultType: TDbgSymbol;
|
||||
function GetSurroundingBracket: TFpPascalExpressionPartBracket;
|
||||
function GetResultType: TFpPasExprType;
|
||||
function GetTopParent: TFpPascalExpressionPart;
|
||||
procedure SetEndChar(AValue: PChar);
|
||||
procedure SetParent(AValue: TFpPascalExpressionPartContainer);
|
||||
@ -105,8 +104,7 @@ type
|
||||
function DebugDump(AIndent: String): String; virtual;
|
||||
protected
|
||||
procedure Init; virtual;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); virtual;
|
||||
procedure InitResultTypeFromDbgInfo(var AResultType: TFpPasExprType; ADbgInfo: TDbgSymbol);
|
||||
function DoGetResultType: TDbgSymbol; virtual;
|
||||
|
||||
Procedure ReplaceInParent(AReplacement: TFpPascalExpressionPart);
|
||||
procedure DoHandleEndOfExpression; virtual;
|
||||
@ -132,7 +130,7 @@ type
|
||||
property Parent: TFpPascalExpressionPartContainer read FParent write SetParent;
|
||||
property TopParent: TFpPascalExpressionPart read GetTopParent; // or self
|
||||
property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingBracket; // incl self
|
||||
property ResultType: TFpPasExprType read GetResultType;
|
||||
property ResultType: TDbgSymbol read GetResultType;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartContainer }
|
||||
@ -164,7 +162,7 @@ type
|
||||
private
|
||||
FDbgType: TDbgSymbol; // may be a variable or function or a type ...
|
||||
protected
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
@ -210,7 +208,7 @@ type
|
||||
TFpPascalExpressionPartBracketSubExpression = class(TFpPascalExpressionPartRoundBracket)
|
||||
protected
|
||||
function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartBracketArgumentList }
|
||||
@ -290,7 +288,7 @@ type
|
||||
TFpPascalExpressionPartOperatorAddressOf = class(TFpPascalExpressionPartUnaryOperator) // @
|
||||
protected
|
||||
procedure Init; override;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorMakeRef }
|
||||
@ -299,7 +297,7 @@ type
|
||||
protected
|
||||
procedure Init; override;
|
||||
function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
//function DoGetResultType: TDbgSymbol; override;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorDeRef }
|
||||
@ -307,7 +305,7 @@ type
|
||||
TFpPascalExpressionPartOperatorDeRef = class(TFpPascalExpressionPartUnaryOperator) // ptrval^
|
||||
protected
|
||||
procedure Init; override;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
|
||||
var AResult: TFpPascalExpressionPart): Boolean; override;
|
||||
function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartWithPrecedence):
|
||||
@ -346,7 +344,7 @@ type
|
||||
protected
|
||||
procedure Init; override;
|
||||
function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override;
|
||||
procedure DoGetResultType(var AResultType: TFpPasExprType); override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -363,6 +361,35 @@ const
|
||||
PRECEDENCE_MUL_DIV = 10; // a * b
|
||||
PRECEDENCE_PLUS_MINUS = 11; // a + b
|
||||
|
||||
type
|
||||
|
||||
{ TPasParserSymbolPointer }
|
||||
|
||||
TPasParserSymbolPointer = class(TDbgSymbol)
|
||||
private
|
||||
FPointedTo: TDbgSymbol;
|
||||
protected
|
||||
// NameNeeded // "^TPointedTo"
|
||||
function GetPointedToType: TDbgSymbol; override;
|
||||
public
|
||||
constructor Create(const APointedTo: TDbgSymbol);
|
||||
end;
|
||||
|
||||
{ TPasParserSymbolPointer }
|
||||
|
||||
function TPasParserSymbolPointer.GetPointedToType: TDbgSymbol;
|
||||
begin
|
||||
Result := FPointedTo;
|
||||
end;
|
||||
|
||||
constructor TPasParserSymbolPointer.Create(const APointedTo: TDbgSymbol);
|
||||
begin
|
||||
FPointedTo := APointedTo;
|
||||
inherited Create('');
|
||||
SetKind(skPointer);
|
||||
end;
|
||||
|
||||
|
||||
{ TFpPascalExpressionPartBracketIndex }
|
||||
|
||||
procedure TFpPascalExpressionPartBracketIndex.Init;
|
||||
@ -529,22 +556,32 @@ begin
|
||||
Add(APart);
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPartBracketSubExpression.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPartBracketSubExpression.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
if Count <> 1 then
|
||||
AResultType.Kind := ptkInvalid
|
||||
Result := nil
|
||||
else
|
||||
AResultType := Items[0].ResultType;
|
||||
if AResultType.DbgType <> nil then
|
||||
AResultType.DbgType.AddReference;
|
||||
Result := Items[0].ResultType;
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartIdentifer }
|
||||
|
||||
procedure TFpPascalExpressionPartIdentifer.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPartIdentifer.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
FDbgType := FExpression.GetDbgTyeForIdentifier(GetText);
|
||||
InitResultTypeFromDbgInfo(AResultType, FDbgType);
|
||||
if FDbgType = nil then
|
||||
FDbgType := FExpression.GetDbgTyeForIdentifier(GetText);
|
||||
if FDbgType = nil then
|
||||
exit;
|
||||
|
||||
if FDbgType is TDbgDwarfValueIdentifier then
|
||||
Result := TDbgDwarfValueIdentifier(FDbgType).TypeInfo
|
||||
else
|
||||
Result := nil; // Todo handled by typecast operator // maybe wrap in TTypeOf class?
|
||||
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
end;
|
||||
|
||||
destructor TFpPascalExpressionPartIdentifer.Destroy;
|
||||
@ -708,13 +745,12 @@ begin
|
||||
FExpressionPart := CurPart;
|
||||
end;
|
||||
|
||||
function TFpPascalExpression.GetResultType: TFpPasExprType;
|
||||
function TFpPascalExpression.GetResultType: TDbgSymbol;
|
||||
begin
|
||||
if (FExpressionPart = nil) or (not Valid) then
|
||||
FResultType.Kind := ptkInvalid;
|
||||
if FResultType.Kind = ptkUnknown then
|
||||
FResultType := FExpressionPart.GetResultType;
|
||||
Result := FResultType;
|
||||
Result := nil
|
||||
else
|
||||
Result := FExpressionPart.ResultType;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpression.SetError(AMsg: String);
|
||||
@ -737,7 +773,6 @@ constructor TFpPascalExpression.Create(ATextExpression: String);
|
||||
begin
|
||||
FTextExpression := ATextExpression;
|
||||
FValid := True;
|
||||
FResultType.Kind := ptkUnknown;
|
||||
Parse;
|
||||
end;
|
||||
|
||||
@ -783,10 +818,11 @@ begin
|
||||
Result := TFpPascalExpressionPartBracket(tmp);
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPart.GetResultType: TFpPasExprType;
|
||||
function TFpPascalExpressionPart.GetResultType: TDbgSymbol;
|
||||
begin
|
||||
if FResultType.Kind = ptkUnknown then
|
||||
DoGetResultType(FResultType);
|
||||
// TODO: flag, so nil=invalid will be cached
|
||||
if FResultType = nil then
|
||||
FResultType := DoGetResultType;
|
||||
Result := FResultType;
|
||||
end;
|
||||
|
||||
@ -836,35 +872,9 @@ begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPart.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPart.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
FResultType.Kind := ptkInvalid;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPart.InitResultTypeFromDbgInfo(var AResultType: TFpPasExprType;
|
||||
ADbgInfo: TDbgSymbol);
|
||||
begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
if (ADbgInfo = nil) then
|
||||
exit;
|
||||
|
||||
if (ADbgInfo is TDbgDwarfTypeIdentifier) then begin
|
||||
AResultType.DbgType := TDbgDwarfTypeIdentifier(ADbgInfo);
|
||||
AResultType.DbgType.AddReference;
|
||||
AResultType.Kind := ptkTypeDbgType;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ADbgInfo is TDbgDwarfValueIdentifier then begin
|
||||
AResultType.DbgType := TDbgDwarfValueIdentifier(ADbgInfo).TypeInfo;
|
||||
AResultType.DbgType.AddReference;
|
||||
if AResultType.DbgType <> nil then
|
||||
AResultType.Kind := ptkValueDbgType;
|
||||
exit;
|
||||
end;
|
||||
|
||||
debugln(['TFpPascalExpressionPartIdentifer.DoGetResultType UNKNOWN: ', DbgSName(ADbgInfo)]);
|
||||
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPart.ReplaceInParent(AReplacement: TFpPascalExpressionPart);
|
||||
@ -932,14 +942,13 @@ begin
|
||||
FExpression := AExpression;
|
||||
FStartChar := AStartChar;
|
||||
FEndChar := AnEndChar;
|
||||
FResultType.Kind := ptkUnknown;
|
||||
Init;
|
||||
end;
|
||||
|
||||
destructor TFpPascalExpressionPart.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
ReleaseRefAndNil(FResultType.DbgType);
|
||||
ReleaseRefAndNil(FResultType);
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPart.HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart;
|
||||
@ -1237,18 +1246,15 @@ begin
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPartOperatorAddressOf.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPartOperatorAddressOf.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
Result := nil;
|
||||
if Count <> 1 then exit;
|
||||
AResultType := Items[0].ResultType;
|
||||
if AResultType.Kind = ptkValueDbgType then
|
||||
AResultType.Kind := ptkPointerToValueDbgType
|
||||
else
|
||||
AResultType.Kind := ptkInvalid; // can not take address of...
|
||||
|
||||
if FResultType.DbgType <> nil then
|
||||
FResultType.DbgType.AddReference;
|
||||
Result := Items[0].ResultType;
|
||||
if Result = nil then
|
||||
exit;
|
||||
Result := TPasParserSymbolPointer.Create(Result);
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorMakeRef }
|
||||
@ -1265,20 +1271,6 @@ begin
|
||||
(APart is TFpPascalExpressionPartIdentifer);
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPartOperatorMakeRef.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
if Count <> 1 then exit;
|
||||
AResultType := Items[0].ResultType;
|
||||
if AResultType.Kind = ptkTypeDbgType then
|
||||
AResultType.Kind := ptkPointerOfTypeDbgType
|
||||
else
|
||||
AResultType.Kind := ptkInvalid; // can not take address of...
|
||||
|
||||
if FResultType.DbgType <> nil then
|
||||
FResultType.DbgType.AddReference;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorDeRef }
|
||||
|
||||
procedure TFpPascalExpressionPartOperatorDeRef.Init;
|
||||
@ -1287,28 +1279,23 @@ begin
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPartOperatorDeRef.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPartOperatorDeRef.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
Result := nil;
|
||||
if Count <> 1 then exit;
|
||||
|
||||
AResultType := Items[0].ResultType;
|
||||
case AResultType.Kind of
|
||||
ptkValueDbgType: begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
if AResultType.DbgType.IsPointerType then begin
|
||||
AResultType.DbgType := AResultType.DbgType.PointedToType;
|
||||
if AResultType.DbgType <> nil then
|
||||
AResultType.Kind := ptkPointerToValueDbgType;
|
||||
end;
|
||||
end;
|
||||
ptkPointerToValueDbgType: AResultType.Kind := ptkValueDbgType;
|
||||
else
|
||||
AResultType.Kind := ptkInvalid;
|
||||
end;
|
||||
Result := Items[0].ResultType;
|
||||
if Result = nil then
|
||||
exit;;
|
||||
|
||||
if FResultType.DbgType <> nil then
|
||||
FResultType.DbgType.AddReference;
|
||||
if Result.Kind = skPointer then
|
||||
Result := Result.PointedToType
|
||||
//if Result.Kind = skArray then // dynarray
|
||||
else
|
||||
Result := nil;
|
||||
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
|
||||
@ -1371,22 +1358,27 @@ begin
|
||||
Result := Result and (APart is TFpPascalExpressionPartIdentifer);
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPartOperatorMemberOf.DoGetResultType(var AResultType: TFpPasExprType);
|
||||
function TFpPascalExpressionPartOperatorMemberOf.DoGetResultType: TDbgSymbol;
|
||||
var
|
||||
tmp: TFpPasExprType;
|
||||
struct: TDbgDwarfIdentifierStructure;
|
||||
member: TDbgDwarfIdentifierMember;
|
||||
tmp: TDbgSymbol;
|
||||
begin
|
||||
AResultType.Kind := ptkInvalid;
|
||||
Result := nil;
|
||||
if Count <> 2 then exit;
|
||||
|
||||
tmp := Items[0].ResultType;
|
||||
// Todo unit
|
||||
if (tmp.Kind = ptkValueDbgType) and (tmp.DbgType.IsStructType) then begin
|
||||
struct := tmp.DbgType.StructTypeInfo;
|
||||
member := struct.MemberByName[Items[1].GetText];
|
||||
InitResultTypeFromDbgInfo(AResultType, member);
|
||||
ReleaseRefAndNil(member);
|
||||
if (tmp <> nil) and (tmp is TDbgDwarfTypeIdentifier) and
|
||||
(TDbgDwarfTypeIdentifier(tmp).IsStructType)
|
||||
then begin
|
||||
struct := TDbgDwarfTypeIdentifier(tmp).StructTypeInfo;
|
||||
tmp := struct.MemberByName[Items[1].GetText];
|
||||
|
||||
if (tmp <> nil) and (tmp is TDbgDwarfValueIdentifier) then begin
|
||||
Result := TDbgDwarfValueIdentifier(tmp).TypeInfo;
|
||||
Result.AddReference;
|
||||
end;
|
||||
ReleaseRefAndNil(tmp);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -161,7 +161,7 @@ const
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgDwarfTypeIdentifier; AnIsPointer: Boolean);
|
||||
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgSymbol);
|
||||
var
|
||||
TypeName: String;
|
||||
IsPointerPointer: Boolean;
|
||||
@ -169,20 +169,20 @@ const
|
||||
begin
|
||||
if (ASourceExpr = '') or (ATypeIdent = nil) then exit;
|
||||
|
||||
IsPointerType := ATypeIdent.IsPointerType;
|
||||
if IsPointerType then begin
|
||||
IsPointerType := ATypeIdent.Kind = FpDbgClasses.skPointer;
|
||||
if IsPointerType and (ATypeIdent.PointedToType <> nil) then begin
|
||||
ATypeIdent := ATypeIdent.PointedToType;
|
||||
if ATypeIdent = nil then exit;
|
||||
|
||||
IsPointerPointer := AnIsPointer or ATypeIdent.IsPointerType;
|
||||
|
||||
while (ATypeIdent <> nil) and ATypeIdent.IsPointerType do
|
||||
IsPointerPointer := ATypeIdent.Kind = FpDbgClasses.skPointer;
|
||||
while (ATypeIdent.Kind = FpDbgClasses.skPointer) and (ATypeIdent.PointedToType <> nil) do
|
||||
ATypeIdent := ATypeIdent.PointedToType;
|
||||
if ATypeIdent = nil then exit;
|
||||
end;
|
||||
TypeName := ATypeIdent.IdentifierName;
|
||||
TypeName := ATypeIdent.Name;
|
||||
|
||||
if ATypeIdent.IsBaseType then begin
|
||||
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', [TypeName]));
|
||||
@ -208,7 +208,6 @@ var
|
||||
Loc: TDBGPtr;
|
||||
Ident: TDbgSymbol;
|
||||
PasExpr: TFpGDBMIPascalExpression;
|
||||
PasType: TFpPasExprType;
|
||||
TypeIdent: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
||||
@ -227,18 +226,9 @@ DebugLn('############### '+ARequest.Request);
|
||||
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
|
||||
|
||||
PasExpr := TFpGDBMIPascalExpression.Create(IdentName, FDebugger, AThreadId, AStackFrame);
|
||||
PasType := PasExpr.ResultType;
|
||||
|
||||
case PasType.Kind of
|
||||
ptkValueDbgType: begin
|
||||
AddType(IdentName, PasType.DbgType, False);
|
||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
||||
end;
|
||||
ptkPointerToValueDbgType: begin
|
||||
AddType(IdentName, PasType.DbgType, True);
|
||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
||||
end;
|
||||
end;
|
||||
AddType(IdentName, PasExpr.ResultType);
|
||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
||||
|
||||
finally
|
||||
PasExpr.Free;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user