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

FpDebug: refactor getting instantiated classname.

Browse Source 
git-svn-id: trunk@63355 -
This commit is contained in:
martin 2020-06-15 16:18:26 +00:00
parent 2013a99dc3
commit 8d02777940
4 changed files with 124 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -129,6 +129,13 @@ type
TFpSymbolDwarfFreePascalTypeStructure = class(TFpSymbolDwarfTypeStructure)
protected
procedure KindNeeded; override;
public
function GetInstanceClassName(AValueObj: TFpValue; out
AClassName: String): boolean; override;
//function GetInstanceClass(AValueObj: TFpValueDwarf): TFpSymbolDwarf; override;
class function GetInstanceClassNameFromPVmt(APVmt: TDbgPtr;
AMemManager: TFpDbgMemManager; ASizeOfAddr: Integer;
out AClassName: String; out AnError: TFpError): boolean;
end;
(* *** Record vs ShortString *** *)
@ -759,6 +766,65 @@ begin
end;
end;
function TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassName(
AValueObj: TFpValue; out AClassName: String): boolean;
var
AnErr: TFpError;
begin
Result := AValueObj is TFpValueDwarf;
if not Result then
exit;
Result := GetInstanceClassNameFromPVmt(LocToAddrOrNil(AValueObj.DataAddress),
TFpValueDwarf(AValueObj).MemManager, TFpValueDwarf(AValueObj).Context.SizeOfAddress, AClassName, AnErr);
if not Result then
SetLastError(AValueObj, AnErr);
end;
class function TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassNameFromPVmt
(APVmt: TDbgPtr; AMemManager: TFpDbgMemManager; ASizeOfAddr: Integer; out
AClassName: String; out AnError: TFpError): boolean;
var
VmtAddr, ClassNameAddr: TFpDbgMemLocation;
NameLen: QWord;
begin
Result := False;
AnError := NoError;
AClassName := '';
if not AMemManager.ReadAddress(TargetLoc(APVmt), SizeVal(ASizeOfAddr), VmtAddr) then begin
AnError := AMemManager.LastError;
exit;
end;
if not IsReadableMem(VmtAddr) then begin
AnError := CreateError(fpErrCanNotReadMemAtAddr, [VmtAddr.Address]);
exit;
end;
{$PUSH}{$Q-}
VmtAddr.Address := VmtAddr.Address + TDBGPtr(3 * ASizeOfAddr);
{$POP}
if not AMemManager.ReadAddress(VmtAddr, SizeVal(ASizeOfAddr), ClassNameAddr) then begin
AnError := AMemManager.LastError;
exit;
end;
if not IsReadableMem(ClassNameAddr) then begin
AnError := CreateError(fpErrCanNotReadMemAtAddr, [ClassNameAddr.Address]);
exit;
end;
if not AMemManager.ReadUnsignedInt(ClassNameAddr, SizeVal(1), NameLen) then begin
AnError := AMemManager.LastError;
exit;
end;
if NameLen = 0 then begin
AnError := CreateError(fpErrAnyError, ['No name found']);
exit;
end;
SetLength(AClassName, NameLen);
ClassNameAddr.Address := ClassNameAddr.Address + 1;
Result := AMemManager.ReadMemory(ClassNameAddr, SizeVal(NameLen), @AClassName[1]);
if not Result then
AnError := AMemManager.LastError;
end;
{ TFpValueDwarfV2FreePascalShortString }
function TFpValueDwarfV2FreePascalShortString.IsValidTypeCast: Boolean;

35
components/fpdebug/fpdbginfo.pas
View File

