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

FpDebug: Allow constants in type-cast to be treated as address

Browse Source 
git-svn-id: trunk@61501 -
This commit is contained in:
martin 2019-06-30 19:17:01 +00:00
parent 3fa2c1926a
commit 2ca01a1067
4 changed files with 103 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
components/fpdebug/fpdbgdwarf.pas
View File

@ -939,7 +939,7 @@ function dbgs(ASubRangeBoundReadState: TFpDwarfSubRangeBoundReadState): String;
implementation
var
FPDBG_DWARF_VERBOSE, FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_DATA_WARNINGS: PLazLoggerLogGroup;
DBG_WARNINGS, FPDBG_DWARF_VERBOSE, FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_DATA_WARNINGS: PLazLoggerLogGroup;
function dbgs(ASubRangeBoundReadState: TFpDwarfSubRangeBoundReadState): String;
begin
@ -2931,13 +2931,24 @@ end;
function TFpDwarfSymbol.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
AnInitLocParserData: PInitLocParserData): Boolean;
var
ObjDataAddr: TFpDbgMemLocation;
begin
if (AnInitLocParserData <> nil) and IsValidLoc(AnInitLocParserData^.ObjectDataAddress)
then begin
debugln(FPDBG_DWARF_VERBOSE, ['TFpDwarfSymbol.InitLocationParser CurrentObjectAddress=', dbgs(AnInitLocParserData^.ObjectDataAddress), ' Push=',AnInitLocParserData^.ObjectDataAddrPush]);
ALocationParser.CurrentObjectAddress := AnInitLocParserData^.ObjectDataAddress;
if AnInitLocParserData^.ObjectDataAddrPush then
ALocationParser.Push(AnInitLocParserData^.ObjectDataAddress);
if (AnInitLocParserData <> nil) then begin
ObjDataAddr := AnInitLocParserData^.ObjectDataAddress;
if IsValidLoc(ObjDataAddr) then begin
if ObjDataAddr.MType = mlfConstant then begin
DebugLn(DBG_WARNINGS, 'Changing mlfConstant to mlfConstantDeref'); // TODO: Should be done by caller
ObjDataAddr.MType := mlfConstantDeref;
end;
debugln(FPDBG_DWARF_VERBOSE, ['TFpDwarfSymbol.InitLocationParser CurrentObjectAddress=', dbgs(ObjDataAddr), ' Push=',AnInitLocParserData^.ObjectDataAddrPush]);
ALocationParser.CurrentObjectAddress := ObjDataAddr;
if AnInitLocParserData^.ObjectDataAddrPush then
ALocationParser.Push(ObjDataAddr);
end
else
ALocationParser.CurrentObjectAddress := InvalidLoc
end
else
ALocationParser.CurrentObjectAddress := InvalidLoc;
@ -3637,6 +3648,8 @@ begin
begin
if assigned(AValueObj) then begin
InitLocParserData.ObjectDataAddress := AValueObj.Address;
if not IsValidLoc(InitLocParserData.ObjectDataAddress) then
InitLocParserData.ObjectDataAddress := AValueObj.OrdOrAddress;
InitLocParserData.ObjectDataAddrPush := False;
if LocationFromTag(AnAttrib, AttrData, AValueObj, AnAddress, @InitLocParserData) then begin
ABoundState := rfConst;
@ -4948,6 +4961,7 @@ end;
initialization
DwarfSymbolClassMapList.SetDefaultMap(TFpDwarfDefaultSymbolClassMap);
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
FPDBG_DWARF_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , 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} );

