paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-28 13:33:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: DwarfClassMap (fpc specific classes), use instances.

Browse Source 
git-svn-id: trunk@61416 -
This commit is contained in:
martin 2019-06-18 18:39:17 +00:00
parent 5d6b05e0c0
commit 970cf11642
3 changed files with 159 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/fpdebug/fpdbgdwarf.pas
View File

@ -57,12 +57,18 @@ type
{ TFpDwarfDefaultSymbolClassMap }
TFpDwarfDefaultSymbolClassMap = class(TFpDwarfSymbolClassMap)
private
class var ExistingClassMap: TFpDwarfSymbolClassMap;
protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress:
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public
//function CanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
function CreateContext(AThreadId, AStackFrame: Integer; AnAddress:
TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
end;
@ -932,12 +938,17 @@ var
{ TFpDwarfDefaultSymbolClassMap }
class function TFpDwarfDefaultSymbolClassMap.HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
class function TFpDwarfDefaultSymbolClassMap.GetExistingClassMap: PFpDwarfSymbolClassMap;
begin
Result := @ExistingClassMap;
end;
class function TFpDwarfDefaultSymbolClassMap.ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
begin
Result := True;
end;
class function TFpDwarfDefaultSymbolClassMap.GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass;
function TFpDwarfDefaultSymbolClassMap.GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass;
begin
case ATag of
// TODO:
@ -978,13 +989,13 @@ begin
end;
end;
class function TFpDwarfDefaultSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
function TFpDwarfDefaultSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext;
begin
Result := TFpDwarfInfoAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf);
end;
class function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase;
begin
Result := TFpDwarfSymbolValueProc.Create(ACompilationUnit, AInfo, AAddress);