@ -175,6 +175,9 @@ type
// memdump
public
function GetTypeCastedValue(ADataVal: TFpValue): TFpValue; virtual; // only if Symbol is a type
function GetInstanceClassName(out AClassName: String): boolean; virtual;
// base class? Or Member includes member from base
(* Member:
* skClass, skStructure:
@ -419,6 +422,8 @@ type
//
property Flags: TDbgSymbolFlags read GetFlags;
property Parent: TFpSymbol read GetParent; deprecated;
function GetInstanceClassName(AValueObj: TFpValue; out AClassName: String): boolean; virtual;
// for Subranges // Type-Symbols only?
// TODO: flag bounds as cardinal if needed
function GetValueBounds(AValueObj: TFpValue; out ALowBound, AHighBound: Int64): Boolean; virtual;
@ -460,6 +465,7 @@ type
function GetNestedSymbolByName(AIndex: String): TFpSymbol; override;
function GetNestedSymbolCount: Integer; override;
public
function GetInstanceClassName(AValueObj: TFpValue; out AClassName: String): boolean; override;
function GetValueBounds(AValueObj: TFpValue; out ALowBound, AHighBound: Int64): Boolean; override;
function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;
function GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; override;
@ -614,6 +620,16 @@ begin
Result := nil;
end;
function TFpValue.GetInstanceClassName(out AClassName: String): boolean;
var
ti: TFpSymbol;
begin
ti := TypeInfo;
Result := ti <> nil;
if Result then
Result := ti.GetInstanceClassName(Self, AClassName);
end;
function TFpValue.GetTypeInfo: TFpSymbol;
begin
if (DbgSymbol <> nil) and (DbgSymbol.SymbolType = stValue) then
@ -961,6 +977,13 @@ begin
Result := DoReadSize(AValueObj, ASize);
end;
function TFpSymbol.GetInstanceClassName(AValueObj: TFpValue; out
AClassName: String): boolean;
begin
AClassName := '';
Result := False;
end;
function TFpSymbol.GetValueBounds(AValueObj: TFpValue; out ALowBound,
AHighBound: Int64): Boolean;
begin
@ -1313,6 +1336,18 @@ begin
Result := 0; // Result := inherited GetOrdinalValue;
end;
function TFpSymbolForwarder.GetInstanceClassName(AValueObj: TFpValue; out
AClassName: String): boolean;
var
p: TFpSymbol;
begin
p := GetForwardToSymbol;
if p <> nil then
Result := p.GetInstanceClassName(AValueObj, AClassName)
else
Result := inherited GetInstanceClassName(AValueObj, AClassName);
end;
function TFpSymbolForwarder.GetValueBounds(AValueObj: TFpValue; out
ALowBound, AHighBound: Int64): Boolean;
var

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

@ -2337,8 +2337,6 @@ var
StackFrame, ThreadId: Integer;
ResValue: TFpValue;
CastName, ResText2: String;
ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord;
begin
Result := False;
AResText := '';
@ -2395,28 +2393,16 @@ begin
if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags)
then begin
CastName := '';
if FMemManager.ReadAddress(ResValue.DataAddress, SizeVal(AContext.SizeOfAddress), ClassAddr) then begin
{$PUSH}{$Q-}
ClassAddr.Address := ClassAddr.Address + TDBGPtr(3 * AContext.SizeOfAddress);
{$POP}
if FMemManager.ReadAddress(ClassAddr, SizeVal(AContext.SizeOfAddress), CNameAddr) then begin
if (FMemManager.ReadUnsignedInt(CNameAddr, SizeVal(1), NameLen)) then
if NameLen > 0 then begin
SetLength(CastName, NameLen);
CNameAddr.Address := CNameAddr.Address + 1;
FMemManager.ReadMemory(CNameAddr, SizeVal(NameLen), @CastName[1]);
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', AContext);
PasExpr2.ResultValue;
if PasExpr2.Valid then begin
APasExpr.Free;
APasExpr := PasExpr2;
ResValue := APasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
if ResValue.GetInstanceClassName(CastName) then begin
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', AContext);
PasExpr2.ResultValue;
if PasExpr2.Valid then begin
APasExpr.Free;
APasExpr := PasExpr2;
ResValue := APasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
@ -2609,22 +2595,10 @@ end;
function TFpDebugDebugger.GetClassInstanceName(AnAddr: TDBGPtr): string;
var
VMTAddr: TDBGPtr;
ClassNameAddr: TDBGPtr;
b: byte;
AnErr: TFpError;
begin
Result := '';
// Read address of the vmt
ReadAddress(AnAddr, VMTAddr);
if VMTAddr = 0 then
exit;
ReadAddress(VMTAddr+3*DBGPTRSIZE[FDbgController.CurrentProcess.Mode], ClassNameAddr);
if ClassNameAddr = 0 then
exit;
// read classname (as shortstring)
ReadData(ClassNameAddr, 1, b);
setlength(result,b);
ReadData(ClassNameAddr+1, b, result[1]);
TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassNameFromPVmt(AnAddr,
FMemManager, DBGPTRSIZE[FDbgController.CurrentProcess.Mode], Result, AnErr);
end;
function TFpDebugDebugger.ReadAnsiString(AnAddr: TDbgPtr): string;

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

@ -991,8 +991,6 @@ var
var
CastName: String;
ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord;
begin
Result := False;
ATypeInfo := nil;
@ -1057,26 +1055,16 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags)
then begin
CastName := '';
if FMemManager.ReadAddress(ResValue.DataAddress, SizeVal(Ctx.SizeOfAddress), ClassAddr) then begin
ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress;
if FMemManager.ReadAddress(ClassAddr, SizeVal(Ctx.SizeOfAddress), CNameAddr) then begin
if (FMemManager.ReadUnsignedInt(CNameAddr, SizeVal(1), NameLen)) then
if NameLen > 0 then begin
SetLength(CastName, NameLen);
CNameAddr.Address := CNameAddr.Address + 1;
FMemManager.ReadMemory(CNameAddr, SizeVal(NameLen), @CastName[1]);
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
PasExpr2.ResultValue;
if PasExpr2.Valid then begin
PasExpr.Free;
PasExpr := PasExpr2;
ResValue := PasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
if ResValue.GetInstanceClassName(CastName) then begin
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
PasExpr2.ResultValue;
if PasExpr2.Valid then begin
PasExpr.Free;
PasExpr := PasExpr2;
ResValue := PasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;