paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-20 11:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Refactor class names for TFpDbgValue and TFpDbgSymbol descendants.

Browse Source 
git-svn-id: trunk@61722 -
This commit is contained in:
martin 2019-08-18 13:43:45 +00:00
parent a8233705f3
commit 5a7c9f1487
17 changed files with 1589 additions and 1589 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpdebug/app/fpd/fpdcommand.pas
View File

@ -216,7 +216,7 @@ var
bp: TFpInternalBreakpoint; bp: TFpInternalBreakpoint;
AContext: TFpDbgInfoContext; AContext: TFpDbgInfoContext;
AValue: TFpDbgValue; AValue: TFpValue;
begin begin
CallProcessLoop:=false; CallProcessLoop:=false;

2
components/fpdebug/app/fpd/fpdloop.pas
View File

@ -154,7 +154,7 @@ end;
procedure TFPDLoop.ShowCode; procedure TFPDLoop.ShowCode;
var var
a: TDbgPtr; a: TDbgPtr;
sym, symproc: TFpDbgSymbol; sym, symproc: TFpSymbol;
S: TStringList; S: TStringList;
AName: String; AName: String;
begin begin

10
components/fpdebug/app/fpdserver/debugthreadcommand.pas
View File

@ -306,9 +306,9 @@ end;
function TFpDebugLocalsCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; function TFpDebugLocalsCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var var
AContext: TFpDbgInfoContext; AContext: TFpDbgInfoContext;
ProcVal: TFpDbgValue; ProcVal: TFpValue;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
n, v: String; n, v: String;
Reg: TDBGPtr; Reg: TDBGPtr;
PrettyPrinter: TFpPascalPrettyPrinter; PrettyPrinter: TFpPascalPrettyPrinter;
@ -393,7 +393,7 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TFpServerDbgContr
function {$ifndef disassemblernestedproc}TFpDebugThreadDisassembleCommand.{$endif}OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean; function {$ifndef disassemblernestedproc}TFpDebugThreadDisassembleCommand.{$endif}OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
var var
Sym: TFpDbgSymbol; Sym: TFpSymbol;
begin begin
Sym := {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.FindSymbol(AStartAddr.GuessedValue); Sym := {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.FindSymbol(AStartAddr.GuessedValue);
if assigned(Sym) and (Sym.Kind in [skProcedure, skFunction]) then if assigned(Sym) and (Sym.Kind in [skProcedure, skFunction]) then
@ -419,7 +419,7 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TFpServerDbgContr
ASrcFileName: string; ASrcFileName: string;
ASrcFileLine: cardinal; ASrcFileLine: cardinal;
i,j: Integer; i,j: Integer;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
StatIndex: integer; StatIndex: integer;
FirstIndex: integer; FirstIndex: integer;
AResultList: TDBGDisassemblerEntryRange; AResultList: TDBGDisassemblerEntryRange;
@ -883,7 +883,7 @@ end;
function TFpDebugThreadGetLocationInfoCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; function TFpDebugThreadGetLocationInfoCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var var
sym, symproc: TFpDbgSymbol; sym, symproc: TFpSymbol;
begin begin
DoProcessLoop:=false; DoProcessLoop:=false;
result := false; result := false;

36
components/fpdebug/fpdbgclasses.pp
View File

@ -92,11 +92,11 @@ type
FFrameAdress: TDBGPtr; FFrameAdress: TDBGPtr;
FThread: TDbgThread; FThread: TDbgThread;
FIsSymbolResolved: boolean; FIsSymbolResolved: boolean;
FSymbol: TFpDbgSymbol; FSymbol: TFpSymbol;
FRegisterValueList: TDbgRegisterValueList; FRegisterValueList: TDbgRegisterValueList;
FIndex: integer; FIndex: integer;
function GetFunctionName: string; function GetFunctionName: string;
function GetSymbol: TFpDbgSymbol; function GetSymbol: TFpSymbol;
function GetLine: integer; function GetLine: integer;
function GetSourceFile: string; function GetSourceFile: string;
public public
@ -109,7 +109,7 @@ type
property FunctionName: string read GetFunctionName; property FunctionName: string read GetFunctionName;
property Line: integer read GetLine; property Line: integer read GetLine;
property RegisterValueList: TDbgRegisterValueList read FRegisterValueList; property RegisterValueList: TDbgRegisterValueList read FRegisterValueList;
property ProcSymbol: TFpDbgSymbol read GetSymbol; property ProcSymbol: TFpSymbol read GetSymbol;
property Index: integer read FIndex; property Index: integer read FIndex;
end; end;
@ -296,7 +296,7 @@ type
function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload; function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload;
function AddrOffset: Int64; virtual; // gives the offset between the loaded addresses and the compiled addresses function AddrOffset: Int64; virtual; // gives the offset between the loaded addresses and the compiled addresses
function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; function FindSymbol(AAdress: TDbgPtr): TFpSymbol;
procedure LoadInfo; virtual; procedure LoadInfo; virtual;
property Process: TDbgProcess read FProcess; property Process: TDbgProcess read FProcess;
@ -370,8 +370,8 @@ type
destructor Destroy; override; destructor Destroy; override;
function AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload; function AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
function AddBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload; function AddBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload;
function FindSymbol(const AName: String): TFpDbgSymbol; function FindSymbol(const AName: String): TFpSymbol;
function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; function FindSymbol(AAdress: TDbgPtr): TFpSymbol;
function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean; function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean;
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean; function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
procedure RemoveBreak(const ABreakPoint: TFpInternalBreakpoint); procedure RemoveBreak(const ABreakPoint: TFpInternalBreakpoint);
@ -713,7 +713,7 @@ end;
{ TDbgCallstackEntry } { TDbgCallstackEntry }
function TDbgCallstackEntry.GetSymbol: TFpDbgSymbol; function TDbgCallstackEntry.GetSymbol: TFpSymbol;
begin begin
if not FIsSymbolResolved then begin if not FIsSymbolResolved then begin
if FIndex > 0 then if FIndex > 0 then
@ -727,7 +727,7 @@ end;
function TDbgCallstackEntry.GetFunctionName: string; function TDbgCallstackEntry.GetFunctionName: string;
var var
Symbol: TFpDbgSymbol; Symbol: TFpSymbol;
begin begin
Symbol := GetSymbol; Symbol := GetSymbol;
if assigned(Symbol) then if assigned(Symbol) then
@ -738,11 +738,11 @@ end;
function TDbgCallstackEntry.GetParamsAsString: string; function TDbgCallstackEntry.GetParamsAsString: string;
var var
ProcVal: TFpDbgValue; ProcVal: TFpValue;
InstrPointerValue: TDBGPtr; InstrPointerValue: TDBGPtr;
AContext: TFpDbgInfoContext; AContext: TFpDbgInfoContext;
APrettyPrinter: TFpPascalPrettyPrinter; APrettyPrinter: TFpPascalPrettyPrinter;
m: TFpDbgValue; m: TFpValue;
v: String; v: String;
i: Integer; i: Integer;
begin begin
@ -778,7 +778,7 @@ end;
function TDbgCallstackEntry.GetLine: integer; function TDbgCallstackEntry.GetLine: integer;
var var
Symbol: TFpDbgSymbol; Symbol: TFpSymbol;
begin begin
Symbol := GetSymbol; Symbol := GetSymbol;
if assigned(Symbol) then if assigned(Symbol) then
@ -789,7 +789,7 @@ end;
function TDbgCallstackEntry.GetSourceFile: string; function TDbgCallstackEntry.GetSourceFile: string;
var var
Symbol: TFpDbgSymbol; Symbol: TFpSymbol;
begin begin
Symbol := GetSymbol; Symbol := GetSymbol;
if assigned(Symbol) then if assigned(Symbol) then
@ -1005,7 +1005,7 @@ begin
inherited; inherited;
end; end;
function TDbgInstance.FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; function TDbgInstance.FindSymbol(AAdress: TDbgPtr): TFpSymbol;
begin begin
Result := FDbgInfo.FindSymbol(AAdress + AddrOffset); Result := FDbgInfo.FindSymbol(AAdress + AddrOffset);
if not assigned(Result) then if not assigned(Result) then
@ -1133,12 +1133,12 @@ begin
inherited; inherited;
end; end;
function TDbgProcess.FindSymbol(const AName: String): TFpDbgSymbol; function TDbgProcess.FindSymbol(const AName: String): TFpSymbol;
begin begin
Result := FDbgInfo.FindSymbol(AName); Result := FDbgInfo.FindSymbol(AName);
end; end;
function TDbgProcess.FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; function TDbgProcess.FindSymbol(AAdress: TDbgPtr): TFpSymbol;
var var
n: Integer; n: Integer;
Inst: TDbgInstance; Inst: TDbgInstance;
@ -1581,7 +1581,7 @@ end;
function TDbgThread.CompareStepInfo: TFPDCompareStepInfo; function TDbgThread.CompareStepInfo: TFPDCompareStepInfo;
var var
AnAddr: TDBGPtr; AnAddr: TDBGPtr;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
begin begin
AnAddr := GetInstructionPointerRegisterValue; AnAddr := GetInstructionPointerRegisterValue;
sym := FProcess.FindSymbol(AnAddr); sym := FProcess.FindSymbol(AnAddr);
@ -1603,7 +1603,7 @@ end;
function TDbgThread.IsAtStartOfLine: boolean; function TDbgThread.IsAtStartOfLine: boolean;
var var
AnAddr, b: TDBGPtr; AnAddr, b: TDBGPtr;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
CU: TDwarfCompilationUnit; CU: TDwarfCompilationUnit;
a: TDBGPtrArray; a: TDBGPtrArray;
begin begin
@ -1627,7 +1627,7 @@ end;
procedure TDbgThread.StoreStepInfo; procedure TDbgThread.StoreStepInfo;
var var
AnAddr: TDBGPtr; AnAddr: TDBGPtr;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
begin begin
FStoreStepStackFrame := GetStackBasePointerRegisterValue; FStoreStepStackFrame := GetStackBasePointerRegisterValue;
AnAddr := GetInstructionPointerRegisterValue; AnAddr := GetInstructionPointerRegisterValue;

1666
components/fpdebug/fpdbgdwarf.pas
View File

File diff suppressed because it is too large Load Diff

80
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -453,45 +453,45 @@ type
end; end;
TDbgDwarfSymbolBaseClass = class of TDbgDwarfSymbolBase; TDbgDwarfSymbolBaseClass = class of TDbgDwarfSymbolBase;
{ TFpDwarfSymbolClassMap { TFpSymbolDwarfClassMap
Provides Symbol and VAlue evaluation classes depending on the compiler Provides Symbol and VAlue evaluation classes depending on the compiler
} }
PFpDwarfSymbolClassMap = ^TFpDwarfSymbolClassMap; PFpDwarfSymbolClassMap = ^TFpSymbolDwarfClassMap;
TFpDwarfSymbolClassMap = class TFpSymbolDwarfClassMap = class
private private
NextExistingClassMap: TFpDwarfSymbolClassMap; NextExistingClassMap: TFpSymbolDwarfClassMap;
protected protected
function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; virtual; function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; virtual;
class function GetExistingClassMap: PFpDwarfSymbolClassMap; virtual; abstract; // Each class must have its own storage class function GetExistingClassMap: PFpDwarfSymbolClassMap; virtual; abstract; // Each class must have its own storage
class function DoGetInstanceForCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpDwarfSymbolClassMap; class function DoGetInstanceForCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpSymbolDwarfClassMap;
public public
class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; virtual; class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap; virtual;
class procedure FreeAllInstances; class procedure FreeAllInstances;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; virtual; abstract; class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; virtual; abstract;
public public
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); virtual; constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); virtual;
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract; function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpSymbol;
ADwarf: TFpDwarfInfo): TFpDbgInfoContext; virtual; abstract; ADwarf: TFpDwarfInfo): TFpDbgInfoContext; virtual; abstract;
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; virtual; abstract; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; virtual; abstract;
end; end;
TFpDwarfSymbolClassMapClass = class of TFpDwarfSymbolClassMap; TFpSymbolDwarfClassMapClass = class of TFpSymbolDwarfClassMap;
{ TFpDwarfSymbolClassMapList } { TFpSymbolDwarfClassMapList }
TFpDwarfSymbolClassMapList = class TFpSymbolDwarfClassMapList = class
private private
FDefaultMap: TFpDwarfSymbolClassMapClass; FDefaultMap: TFpSymbolDwarfClassMapClass;
FMapList: array of TFpDwarfSymbolClassMapClass; FMapList: array of TFpSymbolDwarfClassMapClass;
public public
destructor Destroy; override; destructor Destroy; override;
function FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; function FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
procedure FreeAllInstances; procedure FreeAllInstances;
procedure AddMap(AMap: TFpDwarfSymbolClassMapClass); procedure AddMap(AMap: TFpSymbolDwarfClassMapClass);
procedure SetDefaultMap(AMap: TFpDwarfSymbolClassMapClass); procedure SetDefaultMap(AMap: TFpSymbolDwarfClassMapClass);
end; end;
{%endregion Base classes for handling Symbols in unit FPDbgDwarf} {%endregion Base classes for handling Symbols in unit FPDbgDwarf}
@ -516,7 +516,7 @@ type
private private
FOwner: TFpDwarfInfo; FOwner: TFpDwarfInfo;
FDebugFile: PDwarfDebugFile; FDebugFile: PDwarfDebugFile;
FDwarfSymbolClassMap: TFpDwarfSymbolClassMap; FDwarfSymbolClassMap: TFpSymbolDwarfClassMap;
FValid: Boolean; // set if the compilationunit has compile unit tag. FValid: Boolean; // set if the compilationunit has compile unit tag.
// --- Header --- // --- Header ---
@ -625,7 +625,7 @@ type
property Owner: TFpDwarfInfo read FOwner; property Owner: TFpDwarfInfo read FOwner;
property DebugFile: PDwarfDebugFile read FDebugFile; property DebugFile: PDwarfDebugFile read FDebugFile;
property DwarfSymbolClassMap: TFpDwarfSymbolClassMap read FDwarfSymbolClassMap; property DwarfSymbolClassMap: TFpSymbolDwarfClassMap read FDwarfSymbolClassMap;
property FirstScope: TDwarfScopeInfo read FScope; property FirstScope: TDwarfScopeInfo read FScope;
// public for FpDbgDwarfVerbosePrinter // public for FpDbgDwarfVerbosePrinter
@ -655,7 +655,7 @@ type
destructor Destroy; override; destructor Destroy; override;
function FindContext(AThreadId, AStackFrame: Integer; AAddress: TDbgPtr = 0): TFpDbgInfoContext; override; function FindContext(AThreadId, AStackFrame: Integer; AAddress: TDbgPtr = 0): TFpDbgInfoContext; override;
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override; function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override;
function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override; function FindSymbol(AAddress: TDbgPtr): TFpSymbol; override;
//function FindSymbol(const AName: String): TDbgSymbol; override; //function FindSymbol(const AName: String): TDbgSymbol; override;
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; override; function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; override;
function GetLineAddressMap(const AFileName: String): PDWarfLineMap; function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
@ -734,9 +734,9 @@ function Dbgs(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String
function Dbgs(AInfoEntry: TDwarfInformationEntry; ACompUnit: TDwarfCompilationUnit): String; overload; function Dbgs(AInfoEntry: TDwarfInformationEntry; ACompUnit: TDwarfCompilationUnit): String; overload;
function DbgsDump(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String; overload; function DbgsDump(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String; overload;
function GetDwarfSymbolClassMapList: TFpDwarfSymbolClassMapList; inline; function GetDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList; inline;
property DwarfSymbolClassMapList: TFpDwarfSymbolClassMapList read GetDwarfSymbolClassMapList; property DwarfSymbolClassMapList: TFpSymbolDwarfClassMapList read GetDwarfSymbolClassMapList;
implementation implementation
@ -746,12 +746,12 @@ var
FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup; FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup;
var var
TheDwarfSymbolClassMapList: TFpDwarfSymbolClassMapList; TheDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
const const
SCOPE_ALLOC_BLOCK_SIZE = 4096; // Increase scopelist in steps of SCOPE_ALLOC_BLOCK_SIZE = 4096; // Increase scopelist in steps of
function GetDwarfSymbolClassMapList: TFpDwarfSymbolClassMapList; function GetDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
begin begin
Result := TheDwarfSymbolClassMapList; Result := TheDwarfSymbolClassMapList;
end; end;
@ -913,17 +913,17 @@ begin
end; end;
{ TFpDwarfSymbolClassMap } { TFpSymbolDwarfClassMap }
class function TFpDwarfSymbolClassMap.GetInstanceForCompUnit( class function TFpSymbolDwarfClassMap.GetInstanceForCompUnit(
ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
begin begin
Result := DoGetInstanceForCompUnit(ACU, nil); Result := DoGetInstanceForCompUnit(ACU, nil);
end; end;
class procedure TFpDwarfSymbolClassMap.FreeAllInstances; class procedure TFpSymbolDwarfClassMap.FreeAllInstances;
var var
pm, next: TFpDwarfSymbolClassMap; pm, next: TFpSymbolDwarfClassMap;
begin begin
pm := GetExistingClassMap^; pm := GetExistingClassMap^;
while pm <> nil do begin while pm <> nil do begin
@ -934,20 +934,20 @@ begin
GetExistingClassMap^ := nil; GetExistingClassMap^ := nil;
end; end;
constructor TFpDwarfSymbolClassMap.Create(ACU: TDwarfCompilationUnit; constructor TFpSymbolDwarfClassMap.Create(ACU: TDwarfCompilationUnit;
AHelperData: Pointer); AHelperData: Pointer);
begin begin
inherited Create; inherited Create;
end; end;
function TFpDwarfSymbolClassMap.CanHandleCompUnit(ACU: TDwarfCompilationUnit; function TFpSymbolDwarfClassMap.CanHandleCompUnit(ACU: TDwarfCompilationUnit;
AHelperData: Pointer): Boolean; AHelperData: Pointer): Boolean;
begin begin
Result := True; Result := True;
end; end;
class function TFpDwarfSymbolClassMap.DoGetInstanceForCompUnit( class function TFpSymbolDwarfClassMap.DoGetInstanceForCompUnit(
ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpDwarfSymbolClassMap; ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpSymbolDwarfClassMap;
var var
pm: PFpDwarfSymbolClassMap; pm: PFpDwarfSymbolClassMap;
begin begin
@ -3207,7 +3207,7 @@ begin
result := FindContext(1, 0, AAddress); result := FindContext(1, 0, AAddress);
end; end;
function TFpDwarfInfo.FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; function TFpDwarfInfo.FindSymbol(AAddress: TDbgPtr): TFpSymbol;
begin begin
Result := FindProcSymbol(AAddress); Result := FindProcSymbol(AAddress);
end; end;
@ -3594,18 +3594,18 @@ begin
else FFileName := Format('Unknown fileindex(%u)', [AIndex]); else FFileName := Format('Unknown fileindex(%u)', [AIndex]);
end; end;
{ TFpDwarfSymbolClassMapList } { TFpSymbolDwarfClassMapList }
destructor TFpDwarfSymbolClassMapList.Destroy; destructor TFpSymbolDwarfClassMapList.Destroy;
begin begin
FreeAllInstances; FreeAllInstances;
inherited Destroy; inherited Destroy;
end; end;
function TFpDwarfSymbolClassMapList.FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; function TFpSymbolDwarfClassMapList.FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
var var
i: Integer; i: Integer;
ResClass: TFpDwarfSymbolClassMapClass; ResClass: TFpSymbolDwarfClassMapClass;
begin begin
ResClass := FDefaultMap; ResClass := FDefaultMap;
for i := 0 to length(FMapList) - 1 do for i := 0 to length(FMapList) - 1 do
@ -3616,7 +3616,7 @@ begin
Result := ResClass.GetInstanceForCompUnit(ACU); Result := ResClass.GetInstanceForCompUnit(ACU);
end; end;
procedure TFpDwarfSymbolClassMapList.FreeAllInstances; procedure TFpSymbolDwarfClassMapList.FreeAllInstances;
var var
i: Integer; i: Integer;
begin begin
@ -3624,7 +3624,7 @@ begin
FMapList[i].FreeAllInstances; FMapList[i].FreeAllInstances;
end; end;
procedure TFpDwarfSymbolClassMapList.AddMap(AMap: TFpDwarfSymbolClassMapClass); procedure TFpSymbolDwarfClassMapList.AddMap(AMap: TFpSymbolDwarfClassMapClass);
var var
l: Integer; l: Integer;
begin begin
@ -3633,7 +3633,7 @@ begin
FMapList[l] := AMap; FMapList[l] := AMap;
end; end;
procedure TFpDwarfSymbolClassMapList.SetDefaultMap(AMap: TFpDwarfSymbolClassMapClass); procedure TFpSymbolDwarfClassMapList.SetDefaultMap(AMap: TFpSymbolDwarfClassMapClass);
begin begin
FDefaultMap := AMap; FDefaultMap := AMap;
end; end;
@ -4618,7 +4618,7 @@ begin
end; end;
initialization initialization
TheDwarfSymbolClassMapList := TFpDwarfSymbolClassMapList.Create; TheDwarfSymbolClassMapList := TFpSymbolDwarfClassMapList.Create;
FPDBG_DWARF_ERRORS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} ); FPDBG_DWARF_ERRORS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} );
FPDBG_DWARF_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} ); FPDBG_DWARF_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} );