109
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -41,8 +41,9 @@ unit FpDbgDwarfDataClasses;
interface
uses
Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math, FpDbgLoader,
FpImgReaderBase, FpdMemoryTools, FpErrorMessages, LazLoggerBase, // LazLoggerDummy,
Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math,
FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages,
LazLoggerBase, // LazLoggerDummy,
LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes;
type
@ -456,13 +457,25 @@ type
Provides Symbol and VAlue evaluation classes depending on the compiler
}
PFpDwarfSymbolClassMap = ^TFpDwarfSymbolClassMap;
TFpDwarfSymbolClassMap = class
private
NextExistingClassMap: TFpDwarfSymbolClassMap;
protected
function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; virtual;
class function GetExistingClassMap: PFpDwarfSymbolClassMap; virtual; abstract; // Each class must have its own storage
class function DoGetInstanceForCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpDwarfSymbolClassMap;
public
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; virtual; abstract;
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol;
class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap; virtual;
class procedure FreeAllInstances;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; virtual; abstract;
public
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); virtual;
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol;
ADwarf: TFpDwarfInfo): TFpDbgInfoContext; virtual; abstract;
class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; virtual; abstract;
end;
TFpDwarfSymbolClassMapClass = class of TFpDwarfSymbolClassMap;
@ -474,7 +487,9 @@ type
FDefaultMap: TFpDwarfSymbolClassMapClass;
FMapList: array of TFpDwarfSymbolClassMapClass;
public
function FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMapClass;
destructor Destroy; override;
function FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap;
procedure FreeAllInstances;
procedure AddMap(AMap: TFpDwarfSymbolClassMapClass);
procedure SetDefaultMap(AMap: TFpDwarfSymbolClassMapClass);
end;
@ -501,7 +516,7 @@ type
private
FOwner: TFpDwarfInfo;
FDebugFile: PDwarfDebugFile;
FDwarfSymbolClassMap: TFpDwarfSymbolClassMapClass;
FDwarfSymbolClassMap: TFpDwarfSymbolClassMap;
FValid: Boolean; // set if the compilationunit has compile unit tag.
// --- Header ---
@ -610,7 +625,7 @@ type
property Owner: TFpDwarfInfo read FOwner;
property DebugFile: PDwarfDebugFile read FDebugFile;
property DwarfSymbolClassMap: TFpDwarfSymbolClassMapClass read FDwarfSymbolClassMap;
property DwarfSymbolClassMap: TFpDwarfSymbolClassMap read FDwarfSymbolClassMap;
property FirstScope: TDwarfScopeInfo read FScope;
// public for FpDbgDwarfVerbosePrinter
@ -906,6 +921,54 @@ begin
end;
{ TFpDwarfSymbolClassMap }
class function TFpDwarfSymbolClassMap.GetInstanceForCompUnit(
ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap;
begin
Result := DoGetInstanceForCompUnit(ACU, nil);
end;
class procedure TFpDwarfSymbolClassMap.FreeAllInstances;
var
pm, next: TFpDwarfSymbolClassMap;
begin
pm := GetExistingClassMap^;
while pm <> nil do begin
next := pm.NextExistingClassMap;
pm.Destroy;
pm := next;
end;
GetExistingClassMap^ := nil;
end;
constructor TFpDwarfSymbolClassMap.Create(ACU: TDwarfCompilationUnit;
AHelperData: Pointer);
begin
inherited Create;
end;
function TFpDwarfSymbolClassMap.CanHandleCompUnit(ACU: TDwarfCompilationUnit;
AHelperData: Pointer): Boolean;
begin
Result := True;
end;
class function TFpDwarfSymbolClassMap.DoGetInstanceForCompUnit(
ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpDwarfSymbolClassMap;
var
pm: PFpDwarfSymbolClassMap;
begin
pm := GetExistingClassMap;
while pm^ <> nil do begin
if pm^.CanHandleCompUnit(ACU, AHelperData) then
exit(pm^);
pm := @pm^.NextExistingClassMap;
end;
Result := Self.Create(ACU, AHelperData);
pm^ := Result;
end;
{ TLEB128PreFixTree }
procedure TLEB128PreFixTree.SetCapacity(ACapacity: integer);
@ -3480,16 +3543,32 @@ end;
{ TFpDwarfSymbolClassMapList }
function TFpDwarfSymbolClassMapList.FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMapClass;
destructor TFpDwarfSymbolClassMapList.Destroy;
begin
FreeAllInstances;
inherited Destroy;
end;
function TFpDwarfSymbolClassMapList.FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpDwarfSymbolClassMap;
var
i: Integer;
ResClass: TFpDwarfSymbolClassMapClass;
begin
ResClass := FDefaultMap;
for i := 0 to length(FMapList) - 1 do
if FMapList[i].ClassCanHandleCompUnit(ACU) then begin
ResClass := FMapList[i];
break;
end;
Result := ResClass.GetInstanceForCompUnit(ACU);
end;
procedure TFpDwarfSymbolClassMapList.FreeAllInstances;
var
i: Integer;
begin
for i := 0 to length(FMapList) - 1 do
if FMapList[i].HandleCompUnit(ACU) then begin
Result := FMapList[i];
exit;
end;
Result := FDefaultMap;
FMapList[i].FreeAllInstances;
end;
procedure TFpDwarfSymbolClassMapList.AddMap(AMap: TFpDwarfSymbolClassMapClass);

62
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -17,10 +17,15 @@ type
{ TFpDwarfFreePascalSymbolClassMap }
TFpDwarfFreePascalSymbolClassMap = class(TFpDwarfDefaultSymbolClassMap)
strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap;
protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
// AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
@ -29,9 +34,14 @@ type
{ TFpDwarfFreePascalSymbolClassMapDwarf2 }
TFpDwarfFreePascalSymbolClassMapDwarf2 = class(TFpDwarfFreePascalSymbolClassMap)
strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap;
protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
//class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
// ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
@ -41,9 +51,14 @@ type
{ TFpDwarfFreePascalSymbolClassMapDwarf3 }
TFpDwarfFreePascalSymbolClassMapDwarf3 = class(TFpDwarfFreePascalSymbolClassMap)
strict private
class var ExistingClassMap: TFpDwarfSymbolClassMap;
protected
class function GetExistingClassMap: PFpDwarfSymbolClassMap; override;
public
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
public
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
//class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
// ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
@ -149,7 +164,12 @@ implementation
{ TFpDwarfFreePascalSymbolClassMap }
class function TFpDwarfFreePascalSymbolClassMap.HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
class function TFpDwarfFreePascalSymbolClassMap.GetExistingClassMap: PFpDwarfSymbolClassMap;
begin
Result := @ExistingClassMap;
end;
class function TFpDwarfFreePascalSymbolClassMap.ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
var
s: String;
begin
@ -157,7 +177,7 @@ begin
Result := pos('free pascal', s) > 0;
end;
class function TFpDwarfFreePascalSymbolClassMap.GetDwarfSymbolClass(
function TFpDwarfFreePascalSymbolClassMap.GetDwarfSymbolClass(
ATag: Cardinal): TDbgDwarfSymbolBaseClass;
begin
case ATag of
@ -168,7 +188,7 @@ begin
end;
end;
class function TFpDwarfFreePascalSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
function TFpDwarfFreePascalSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext;
begin
Result := TFpDwarfFreePascalAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf);
@ -176,14 +196,19 @@ end;
{ TFpDwarfFreePascalSymbolClassMapDwarf2 }
class function TFpDwarfFreePascalSymbolClassMapDwarf2.HandleCompUnit(
class function TFpDwarfFreePascalSymbolClassMapDwarf2.GetExistingClassMap: PFpDwarfSymbolClassMap;
begin
Result := @ExistingClassMap;
end;
class function TFpDwarfFreePascalSymbolClassMapDwarf2.ClassCanHandleCompUnit(
ACU: TDwarfCompilationUnit): Boolean;
begin
Result := inherited HandleCompUnit(ACU);
Result := inherited ClassCanHandleCompUnit(ACU);
Result := Result and (ACU.Version < 3);
end;
class function TFpDwarfFreePascalSymbolClassMapDwarf2.GetDwarfSymbolClass(
function TFpDwarfFreePascalSymbolClassMapDwarf2.GetDwarfSymbolClass(
ATag: Cardinal): TDbgDwarfSymbolBaseClass;
begin
case ATag of
@ -209,14 +234,19 @@ end;
{ TFpDwarfFreePascalSymbolClassMapDwarf3 }
class function TFpDwarfFreePascalSymbolClassMapDwarf3.HandleCompUnit(
class function TFpDwarfFreePascalSymbolClassMapDwarf3.GetExistingClassMap: PFpDwarfSymbolClassMap;
begin
Result := @ExistingClassMap;
end;
class function TFpDwarfFreePascalSymbolClassMapDwarf3.ClassCanHandleCompUnit(
ACU: TDwarfCompilationUnit): Boolean;
begin
Result := inherited HandleCompUnit(ACU);
Result := inherited ClassCanHandleCompUnit(ACU);
Result := Result and (ACU.Version >= 3);
end;
class function TFpDwarfFreePascalSymbolClassMapDwarf3.GetDwarfSymbolClass(
function TFpDwarfFreePascalSymbolClassMapDwarf3.GetDwarfSymbolClass(
ATag: Cardinal): TDbgDwarfSymbolBaseClass;
begin
case ATag of