56
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -668,22 +668,27 @@ type
property Image64Bit: Boolean read FImage64Bit;
end;
TDwarfLocationExpression = class;
{ TDwarfLocationStack }
TDwarfLocationStack = object
private
FList: array of TFpDbgMemLocation; //TDwarfLocationStackEntry;
FCount: Integer;
FError: TFpErrorCode;
procedure IncCapacity;
public
procedure Clear;
function Count: Integer; inline;
function Pop: TFpDbgMemLocation;
function PopForDeref: TFpDbgMemLocation;
procedure Push(const AEntry: TFpDbgMemLocation);
procedure PushCopy(AFromIndex: Integer);
procedure PushConst(const AVal: TDBGPtr);
procedure PushTargetMem(const AVal: TDBGPtr);
function Peek: PFpDbgMemLocation;
function PeekForDeref: PFpDbgMemLocation;
function PeekKind: TFpDbgMemLocationType; // Can be called on empty stack
function Peek(AIndex: Integer): PFpDbgMemLocation;
procedure Modify(AIndex: Integer; const AEntry: TFpDbgMemLocation);
@ -709,7 +714,7 @@ type
constructor Create(AExpressionData: Pointer; AMaxCount: Integer; ACU: TDwarfCompilationUnit;
AMemManager: TFpDbgMemManager; AContext: TFpDbgAddressContext);
procedure Evaluate;
function ResultData: TFpDbgMemLocation;
function ResultData: TFpDbgMemLocation;
procedure Push(AValue: TFpDbgMemLocation);
property FrameBase: TDbgPtr read FFrameBase write FFrameBase;
property OnFrameBaseNeeded: TNotifyEvent read FOnFrameBaseNeeded write FOnFrameBaseNeeded;
@ -1737,6 +1742,7 @@ end;
procedure TDwarfLocationStack.Clear;
begin
FCount := 0;
FError := fpErrNoError;
end;
function TDwarfLocationStack.Count: Integer;
@ -1745,6 +1751,15 @@ begin
end;
function TDwarfLocationStack.Pop: TFpDbgMemLocation;
begin
Assert(0 < FCount);
dec(FCount);
Result := FList[FCount];
if Result.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
function TDwarfLocationStack.PopForDeref: TFpDbgMemLocation;
begin
Assert(0 < FCount);
dec(FCount);
@ -1791,6 +1806,14 @@ begin
end;
function TDwarfLocationStack.Peek: PFpDbgMemLocation;
begin
Assert(0 < FCount);
Result := @FList[FCount-1];
if Result^.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
function TDwarfLocationStack.PeekForDeref: PFpDbgMemLocation;
begin
Assert(0 < FCount);
Result := @FList[FCount-1];
@ -1808,6 +1831,8 @@ function TDwarfLocationStack.Peek(AIndex: Integer): PFpDbgMemLocation;
begin
Assert(AIndex < FCount);
Result := @FList[FCount-1-AIndex];
if Result^.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
procedure TDwarfLocationStack.Modify(AIndex: Integer;
@ -1858,7 +1883,7 @@ var
function AssertAddressOnStack: Boolean; inline;
begin
Result := FStack.PeekKind in [mlfTargetMem, mlfSelfMem]; // allow const?
Result := (FStack.PeekKind in [mlfTargetMem, mlfSelfMem, mlfConstantDeref]);
if not Result then
SetError(fpErrLocationParserNoAddressOnStack);
end;
@ -1940,7 +1965,7 @@ begin
end;
DW_OP_deref: begin
if not AssertAddressOnStack then exit;
EntryP := FStack.Peek;
EntryP := FStack.PeekForDeref;
if not ReadAddressFromMemory(EntryP^, AddrSize, NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
@ -1955,7 +1980,7 @@ begin
end;
DW_OP_deref_size: begin
if not AssertAddressOnStack then exit;
EntryP := FStack.Peek;
EntryP := FStack.PeekForDeref;
if not ReadAddressFromMemory(EntryP^, ReadUnsignedFromExpression(CurData, 1), NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
@ -2189,9 +2214,10 @@ begin
end;
DW_OP_bra: begin
if not AssertMinCount(1) then exit;
Entry := FStack.Pop;
Entry := FStack.PopForDeref;
x := ReadSignedFromExpression(CurData, 2);
if Entry.Address <> 0 then
// mlfConstantDeref => The virtual address pointing to this constant is not nil
if (Entry.Address <> 0) or (Entry.MType = mlfConstantDeref) then
CurData := CurData + x;
end;
@ -2284,13 +2310,29 @@ begin
exit;
end;
end;
if FStack.FError <> fpErrNoError then begin
SetError(FStack.FError);
exit;
end;
end;
if (FLastError = nil) and (FStack.FError = fpErrNoError) then begin
if not AssertMinCount(1) then exit; // no value for result
//TODO: If a caller expects it, it could accept mlfConstantDeref as result (but it would still need to deref it)
FStack.Peek(); // check that the result value is valid
if FStack.FError <> fpErrNoError then
SetError(FStack.FError);
end;
end;
function TDwarfLocationExpression.ResultData: TFpDbgMemLocation;
begin
if (FLastError <> nil) or (FStack.FError <> fpErrNoError) or (FStack.Count = 0) then
exit(InvalidLoc);
if FStack.Count > 0 then
Result := FStack.Pop
Result := FStack.Peek^
else
Result := InvalidLoc;
end;

8
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -758,7 +758,7 @@ end;
function TFpDwarfV3FreePascalSymbolTypeArray.GetTypedValueObject(
ATypeCast: Boolean): TFpDwarfValue;
begin
if GetInternalStringType in [iasShortString, iasAnsiString, iasUnicodeString] then
if GetInternalStringType in [{iasShortString,} iasAnsiString, iasUnicodeString] then
Result := TFpDwarfV3ValueFreePascalString.Create(Self)
else
Result := inherited GetTypedValueObject(ATypeCast);
@ -791,7 +791,9 @@ begin
assert(TypeCastTargetType.Kind in [skString, skWideString], 'TFpDwarfValueArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray');
f := TypeCastSourceValue.FieldFlags;
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) or
(svfOrdinal in f)
then
exit;
//if sfDynArray in TypeCastTargetType.Flags then begin
@ -854,6 +856,8 @@ begin
exit;
Addr := DataAddr;
if (not IsValidLoc(Addr)) and (svfOrdinal in TypeCastSourceValue.FieldFlags) then
Addr := TargetLoc(TypeCastSourceValue.AsCardinal);
if not IsReadableLoc(Addr) then
exit;

33
components/fpdebug/fpdmemorytools.pas
View File

@ -253,10 +253,18 @@ type
mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...)
// the below will be mapped (and extended) according to endianess
mlfTargetRegister, // reads from the register
mlfConstant // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process)
mlfConstant, // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process)
mlfConstantDeref // A constant that can be used instead of an address (location parser),
// If a value (e.g. literal numeric constant 0x1234) has no address,
// then this is treated as its virtual address.
// If (and only if) the value is attempted to be derefed, then
// it will yield the constant as the result of the deref.
// It can also be tested for nil. The virtual address is never nil.
// Any other access must result in an error.
// Used for PFoo(1234)^ or TObject(1234).Foo
);
TFpDbgMemLocation = record
TFpDbgMemLocation = packed record
Address: TDbgPtr;
MType: TFpDbgMemLocationType;
end;
@ -350,6 +358,7 @@ function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; inline;
function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline;
function IsTargetAddr(ALocation: TFpDbgMemLocation): Boolean; inline;
function IsConstData(ALocation: TFpDbgMemLocation): Boolean; inline;
function IsInitializedLoc(ALocation: TFpDbgMemLocation): Boolean; inline;
function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed
function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil // can be const or reg
@ -357,6 +366,8 @@ function IsReadableMem(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid
function IsTargetNil(ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed = nil
function IsTargetNotNil(ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed <> nil
operator = (a,b: TFpDbgMemLocation): Boolean; inline;
function LocToAddr(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid
function LocToAddrOrNil(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version
@ -419,6 +430,11 @@ begin
Result := ALocation.MType = mlfTargetMem;
end;
function IsConstData(ALocation: TFpDbgMemLocation): Boolean;
begin
Result := not(ALocation.MType in [mlfConstant, mlfConstantDeref]);
end;
function IsInitializedLoc(ALocation: TFpDbgMemLocation): Boolean;
begin
Result := ALocation.MType <> mlfUninitialized;
@ -453,6 +469,11 @@ begin
Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address <> 0);
end;
operator = (a, b: TFpDbgMemLocation): Boolean;
begin
Result := (a.Address = b.Address) and (a.MType = b.MType);
end;
function LocToAddr(ALocation: TFpDbgMemLocation): TDbgPtr;
begin
assert(ALocation.MType = mlfTargetMem, 'LocToAddr for other than mlfTargetMem');
@ -824,10 +845,10 @@ begin
else
TargetMemConvertor.FailedTargetRead(ConvData);
end;
mlfConstant, mlfTargetRegister:
mlfConstant, mlfConstantDeref, mlfTargetRegister:
begin
case ALocation.MType of
mlfConstant: begin
mlfConstant, mlfConstantDeref: begin
TmpVal := ALocation.Address;
i := SizeOf(ALocation.Address);
end;
@ -927,10 +948,10 @@ begin
move(Pointer(ALocation.Address)^, ADest^, ASize);
Result := True;
end;
mlfConstant, mlfTargetRegister:
mlfConstant, mlfConstantDeref, mlfTargetRegister:
begin
case ALocation.MType of
mlfConstant: begin
mlfConstant, mlfConstantDeref: begin
TmpVal := ALocation.Address;
i := SizeOf(ALocation.Address);
end;