254
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -18,14 +18,14 @@ type
TFpDwarfFreePascalSymbolClassMap = class(TFpDwarfDefaultSymbolClassMap) TFpDwarfFreePascalSymbolClassMap = class(TFpDwarfDefaultSymbolClassMap)
strict private strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap; class var ExistingClassMap: TFpSymbolDwarfClassMap;
protected protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override; class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public public
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override; class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public public
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override; function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol; function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpSymbol;
ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override; ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
// AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override; // AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
@ -35,14 +35,14 @@ type
TFpDwarfFreePascalSymbolClassMapDwarf2 = class(TFpDwarfFreePascalSymbolClassMap) TFpDwarfFreePascalSymbolClassMapDwarf2 = class(TFpDwarfFreePascalSymbolClassMap)
strict private strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap; class var ExistingClassMap: TFpSymbolDwarfClassMap;
protected protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override; class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public public
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override; class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public public
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override; function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
//class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol; //class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpSymbol;
// ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override; // ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
// AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override; // AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
@ -52,19 +52,19 @@ type
TFpDwarfFreePascalSymbolClassMapDwarf3 = class(TFpDwarfFreePascalSymbolClassMap) TFpDwarfFreePascalSymbolClassMapDwarf3 = class(TFpDwarfFreePascalSymbolClassMap)
strict private strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap; class var ExistingClassMap: TFpSymbolDwarfClassMap;
private private
FCompilerVersion: Cardinal; FCompilerVersion: Cardinal;
protected protected
function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; override; function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; override;
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override; class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public public
class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; override; class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap; override;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override; class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public public
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); override; constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); override;
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override; function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
//class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol; //class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpSymbol;
// ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override; // ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
// AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override; // AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
@ -81,7 +81,7 @@ type
FOuterNotFound: Boolean; FOuterNotFound: Boolean;
protected protected
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar; function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; override; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; override;
public public
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -91,76 +91,76 @@ type
(* *** Record vs ShortString *** *) (* *** Record vs ShortString *** *)
{ TFpDwarf2FreePascalSymbolTypeStructure } { TFpSymbolDwarfV2FreePascalTypeStructure }
TFpDwarf2FreePascalSymbolTypeStructure = class(TFpDwarfSymbolTypeStructure) TFpSymbolDwarfV2FreePascalTypeStructure = class(TFpSymbolDwarfTypeStructure)
private private
FIsShortString: (issUnknown, issShortString, issStructure); FIsShortString: (issUnknown, issShortString, issStructure);
function IsShortString: Boolean; function IsShortString: Boolean;
protected protected
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override; function GetTypedValueObject(ATypeCast: Boolean): TFpValueDwarf; override;
procedure KindNeeded; override; procedure KindNeeded; override;
function GetMemberCount: Integer; override; function GetMemberCount: Integer; override;
//function GetMemberByName(AIndex: String): TFpDbgSymbol; override; //function GetMemberByName(AIndex: String): TFpSymbol; override;
end; end;
{ TFpDwarfV2ValueFreePascalShortString } { TFpValueDwarfV2FreePascalShortString }
TFpDwarfV2ValueFreePascalShortString = class(TFpDwarfValue) TFpValueDwarfV2FreePascalShortString = class(TFpValueDwarf)
protected protected
function IsValidTypeCast: Boolean; override; function IsValidTypeCast: Boolean; override;
function GetInternMemberByName(AIndex: String): TFpDbgValue; function GetInternMemberByName(AIndex: String): TFpValue;
procedure Reset; override; procedure Reset; override;
private private
FValue: String; FValue: String;
FValueDone: Boolean; FValueDone: Boolean;
protected protected
function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsString: AnsiString; override; function GetAsString: AnsiString; override;
function GetAsWideString: WideString; override; function GetAsWideString: WideString; override;
end; end;
(* *** "Open Array" in params *** *) (* *** "Open Array" in params *** *)
{ TFpDwarfFreePascalSymbolTypeArray } { TFpSymbolDwarfFreePascalSymbolTypeArray }
TFpDwarfFreePascalSymbolTypeArray = class(TFpDwarfSymbolTypeArray) TFpSymbolDwarfFreePascalSymbolTypeArray = class(TFpSymbolDwarfTypeArray)
protected protected
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override; function GetTypedValueObject(ATypeCast: Boolean): TFpValueDwarf; override;
end; end;
{ TFpDwarfValueFreePascalArray } { TFpValueDwarfFreePascalArray }
TFpDwarfValueFreePascalArray = class(TFpDwarfValueArray) TFpValueDwarfFreePascalArray = class(TFpValueDwarfArray)
protected protected
function GetMemberCount: Integer; override; function GetMemberCount: Integer; override;
end; end;
(* *** Array vs AnsiString *** *) (* *** Array vs AnsiString *** *)
{ TFpDwarfV3FreePascalSymbolTypeArray } { TFpSymbolDwarfV3FreePascalSymbolTypeArray }
TFpDwarfV3FreePascalSymbolTypeArray = class(TFpDwarfFreePascalSymbolTypeArray) TFpSymbolDwarfV3FreePascalSymbolTypeArray = class(TFpSymbolDwarfFreePascalSymbolTypeArray)
private type private type
TArrayOrStringType = (iasUnknown, iasArray, iasShortString, iasAnsiString, iasUnicodeString); TArrayOrStringType = (iasUnknown, iasArray, iasShortString, iasAnsiString, iasUnicodeString);
private private
FArrayOrStringType: TArrayOrStringType; FArrayOrStringType: TArrayOrStringType;
function GetInternalStringType: TArrayOrStringType; function GetInternalStringType: TArrayOrStringType;
protected protected
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override; function GetTypedValueObject(ATypeCast: Boolean): TFpValueDwarf; override;
procedure KindNeeded; override; procedure KindNeeded; override;
end; end;
{ TFpDwarfV3ValueFreePascalString } { TFpValueDwarfV3FreePascalString }
TFpDwarfV3ValueFreePascalString = class(TFpDwarfValue) // short & ansi... TFpValueDwarfV3FreePascalString = class(TFpValueDwarf) // short & ansi...
private private
FValue: String; FValue: String;
FValueDone: Boolean; FValueDone: Boolean;
protected protected
function IsValidTypeCast: Boolean; override; function IsValidTypeCast: Boolean; override;
procedure Reset; override; procedure Reset; override;
function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsString: AnsiString; override; function GetAsString: AnsiString; override;
function GetAsWideString: WideString; override; function GetAsWideString: WideString; override;
end; end;
@ -187,14 +187,14 @@ function TFpDwarfFreePascalSymbolClassMap.GetDwarfSymbolClass(
begin begin
case ATag of case ATag of
DW_TAG_array_type: DW_TAG_array_type:
Result := TFpDwarfFreePascalSymbolTypeArray; Result := TFpSymbolDwarfFreePascalSymbolTypeArray;
else else
Result := inherited GetDwarfSymbolClass(ATag); Result := inherited GetDwarfSymbolClass(ATag);
end; end;
end; end;
function TFpDwarfFreePascalSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer; function TFpDwarfFreePascalSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext; AnAddress: TDBGPtr; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext;
begin begin
Result := TFpDwarfFreePascalAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf); Result := TFpDwarfFreePascalAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf);
end; end;
@ -218,19 +218,19 @@ function TFpDwarfFreePascalSymbolClassMapDwarf2.GetDwarfSymbolClass(
begin begin
case ATag of case ATag of
DW_TAG_structure_type: DW_TAG_structure_type:
Result := TFpDwarf2FreePascalSymbolTypeStructure; // maybe record Result := TFpSymbolDwarfV2FreePascalTypeStructure; // maybe record
// // TODO: // // TODO:
// //DW_TAG_reference_type: Result := TFpDwarfSymbolTypeRef; // //DW_TAG_reference_type: Result := TFpSymbolDwarfTypeRef;
// //DW_TAG_typedef: Result := TFpDwarfSymbolTypeDeclaration; // //DW_TAG_typedef: Result := TFpSymbolDwarfTypeDeclaration;
// //DW_TAG_pointer_type: Result := TFpDwarfSymbolTypePointer; // //DW_TAG_pointer_type: Result := TFpSymbolDwarfTypePointer;
// // // //
// //DW_TAG_base_type: Result := TFpDwarfSymbolTypeBasic; // //DW_TAG_base_type: Result := TFpSymbolDwarfTypeBasic;
// //DW_TAG_subrange_type: Result := TFpDwarfSymbolTypeSubRange; // //DW_TAG_subrange_type: Result := TFpSymbolDwarfTypeSubRange;
// //DW_TAG_enumeration_type: Result := TFpDwarfSymbolTypeEnum; // //DW_TAG_enumeration_type: Result := TFpSymbolDwarfTypeEnum;
// //DW_TAG_enumerator: Result := TFpDwarfSymbolValueEnumMember; // //DW_TAG_enumerator: Result := TFpSymbolDwarfDataEnumMember;
// //DW_TAG_array_type: Result := TFpDwarfSymbolTypeArray; // //DW_TAG_array_type: Result := TFpSymbolDwarfTypeArray;
// //// // ////
// //DW_TAG_compile_unit: Result := TFpDwarfSymbolUnit; // //DW_TAG_compile_unit: Result := TFpSymbolDwarfUnit;
// //
else else
Result := inherited GetDwarfSymbolClass(ATag); Result := inherited GetDwarfSymbolClass(ATag);
@ -252,7 +252,7 @@ begin
end; end;
class function TFpDwarfFreePascalSymbolClassMapDwarf3.GetInstanceForCompUnit( class function TFpDwarfFreePascalSymbolClassMapDwarf3.GetInstanceForCompUnit(
ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
var var
s: String; s: String;
i, j, v: Integer; i, j, v: Integer;
@ -316,21 +316,21 @@ function TFpDwarfFreePascalSymbolClassMapDwarf3.GetDwarfSymbolClass(
begin begin
case ATag of case ATag of
DW_TAG_array_type: DW_TAG_array_type:
Result := TFpDwarfV3FreePascalSymbolTypeArray; Result := TFpSymbolDwarfV3FreePascalSymbolTypeArray;
// DW_TAG_structure_type: // DW_TAG_structure_type:
// Result := TFpDwarf2FreePascalSymbolTypeStructure; // maybe record // Result := TFpSymbolDwarfV2FreePascalTypeStructure; // maybe record
// // TODO: // // TODO:
// //DW_TAG_reference_type: Result := TFpDwarfSymbolTypeRef; // //DW_TAG_reference_type: Result := TFpSymbolDwarfTypeRef;
// //DW_TAG_typedef: Result := TFpDwarfSymbolTypeDeclaration; // //DW_TAG_typedef: Result := TFpSymbolDwarfTypeDeclaration;
// //DW_TAG_pointer_type: Result := TFpDwarfSymbolTypePointer; // //DW_TAG_pointer_type: Result := TFpSymbolDwarfTypePointer;
// // // //
// //DW_TAG_base_type: Result := TFpDwarfSymbolTypeBasic; // //DW_TAG_base_type: Result := TFpSymbolDwarfTypeBasic;
// //DW_TAG_subrange_type: Result := TFpDwarfSymbolTypeSubRange; // //DW_TAG_subrange_type: Result := TFpSymbolDwarfTypeSubRange;
// //DW_TAG_enumeration_type: Result := TFpDwarfSymbolTypeEnum; // //DW_TAG_enumeration_type: Result := TFpSymbolDwarfTypeEnum;
// //DW_TAG_enumerator: Result := TFpDwarfSymbolValueEnumMember; // //DW_TAG_enumerator: Result := TFpSymbolDwarfDataEnumMember;
// //DW_TAG_array_type: Result := TFpDwarfSymbolTypeArray; // //DW_TAG_array_type: Result := TFpSymbolDwarfTypeArray;
// //// // ////
// //DW_TAG_compile_unit: Result := TFpDwarfSymbolUnit; // //DW_TAG_compile_unit: Result := TFpSymbolDwarfUnit;
// //
else else
Result := inherited GetDwarfSymbolClass(ATag); Result := inherited GetDwarfSymbolClass(ATag);
@ -340,7 +340,7 @@ end;
{ TFpDwarfFreePascalAddressContext } { TFpDwarfFreePascalAddressContext }
function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper, function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean;
const const
parentfp: string = 'parentfp'; parentfp: string = 'parentfp';
parentfp2: string = '$parentfp'; parentfp2: string = '$parentfp';
@ -352,11 +352,11 @@ const
RegPc32 = 8; RegPc32 = 8;
var var
StartScopeIdx, RegFp, RegPc: Integer; StartScopeIdx, RegFp, RegPc: Integer;
ParentFpVal: TFpDbgValue; ParentFpVal: TFpValue;
SearchCtx: TFpDwarfFreePascalAddressContext; SearchCtx: TFpDwarfFreePascalAddressContext;
par_fp, cur_fp, prev_fp, pc: TDbgPtr; par_fp, cur_fp, prev_fp, pc: TDbgPtr;
d, i: Integer; d, i: Integer;
ParentFpSym: TFpDwarfSymbol; ParentFpSym: TFpSymbolDwarf;
begin begin
if Dwarf.Image64Bit then begin if Dwarf.Image64Bit then begin
RegFP := RegFp64; RegFP := RegFp64;
@ -402,10 +402,10 @@ begin
end; end;
end; end;
ParentFpSym := TFpDwarfSymbol.CreateSubClass(AName, InfoEntry); ParentFpSym := TFpSymbolDwarf.CreateSubClass(AName, InfoEntry);
ParentFpVal := ParentFpSym.Value; ParentFpVal := ParentFpSym.Value;
ApplyContext(ParentFpVal); ApplyContext(ParentFpVal);
//TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol); //TFpSymbolDwarf(ADbgValue.DbgSymbol).ParentTypeInfo := TFpSymbolDwarfDataProc(FSymbol);
if not (svfOrdinal in ParentFpVal.FieldFlags) then begin if not (svfOrdinal in ParentFpVal.FieldFlags) then begin
DebugLn('no ordinal for parentfp'); DebugLn('no ordinal for parentfp');
ParentFpSym.ReleaseReference; ParentFpSym.ReleaseReference;
@ -469,11 +469,11 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{ TFpDwarf2FreePascalSymbolTypeStructure } { TFpSymbolDwarfV2FreePascalTypeStructure }
function TFpDwarf2FreePascalSymbolTypeStructure.IsShortString: Boolean; function TFpSymbolDwarfV2FreePascalTypeStructure.IsShortString: Boolean;
var var
LenSym, StSym, StSymType: TFpDbgSymbol; LenSym, StSym, StSymType: TFpSymbol;
begin begin
if FIsShortString <> issUnknown then if FIsShortString <> issUnknown then
exit(FIsShortString = issShortString); exit(FIsShortString = issShortString);
@ -492,11 +492,11 @@ begin
if (StSym = nil) then if (StSym = nil) then
exit; exit;
StSymType := StSym.TypeInfo; StSymType := StSym.TypeInfo;
if (StSymType = nil) or (StSymType.Kind <> skArray) or not (StSymType is TFpDwarfSymbolTypeArray) then if (StSymType = nil) or (StSymType.Kind <> skArray) or not (StSymType is TFpSymbolDwarfTypeArray) then
exit; exit;
// If it were a user declared array, fpc puts the stride in the subrange // If it were a user declared array, fpc puts the stride in the subrange
if not TFpDwarfSymbolTypeArray(StSymType).InformationEntry.HasAttrib(DW_AT_byte_stride) then if not TFpSymbolDwarfTypeArray(StSymType).InformationEntry.HasAttrib(DW_AT_byte_stride) then
exit; exit;
// check the subrange? // check the subrange?
@ -504,16 +504,16 @@ begin
Result := True; Result := True;
end; end;
function TFpDwarf2FreePascalSymbolTypeStructure.GetTypedValueObject( function TFpSymbolDwarfV2FreePascalTypeStructure.GetTypedValueObject(
ATypeCast: Boolean): TFpDwarfValue; ATypeCast: Boolean): TFpValueDwarf;
begin begin
if not IsShortString then if not IsShortString then
Result := inherited GetTypedValueObject(ATypeCast) Result := inherited GetTypedValueObject(ATypeCast)
else else
Result := TFpDwarfV2ValueFreePascalShortString.Create(Self); Result := TFpValueDwarfV2FreePascalShortString.Create(Self);
end; end;
procedure TFpDwarf2FreePascalSymbolTypeStructure.KindNeeded; procedure TFpSymbolDwarfV2FreePascalTypeStructure.KindNeeded;
begin begin
if not IsShortString then if not IsShortString then
inherited KindNeeded inherited KindNeeded
@ -521,7 +521,7 @@ begin
SetKind(skString); SetKind(skString);
end; end;
function TFpDwarf2FreePascalSymbolTypeStructure.GetMemberCount: Integer; function TFpSymbolDwarfV2FreePascalTypeStructure.GetMemberCount: Integer;
begin begin
if IsShortString then if IsShortString then
Result := 0 Result := 0
@ -529,57 +529,57 @@ begin
Result := inherited GetMemberCount; Result := inherited GetMemberCount;
end; end;
{ TFpDwarfV2ValueFreePascalShortString } { TFpValueDwarfV2FreePascalShortString }
function TFpDwarfV2ValueFreePascalShortString.IsValidTypeCast: Boolean; function TFpValueDwarfV2FreePascalShortString.IsValidTypeCast: Boolean;
begin begin
// currently only allow this / used by array access // currently only allow this / used by array access
Result := TypeCastSourceValue is TFpDbgValueConstAddress; Result := TypeCastSourceValue is TFpValueConstAddress;
end; end;
function TFpDwarfV2ValueFreePascalShortString.GetInternMemberByName( function TFpValueDwarfV2FreePascalShortString.GetInternMemberByName(
AIndex: String): TFpDbgValue; AIndex: String): TFpValue;
var var
tmp: TFpDbgSymbol; tmp: TFpSymbol;
begin begin
if HasTypeCastInfo then begin if HasTypeCastInfo then begin
Result := nil; Result := nil;
tmp := TypeCastTargetType.MemberByName[AIndex]; tmp := TypeCastTargetType.MemberByName[AIndex];
if (tmp <> nil) then begin if (tmp <> nil) then begin
assert((tmp is TFpDwarfSymbolValue), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp)); assert((tmp is TFpSymbolDwarfData), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp));
Result := tmp.Value; Result := tmp.Value;
TFpDwarfValue(Result).StructureValue := Self; TFpValueDwarf(Result).StructureValue := Self;
if (TFpDwarfValue(Result).Context = nil) then if (TFpValueDwarf(Result).Context = nil) then
TFpDwarfValue(Result).Context := Context; TFpValueDwarf(Result).Context := Context;
end; end;
end end
else else
Result := MemberByName[AIndex]; Result := MemberByName[AIndex];
end; end;
procedure TFpDwarfV2ValueFreePascalShortString.Reset; procedure TFpValueDwarfV2FreePascalShortString.Reset;
begin begin
inherited Reset; inherited Reset;
FValueDone := False; FValueDone := False;
end; end;
function TFpDwarfV2ValueFreePascalShortString.GetFieldFlags: TFpDbgValueFieldFlags; function TFpValueDwarfV2FreePascalShortString.GetFieldFlags: TFpValueFieldFlags;
begin begin
Result := inherited GetFieldFlags; Result := inherited GetFieldFlags;
Result := Result + [svfString]; Result := Result + [svfString];
end; end;
function TFpDwarfV2ValueFreePascalShortString.GetAsString: AnsiString; function TFpValueDwarfV2FreePascalShortString.GetAsString: AnsiString;
var var
len: QWord; len: QWord;
LenSym, StSym: TFpDwarfValue; LenSym, StSym: TFpValueDwarf;
begin begin
if FValueDone then if FValueDone then
exit(FValue); exit(FValue);
LenSym := TFpDwarfValue(GetInternMemberByName('length')); LenSym := TFpValueDwarf(GetInternMemberByName('length'));
assert(LenSym is TFpDwarfValue, 'LenSym is TFpDwarfValue'); assert(LenSym is TFpValueDwarf, 'LenSym is TFpValueDwarf');
len := LenSym.AsCardinal; len := LenSym.AsCardinal;
if (TypeInfo.Size < 0) or (len > TypeInfo.Size) then begin if (TypeInfo.Size < 0) or (len > TypeInfo.Size) then begin
@ -587,8 +587,8 @@ begin
exit(''); exit('');
end; end;
StSym := TFpDwarfValue(GetInternMemberByName('st')); StSym := TFpValueDwarf(GetInternMemberByName('st'));
assert(StSym is TFpDwarfValue, 'StSym is TFpDwarfValue'); assert(StSym is TFpValueDwarf, 'StSym is TFpValueDwarf');
@ -604,28 +604,28 @@ begin
FValueDone := True; FValueDone := True;
end; end;
function TFpDwarfV2ValueFreePascalShortString.GetAsWideString: WideString; function TFpValueDwarfV2FreePascalShortString.GetAsWideString: WideString;
begin begin
Result := GetAsString; Result := GetAsString;
end; end;
{ TFpDwarfFreePascalSymbolTypeArray } { TFpSymbolDwarfFreePascalSymbolTypeArray }
function TFpDwarfFreePascalSymbolTypeArray.GetTypedValueObject( function TFpSymbolDwarfFreePascalSymbolTypeArray.GetTypedValueObject(
ATypeCast: Boolean): TFpDwarfValue; ATypeCast: Boolean): TFpValueDwarf;
begin begin
Result := TFpDwarfValueFreePascalArray.Create(Self); Result := TFpValueDwarfFreePascalArray.Create(Self);
end; end;
{ TFpDwarfValueFreePascalArray } { TFpValueDwarfFreePascalArray }
function TFpDwarfValueFreePascalArray.GetMemberCount: Integer; function TFpValueDwarfFreePascalArray.GetMemberCount: Integer;
var var
t, t2: TFpDbgSymbol; t, t2: TFpSymbol;
Info: TDwarfInformationEntry; Info: TDwarfInformationEntry;
n: AnsiString; n: AnsiString;
UpperBoundSym: TFpDwarfSymbol; UpperBoundSym: TFpSymbolDwarf;
val: TFpDbgValue; val: TFpValue;
l, h: Int64; l, h: Int64;
Addr: TFpDbgMemLocation; Addr: TFpDbgMemLocation;
begin begin
@ -635,23 +635,23 @@ begin
exit(inherited GetMemberCount); exit(inherited GetMemberCount);
t2 := t.Member[0]; // IndexType[0]; t2 := t.Member[0]; // IndexType[0];
if not (t2 is TFpDwarfSymbolTypeSubRange) then if not (t2 is TFpSymbolDwarfTypeSubRange) then
exit(inherited GetMemberCount); exit(inherited GetMemberCount);
TFpDwarfSymbolTypeSubRange(t2).GetValueBounds(Self, l, h); TFpSymbolDwarfTypeSubRange(t2).GetValueBounds(Self, l, h);
if (l <> 0) or if (l <> 0) or
(TFpDwarfSymbolTypeSubRange(t2).LowBoundState <> rfConst) or (TFpSymbolDwarfTypeSubRange(t2).LowBoundState <> rfConst) or
(TFpDwarfSymbolTypeSubRange(t2).HighBoundState <> rfNotFound) or (TFpSymbolDwarfTypeSubRange(t2).HighBoundState <> rfNotFound) or
(TFpDwarfSymbolTypeSubRange(t2).CountState <> rfNotFound) (TFpSymbolDwarfTypeSubRange(t2).CountState <> rfNotFound)
then then
exit(inherited GetMemberCount); exit(inherited GetMemberCount);
// Check for open array param // Check for open array param
if (t is TFpDwarfSymbolTypeArray) and if (t is TFpSymbolDwarfTypeArray) and
(DbgSymbol is TFpDwarfSymbolValueParameter) // open array exists only as param (DbgSymbol is TFpSymbolDwarfDataParameter) // open array exists only as param
then begin then begin
Info := TFpDwarfSymbolValueParameter(DbgSymbol).InformationEntry.Clone; Info := TFpSymbolDwarfDataParameter(DbgSymbol).InformationEntry.Clone;
Info.GoNext; Info.GoNext;
if Info.HasValidScope and if Info.HasValidScope and
Info.HasAttrib(DW_AT_location) and // the high param must have a location / cannot be a constant Info.HasAttrib(DW_AT_location) and // the high param must have a location / cannot be a constant
@ -660,10 +660,10 @@ begin
if (n <> '') and (n[1] = '$') then // dwarf3 // TODO: make required in dwarf3 if (n <> '') and (n[1] = '$') then // dwarf3 // TODO: make required in dwarf3
delete(n, 1, 1); delete(n, 1, 1);
if (copy(n,1,4) = 'high') and (UpperCase(copy(n, 5, length(n))) = UpperCase(DbgSymbol.Name)) then begin if (copy(n,1,4) = 'high') and (UpperCase(copy(n, 5, length(n))) = UpperCase(DbgSymbol.Name)) then begin
UpperBoundSym := TFpDwarfSymbol.CreateSubClass('', Info); UpperBoundSym := TFpSymbolDwarf.CreateSubClass('', Info);
if UpperBoundSym <> nil then begin if UpperBoundSym <> nil then begin
val := UpperBoundSym.Value; val := UpperBoundSym.Value;
TFpDwarfValue(val).Context := Context; TFpValueDwarf(val).Context := Context;
//l := t2.OrdLowBound; //l := t2.OrdLowBound;
h := Val.AsInteger; h := Val.AsInteger;
if h > l then begin if h > l then begin
@ -686,12 +686,12 @@ begin
// dynamic array // dynamic array
if (sfDynArray in t.Flags) and (AsCardinal <> 0) and if (sfDynArray in t.Flags) and (AsCardinal <> 0) and
GetDwarfDataAddress(Addr, TFpDwarfSymbolType(Owner)) GetDwarfDataAddress(Addr, TFpSymbolDwarfType(Owner))
then begin then begin
if not (IsReadableMem(Addr) and (LocToAddr(Addr) > AddressSize)) then if not (IsReadableMem(Addr) and (LocToAddr(Addr) > AddressSize)) then
exit(0); // dyn array, but bad data exit(0); // dyn array, but bad data
Addr.Address := Addr.Address - AddressSize; Addr.Address := Addr.Address - AddressSize;
//debugln(['TFpDwarfValueArray.GetMemberCount XXXXXXXXXXXXXXX dwarf 2 read len']); //debugln(['TFpValueDwarfArray.GetMemberCount XXXXXXXXXXXXXXX dwarf 2 read len']);
if MemManager.ReadSignedInt(Addr, AddressSize, h) then begin if MemManager.ReadSignedInt(Addr, AddressSize, h) then begin
Result := Integer(h)+1; Result := Integer(h)+1;
exit; exit;
@ -706,13 +706,13 @@ begin
Result := inherited GetMemberCount; Result := inherited GetMemberCount;
end; end;
{ TFpDwarfV3FreePascalSymbolTypeArray } { TFpSymbolDwarfV3FreePascalSymbolTypeArray }
function TFpDwarfV3FreePascalSymbolTypeArray.GetInternalStringType: TArrayOrStringType; function TFpSymbolDwarfV3FreePascalSymbolTypeArray.GetInternalStringType: TArrayOrStringType;
var var
Info: TDwarfInformationEntry; Info: TDwarfInformationEntry;
t: Cardinal; t: Cardinal;
t2: TFpDbgSymbol; t2: TFpSymbol;
begin begin
Result := FArrayOrStringType; Result := FArrayOrStringType;
if Result <> iasUnknown then if Result <> iasUnknown then
@ -755,16 +755,16 @@ begin
Info.ReleaseReference; Info.ReleaseReference;
end; end;
function TFpDwarfV3FreePascalSymbolTypeArray.GetTypedValueObject( function TFpSymbolDwarfV3FreePascalSymbolTypeArray.GetTypedValueObject(
ATypeCast: Boolean): TFpDwarfValue; ATypeCast: Boolean): TFpValueDwarf;
begin begin
if GetInternalStringType in [{iasShortString,} iasAnsiString, iasUnicodeString] then if GetInternalStringType in [{iasShortString,} iasAnsiString, iasUnicodeString] then
Result := TFpDwarfV3ValueFreePascalString.Create(Self) Result := TFpValueDwarfV3FreePascalString.Create(Self)
else else
Result := inherited GetTypedValueObject(ATypeCast); Result := inherited GetTypedValueObject(ATypeCast);
end; end;
procedure TFpDwarfV3FreePascalSymbolTypeArray.KindNeeded; procedure TFpSymbolDwarfV3FreePascalSymbolTypeArray.KindNeeded;
begin begin
case GetInternalStringType of case GetInternalStringType of
iasShortString: iasShortString:
@ -778,17 +778,17 @@ begin
end; end;
end; end;
{ TFpDwarfV3ValueFreePascalString } { TFpValueDwarfV3FreePascalString }
function TFpDwarfV3ValueFreePascalString.IsValidTypeCast: Boolean; function TFpValueDwarfV3FreePascalString.IsValidTypeCast: Boolean;
var var
f: TFpDbgValueFieldFlags; f: TFpValueFieldFlags;
begin begin
Result := HasTypeCastInfo; Result := HasTypeCastInfo;
If not Result then If not Result then
exit; exit;
assert(TypeCastTargetType.Kind in [skString, skWideString], 'TFpDwarfValueArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray'); assert(TypeCastTargetType.Kind in [skString, skWideString], 'TFpValueDwarfArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray');
f := TypeCastSourceValue.FieldFlags; f := TypeCastSourceValue.FieldFlags;
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) or if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) or
@ -817,21 +817,21 @@ begin
Result := False; Result := False;
end; end;
procedure TFpDwarfV3ValueFreePascalString.Reset; procedure TFpValueDwarfV3FreePascalString.Reset;
begin begin
inherited Reset; inherited Reset;
FValueDone := False; FValueDone := False;
end; end;
function TFpDwarfV3ValueFreePascalString.GetFieldFlags: TFpDbgValueFieldFlags; function TFpValueDwarfV3FreePascalString.GetFieldFlags: TFpValueFieldFlags;
begin begin
Result := inherited GetFieldFlags; Result := inherited GetFieldFlags;
Result := Result + [svfString]; Result := Result + [svfString];
end; end;
function TFpDwarfV3ValueFreePascalString.GetAsString: AnsiString; function TFpValueDwarfV3FreePascalString.GetAsString: AnsiString;
var var
t, t2: TFpDbgSymbol; t, t2: TFpSymbol;
LowBound, HighBound, i: Int64; LowBound, HighBound, i: Int64;
Addr, Addr2: TFpDbgMemLocation; Addr, Addr2: TFpDbgMemLocation;
WResult: UnicodeString; WResult: UnicodeString;
@ -851,7 +851,7 @@ begin
exit; exit;
t2 := t.Member[0]; // subrange type t2 := t.Member[0]; // subrange type
if not( (t2 is TFpDwarfSymbolType) and TFpDwarfSymbolType(t2).GetValueBounds(self, LowBound, HighBound) ) if not( (t2 is TFpSymbolDwarfType) and TFpSymbolDwarfType(t2).GetValueBounds(self, LowBound, HighBound) )
then then
exit; exit;
@ -861,14 +861,14 @@ begin
if not IsReadableLoc(Addr) then if not IsReadableLoc(Addr) then
exit; exit;
assert((Owner <> nil) and (Owner.CompilationUnit <> nil) and (Owner.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3), 'TFpDwarfV3ValueFreePascalString.GetAsString: (Owner <> nil) and (Owner.CompilationUnit <> nil) and (Owner.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3)'); assert((Owner <> nil) and (Owner.CompilationUnit <> nil) and (Owner.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3), 'TFpValueDwarfV3FreePascalString.GetAsString: (Owner <> nil) and (Owner.CompilationUnit <> nil) and (Owner.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3)');
if (TFpDwarfFreePascalSymbolClassMapDwarf3(Owner.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion > 0) and if (TFpDwarfFreePascalSymbolClassMapDwarf3(Owner.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion > 0) and
(TFpDwarfFreePascalSymbolClassMapDwarf3(Owner.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion < $030100) (TFpDwarfFreePascalSymbolClassMapDwarf3(Owner.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion < $030100)
then begin then begin
if t.Kind = skWideString then begin if t.Kind = skWideString then begin
if (t2 is TFpDwarfSymbolTypeSubRange) and (LowBound = 1) then begin if (t2 is TFpSymbolDwarfTypeSubRange) and (LowBound = 1) then begin
if (TFpDwarfSymbolTypeSubRange(t2).InformationEntry.GetAttribData(DW_AT_upper_bound, AttrData)) and if (TFpSymbolDwarfTypeSubRange(t2).InformationEntry.GetAttribData(DW_AT_upper_bound, AttrData)) and
(TFpDwarfSymbolTypeSubRange(t2).InformationEntry.AttribForm[AttrData.Idx] = DW_FORM_block1) and (TFpSymbolDwarfTypeSubRange(t2).InformationEntry.AttribForm[AttrData.Idx] = DW_FORM_block1) and
(IsReadableMem(Addr) and (LocToAddr(Addr) > AddressSize)) (IsReadableMem(Addr) and (LocToAddr(Addr) > AddressSize))
then begin then begin
// fpc issue 0035359 // fpc issue 0035359
@ -914,7 +914,7 @@ begin
end; end;
function TFpDwarfV3ValueFreePascalString.GetAsWideString: WideString; function TFpValueDwarfV3FreePascalString.GetAsWideString: WideString;
begin begin
// todo: widestring, but currently that is encoded as PWideChar // todo: widestring, but currently that is encoded as PWideChar
Result := GetAsString; Result := GetAsString;

476
components/fpdebug/fpdbginfo.pas
View File

File diff suppressed because it is too large Load Diff

4
components/fpdebug/fpdbgsymbols.pas
View File

@ -46,7 +46,7 @@ uses
{$ifdef windows} {$ifdef windows}
procedure AddSymbols(AParent: TFpDbgSymbol; AModule: THandle); procedure AddSymbols(AParent: TFpSymbol; AModule: THandle);
{$endif} {$endif}
implementation implementation
@ -55,7 +55,7 @@ var
DBG_WARNINGS, FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup; DBG_WARNINGS, FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup;
{$ifdef windows} {$ifdef windows}
procedure AddSymbols(AParent: TFpDbgSymbol; AModule: THandle); procedure AddSymbols(AParent: TFpSymbol; AModule: THandle);
var var
ModulePtr: Pointer; ModulePtr: Pointer;
//Is64: Boolean; //Is64: Boolean;

14
components/fpdebug/fpdbgsymtablecontext.pas
View File

@ -31,7 +31,7 @@ type
function GetSizeOfAddress: Integer; override; function GetSizeOfAddress: Integer; override;
public public
constructor Create(AFpSymbolInfo: TFpSymbolInfo); constructor Create(AFpSymbolInfo: TFpSymbolInfo);
function FindSymbol(const AName: String): TFpDbgValue; override; function FindSymbol(const AName: String): TFpValue; override;
end; end;
{ TFpSymbolInfo } { TFpSymbolInfo }
@ -46,8 +46,8 @@ type
destructor Destroy; override; destructor Destroy; override;
function FindContext(AThreadId, AStackFrame: Integer; AAddress: TDbgPtr = 0): TFpDbgInfoContext; override; function FindContext(AThreadId, AStackFrame: Integer; AAddress: TDbgPtr = 0): TFpDbgInfoContext; override;
function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override; function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override;
function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override; function FindSymbol(AAddress: TDbgPtr): TFpSymbol; override;
function FindSymbol(const AName: String): TFpDbgSymbol; override; function FindSymbol(const AName: String): TFpSymbol; override;
property Image64Bit: boolean read FImage64Bit; property Image64Bit: boolean read FImage64Bit;
end; end;
@ -85,7 +85,7 @@ begin
FSizeOfAddress:=4; FSizeOfAddress:=4;
end; end;
function TFpSymbolContext.FindSymbol(const AName: String): TFpDbgValue; function TFpSymbolContext.FindSymbol(const AName: String): TFpValue;
var var
i: integer; i: integer;
val: TFpDbgMemLocation; val: TFpDbgMemLocation;
@ -95,7 +95,7 @@ begin
begin begin
val.Address:=FFpSymbolInfo.FSymbolList.Data[i]; val.Address:=FFpSymbolInfo.FSymbolList.Data[i];
val.MType:=mlfTargetMem; val.MType:=mlfTargetMem;
result := TFpDbgValueConstAddress.Create(val); result := TFpValueConstAddress.Create(val);
end end
else else
result := nil; result := nil;
@ -135,12 +135,12 @@ begin
Result:=FContext; Result:=FContext;
end; end;
function TFpSymbolInfo.FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; function TFpSymbolInfo.FindSymbol(AAddress: TDbgPtr): TFpSymbol;
begin begin
Result:=inherited FindSymbol(AAddress); Result:=inherited FindSymbol(AAddress);
end; end;
function TFpSymbolInfo.FindSymbol(const AName: String): TFpDbgSymbol; function TFpSymbolInfo.FindSymbol(const AName: String): TFpSymbol;
begin begin
result := nil; result := nil;
//Result:=FContext.FindSymbol(AName); //Result:=FContext.FindSymbol(AName);

54
components/fpdebug/fppascalbuilder.pas
View File

@ -54,7 +54,7 @@ type
FAddressSize: Integer; FAddressSize: Integer;
FMemManager: TFpDbgMemManager; FMemManager: TFpDbgMemManager;
function InternalPrintValue(out APrintedValue: String; function InternalPrintValue(out APrintedValue: String;
AValue: TFpDbgValue; AValue: TFpValue;
AnAddressSize: Integer; AnAddressSize: Integer;
AFlags: TFpPrettyPrintValueFlags; AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String; ANestLevel: Integer; AnIndent: String;
@ -66,14 +66,14 @@ type
public public
constructor Create(AnAddressSize: Integer); constructor Create(AnAddressSize: Integer);
function PrintValue(out APrintedValue: String; function PrintValue(out APrintedValue: String;
AValue: TFpDbgValue; AValue: TFpValue;
ADisplayFormat: TWatchDisplayFormat = wdfDefault; ADisplayFormat: TWatchDisplayFormat = wdfDefault;
ARepeatCount: Integer = -1; ARepeatCount: Integer = -1;
AOptions: TFpPrettyPrintOptions = [] AOptions: TFpPrettyPrintOptions = []
): Boolean; ): Boolean;
function PrintValue(out APrintedValue: String; function PrintValue(out APrintedValue: String;
out ADBGTypeInfo: TDBGType; out ADBGTypeInfo: TDBGType;
AValue: TFpDbgValue; AValue: TFpValue;
ADisplayFormat: TWatchDisplayFormat = wdfDefault; ADisplayFormat: TWatchDisplayFormat = wdfDefault;
ARepeatCount: Integer = -1 ARepeatCount: Integer = -1
): Boolean; ): Boolean;
@ -83,15 +83,15 @@ type
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol; AFlags: TTypeNameFlags = []): Boolean; function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol; AFlags: TTypeNameFlags = []): Boolean;
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpDbgSymbol; function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpSymbol;
AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean; AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
function QuoteText(AText: Utf8String): UTf8String; function QuoteText(AText: Utf8String): UTf8String;
implementation implementation
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol; function GetTypeName(out ATypeName: String; ADbgSymbol: TFpSymbol;
AFlags: TTypeNameFlags): Boolean; AFlags: TTypeNameFlags): Boolean;
var var
s: String; s: String;
@ -134,7 +134,7 @@ begin
end; end;
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpDbgSymbol; function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpSymbol;
AFlags: TTypeDeclarationFlags; AnIndent: Integer): Boolean; AFlags: TTypeDeclarationFlags; AnIndent: Integer): Boolean;
var var
IndentString: String; IndentString: String;
@ -183,7 +183,7 @@ var
var var
c, i: Integer; c, i: Integer;
m: TFpDbgSymbol; m: TFpSymbol;
s: String; s: String;
begin begin
Result := True; Result := True;
@ -262,7 +262,7 @@ var
function GetParameterList(out ADeclaration: String): Boolean; function GetParameterList(out ADeclaration: String): Boolean;
var var
i: Integer; i: Integer;
m: TFpDbgSymbol; m: TFpSymbol;
name, lname: String; name, lname: String;
begin begin
ADeclaration := ''; ADeclaration := '';
@ -348,7 +348,7 @@ var
function GetEnumType(out ADeclaration: String): Boolean; function GetEnumType(out ADeclaration: String): Boolean;
var var
i, j, val: Integer; i, j, val: Integer;
m: TFpDbgSymbol; m: TFpSymbol;
begin begin
// TODO assigned value (a,b:=3,...) // TODO assigned value (a,b:=3,...)
Result := True; Result := True;
@ -373,7 +373,7 @@ var
function GetSetType(out ADeclaration: String): Boolean; function GetSetType(out ADeclaration: String): Boolean;
var var
t: TFpDbgSymbol; t: TFpSymbol;
s: String; s: String;
lb, hb: Int64; lb, hb: Int64;
begin begin
@ -407,7 +407,7 @@ var
function GetArrayType(out ADeclaration: String): Boolean; function GetArrayType(out ADeclaration: String): Boolean;
var var
t: TFpDbgSymbol; t: TFpSymbol;
s: String; s: String;
i: Integer; i: Integer;
lb, hb: Int64; lb, hb: Int64;
@ -594,7 +594,7 @@ end;
{ TFpPascalPrettyPrinter } { TFpPascalPrettyPrinter }
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags; AValue: TFpValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat; ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat;
ARepeatCount: Integer; ADBGTypeInfo: PDBGType; AOptions: TFpPrettyPrintOptions): Boolean; ARepeatCount: Integer; ADBGTypeInfo: PDBGType; AOptions: TFpPrettyPrintOptions): Boolean;
@ -606,7 +606,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
then then
Result := ''; Result := '';
end; end;
function ResTypeName(AVal : TFpDbgValue): String; function ResTypeName(AVal : TFpValue): String;
begin begin
if not((AVal.TypeInfo<> nil) and if not((AVal.TypeInfo<> nil) and
GetTypeName(Result, AVal.TypeInfo, [])) GetTypeName(Result, AVal.TypeInfo, []))
@ -670,10 +670,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
procedure DoFunction; procedure DoFunction;
var var
s: String; s: String;
proc: TFpDwarfSymbol; proc: TFpSymbolDwarf;
v: TDBGPtr; v: TDBGPtr;
t: TFpDbgSymbol; t: TFpSymbol;
par: TFpDwarfValue; par: TFpValueDwarf;
begin begin
proc := nil; proc := nil;
v := AValue.DataAddress.Address; v := AValue.DataAddress.Address;
@ -691,13 +691,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
APrintedValue := '$'+IntToHex(v, AnAddressSize*2); APrintedValue := '$'+IntToHex(v, AnAddressSize*2);
t := AValue.TypeInfo; t := AValue.TypeInfo;
proc := TFpDwarfSymbol(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(v)); proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(v));
if proc <> nil then begin if proc <> nil then begin
//t := proc; //t := proc;
s := proc.Name; s := proc.Name;
par := nil; par := nil;
if (proc is TFpDwarfSymbolValueProc) then if (proc is TFpSymbolDwarfDataProc) then
par := TFpDwarfSymbolValueProc(proc).GetSelfParameter; par := TFpSymbolDwarfDataProc(proc).GetSelfParameter;
if (par <> nil) and (par.TypeInfo <> nil) then if (par <> nil) and (par.TypeInfo <> nil) then
s := par.TypeInfo.Name + '.' + s; s := par.TypeInfo.Name + '.' + s;
APrintedValue := APrintedValue + ' = ' + s; // TODO: offset to startaddress APrintedValue := APrintedValue + ' = ' + s; // TODO: offset to startaddress
@ -705,7 +705,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
APrintedValue := APrintedValue + ': '; APrintedValue := APrintedValue + ': ';
end end
else else
t := TFpDwarfValue(AValue).ValueSymbol; t := TFpValueDwarf(AValue).ValueSymbol;
if AFlags * PV_FORWARD_FLAGS <> [] then if AFlags * PV_FORWARD_FLAGS <> [] then
GetTypeName(s, t) GetTypeName(s, t)
@ -862,7 +862,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
var var
s: String; s: String;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
begin begin
APrintedValue := ''; APrintedValue := '';
for i := 0 to AValue.MemberCount-1 do begin for i := 0 to AValue.MemberCount-1 do begin
@ -890,10 +890,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
var var
s, s2, MbName, MbVal: String; s, s2, MbName, MbVal: String;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
fl: TFpPrettyPrintValueFlags; fl: TFpPrettyPrintValueFlags;
f: TDBGField; f: TDBGField;
ti: TFpDbgSymbol; ti: TFpSymbol;
Cache: TFpDbgMemCacheBase; Cache: TFpDbgMemCacheBase;
begin begin
if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin
@ -1002,7 +1002,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
var var
s: String; s: String;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
Cnt, FullCnt: Integer; Cnt, FullCnt: Integer;
d: Int64; d: Int64;
begin begin
@ -1144,7 +1144,7 @@ begin
FAddressSize := AnAddressSize; FAddressSize := AnAddressSize;
end; end;
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue; function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpValue;
ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer; ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer;
AOptions: TFpPrettyPrintOptions): Boolean; AOptions: TFpPrettyPrintOptions): Boolean;
begin begin
@ -1153,7 +1153,7 @@ begin
end; end;
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; out function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; out
ADBGTypeInfo: TDBGType; AValue: TFpDbgValue; ADisplayFormat: TWatchDisplayFormat; ADBGTypeInfo: TDBGType; AValue: TFpValue; ADisplayFormat: TWatchDisplayFormat;
ARepeatCount: Integer): Boolean; ARepeatCount: Integer): Boolean;
begin begin
Result := InternalPrintValue(APrintedValue, AValue, Result := InternalPrintValue(APrintedValue, AValue,

444
components/fpdebug/fppascalparser.pas
View File

File diff suppressed because it is too large Load Diff

98
components/fpdebug/test/testtypeinfo.pas
View File

@ -31,22 +31,22 @@ type
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord); procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
procedure ExpTestFlags(AVal: TFpDbgValue; ATestFlags: TTestFlags = []); procedure ExpTestFlags(AVal: TFpValue; ATestFlags: TTestFlags = []);
procedure ExpKind(AVal: TFpDbgValue; AExpKind: TDbgSymbolKind; TestFlags: TTestFlags = []); procedure ExpKind(AVal: TFpValue; AExpKind: TDbgSymbolKind; TestFlags: TTestFlags = []);
procedure ExpFlags(AVal: TFpDbgValue; AExpFlags: TFpDbgValueFieldFlags; ExpNotFlags: TFpDbgValueFieldFlags = []); procedure ExpFlags(AVal: TFpValue; AExpFlags: TFpValueFieldFlags; ExpNotFlags: TFpValueFieldFlags = []);
procedure ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; ExpValue: QWord); procedure ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag; ExpValue: QWord);
procedure ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; ExpValue: Int64); procedure ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag; ExpValue: Int64);
procedure ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; ExpValue: Boolean); procedure ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag; ExpValue: Boolean);
procedure ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; ExpValue: String); procedure ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag; ExpValue: String);
procedure ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; ExpValue: WideString); procedure ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag; ExpValue: WideString);
procedure ExpMemberCount(AVal: TFpDbgValue; ExpValue: Integer); procedure ExpMemberCount(AVal: TFpValue; ExpValue: Integer);
procedure ExpFlags(AExpFlags: TFpDbgValueFieldFlags; ExpNotFlags: TFpDbgValueFieldFlags = []); procedure ExpFlags(AExpFlags: TFpValueFieldFlags; ExpNotFlags: TFpValueFieldFlags = []);
procedure ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: QWord); procedure ExpResult(Field: TFpValueFieldFlag; ExpValue: QWord);
procedure ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: Int64); procedure ExpResult(Field: TFpValueFieldFlag; ExpValue: Int64);
procedure ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: Boolean); procedure ExpResult(Field: TFpValueFieldFlag; ExpValue: Boolean);
procedure ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: String); procedure ExpResult(Field: TFpValueFieldFlag; ExpValue: String);
procedure ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: WideString); procedure ExpResult(Field: TFpValueFieldFlag; ExpValue: WideString);
procedure ExpMemberCount(ExpValue: Integer); procedure ExpMemberCount(ExpValue: Integer);
procedure InitTest(Expr: String; ExtraName: String = ''); procedure InitTest(Expr: String; ExtraName: String = '');
@ -73,7 +73,7 @@ begin
AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual); AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
end; end;
procedure TTestTypeInfo.ExpTestFlags(AVal: TFpDbgValue; ATestFlags: TTestFlags); procedure TTestTypeInfo.ExpTestFlags(AVal: TFpValue; ATestFlags: TTestFlags);
var var
i: TTestFlag; i: TTestFlag;
begin begin
@ -90,7 +90,7 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpKind(AVal: TFpDbgValue; AExpKind: TDbgSymbolKind; procedure TTestTypeInfo.ExpKind(AVal: TFpValue; AExpKind: TDbgSymbolKind;
TestFlags: TTestFlags); TestFlags: TTestFlags);
var var
s: String; s: String;
@ -139,28 +139,28 @@ begin
FCurrentTestName := s; FCurrentTestName := s;
end; end;
procedure TTestTypeInfo.ExpFlags(AVal: TFpDbgValue; AExpFlags: TFpDbgValueFieldFlags; procedure TTestTypeInfo.ExpFlags(AVal: TFpValue; AExpFlags: TFpValueFieldFlags;
ExpNotFlags: TFpDbgValueFieldFlags); ExpNotFlags: TFpValueFieldFlags);
var var
i: TFpDbgValueFieldFlag; i: TFpValueFieldFlag;
s: string; s: string;
f: TFpDbgValueFieldFlags; f: TFpValueFieldFlags;
begin begin
AssertTrue(FCurrentTestName + 'has ResVal', AVal <> nil); AssertTrue(FCurrentTestName + 'has ResVal', AVal <> nil);
f := AVal.FieldFlags; f := AVal.FieldFlags;
For i := low(TFpDbgValueFieldFlag) to High(TFpDbgValueFieldFlag) do For i := low(TFpValueFieldFlag) to High(TFpValueFieldFlag) do
if i in AExpFlags then begin if i in AExpFlags then begin
WriteStr(s, i); WriteStr(s, i);
AssertTrue(FCurrentTestName + 'Has flag' + s, i in f); AssertTrue(FCurrentTestName + 'Has flag' + s, i in f);
end; end;
For i := low(TFpDbgValueFieldFlag) to High(TFpDbgValueFieldFlag) do For i := low(TFpValueFieldFlag) to High(TFpValueFieldFlag) do
if i in ExpNotFlags then begin if i in ExpNotFlags then begin
WriteStr(s, i); WriteStr(s, i);
AssertTrue(FCurrentTestName + 'Has NOT flag' + s, not (i in f)); AssertTrue(FCurrentTestName + 'Has NOT flag' + s, not (i in f));
end; end;
end; end;
procedure TTestTypeInfo.ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; procedure TTestTypeInfo.ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag;
ExpValue: QWord); ExpValue: QWord);
var var
s: string; s: string;
@ -179,7 +179,7 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; procedure TTestTypeInfo.ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag;
ExpValue: Int64); ExpValue: Int64);
var var
s: string; s: string;
@ -198,7 +198,7 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; procedure TTestTypeInfo.ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag;
ExpValue: Boolean); ExpValue: Boolean);
var var
s: string; s: string;
@ -211,7 +211,7 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; procedure TTestTypeInfo.ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag;
ExpValue: String); ExpValue: String);
var var
s: string; s: string;
@ -225,7 +225,7 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpResult(AVal: TFpDbgValue; Field: TFpDbgValueFieldFlag; procedure TTestTypeInfo.ExpResult(AVal: TFpValue; Field: TFpValueFieldFlag;
ExpValue: WideString); ExpValue: WideString);
var var
s: string; s: string;
@ -238,39 +238,39 @@ begin
end; end;
end; end;
procedure TTestTypeInfo.ExpMemberCount(AVal: TFpDbgValue; ExpValue: Integer); procedure TTestTypeInfo.ExpMemberCount(AVal: TFpValue; ExpValue: Integer);
begin begin
ExpFlags([svfMembers]); ExpFlags([svfMembers]);
AssertEquals(FCurrentTestName+'MemberCount', ExpValue, AVal.MemberCount); AssertEquals(FCurrentTestName+'MemberCount', ExpValue, AVal.MemberCount);
end; end;
procedure TTestTypeInfo.ExpFlags(AExpFlags: TFpDbgValueFieldFlags; procedure TTestTypeInfo.ExpFlags(AExpFlags: TFpValueFieldFlags;
ExpNotFlags: TFpDbgValueFieldFlags); ExpNotFlags: TFpValueFieldFlags);
begin begin
ExpFlags(FExpression.ResultValue, AExpFlags, ExpNotFlags); ExpFlags(FExpression.ResultValue, AExpFlags, ExpNotFlags);
end; end;
procedure TTestTypeInfo.ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: QWord); procedure TTestTypeInfo.ExpResult(Field: TFpValueFieldFlag; ExpValue: QWord);
begin begin
ExpResult(FExpression.ResultValue, Field, ExpValue); ExpResult(FExpression.ResultValue, Field, ExpValue);
end; end;
procedure TTestTypeInfo.ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: Int64); procedure TTestTypeInfo.ExpResult(Field: TFpValueFieldFlag; ExpValue: Int64);
begin begin
ExpResult(FExpression.ResultValue, Field, ExpValue); ExpResult(FExpression.ResultValue, Field, ExpValue);
end; end;
procedure TTestTypeInfo.ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: Boolean); procedure TTestTypeInfo.ExpResult(Field: TFpValueFieldFlag; ExpValue: Boolean);
begin begin
ExpResult(FExpression.ResultValue, Field, ExpValue); ExpResult(FExpression.ResultValue, Field, ExpValue);
end; end;
procedure TTestTypeInfo.ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: String); procedure TTestTypeInfo.ExpResult(Field: TFpValueFieldFlag; ExpValue: String);
begin begin
ExpResult(FExpression.ResultValue, Field, ExpValue); ExpResult(FExpression.ResultValue, Field, ExpValue);
end; end;
procedure TTestTypeInfo.ExpResult(Field: TFpDbgValueFieldFlag; ExpValue: WideString); procedure TTestTypeInfo.ExpResult(Field: TFpValueFieldFlag; ExpValue: WideString);
begin begin
ExpResult(FExpression.ResultValue, Field, ExpValue); ExpResult(FExpression.ResultValue, Field, ExpValue);
end; end;
@ -361,9 +361,9 @@ end;
procedure TTestTypeInfo.TestExpressionInt; procedure TTestTypeInfo.TestExpressionInt;
var var
sym: TFpDbgValue; sym: TFpValue;
ImgLoader: TTestLoaderSetupBasic; ImgLoader: TTestLoaderSetupBasic;
TmpResVal: TFpDbgValue; TmpResVal: TFpValue;
begin begin
InitDwarf(TTestLoaderSetupBasic); InitDwarf(TTestLoaderSetupBasic);
ImgLoader := TTestLoaderSetupBasic(FImageLoader); ImgLoader := TTestLoaderSetupBasic(FImageLoader);
@ -408,9 +408,9 @@ end;
procedure TTestTypeInfo.TestExpressionBool; procedure TTestTypeInfo.TestExpressionBool;
var var
sym: TFpDbgValue; sym: TFpValue;
ImgLoader: TTestLoaderSetupBasic; ImgLoader: TTestLoaderSetupBasic;
TmpResVal: TFpDbgValue; TmpResVal: TFpValue;
i: Integer; i: Integer;
s: String; s: String;
begin begin
@ -472,9 +472,9 @@ end;
procedure TTestTypeInfo.TestExpressionArray; procedure TTestTypeInfo.TestExpressionArray;
var var
sym: TFpDbgValue; sym: TFpValue;
ImgLoader: TTestLoaderSetupArray; ImgLoader: TTestLoaderSetupArray;
TmpResVal: TFpDbgValue; TmpResVal: TFpValue;
i: Integer; i: Integer;
s: String; s: String;
begin begin
@ -566,13 +566,13 @@ end;
procedure TTestTypeInfo.TestExpressionStructures; procedure TTestTypeInfo.TestExpressionStructures;
var var
sym: TFpDbgValue; sym: TFpValue;
obj1: TTestSetup1Class; obj1: TTestSetup1Class;
obj1c: TTestSetup1ClassChild; obj1c: TTestSetup1ClassChild;
vobj1: TTestSetup1Object; vobj1: TTestSetup1Object;
i, j: Integer; i, j: Integer;
FieldsExp: TFpDbgValueFieldFlags; FieldsExp: TFpValueFieldFlags;
AddrExp: TDbgPtr; AddrExp: TDbgPtr;
s, s2: String; s, s2: String;
ImgLoader: TTestLoaderSetup1; ImgLoader: TTestLoaderSetup1;
@ -1167,7 +1167,7 @@ procedure TTestTypeInfo.TestExpressionEnumAndSet;
else else
ExpMemberCount(0); ExpMemberCount(0);
end; end;
function ExpEnumMemberVal(AnIdent: String; AnOrd: QWord): TFpDbgValue; function ExpEnumMemberVal(AnIdent: String; AnOrd: QWord): TFpValue;
begin begin
FCurrentTestName := FCurrentTestName + ' (enum-val)'; FCurrentTestName := FCurrentTestName + ' (enum-val)';
Result := FExpression.ResultValue.Member[0]; Result := FExpression.ResultValue.Member[0];
@ -1199,7 +1199,7 @@ procedure TTestTypeInfo.TestExpressionEnumAndSet;
procedure ExpSetIdent(AnIdentList: array of string); procedure ExpSetIdent(AnIdentList: array of string);
var var
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
begin begin
for i := low(AnIdentList) to high(AnIdentList) do begin for i := low(AnIdentList) to high(AnIdentList) do begin
m := FExpression.ResultValue.Member[i]; m := FExpression.ResultValue.Member[i];
@ -1212,7 +1212,7 @@ procedure TTestTypeInfo.TestExpressionEnumAndSet;
procedure ExpSetOrd(AnIdentList: array of QWord); procedure ExpSetOrd(AnIdentList: array of QWord);
var var
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
begin begin
for i := low(AnIdentList) to high(AnIdentList) do begin for i := low(AnIdentList) to high(AnIdentList) do begin
m := FExpression.ResultValue.Member[i]; m := FExpression.ResultValue.Member[i];
@ -1224,9 +1224,9 @@ procedure TTestTypeInfo.TestExpressionEnumAndSet;
var var
sym: TFpDbgValue; sym: TFpValue;
ImgLoader: TTestLoaderSetupBasic; ImgLoader: TTestLoaderSetupBasic;
TmpResVal: TFpDbgValue; TmpResVal: TFpValue;
begin begin
InitDwarf(TTestLoaderSetupBasic); InitDwarf(TTestLoaderSetupBasic);
ImgLoader := TTestLoaderSetupBasic(FImageLoader); ImgLoader := TTestLoaderSetupBasic(FImageLoader);

