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

FpDebug: Read embedded type for enum signed-ness (fpc 3.3.1). Add other checks for enum signed-ness

Browse Source
This commit is contained in:
Martin 2025-04-19 16:50:56 +02:00
parent d26f6d30af
commit c80e65bab0
2 changed files with 273 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

277
components/fpdebug/fpdbgdwarf.pas
View File

@ -568,6 +568,8 @@ type
TFpDwarfAtEntryDataReadState = (rfNotRead, rfNotFound, rfError, rfConst, rfValue, rfExpression);
PFpDwarfAtEntryDataReadState = ^TFpDwarfAtEntryDataReadState;
TFpDwarfSignInfo = (sgnUnknown, sgnNotAvail, sgnUnsigned, sgnSigned);
{ TFpSymbolDwarf }
TFpSymbolDwarf = class(TDbgDwarfSymbolBase)
@ -577,6 +579,7 @@ type
function GetNestedTypeInfo: TFpSymbolDwarfType;
function GetTypeInfo: TFpSymbolDwarfType; inline;
protected
function GetSignInfo: TFpDwarfSignInfo; virtual;
function DoGetNestedTypeInfo: TFpSymbolDwarfType; virtual;
function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
function IsArtificial: Boolean; // usud by formal param and subprogram
@ -888,8 +891,12 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
{ TFpSymbolDwarfDataEnumMember }
TFpSymbolDwarfDataEnumMember = class(TFpSymbolDwarfData)
FSigned: TFpDwarfSignInfo;
FOrdinalValue: Int64;
FOrdinalValueRead, FHasOrdinalValue: Boolean;
FCardinalValue: QWord;
FCardinalValueRead, FHasCardinalValue: Boolean;
function ReadCardinalValue(out AValue: QWord): Boolean;
procedure ReadOrdinalValue;
protected
procedure KindNeeded; override;
@ -905,8 +912,11 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
TFpSymbolDwarfTypeEnum = class(TFpSymbolDwarfType)
private
FMembers: TRefCntObjList;
FSigned: TFpDwarfSignInfo;
FNstSymForSigned: TFpSymbolDwarf;
procedure CreateMembers;
protected
function GetSignInfo: TFpDwarfSignInfo; override;
procedure KindNeeded; override;
function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
@ -2998,10 +3008,11 @@ end;
procedure TFpValueDwarfEnum.InitMemberIndex;
var
MbrVal: QWord;
i, j: Integer;
MbrVal, NstVal: QWord;
i: Integer;
Sz: TFpDbgValueSize;
Mask: TDBGPtr;
nst: TFpSymbol;
begin
// TODO: if TypeInfo is a subrange, check against the bounds, then bypass it, and scan all members (avoid subrange scanning members)
if FMemberValueDone then exit;
@ -3013,10 +3024,19 @@ begin
MbrVal := GetAsCardinal and Mask;
i := FTypeSymbol.NestedSymbolCount - 1;
j := -1;
while i >= 0 do begin
if (QWord(FTypeSymbol.NestedSymbol[i].OrdinalValue) and Mask) = MbrVal then
break;
nst := FTypeSymbol.NestedSymbol[i];
if nst is TFpSymbolDwarfDataEnumMember then begin
if TFpSymbolDwarfDataEnumMember(nst).ReadCardinalValue(NstVal) and
((NstVal and Mask) = MbrVal)
then
break;
end
else begin
assert(False, 'TFpValueDwarfEnum.InitMemberIndex: False');
if nst.HasOrdinalValue and ((QWord(nst.OrdinalValue) and Mask) = MbrVal) then
break;
end;
dec(i);
end;
FMemberIndex := i;
@ -3047,10 +3067,27 @@ begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
Result := inherited GetAsCardinal
else
if not Context.ReadEnum(OrdOrDataAddr, Size, Result) then begin
SetLastError(Context.LastMemError);
Result := 0; // TODO: error
else begin
case TFpSymbolDwarf(FTypeSymbol).GetSignInfo of
sgnUnknown, sgnNotAvail: begin
if not Context.ReadEnum(OrdOrDataAddr, Size, Result) then begin
SetLastError(Context.LastMemError);
Result := 0;
end
else
Result := QWord(SignExtend(Result, Size));
end;
sgnUnsigned:
if not Context.ReadUnsignedInt(OrdOrDataAddr, Size, Result) then begin
SetLastError(Context.LastMemError);
Result := 0;
end;
sgnSigned:
if not Context.ReadSignedInt(OrdOrDataAddr, Size, int64(Result)) then begin
SetLastError(Context.LastMemError);
Result := 0;
end;
end;
end;
FValue := Result;
@ -3060,9 +3097,7 @@ function TFpValueDwarfEnum.GetAsInteger: Int64;
var
Size: TFpDbgValueSize;
begin
Result := GetAsCardinal;
if GetSize(Size) then
Result := SignExtend(QWord(Result), Size);
Result := Int64(GetAsCardinal);
end;
procedure TFpValueDwarfEnum.SetAsCardinal(AValue: QWord);
@ -4422,6 +4457,17 @@ begin
Result := TFpSymbolDwarfType(inherited TypeInfo);
end;
function TFpSymbolDwarf.GetSignInfo: TFpDwarfSignInfo;
var
n: TFpSymbolDwarfType;
begin
n := NestedTypeInfo;
if (n <> nil) then
Result := n.GetSignInfo
else
Result := sgnNotAvail;
end;
function TFpSymbolDwarf.DoGetNestedTypeInfo: TFpSymbolDwarfType;
var
FwdInfoPtr: Pointer;
@ -5940,11 +5986,62 @@ end;
{ TDbgDwarfIdentifierEnumElement }
procedure TFpSymbolDwarfDataEnumMember.ReadOrdinalValue;
function TFpSymbolDwarfDataEnumMember.ReadCardinalValue(out AValue: QWord): Boolean;
begin
if FOrdinalValueRead then exit;
AValue := FCardinalValue;
Result := FHasCardinalValue;
if FCardinalValueRead then
exit;
FCardinalValueRead := True;
FHasCardinalValue := InformationEntry.ReadValue(DW_AT_const_value, FCardinalValue);
AValue := FCardinalValue;
Result := FHasCardinalValue;
end;
procedure TFpSymbolDwarfDataEnumMember.ReadOrdinalValue;
function GetSignInfo: TFpDwarfSignInfo;
var
ParentInfo: TDwarfInformationEntry;
ParentSym: TFpSymbolDwarf;
begin
Result := FSigned;
if FSigned <> sgnUnknown then
exit;
ParentInfo := InformationEntry.Clone;
ParentInfo.GoParent;
ParentSym := TFpSymbolDwarf.CreateSubClass('', ParentInfo);
ParentInfo.ReleaseReference;
if ParentSym is TFpSymbolDwarfTypeEnum then
TFpSymbolDwarfTypeEnum(ParentSym).FNstSymForSigned := Self; // don't create a new member
Result := ParentSym.GetSignInfo;
FSigned := Result;
ParentSym.ReleaseReference;
end;
var
AttrData: TDwarfAttribData;
begin
if FOrdinalValueRead then
exit;
FOrdinalValueRead := True;
FHasOrdinalValue := InformationEntry.ReadValue(DW_AT_const_value, FOrdinalValue);
FHasOrdinalValue := ReadCardinalValue(QWord(FOrdinalValue));
if FHasOrdinalValue and
InformationEntry.GetAttribData(DW_AT_const_value, AttrData) and
(AttrData.InformationEntry <> nil)
then begin
case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
DW_FORM_data1: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(1));
DW_FORM_data2: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(2));
DW_FORM_data4: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(4));
end;
end;
end;
procedure TFpSymbolDwarfDataEnumMember.KindNeeded;
@ -5993,6 +6090,8 @@ begin
if (Info.AbbrevTag = DW_TAG_enumerator) then begin
Info2 := Info.Clone;
sym := TFpSymbolDwarf.CreateSubClass('', Info2);
if sym is TFpSymbolDwarfDataEnumMember then
TFpSymbolDwarfDataEnumMember(sym).FSigned := FSigned;
FMembers.Add(sym);
sym.ReleaseReference;
Info2.ReleaseReference;
@ -6003,6 +6102,154 @@ begin
Info.ReleaseReference;
end;
function TFpSymbolDwarfTypeEnum.GetSignInfo: TFpDwarfSignInfo;
var
NstType: TFpSymbolDwarfType;
InfoEntry: TDwarfInformationEntry;
AttrData: TDwarfAttribData;
NstSym: TFpSymbolDwarf;
Sz: TFpDbgValueSize;
MaybeUnsigned: Boolean;
Encoding, i, c: Integer;
NstVal, SgnMask: QWord;
sym: TFpSymbol;
begin
Result := FSigned;
if FSigned <> sgnUnknown then
exit;
try
FSigned := sgnNotAvail;
NstType := NestedTypeInfo;
if NstType <> nil then begin
case NstType.Kind of
skInteger: FSigned := sgnSigned;
skCardinal: FSigned := sgnUnsigned;
end;
Result := FSigned;
if FSigned <> sgnNotAvail then
exit;
end;
// GCC writes DW_AT_encoding - even thought it is not allowed here
if InformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin
debugln(FPDBG_DWARF_VERBOSE, ['TFpSymbolDwarfTypeEnum.InitSigned found DW_AT_encoding']);
case Encoding of
DW_ATE_signed, DW_ATE_signed_char: FSigned := sgnSigned;
DW_ATE_unsigned, DW_ATE_unsigned_char: FSigned := sgnUnsigned;
end;
Result := FSigned;
if FSigned <> sgnNotAvail then
exit;
end;
// Guess from member data
if (FNstSymForSigned <> nil) then begin
InfoEntry := FNstSymForSigned.InformationEntry;
if (InfoEntry <> nil) and
InfoEntry.GetAttribData(DW_AT_const_value, AttrData) and
(AttrData.InformationEntry <> nil)
then begin
case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
DW_FORM_sdata: FSigned := sgnSigned; // may be unsigned (llvm), but the enum-member will not sign extend it
DW_FORM_udata: FSigned := sgnUnsigned;
end;
end;
Result := FSigned;
if FSigned <> sgnNotAvail then
exit;
end;
if (FNstSymForSigned <> nil) or (NestedSymbolCount > 0) then begin
if ReadSize(nil, Sz) and (not IsZeroSize(Sz)) then begin
MaybeUnsigned := True;
SgnMask := SignMask(Sz);
c := 0;
if FNstSymForSigned = nil then
c := NestedSymbolCount - 1;
for i := 0 to c do begin
NstSym := FNstSymForSigned;
if NstSym = nil then
NstSym := TFpSymbolDwarf(NestedSymbol[i]);
if (NstSym <> nil) then begin
InfoEntry := NstSym.InformationEntry;
if (InfoEntry <> nil) and
InfoEntry.GetAttribData(DW_AT_const_value, AttrData) and
(AttrData.InformationEntry <> nil)
then begin
case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
DW_FORM_sdata: begin
if TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) then begin
if Int64(NstVal) < 0 then
FSigned := sgnSigned
else
if (NstVal and SgnMask) <> 0 then
FSigned := sgnUnsigned; // positive value that was not sign extended
end;
end;
DW_FORM_udata: FSigned := sgnUnsigned;
// If the form is bigger than the size, then use the lead as sign info
DW_FORM_data2:
if (SizeToFullBytes(Sz) < 2) then begin
if (NstSym is TFpSymbolDwarfDataEnumMember) and
TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
(NstVal and QWord($8000) <> 0)
then
FSigned := sgnSigned;
end
else
MaybeUnsigned := False;
DW_FORM_data4:
if (SizeToFullBytes(Sz) < 4) then begin
if (NstSym is TFpSymbolDwarfDataEnumMember) and
TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
(NstVal and QWord($80000000) <> 0)
then
FSigned := sgnSigned;
end
else
MaybeUnsigned := False;
DW_FORM_data8:
if (SizeToFullBytes(Sz) < 8) then begin
if (NstSym is TFpSymbolDwarfDataEnumMember) and
TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
(NstVal and QWord($8000000000000000) <> 0)
then
FSigned := sgnSigned;
end
else
MaybeUnsigned := False;
otherwise begin
MaybeUnsigned := False;
break;
end;
end;
end;
end;
Result := FSigned;
if FSigned <> sgnNotAvail then
exit;
if (not MaybeUnsigned) then
break;
end;
end;
if MaybeUnsigned and (FSigned = sgnNotAvail) then begin
FSigned := sgnUnsigned;
Result := FSigned;
end;
end;
finally
if (FMembers <> nil) and (FNstSymForSigned = nil) then begin
for i := 0 to FMembers.Count - 1 do begin
sym := TFpSymbol(FMembers[i]);
if sym is TFpSymbolDwarfDataEnumMember then
TFpSymbolDwarfDataEnumMember(sym).FSigned := FSigned;
end;
end;
end;
end;
function TFpSymbolDwarfTypeEnum.GetTypedValueObject(ATypeCast: Boolean;
AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
begin

11
components/fpdebug/fpdmemorytools.pas
View File

@ -613,6 +613,7 @@ function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; //
function SignExtend(ASrcVal: QWord; ASrcSize: TFpDbgValueSize): Int64;
function BitMask(ASize: TFpDbgValueSize): QWord; inline;
function SignMask(ASize: TFpDbgValueSize): QWord; inline;
//function EmptyMemReadOpts:TFpDbgMemReadOptions;
@ -1027,6 +1028,16 @@ begin
Result := Result shr (64 - i);
end;
function SignMask(ASize: TFpDbgValueSize): QWord;
var
i: Int64;
begin
Result := 0;
i := SizeToBits(ASize) - 1;
if (i >= 0) and (i < 64) then
Result := QWord(1) shl i;
end;
//function {%H-}EmptyMemReadOpts: TFpDbgMemReadOptions;
//begin
// //