mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-01 06:40:36 +02:00
FPDebug: refactor, break circle unit ref
git-svn-id: trunk@43374 -
This commit is contained in:
martin
parent
c77e5896f2
commit
adf1d0e502
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1227,6 +1227,7 @@ components/fpdebug/fpdbgclasses.pp svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdisasx86.pp svneol=native#text/plain
|
||||
components/fpdebug/fpdbgdwarf.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarfconst.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbginfo.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgloader.pp svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgpetypes.pp svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgsymbols.pas svneol=native#text/pascal
|
||||
|
||||
@ -36,7 +36,7 @@ unit FPDCommand;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Windows, LCLProc, FpDbgWinExtra, FpDbgClasses;
|
||||
SysUtils, Classes, Windows, LCLProc, FpDbgWinExtra, FpDbgInfo, FpDbgClasses;
|
||||
|
||||
procedure HandleCommand(ACommand: String);
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@ unit FPDLoop;
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, SysUtils, FileUtil, FpDbgClasses, FpDbgWinExtra, FpDbgDisasX86;
|
||||
Windows, Classes, SysUtils, FileUtil, FpDbgInfo, FpDbgClasses, FpDbgWinExtra, FpDbgDisasX86;
|
||||
|
||||
procedure DebugLoop;
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@ unit FPDPEImage;
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, SysUtils, FPDGLobal, FpDbgClasses, FpDbgPETypes;
|
||||
Windows, SysUtils, FPDGLobal, FpDbgInfo, FpDbgClasses, FpDbgPETypes;
|
||||
|
||||
procedure DumpPEImage(const AProcessHandle: THandle; const AAddress: TDbgPtr);
|
||||
|
||||
|
||||
@ -40,11 +40,9 @@ uses
|
||||
{$ifdef windows}
|
||||
Windows,
|
||||
{$endif}
|
||||
Classes, SysUtils, Maps, FpDbgUtil, FpDbgWinExtra, FpDbgLoader, LazLoggerBase, LazClasses;
|
||||
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgWinExtra, FpDbgLoader, FpDbgInfo, LazLoggerBase, LazClasses;
|
||||
|
||||
type
|
||||
TDbgPtr = QWord; // PtrUInt;
|
||||
|
||||
{$ifdef windows}
|
||||
TDbgProcess = class;
|
||||
{$endif}
|
||||
@ -69,220 +67,6 @@ type
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
TDbgSymbolType = (
|
||||
stNone,
|
||||
stValue, // The symbol has a value (var, field, function, procedure (value is address of func/proc, so it can be called)
|
||||
stType // The Symbol is a type (including proc/func declaration / without DW_AT_low_pc)
|
||||
);
|
||||
|
||||
TDbgSymbolKind = (
|
||||
skNone, // undefined type
|
||||
// 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
|
||||
//--------------------------------------------------------------------------
|
||||
skRecord, // the address member is the relative location within the
|
||||
skObject, // structure
|
||||
skClass,
|
||||
skInterface,
|
||||
skProcedure,
|
||||
skFunction,
|
||||
//--------------------------------------------------------------------------
|
||||
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.
|
||||
skChar,
|
||||
skFloat,
|
||||
skString,
|
||||
skAnsiString,
|
||||
skCurrency,
|
||||
skVariant,
|
||||
skWideString,
|
||||
skEnum, // Variable holding an enum / enum type
|
||||
skEnumValue, // a single element from an enum
|
||||
skSet,
|
||||
//--------------------------------------------------------------------------
|
||||
skRegister // the Address member is the register number
|
||||
//--------------------------------------------------------------------------
|
||||
);
|
||||
|
||||
TDbgSymbolMemberVisibility =(
|
||||
svPrivate,
|
||||
svProtected,
|
||||
svPublic
|
||||
);
|
||||
|
||||
TDbgSymbolFlag =(
|
||||
sfSubRange, // This is a subrange, e.g 3..99
|
||||
sfDynArray, // skArray is known to be a dynamic array
|
||||
sfStatArray, // skArray is known to be a static array
|
||||
sfVirtual, // skProcedure,skFunction: virtual function (or overriden)
|
||||
// unimplemented:
|
||||
sfInternalRef, // TODO: (May not always be present) Internal ref/pointer e.g. var/constref parameters
|
||||
sfConst, // The sym is a constant and cannot be modified
|
||||
sfVar,
|
||||
sfOut,
|
||||
sfpropGet,
|
||||
sfPropSet,
|
||||
sfPropStored
|
||||
);
|
||||
TDbgSymbolFlags = set of TDbgSymbolFlag;
|
||||
|
||||
TDbgSymbolField = (
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize,
|
||||
sfiTypeInfo, sfiMemberVisibility,
|
||||
sfiForwardToSymbol
|
||||
);
|
||||
TDbgSymbolFields = set of TDbgSymbolField;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
TDbgSymbol = class(TRefCountedObject)
|
||||
private
|
||||
FEvaluatedFields: TDbgSymbolFields;
|
||||
|
||||
// Cached fields
|
||||
FName: String;
|
||||
FKind: TDbgSymbolKind;
|
||||
FSymbolType: TDbgSymbolType;
|
||||
FAddress: TDbgPtr;
|
||||
FSize: Integer;
|
||||
FTypeInfo: TDbgSymbol;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
|
||||
function GetSymbolType: TDbgSymbolType; //inline;
|
||||
function GetKind: TDbgSymbolKind; //inline;
|
||||
function GetName: String;
|
||||
function GetSize: Integer;
|
||||
function GetAddress: TDbgPtr;
|
||||
function GetTypeInfo: TDbgSymbol;
|
||||
function GetMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
protected
|
||||
// NOT cached fields
|
||||
function GetChild({%H-}AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetColumn: Cardinal; virtual;
|
||||
function GetCount: Integer; virtual;
|
||||
function GetFile: String; virtual;
|
||||
function GetFlags: TDbgSymbolFlags; virtual;
|
||||
function GetLine: Cardinal; virtual;
|
||||
function GetParent: TDbgSymbol; virtual;
|
||||
function GetReference: TDbgSymbol; virtual;
|
||||
|
||||
function GetHasOrdinalValue: Boolean; virtual;
|
||||
function GetOrdinalValue: Int64; virtual;
|
||||
|
||||
function GetHasBounds: Boolean; virtual;
|
||||
function GetOrdHighBound: Int64; virtual;
|
||||
function GetOrdLowBound: Int64; virtual;
|
||||
|
||||
function GetMember({%H-}AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetMemberByName({%H-}AIndex: String): TDbgSymbol; virtual;
|
||||
function GetMemberCount: Integer; virtual;
|
||||
protected
|
||||
property EvaluatedFields: TDbgSymbolFields read FEvaluatedFields write FEvaluatedFields;
|
||||
// Cached fields
|
||||
procedure SetName(AValue: String);
|
||||
procedure SetKind(AValue: TDbgSymbolKind);
|
||||
procedure SetSymbolType(AValue: TDbgSymbolType);
|
||||
procedure SetAddress(AValue: TDbgPtr);
|
||||
procedure SetSize(AValue: Integer);
|
||||
procedure SetTypeInfo(AValue: TDbgSymbol);
|
||||
procedure SetMemberVisibility(AValue: TDbgSymbolMemberVisibility);
|
||||
|
||||
procedure KindNeeded; virtual;
|
||||
procedure NameNeeded; virtual;
|
||||
procedure SymbolTypeNeeded; virtual;
|
||||
procedure AddressNeeded; virtual;
|
||||
procedure SizeNeeded; virtual;
|
||||
procedure TypeInfoNeeded; virtual;
|
||||
procedure MemberVisibilityNeeded; virtual;
|
||||
//procedure Needed; virtual;
|
||||
public
|
||||
constructor Create(const AName: String);
|
||||
constructor Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
destructor Destroy; override;
|
||||
// Basic info
|
||||
property Name: String read GetName;
|
||||
property SymbolType: TDbgSymbolType read GetSymbolType;
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
// Memory; Size is also part of type (byte vs word vs ...)
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property Size: Integer read GetSize; // In Bytes
|
||||
// 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 / enum)
|
||||
// array: each member represents an index (enum or subrange) and has low/high bounds
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
property Member[AIndex: Integer]: TDbgSymbol read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbol read GetMemberByName; // Includes inheritance
|
||||
//
|
||||
property Flags: TDbgSymbolFlags read GetFlags;
|
||||
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;
|
||||
// VALUE
|
||||
property HasOrdinalValue: Boolean read GetHasOrdinalValue;
|
||||
property OrdinalValue: Int64 read GetOrdinalValue; // need typecast for QuadWord
|
||||
// for Subranges
|
||||
property HasBounds: Boolean read GetHasBounds;
|
||||
property OrdLowBound: Int64 read GetOrdLowBound; // need typecast for QuadWord
|
||||
property OrdHighBound: Int64 read GetOrdHighBound; // need typecast for QuadWord
|
||||
end;
|
||||
|
||||
{ TDbgSymbolForwarder }
|
||||
|
||||
TDbgSymbolForwarder = class(TDbgSymbol)
|
||||
private
|
||||
FForwardToSymbol: TDbgSymbol; // sfiForwardToSymbol
|
||||
protected
|
||||
procedure SetForwardToSymbol(AValue: TDbgSymbol); // inline
|
||||
procedure ForwardToSymbolNeeded; virtual;
|
||||
function GetForwardToSymbol: TDbgSymbol; //inline;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
procedure NameNeeded; override;
|
||||
procedure SymbolTypeNeeded; override;
|
||||
procedure SizeNeeded; override;
|
||||
procedure TypeInfoNeeded; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
|
||||
function GetFlags: TDbgSymbolFlags; override;
|
||||
function GetHasOrdinalValue: Boolean; override;
|
||||
function GetOrdinalValue: Int64; override;
|
||||
function GetHasBounds: Boolean; override;
|
||||
function GetOrdLowBound: Int64; override;
|
||||
function GetOrdHighBound: Int64; override;
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
TDbgInfo = class(TObject)
|
||||
private
|
||||
FHasInfo: Boolean;
|
||||
protected
|
||||
procedure SetHasInfo;
|
||||
public
|
||||
constructor Create({%H-}ALoader: TDbgImageLoader); virtual;
|
||||
function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual;
|
||||
function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual;
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef windows}
|
||||
TDbgBreakpoint = class;
|
||||
@ -398,24 +182,13 @@ type
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String; overload;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
FpDbgDwarf;
|
||||
|
||||
procedure LogLastError;
|
||||
begin
|
||||
DebugLn('FpDbg-ERROR: ', GetLastErrorText);
|
||||
end;
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String;
|
||||
begin
|
||||
Result := '';
|
||||
WriteStr(Result, ADbgSymbolKind);
|
||||
end;
|
||||
|
||||
{$ifdef windows}
|
||||
{ TDbgInstance }
|
||||
|
||||
@ -952,454 +725,6 @@ begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
constructor TDbgInfo.Create(ALoader: TDbgImageLoader);
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbol(const AName: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgInfo.SetHasInfo;
|
||||
begin
|
||||
FHasInfo := True;
|
||||
end;
|
||||
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String);
|
||||
begin
|
||||
inherited Create;
|
||||
AddReference;
|
||||
if AName <> '' then
|
||||
SetName(AName);
|
||||
end;
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
begin
|
||||
Create(AName);
|
||||
SetKind(AKind);
|
||||
FAddress := AAddress;
|
||||
end;
|
||||
|
||||
destructor TDbgSymbol.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
ReleaseRefAndNil(FTypeInfo);
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetAddress: TDbgPtr;
|
||||
begin
|
||||
if not(sfiAddress in FEvaluatedFields) then
|
||||
AddressNeeded;
|
||||
Result := FAddress;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetTypeInfo: TDbgSymbol;
|
||||
begin
|
||||
if not(sfiTypeInfo in FEvaluatedFields) then
|
||||
TypeInfoNeeded;
|
||||
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
|
||||
KindNeeded;
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetName: String;
|
||||
begin
|
||||
if not(sfiName in FEvaluatedFields) then
|
||||
NameNeeded;
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetSize: Integer;
|
||||
begin
|
||||
if not(sfiSize in FEvaluatedFields) then
|
||||
SizeNeeded;
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetSymbolType: TDbgSymbolType;
|
||||
begin
|
||||
if not(sfiSymType in FEvaluatedFields) then
|
||||
SymbolTypeNeeded;
|
||||
Result := FSymbolType;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetHasBounds: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdHighBound: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdLowBound: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetHasOrdinalValue: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdinalValue: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMemberCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetAddress(AValue: TDbgPtr);
|
||||
begin
|
||||
FAddress := AValue;
|
||||
Include(FEvaluatedFields, sfiAddress);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetKind(AValue: TDbgSymbolKind);
|
||||
begin
|
||||
FKind := AValue;
|
||||
Include(FEvaluatedFields, sfiKind);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetSymbolType(AValue: TDbgSymbolType);
|
||||
begin
|
||||
FSymbolType := AValue;
|
||||
Include(FEvaluatedFields, sfiSymType);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetSize(AValue: Integer);
|
||||
begin
|
||||
FSize := AValue;
|
||||
Include(FEvaluatedFields, sfiSize);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetTypeInfo(AValue: TDbgSymbol);
|
||||
begin
|
||||
ReleaseRefAndNil(FTypeInfo);
|
||||
FTypeInfo := AValue;
|
||||
Include(FEvaluatedFields, sfiTypeInfo);
|
||||
if FTypeInfo <> nil then
|
||||
FTypeInfo.AddReference;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetMemberVisibility(AValue: TDbgSymbolMemberVisibility);
|
||||
begin
|
||||
FMemberVisibility := AValue;
|
||||
Include(FEvaluatedFields, sfiMemberVisibility);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetName(AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
Include(FEvaluatedFields, sfiName);
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetChild(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetColumn: Cardinal;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetFile: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetFlags: TDbgSymbolFlags;
|
||||
begin
|
||||
Result := [];
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetLine: Cardinal;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetParent: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetReference: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.KindNeeded;
|
||||
begin
|
||||
SetKind(skNone);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.NameNeeded;
|
||||
begin
|
||||
SetName('');
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SymbolTypeNeeded;
|
||||
begin
|
||||
SetSymbolType(stNone);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.AddressNeeded;
|
||||
begin
|
||||
SetAddress(0);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SizeNeeded;
|
||||
begin
|
||||
SetSize(0);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.TypeInfoNeeded;
|
||||
begin
|
||||
SetTypeInfo(nil);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.MemberVisibilityNeeded;
|
||||
begin
|
||||
SetMemberVisibility(svPrivate);
|
||||
end;
|
||||
|
||||
{ TDbgSymbolForwarder }
|
||||
|
||||
procedure TDbgSymbolForwarder.SetForwardToSymbol(AValue: TDbgSymbol);
|
||||
begin
|
||||
FForwardToSymbol := AValue;
|
||||
EvaluatedFields := EvaluatedFields + [sfiForwardToSymbol];
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.ForwardToSymbolNeeded;
|
||||
begin
|
||||
SetForwardToSymbol(nil);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetForwardToSymbol: TDbgSymbol;
|
||||
begin
|
||||
if TMethod(@ForwardToSymbolNeeded).Code = Pointer(@TDbgSymbolForwarder.ForwardToSymbolNeeded) then
|
||||
exit(nil);
|
||||
|
||||
if not(sfiForwardToSymbol in EvaluatedFields) then
|
||||
ForwardToSymbolNeeded;
|
||||
Result := FForwardToSymbol;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.KindNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetKind(p.Kind)
|
||||
else
|
||||
SetKind(skNone); // inherited KindNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.NameNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetName(p.Name)
|
||||
else
|
||||
SetName(''); // inherited NameNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.SymbolTypeNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetSymbolType(p.SymbolType)
|
||||
else
|
||||
SetSymbolType(stNone); // inherited SymbolTypeNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.SizeNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetSize(p.Size)
|
||||
else
|
||||
SetSize(0); // inherited SizeNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.TypeInfoNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetTypeInfo(p.TypeInfo)
|
||||
else
|
||||
SetTypeInfo(nil); // inherited TypeInfoNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.MemberVisibilityNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetMemberVisibility(p.MemberVisibility)
|
||||
else
|
||||
SetMemberVisibility(svPrivate); // inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetFlags: TDbgSymbolFlags;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.Flags
|
||||
else
|
||||
Result := []; // Result := inherited GetFlags;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetHasOrdinalValue: Boolean;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.HasOrdinalValue
|
||||
else
|
||||
Result := False; // Result := inherited GetHasOrdinalValue;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdinalValue: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdinalValue
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdinalValue;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetHasBounds: Boolean;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.HasBounds
|
||||
else
|
||||
Result := False; // Result := inherited GetHasBounds;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdLowBound: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdLowBound
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdLowBound;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdHighBound: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdHighBound
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdHighBound;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.Member[AIndex]
|
||||
else
|
||||
Result := nil; // Result := inherited GetMember(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.MemberByName[AIndex]
|
||||
else
|
||||
Result := nil; // Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMemberCount: Integer;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.MemberCount
|
||||
else
|
||||
Result := 0; // Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
{$ifdef windows}
|
||||
{ TDbgBreak }
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@ uses
|
||||
{$ifdef windows}
|
||||
Windows,
|
||||
{$endif}
|
||||
FpDbgUtil, FpDbgClasses;
|
||||
FpDbgUtil, FpDbgInfo;
|
||||
|
||||
{
|
||||
The function Disassemble decodes the instruction at the given address.
|
||||
|
||||
@ -41,7 +41,7 @@ unit FpDbgDwarf;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Types, SysUtils, FpDbgClasses, FpDbgDwarfConst, Maps, Math,
|
||||
Classes, Types, SysUtils, FpDbgInfo, FpDbgDwarfConst, Maps, Math,
|
||||
FpDbgLoader, FpImgReaderBase, LazLoggerBase, LazClasses, contnrs;
|
||||
|
||||
type
|
||||
|
||||
685
components/fpdebug/fpdbginfo.pas
Normal file
685
components/fpdebug/fpdbginfo.pas
Normal file
@ -0,0 +1,685 @@
|
||||
unit FpDbgInfo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Maps, FpDbgUtil, FpDbgWinExtra, FpDbgLoader, LazLoggerBase, LazClasses;
|
||||
|
||||
type
|
||||
TDbgPtr = QWord; // PtrUInt;
|
||||
|
||||
TDbgSymbolType = (
|
||||
stNone,
|
||||
stValue, // The symbol has a value (var, field, function, procedure (value is address of func/proc, so it can be called)
|
||||
stType // The Symbol is a type (including proc/func declaration / without DW_AT_low_pc)
|
||||
);
|
||||
|
||||
TDbgSymbolKind = (
|
||||
skNone, // undefined type
|
||||
// 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
|
||||
//--------------------------------------------------------------------------
|
||||
skRecord, // the address member is the relative location within the
|
||||
skObject, // structure
|
||||
skClass,
|
||||
skInterface,
|
||||
skProcedure,
|
||||
skFunction,
|
||||
//--------------------------------------------------------------------------
|
||||
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.
|
||||
skChar,
|
||||
skFloat,
|
||||
skString,
|
||||
skAnsiString,
|
||||
skCurrency,
|
||||
skVariant,
|
||||
skWideString,
|
||||
skEnum, // Variable holding an enum / enum type
|
||||
skEnumValue, // a single element from an enum
|
||||
skSet,
|
||||
//--------------------------------------------------------------------------
|
||||
skRegister // the Address member is the register number
|
||||
//--------------------------------------------------------------------------
|
||||
);
|
||||
|
||||
TDbgSymbolMemberVisibility =(
|
||||
svPrivate,
|
||||
svProtected,
|
||||
svPublic
|
||||
);
|
||||
|
||||
TDbgSymbolFlag =(
|
||||
sfSubRange, // This is a subrange, e.g 3..99
|
||||
sfDynArray, // skArray is known to be a dynamic array
|
||||
sfStatArray, // skArray is known to be a static array
|
||||
sfVirtual, // skProcedure,skFunction: virtual function (or overriden)
|
||||
// unimplemented:
|
||||
sfInternalRef, // TODO: (May not always be present) Internal ref/pointer e.g. var/constref parameters
|
||||
sfConst, // The sym is a constant and cannot be modified
|
||||
sfVar,
|
||||
sfOut,
|
||||
sfpropGet,
|
||||
sfPropSet,
|
||||
sfPropStored
|
||||
);
|
||||
TDbgSymbolFlags = set of TDbgSymbolFlag;
|
||||
|
||||
TDbgSymbolField = (
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize,
|
||||
sfiTypeInfo, sfiMemberVisibility,
|
||||
sfiForwardToSymbol
|
||||
);
|
||||
TDbgSymbolFields = set of TDbgSymbolField;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
TDbgSymbol = class(TRefCountedObject)
|
||||
private
|
||||
FEvaluatedFields: TDbgSymbolFields;
|
||||
|
||||
// Cached fields
|
||||
FName: String;
|
||||
FKind: TDbgSymbolKind;
|
||||
FSymbolType: TDbgSymbolType;
|
||||
FAddress: TDbgPtr;
|
||||
FSize: Integer;
|
||||
FTypeInfo: TDbgSymbol;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
|
||||
function GetSymbolType: TDbgSymbolType; inline;
|
||||
function GetKind: TDbgSymbolKind; inline;
|
||||
function GetName: String; inline;
|
||||
function GetSize: Integer; inline;
|
||||
function GetAddress: TDbgPtr; inline;
|
||||
function GetTypeInfo: TDbgSymbol; inline;
|
||||
function GetMemberVisibility: TDbgSymbolMemberVisibility; inline;
|
||||
protected
|
||||
// NOT cached fields
|
||||
function GetChild({%H-}AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetColumn: Cardinal; virtual;
|
||||
function GetCount: Integer; virtual;
|
||||
function GetFile: String; virtual;
|
||||
function GetFlags: TDbgSymbolFlags; virtual;
|
||||
function GetLine: Cardinal; virtual;
|
||||
function GetParent: TDbgSymbol; virtual;
|
||||
function GetReference: TDbgSymbol; virtual;
|
||||
|
||||
function GetHasOrdinalValue: Boolean; virtual;
|
||||
function GetOrdinalValue: Int64; virtual;
|
||||
|
||||
function GetHasBounds: Boolean; virtual;
|
||||
function GetOrdHighBound: Int64; virtual;
|
||||
function GetOrdLowBound: Int64; virtual;
|
||||
|
||||
function GetMember({%H-}AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetMemberByName({%H-}AIndex: String): TDbgSymbol; virtual;
|
||||
function GetMemberCount: Integer; virtual;
|
||||
protected
|
||||
property EvaluatedFields: TDbgSymbolFields read FEvaluatedFields write FEvaluatedFields;
|
||||
// Cached fields
|
||||
procedure SetName(AValue: String); inline;
|
||||
procedure SetKind(AValue: TDbgSymbolKind); inline;
|
||||
procedure SetSymbolType(AValue: TDbgSymbolType); inline;
|
||||
procedure SetAddress(AValue: TDbgPtr); inline;
|
||||
procedure SetSize(AValue: Integer); inline;
|
||||
procedure SetTypeInfo(AValue: TDbgSymbol); inline;
|
||||
procedure SetMemberVisibility(AValue: TDbgSymbolMemberVisibility); inline;
|
||||
|
||||
procedure KindNeeded; virtual;
|
||||
procedure NameNeeded; virtual;
|
||||
procedure SymbolTypeNeeded; virtual;
|
||||
procedure AddressNeeded; virtual;
|
||||
procedure SizeNeeded; virtual;
|
||||
procedure TypeInfoNeeded; virtual;
|
||||
procedure MemberVisibilityNeeded; virtual;
|
||||
//procedure Needed; virtual;
|
||||
public
|
||||
constructor Create(const AName: String);
|
||||
constructor Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
destructor Destroy; override;
|
||||
// Basic info
|
||||
property Name: String read GetName;
|
||||
property SymbolType: TDbgSymbolType read GetSymbolType;
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
// Memory; Size is also part of type (byte vs word vs ...)
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property Size: Integer read GetSize; // In Bytes
|
||||
// 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 / enum)
|
||||
// array: each member represents an index (enum or subrange) and has low/high bounds
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
property Member[AIndex: Integer]: TDbgSymbol read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbol read GetMemberByName; // Includes inheritance
|
||||
//
|
||||
property Flags: TDbgSymbolFlags read GetFlags;
|
||||
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;
|
||||
// VALUE
|
||||
property HasOrdinalValue: Boolean read GetHasOrdinalValue;
|
||||
property OrdinalValue: Int64 read GetOrdinalValue; // need typecast for QuadWord
|
||||
// for Subranges
|
||||
property HasBounds: Boolean read GetHasBounds;
|
||||
property OrdLowBound: Int64 read GetOrdLowBound; // need typecast for QuadWord
|
||||
property OrdHighBound: Int64 read GetOrdHighBound; // need typecast for QuadWord
|
||||
end;
|
||||
|
||||
{ TDbgSymbolForwarder }
|
||||
|
||||
TDbgSymbolForwarder = class(TDbgSymbol)
|
||||
private
|
||||
FForwardToSymbol: TDbgSymbol;
|
||||
protected
|
||||
procedure SetForwardToSymbol(AValue: TDbgSymbol); inline;
|
||||
procedure ForwardToSymbolNeeded; virtual;
|
||||
function GetForwardToSymbol: TDbgSymbol; inline;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
procedure NameNeeded; override;
|
||||
procedure SymbolTypeNeeded; override;
|
||||
procedure SizeNeeded; override;
|
||||
procedure TypeInfoNeeded; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
|
||||
function GetFlags: TDbgSymbolFlags; override;
|
||||
function GetHasOrdinalValue: Boolean; override;
|
||||
function GetOrdinalValue: Int64; override;
|
||||
function GetHasBounds: Boolean; override;
|
||||
function GetOrdLowBound: Int64; override;
|
||||
function GetOrdHighBound: Int64; override;
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
TDbgInfo = class(TObject)
|
||||
private
|
||||
FHasInfo: Boolean;
|
||||
protected
|
||||
procedure SetHasInfo;
|
||||
public
|
||||
constructor Create({%H-}ALoader: TDbgImageLoader); virtual;
|
||||
function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual;
|
||||
function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual;
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual;
|
||||
end;
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String; overload;
|
||||
|
||||
implementation
|
||||
|
||||
function dbgs(ADbgSymbolKind: TDbgSymbolKind): String;
|
||||
begin
|
||||
Result := '';
|
||||
WriteStr(Result, ADbgSymbolKind);
|
||||
end;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String);
|
||||
begin
|
||||
inherited Create;
|
||||
AddReference;
|
||||
if AName <> '' then
|
||||
SetName(AName);
|
||||
end;
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
|
||||
begin
|
||||
Create(AName);
|
||||
SetKind(AKind);
|
||||
FAddress := AAddress;
|
||||
end;
|
||||
|
||||
destructor TDbgSymbol.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
ReleaseRefAndNil(FTypeInfo);
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetAddress: TDbgPtr;
|
||||
begin
|
||||
if not(sfiAddress in FEvaluatedFields) then
|
||||
AddressNeeded;
|
||||
Result := FAddress;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetTypeInfo: TDbgSymbol;
|
||||
begin
|
||||
if not(sfiTypeInfo in FEvaluatedFields) then
|
||||
TypeInfoNeeded;
|
||||
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
|
||||
KindNeeded;
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetName: String;
|
||||
begin
|
||||
if not(sfiName in FEvaluatedFields) then
|
||||
NameNeeded;
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetSize: Integer;
|
||||
begin
|
||||
if not(sfiSize in FEvaluatedFields) then
|
||||
SizeNeeded;
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetSymbolType: TDbgSymbolType;
|
||||
begin
|
||||
if not(sfiSymType in FEvaluatedFields) then
|
||||
SymbolTypeNeeded;
|
||||
Result := FSymbolType;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetHasBounds: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdHighBound: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdLowBound: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetHasOrdinalValue: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetOrdinalValue: Int64;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetMemberCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetAddress(AValue: TDbgPtr);
|
||||
begin
|
||||
FAddress := AValue;
|
||||
Include(FEvaluatedFields, sfiAddress);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetKind(AValue: TDbgSymbolKind);
|
||||
begin
|
||||
FKind := AValue;
|
||||
Include(FEvaluatedFields, sfiKind);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetSymbolType(AValue: TDbgSymbolType);
|
||||
begin
|
||||
FSymbolType := AValue;
|
||||
Include(FEvaluatedFields, sfiSymType);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetSize(AValue: Integer);
|
||||
begin
|
||||
FSize := AValue;
|
||||
Include(FEvaluatedFields, sfiSize);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetTypeInfo(AValue: TDbgSymbol);
|
||||
begin
|
||||
ReleaseRefAndNil(FTypeInfo);
|
||||
FTypeInfo := AValue;
|
||||
Include(FEvaluatedFields, sfiTypeInfo);
|
||||
if FTypeInfo <> nil then
|
||||
FTypeInfo.AddReference;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetMemberVisibility(AValue: TDbgSymbolMemberVisibility);
|
||||
begin
|
||||
FMemberVisibility := AValue;
|
||||
Include(FEvaluatedFields, sfiMemberVisibility);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SetName(AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
Include(FEvaluatedFields, sfiName);
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetChild(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetColumn: Cardinal;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetFile: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetFlags: TDbgSymbolFlags;
|
||||
begin
|
||||
Result := [];
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetLine: Cardinal;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetParent: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbol.GetReference: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.KindNeeded;
|
||||
begin
|
||||
SetKind(skNone);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.NameNeeded;
|
||||
begin
|
||||
SetName('');
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SymbolTypeNeeded;
|
||||
begin
|
||||
SetSymbolType(stNone);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.AddressNeeded;
|
||||
begin
|
||||
SetAddress(0);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.SizeNeeded;
|
||||
begin
|
||||
SetSize(0);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.TypeInfoNeeded;
|
||||
begin
|
||||
SetTypeInfo(nil);
|
||||
end;
|
||||
|
||||
procedure TDbgSymbol.MemberVisibilityNeeded;
|
||||
begin
|
||||
SetMemberVisibility(svPrivate);
|
||||
end;
|
||||
|
||||
{ TDbgSymbolForwarder }
|
||||
|
||||
procedure TDbgSymbolForwarder.SetForwardToSymbol(AValue: TDbgSymbol);
|
||||
begin
|
||||
FForwardToSymbol := AValue;
|
||||
EvaluatedFields := EvaluatedFields + [sfiForwardToSymbol];
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.ForwardToSymbolNeeded;
|
||||
begin
|
||||
SetForwardToSymbol(nil);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetForwardToSymbol: TDbgSymbol;
|
||||
begin
|
||||
if TMethod(@ForwardToSymbolNeeded).Code = Pointer(@TDbgSymbolForwarder.ForwardToSymbolNeeded) then
|
||||
exit(nil);
|
||||
|
||||
if not(sfiForwardToSymbol in EvaluatedFields) then
|
||||
ForwardToSymbolNeeded;
|
||||
Result := FForwardToSymbol;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.KindNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetKind(p.Kind)
|
||||
else
|
||||
SetKind(skNone); // inherited KindNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.NameNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetName(p.Name)
|
||||
else
|
||||
SetName(''); // inherited NameNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.SymbolTypeNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetSymbolType(p.SymbolType)
|
||||
else
|
||||
SetSymbolType(stNone); // inherited SymbolTypeNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.SizeNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetSize(p.Size)
|
||||
else
|
||||
SetSize(0); // inherited SizeNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.TypeInfoNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetTypeInfo(p.TypeInfo)
|
||||
else
|
||||
SetTypeInfo(nil); // inherited TypeInfoNeeded;
|
||||
end;
|
||||
|
||||
procedure TDbgSymbolForwarder.MemberVisibilityNeeded;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetMemberVisibility(p.MemberVisibility)
|
||||
else
|
||||
SetMemberVisibility(svPrivate); // inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetFlags: TDbgSymbolFlags;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.Flags
|
||||
else
|
||||
Result := []; // Result := inherited GetFlags;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetHasOrdinalValue: Boolean;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.HasOrdinalValue
|
||||
else
|
||||
Result := False; // Result := inherited GetHasOrdinalValue;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdinalValue: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdinalValue
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdinalValue;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetHasBounds: Boolean;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.HasBounds
|
||||
else
|
||||
Result := False; // Result := inherited GetHasBounds;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdLowBound: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdLowBound
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdLowBound;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetOrdHighBound: Int64;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.OrdHighBound
|
||||
else
|
||||
Result := 0; // Result := inherited GetOrdHighBound;
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.Member[AIndex]
|
||||
else
|
||||
Result := nil; // Result := inherited GetMember(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.MemberByName[AIndex]
|
||||
else
|
||||
Result := nil; // Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgSymbolForwarder.GetMemberCount: Integer;
|
||||
var
|
||||
p: TDbgSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.MemberCount
|
||||
else
|
||||
Result := 0; // Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
constructor TDbgInfo.Create(ALoader: TDbgImageLoader);
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbol(const AName: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TDbgInfo.SetHasInfo;
|
||||
begin
|
||||
FHasInfo := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -41,7 +41,7 @@ uses
|
||||
{$ifdef windows}
|
||||
Windows,
|
||||
{$endif}
|
||||
Classes, SysUtils, FpDbgClasses, FpDbgWinExtra, FpDbgPETypes, FpDbgDwarf, FpDbgUtil;
|
||||
Classes, SysUtils, FpDbgInfo, FpDbgWinExtra, FpDbgPETypes, FpDbgDwarf, FpDbgUtil;
|
||||
|
||||
|
||||
{$ifdef windows}
|
||||
|
||||
@ -34,7 +34,7 @@ File(s) with other licenses (see also header in file(s):
|
||||
|
||||
(Any modifications/translations of this file are from duby)
|
||||
"/>
|
||||
<Files Count="18">
|
||||
<Files Count="19">
|
||||
<Item1>
|
||||
<Filename Value="fpdbgclasses.pp"/>
|
||||
<UnitName Value="FpDbgClasses"/>
|
||||
@ -105,8 +105,12 @@ File(s) with other licenses (see also header in file(s):
|
||||
</Item17>
|
||||
<Item18>
|
||||
<Filename Value="fppascalbuilder.pas"/>
|
||||
<UnitName Value="fppascalbuilder"/>
|
||||
<UnitName Value="FpPascalBuilder"/>
|
||||
</Item18>
|
||||
<Item19>
|
||||
<Filename Value="fpdbginfo.pas"/>
|
||||
<UnitName Value="fpdbginfo"/>
|
||||
</Item19>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
|
||||
@ -10,7 +10,7 @@ uses
|
||||
FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, FpDbgPETypes,
|
||||
FpDbgSymbols, FpDbgUtil, FpDbgWinExtra, FpImgReaderWinPE, FpImgReaderElf,
|
||||
FpImgReaderElfTypes, FpImgReaderBase, FpPascalParser, macho, FpImgReaderMachoFile,
|
||||
FpImgReaderMacho, FpPascalBuilder, LazarusPackageIntf;
|
||||
FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -5,7 +5,7 @@ unit FpPascalBuilder;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FpDbgClasses;
|
||||
Classes, SysUtils, FpDbgInfo;
|
||||
|
||||
type
|
||||
TTypeNameFlag = (
|
||||
|
||||
@ -29,7 +29,7 @@ unit FpPascalParser;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, sysutils, math, FpDbgClasses, LazLoggerBase, LazClasses;
|
||||
Classes, sysutils, math, FpDbgInfo, LazLoggerBase, LazClasses;
|
||||
|
||||
type
|
||||
|
||||
|
||||
@ -2,19 +2,95 @@ program Foo;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
type
|
||||
|
||||
TStatArray = Array[3..7] of boolean;
|
||||
TStatArray2 = Array[3..7, 2..4] of boolean;
|
||||
TDynArray = Array of boolean;
|
||||
TDynArray2 = Array of Array of boolean;
|
||||
PDynArray = ^TDynArray;
|
||||
|
||||
TString25 = String[25];
|
||||
|
||||
TEnum1 = (enum1a,enum1b,enum1c,enum1d);
|
||||
PTEnum1 = ^TEnum1;
|
||||
TSet1 = set of TEnum1;
|
||||
PTSet1 = ^TSet1;
|
||||
|
||||
TTestClass = class;
|
||||
|
||||
{ TTestRecord }
|
||||
|
||||
TTestRecord = record
|
||||
FWord: Word;
|
||||
FBool: Boolean;
|
||||
FTest: TTestClass;
|
||||
end;
|
||||
PTestRecord = ^TTestRecord;
|
||||
|
||||
{ TTestClass }
|
||||
|
||||
TTestClass = class
|
||||
public
|
||||
FWord: Word;
|
||||
FBool: Boolean;
|
||||
FTest: TTestClass;
|
||||
procedure f0(a:integer); virtual;
|
||||
end;
|
||||
|
||||
{ TTestClass2 }
|
||||
|
||||
TTestClass2 = class(TTestClass)
|
||||
public
|
||||
FWord2: Word;
|
||||
FBool2: Boolean;
|
||||
FTest2: TTestClass;
|
||||
a1: TStatArray;
|
||||
a2: TDynArray;
|
||||
a3: Array[3..7, 2..4] of boolean;
|
||||
a4: Array of Array of boolean;
|
||||
a5: array [1..2] of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
|
||||
a6: array of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
|
||||
a7: array [(a7e1,a7e2,a7e3)] of set of (a7s1,a7s2,a7s3);
|
||||
r1: record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
|
||||
r2: TTestRecord;
|
||||
s1: string[25];
|
||||
s2: TString25;
|
||||
enum1: (ee1,ee2,ee3);
|
||||
set1: set of (se1,se2,se3);
|
||||
enum4: ^TEnum1;
|
||||
enum5: PTEnum1;
|
||||
set4: TSet1;
|
||||
set5: ^TSet1;
|
||||
procedure f0(a:integer); override;
|
||||
procedure f1(a:integer);
|
||||
procedure f2(a:integer); virtual;
|
||||
procedure f2a(a:integer); virtual; abstract;
|
||||
procedure f3(a:integer); dynamic;
|
||||
end;
|
||||
PTestClass2 = ^TTestClass2;
|
||||
|
||||
TTestObject = object
|
||||
public
|
||||
FWord: Word;
|
||||
FBool: Boolean;
|
||||
FTest: TTestClass;
|
||||
end;
|
||||
|
||||
TTestObject2 = object(TTestObject)
|
||||
public
|
||||
FWord2: Word;
|
||||
FBool2: Boolean;
|
||||
FTest2: TTestClass;
|
||||
end;
|
||||
PTestObject2 = ^TTestObject2;
|
||||
|
||||
|
||||
Pint = ^ integer;
|
||||
PPInt = ^Pint;
|
||||
PPPInt = ^PPint;
|
||||
//shortstring = record end;
|
||||
|
||||
procedure Bar;
|
||||
procedure Bar(ArgClass: TTestClass; var VArgClass: TTestClass; pdarg: PDynArray);
|
||||
var
|
||||
int1, int2: Integer;
|
||||
pint1, pint2: ^Integer;
|
||||
@ -22,7 +98,14 @@ var
|
||||
puint1, puint2: ^Cardinal;
|
||||
b1,b2: Byte;
|
||||
bool1,bool2: Boolean;
|
||||
test: TTestClass;
|
||||
|
||||
TestC: TTestClass; testC2: TTestClass2;
|
||||
PtestC2: PTestClass2; PtestC2a: ^TTestClass2;
|
||||
testO: TTestObject; testO2: TTestObject2;
|
||||
PtestO2: PTestObject2; PtestO2a: ^TTestObject2;
|
||||
TestR: TTestRecord;
|
||||
PTestR: PTestRecord; PTestRa: ^TTestRecord;
|
||||
ITestR: record FWord: Word; FBool: Boolean; end;
|
||||
|
||||
s1: string[5];
|
||||
s2: string[15];
|
||||
@ -33,6 +116,30 @@ var
|
||||
ppi: PPint;
|
||||
pppi: PPPint;
|
||||
|
||||
a1: TStatArray;
|
||||
a2: TDynArray;
|
||||
a1p: ^TStatArray;
|
||||
a2p: ^TDynArray;
|
||||
a1b: TStatArray2;
|
||||
a2b: TDynArray2;
|
||||
a3: Array[3..7, 2..4] of boolean;
|
||||
a4: Array of Array of boolean;
|
||||
|
||||
enum1: TEnum1;
|
||||
enum2: enum1b..enum1d;
|
||||
enum3: enum1a..enum1c;
|
||||
enum4: ^TEnum1;
|
||||
enum5: PTEnum1;
|
||||
set1: set of byte;
|
||||
set2: set of (enum1a,enum1d);
|
||||
set3: set of 1..5;
|
||||
set4: TSet1;
|
||||
set5: ^TSet1;
|
||||
set6: PTSet1;
|
||||
subr: 1..9;
|
||||
subr2: -11..-9;
|
||||
subr3: #9..'m';
|
||||
|
||||
begin
|
||||
int1 := int2;
|
||||
pint1 := pint2;
|
||||
@ -43,10 +150,72 @@ begin
|
||||
s1:= 'aa';
|
||||
st1:= 'bb';
|
||||
pc1:= @st1[1];
|
||||
writeln(int1,uint1,b1,bool1, test.FWord);
|
||||
SetLength(a2,9);
|
||||
SetLength(a2b,9,3);
|
||||
SetLength(a4,9,3);
|
||||
testC2 := TTestClass2.Create;
|
||||
a1[3]:= a1b[3,3];
|
||||
a1[3]:= a3[3,3];
|
||||
a1p := @a1;
|
||||
a2p := @a2;
|
||||
SetLength(testC2.a2,9);
|
||||
SetLength(testC2.a4,9,3);
|
||||
testC2.f1(1);
|
||||
testC2.f2(1);
|
||||
testC2.f3(1);
|
||||
testC2.f0(1);
|
||||
enum1 := enum1b;
|
||||
enum2 := enum1b;
|
||||
enum3 := enum1b;
|
||||
enum4 := @enum1;
|
||||
enum5 := @enum1;
|
||||
set1 := [];
|
||||
set2 := [];
|
||||
set3 := [];
|
||||
set4 := [];
|
||||
set5 := @set4;
|
||||
set6 := @set4;
|
||||
subr := 1;
|
||||
subr2 := -11;
|
||||
subr3 := 'm';
|
||||
writeln(int1,uint1,b1,bool1,
|
||||
testC.FWord, testC2.FWord, PtestC2^.FWord, PtestC2a^.FWord,
|
||||
testO.FWord, testO2.FWord, PtestO2^.FWord, PtestO2a^.FWord,
|
||||
testR.FWord, PtestR^.FWord, PtestRa^.FWord
|
||||
);
|
||||
WriteLn(s1,s2,s3,st1,st2,pc1,pc2, pi^,ppi^^,pppi^^^);
|
||||
end;
|
||||
|
||||
var
|
||||
GlobClass: TTestClass;
|
||||
|
||||
procedure TTestClass.f0(a: integer);
|
||||
begin
|
||||
Bar;
|
||||
//
|
||||
end;
|
||||
|
||||
{ TTestClass2 }
|
||||
|
||||
procedure TTestClass2.f0(a: integer);
|
||||
begin
|
||||
inherited f0(a);
|
||||
end;
|
||||
|
||||
procedure TTestClass2.f1(a: integer);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TTestClass2.f2(a: integer);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TTestClass2.f3(a: integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
Bar(GlobClass, GlobClass, nil);
|
||||
end.
|
||||
|
||||
@ -5,11 +5,11 @@ unit TestTypeInfo;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FpPascalParser, FpDbgDwarf, FpDbgClasses, FpDbgLoader, FileUtil,
|
||||
LazLoggerBase, fpcunit, testutils, testregistry;
|
||||
Classes, SysUtils, FpPascalParser, FpDbgDwarf, FpDbgInfo, FpDbgLoader, FpPascalBuilder,
|
||||
FileUtil, LazLoggerBase, fpcunit, testutils, testregistry;
|
||||
|
||||
const
|
||||
TESTPROG1_FUNC_BAR_LINE = 35;
|
||||
TESTPROG1_FUNC_BAR_LINE = 155;
|
||||
|
||||
type
|
||||
|
||||
@ -114,6 +114,15 @@ debugln(['### ', TestText, ' ## ', dbgs(Expr.ResultType.Kind), ' # ',Expr.Result
|
||||
AssertEquals(TestText+' kind', dbgs(AKind), dbgs(Expr.ResultType.Kind));
|
||||
end;
|
||||
|
||||
procedure TestTypeName(AExpName: String; AFlags: TTypeNameFlags = []);
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
AssertEquals(TestText + ' GetTypeName bool ', AExpName <> '', GetTypeName(s, Expr.ResultType, AFlags));
|
||||
if AExpName <> '' then
|
||||
AssertEquals(TestText + ' GetTypeName result ', LowerCase(AExpName), LowerCase(s));
|
||||
end;
|
||||
|
||||
procedure DoTestInvalid(AExprText: String);
|
||||
begin
|
||||
FreeAndNil(Expr);
|
||||
@ -124,18 +133,22 @@ debugln(['### ', TestText, ' ## ', dbgs(Expr.ResultType.Kind), ' # ',Expr.Result
|
||||
end;
|
||||
|
||||
procedure DoRun;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
LineInfo := FDwarfInfo.GetLineAddressMap('testprog1.pas');
|
||||
Location := LineInfo^.GetAddressForLine(TESTPROG1_FUNC_BAR_LINE);
|
||||
|
||||
DoTest('int1', skInteger);
|
||||
DoTest('b1', skCardinal);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('pint1', skPointer);
|
||||
DoTest(Expr.ResultType.TypeInfo, skInteger);
|
||||
|
||||
DoTest('@int1', skPointer);
|
||||
DoTest(Expr.ResultType.TypeInfo, skInteger);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('pint1^', skInteger);
|
||||
DoTest('@int1^', skInteger);
|
||||
@ -146,10 +159,10 @@ debugln(['### ', TestText, ' ## ', dbgs(Expr.ResultType.Kind), ' # ',Expr.Result
|
||||
|
||||
DoTest('bool1', skBoolean);
|
||||
|
||||
DoTest('test.FWord', skCardinal);
|
||||
DoTest('test.FBool', skBoolean);
|
||||
DoTest('test.FTest.FWord', skCardinal);
|
||||
DoTest('test.FTest.FBool', skBoolean);
|
||||
DoTest('testC.FWord', skCardinal);
|
||||
DoTest('testC.FBool', skBoolean);
|
||||
DoTest('testC.FTest.FWord', skCardinal);
|
||||
DoTest('testC.FTest.FBool', skBoolean);
|
||||
|
||||
|
||||
DoTest('longint(bool1)', skInteger);
|
||||
@ -159,6 +172,106 @@ debugln(['### ', TestText, ' ## ', dbgs(Expr.ResultType.Kind), ' # ',Expr.Result
|
||||
DoTestInvalid('^int1');
|
||||
DoTestInvalid('^int1(int2)');
|
||||
|
||||
DoTest('ppi', skPointer, 'ppint');
|
||||
TestTypeName('^pint', [tnfIncludeOneRef]);
|
||||
|
||||
DoTest('@int1', skPointer, '');
|
||||
TestTypeName('^longint', []);
|
||||
TestTypeName('^longint', [tnfIncludeOneRef]);
|
||||
TestTypeName('', [tnfOnlyDeclared]);
|
||||
|
||||
DoTest('testC', skClass);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('testC2', skClass);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('enum1', skEnum);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('subr', skCardinal);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('subr2', skInteger);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('subr3', skChar);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('set1', skSet);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('set2', skSet);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('set3', skSet);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('a1', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a2', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a1b', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a2b', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a1p', skPointer);
|
||||
//AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a2p', skPointer);
|
||||
//AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('pdarg', skPointer);
|
||||
//AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a3', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a4', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
|
||||
|
||||
DoTest('testc2.a1', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a2', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a3', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a4', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a5', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a6', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('testc2.a7', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
|
||||
FreeAndNil(expr);
|
||||
end;
|
||||
|
||||
|
||||
@ -5,7 +5,7 @@ unit FpGdbmiDebugger;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, sysutils, math, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger,
|
||||
Classes, sysutils, math, FpDbgInfo, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger,
|
||||
GDBMIMiscClasses, GDBTypeInfo, maps, LCLProc, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst,
|
||||
LazLoggerBase, LazLoggerProfiling, FpPascalParser, FpPascalBuilder;
|
||||
|
||||
@ -162,7 +162,7 @@ const
|
||||
ADeRefTypeName := '';
|
||||
ABaseTypeName := ABaseType.Name;
|
||||
|
||||
while (ABaseType.Kind = FpDbgClasses.skPointer) and (ABaseType.TypeInfo <> nil) do begin
|
||||
while (ABaseType.Kind = FpDbgInfo.skPointer) and (ABaseType.TypeInfo <> nil) do begin
|
||||
ABaseType := ABaseType.TypeInfo;
|
||||
inc(APointerLevel);
|
||||
|
||||
@ -206,7 +206,7 @@ const
|
||||
begin
|
||||
//todo: functions / virtual / array ...
|
||||
s2 := '';
|
||||
if AMember.Kind = FpDbgClasses.skProcedure then begin
|
||||
if AMember.Kind = FpDbgInfo.skProcedure then begin
|
||||
if sfVirtual in AMember.Flags then s2 := ' virtual;';
|
||||
AText := AText + ' procedure ' + AMember.Name + ' ();' + s2 + LineEnding;
|
||||
exit
|
||||
@ -219,23 +219,23 @@ const
|
||||
end;
|
||||
s := ti.Name;
|
||||
if s = '' then begin
|
||||
if (AMember.Kind = FpDbgClasses.skSet) or (AMember.Kind = FpDbgClasses.skEnum) or
|
||||
(AMember.Kind = FpDbgClasses.skArray)
|
||||
if (AMember.Kind = FpDbgInfo.skSet) or (AMember.Kind = FpDbgInfo.skEnum) or
|
||||
(AMember.Kind = FpDbgInfo.skArray)
|
||||
then
|
||||
if not GetTypeAsDeclaration(s, ti, [tdfSkipClassBody, tdfSkipRecordBody]) then
|
||||
s := '';
|
||||
end;
|
||||
if (s = '') and not (AMember.Kind = FpDbgClasses.skRecord) then begin
|
||||
if (s = '') and not (AMember.Kind = FpDbgInfo.skRecord) then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if AMember.Kind = FpDbgClasses.skFunction then begin
|
||||
if AMember.Kind = FpDbgInfo.skFunction then begin
|
||||
if sfVirtual in AMember.Flags then s2 := ' virtual;';
|
||||
AText := AText + ' function ' + AMember.Name + ' () : '+s+';' + s2 + LineEnding;
|
||||
end
|
||||
else
|
||||
if AMember.Kind = FpDbgClasses.skRecord then begin
|
||||
if AMember.Kind = FpDbgInfo.skRecord then begin
|
||||
AText := AText + ' ' + AMember.Name + ' : '+s+' = record ;' + LineEnding;
|
||||
end
|
||||
else
|
||||
@ -532,23 +532,23 @@ const
|
||||
AddBaseType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
FpDbgClasses.skClass:
|
||||
FpDbgInfo.skClass:
|
||||
AddClassType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
FpDbgClasses.skRecord:
|
||||
FpDbgInfo.skRecord:
|
||||
AddRecordType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
FpDbgClasses.skEnum:
|
||||
FpDbgInfo.skEnum:
|
||||
AddEnumType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
FpDbgClasses.skSet:
|
||||
FpDbgInfo.skSet:
|
||||
AddSetType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
FpDbgClasses.skArray:
|
||||
FpDbgInfo.skArray:
|
||||
AddArrayType(ASourceExpr, PointerLevel,
|
||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
||||
ATypeIdent, BaseType);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user