14
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -621,7 +621,7 @@ var
ThreadCallStack: TDbgCallstackEntryList; ThreadCallStack: TDbgCallstackEntryList;
v, params: String; v, params: String;
i: Integer; i: Integer;
ProcVal, m: TFpDbgValue; ProcVal, m: TFpValue;
RegList: TDbgRegisterValueList; RegList: TDbgRegisterValueList;
Reg: TDbgRegisterValue; Reg: TDbgRegisterValue;
AController: TDbgController; AController: TDbgController;
@ -729,9 +729,9 @@ procedure TFPLocals.RequestData(ALocals: TLocals);
var var
AContext: TFpDbgInfoContext; AContext: TFpDbgInfoContext;
AController: TDbgController; AController: TDbgController;
ProcVal: TFpDbgValue; ProcVal: TFpValue;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
n, v: String; n, v: String;
CurThreadId, CurStackFrame: Integer; CurThreadId, CurStackFrame: Integer;
AFrame: TDbgCallstackEntry; AFrame: TDbgCallstackEntry;
@ -981,7 +981,7 @@ var
ASrcFileName: string; ASrcFileName: string;
ASrcFileLine: integer; ASrcFileLine: integer;
i,j: Integer; i,j: Integer;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
StatIndex: integer; StatIndex: integer;
FirstIndex: integer; FirstIndex: integer;
ALastAddr: TDBGPtr; ALastAddr: TDBGPtr;
@ -1333,7 +1333,7 @@ var
Res: Boolean; Res: Boolean;
StackFrame, ThreadId: Integer; StackFrame, ThreadId: Integer;
StackList: TCallStackBase; StackList: TCallStackBase;
ResValue: TFpDbgValue; ResValue: TFpValue;
CastName, ResText2: String; CastName, ResText2: String;
ClassAddr, CNameAddr: TFpDbgMemLocation; ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord; NameLen: QWord;
@ -1630,7 +1630,7 @@ end;
function TFpDebugDebugger.SetSoftwareExceptionBreakpoint: boolean; function TFpDebugDebugger.SetSoftwareExceptionBreakpoint: boolean;
var var
AContext: TFpDbgInfoContext; AContext: TFpDbgInfoContext;
AValue: TFpDbgValue; AValue: TFpValue;
AnAddr: TDBGPtr; AnAddr: TDBGPtr;
begin begin
result := false; result := false;
@ -2174,7 +2174,7 @@ end;
function TFpDebugDebugger.GetLocationRec(AnAddress: TDBGPtr): TDBGLocationRec; function TFpDebugDebugger.GetLocationRec(AnAddress: TDBGPtr): TDBGLocationRec;
var var
sym, symproc: TFpDbgSymbol; sym, symproc: TFpSymbol;
begin begin
if Assigned(FDbgController.CurrentProcess) then if Assigned(FDbgController.CurrentProcess) then
begin begin

10
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -269,9 +269,9 @@ end;
procedure TFPGDBMILocals.ProcessLocals(ALocals: TLocals); procedure TFPGDBMILocals.ProcessLocals(ALocals: TLocals);
var var
Ctx: TFpDbgInfoContext; Ctx: TFpDbgInfoContext;
ProcVal: TFpDbgValue; ProcVal: TFpValue;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
n, v: String; n, v: String;
begin begin
Ctx := FpDebugger.GetInfoContextForContext(ALocals.ThreadId, ALocals.StackFrame); Ctx := FpDebugger.GetInfoContextForContext(ALocals.ThreadId, ALocals.StackFrame);
@ -958,7 +958,7 @@ begin
end; end;
type type
TGDBMIDwarfTypeIdentifier = class(TFpDwarfSymbolType) TGDBMIDwarfTypeIdentifier = class(TFpSymbolDwarfType)
public public
property InformationEntry; property InformationEntry;
end; end;
@ -973,11 +973,11 @@ function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue; AExpressi
var var
Ctx: TFpDbgInfoContext; Ctx: TFpDbgInfoContext;
PasExpr, PasExpr2: TFpPascalExpression; PasExpr, PasExpr2: TFpPascalExpression;
ResValue: TFpDbgValue; ResValue: TFpValue;
s: String; s: String;
DispFormat: TWatchDisplayFormat; DispFormat: TWatchDisplayFormat;
RepeatCnt: Integer; RepeatCnt: Integer;
TiSym: TFpDbgSymbol; TiSym: TFpSymbol;
function IsWatchValueAlive: Boolean; function IsWatchValueAlive: Boolean;
begin begin

12
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -402,9 +402,9 @@ end;
procedure TFPLldbLocals.ProcessLocals(ALocals: TLocals); procedure TFPLldbLocals.ProcessLocals(ALocals: TLocals);
var var
Ctx: TFpDbgInfoContext; Ctx: TFpDbgInfoContext;
ProcVal: TFpDbgValue; ProcVal: TFpValue;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpValue;
n, v: String; n, v: String;
begin begin
if FLocalsEvalCancel then begin if FLocalsEvalCancel then begin
@ -966,7 +966,7 @@ var
AnEntry: TDisassemblerEntry; AnEntry: TDisassemblerEntry;
SrcFileName, LineAddrStr: String; SrcFileName, LineAddrStr: String;
i,j, StatIndex, FirstIndex, SrcFileLine: Integer; i,j, StatIndex, FirstIndex, SrcFileLine: Integer;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
ALastAddr, LineAddr: TDBGPtr; ALastAddr, LineAddr: TDBGPtr;
begin begin
StatIndex := 0; StatIndex := 0;
@ -1041,7 +1041,7 @@ end;
procedure TFpLldbDebuggerCommandDisassemble.DoExecute; procedure TFpLldbDebuggerCommandDisassemble.DoExecute;
var var
DInstr: TLldbInstructionDisassem; DInstr: TLldbInstructionDisassem;
Sym: TFpDbgSymbol; Sym: TFpSymbol;
StartRange, EndRange: TDBGPtr; StartRange, EndRange: TDBGPtr;
begin begin
@ -1413,11 +1413,11 @@ function TFpLldbDebugger.EvaluateExpression(AWatchValue: TWatchValue; AExpressio
var var
Ctx: TFpDbgInfoContext; Ctx: TFpDbgInfoContext;
PasExpr, PasExpr2: TFpPascalExpression; PasExpr, PasExpr2: TFpPascalExpression;
ResValue: TFpDbgValue; ResValue: TFpValue;
s: String; s: String;
DispFormat: TWatchDisplayFormat; DispFormat: TWatchDisplayFormat;
RepeatCnt: Integer; RepeatCnt: Integer;
TiSym: TFpDbgSymbol; TiSym: TFpSymbol;
function IsWatchValueAlive: Boolean; function IsWatchValueAlive: Boolean;
begin begin

2
components/leakview/leakinfo.pas
View File

@ -908,7 +908,7 @@ var
SrcLine: longint; SrcLine: longint;
{$ENDIF} {$ENDIF}
BadAddresses: TStackLines; BadAddresses: TStackLines;
sym: TFpDbgSymbol; sym: TFpSymbol;
begin begin
Result := False; Result := False;
{$IFDEF LEAK_RESOLVE_USE_FPC} {$IFDEF LEAK_RESOLVE_USE_FPC}