mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 22:29:25 +02:00
FpDebug: Refactor TFpSymbol.Size
git-svn-id: trunk@61923 -
This commit is contained in:
martin
parent
f40380b1ea
commit
9c280bd0e3
File diff suppressed because it is too large
Load Diff
@ -690,9 +690,18 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfFreePascalTypePointer.DataSize: Integer;
|
||||
var
|
||||
Size: QWord;
|
||||
begin
|
||||
if Kind = skClass then
|
||||
Result := NestedTypeInfo.Size
|
||||
if Kind = skClass then begin
|
||||
// TODO: get a value object // though fpc does not yet write variable sizes
|
||||
if not NestedTypeInfo.ReadSize(nil, Size) then begin
|
||||
Result := 0;
|
||||
SetLastError(CreateError(fpErrAnyError, ['unknown size']));
|
||||
exit;
|
||||
end;
|
||||
Result := Size
|
||||
end
|
||||
else
|
||||
Result := inherited DataSize;
|
||||
end;
|
||||
@ -779,7 +788,7 @@ end;
|
||||
|
||||
function TFpValueDwarfV2FreePascalShortString.GetAsString: AnsiString;
|
||||
var
|
||||
len: QWord;
|
||||
len, Size: QWord;
|
||||
LenSym, StSym: TFpValueDwarf;
|
||||
begin
|
||||
if FValueDone then
|
||||
@ -789,8 +798,12 @@ begin
|
||||
assert(LenSym is TFpValueDwarf, 'LenSym is TFpValueDwarf');
|
||||
len := LenSym.AsCardinal;
|
||||
|
||||
if (TypeInfo.Size < 0) or (len > TypeInfo.Size) then begin
|
||||
FLastError := CreateError(fpErrAnyError);
|
||||
if not GetSize(Size) then begin;
|
||||
SetLastError(CreateError(fpErrAnyError));
|
||||
exit('');
|
||||
end;
|
||||
if (Size < 0) or (len > Size) then begin
|
||||
SetLastError(CreateError(fpErrAnyError));
|
||||
exit('');
|
||||
end;
|
||||
|
||||
@ -803,7 +816,7 @@ begin
|
||||
if len > 0 then
|
||||
if not MemManager.ReadMemory(StSym.DataAddress, len, @Result[1]) then begin
|
||||
Result := ''; // TODO: error
|
||||
FLastError := MemManager.LastError;
|
||||
SetLastError(MemManager.LastError);
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -904,7 +917,7 @@ begin
|
||||
exit;
|
||||
end
|
||||
else
|
||||
FLastError := MemManager.LastError;
|
||||
SetLastError(MemManager.LastError);
|
||||
Result := 0;
|
||||
exit;
|
||||
end;
|
||||
@ -920,6 +933,7 @@ var
|
||||
Info: TDwarfInformationEntry;
|
||||
t: Cardinal;
|
||||
t2: TFpSymbol;
|
||||
CharSize: QWord;
|
||||
begin
|
||||
Result := FArrayOrStringType;
|
||||
if Result <> iasUnknown then
|
||||
@ -949,7 +963,9 @@ begin
|
||||
// This is a string
|
||||
// TODO: check the location parser, if it is a reference
|
||||
//FIsShortString := iasShortString;
|
||||
if (t2.Size = 2) then
|
||||
if not t2.ReadSize(nil, CharSize) then
|
||||
CharSize := 0; // TODO: error
|
||||
if (CharSize = 2) then
|
||||
FArrayOrStringType := iasUnicodeString
|
||||
else
|
||||
FArrayOrStringType := iasAnsiString;
|
||||
@ -1105,7 +1121,7 @@ begin
|
||||
|
||||
if not MemManager.ReadMemory(Addr, (HighBound-LowBound+1)*2, @WResult[1]) then begin
|
||||
WResult := '';
|
||||
FLastError := MemManager.LastError;
|
||||
SetLastError(MemManager.LastError);
|
||||
end;
|
||||
Result := WResult;
|
||||
end else begin
|
||||
@ -1113,7 +1129,7 @@ begin
|
||||
|
||||
if not MemManager.ReadMemory(Addr, HighBound-LowBound+1, @Result[1]) then begin
|
||||
Result := '';
|
||||
FLastError := MemManager.LastError;
|
||||
SetLastError(MemManager.LastError);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -99,7 +99,7 @@ type
|
||||
TDbgSymbolFlags = set of TDbgSymbolFlag;
|
||||
|
||||
TFpSymbolField = (
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize,
|
||||
sfiName, sfiKind, sfiSymType, sfiAddress, //sfiSize,
|
||||
sfiTypeInfo, sfiMemberVisibility,
|
||||
sfiForwardToSymbol
|
||||
);
|
||||
@ -125,7 +125,14 @@ type
|
||||
{ TFpValue }
|
||||
|
||||
TFpValue = class(TFpDbgCircularRefCountedObject)
|
||||
private
|
||||
FEvalFlags: set of (efSizeDone, efSizeUnavail);
|
||||
FLastError: TFpError;
|
||||
FSize: QWord;
|
||||
protected
|
||||
procedure Reset; virtual; // keeps lastmember and structureninfo
|
||||
procedure SetLastError(ALastError: TFpError);
|
||||
|
||||
function GetKind: TDbgSymbolKind; virtual;
|
||||
function GetFieldFlags: TFpValueFieldFlags; virtual;
|
||||
|
||||
@ -137,9 +144,9 @@ type
|
||||
function GetAsFloat: Extended; virtual;
|
||||
|
||||
function GetAddress: TFpDbgMemLocation; virtual;
|
||||
function GetSize: Integer; virtual; // returns -1, if not available
|
||||
function DoGetSize(out ASize: QWord): Boolean; virtual;
|
||||
function GetDataAddress: TFpDbgMemLocation; virtual;
|
||||
function GetDataSize: Integer; virtual;
|
||||
function GetDataSize: QWord; virtual;
|
||||
|
||||
function GetHasBounds: Boolean; virtual;
|
||||
function GetOrdHighBound: Int64; virtual;
|
||||
@ -162,6 +169,8 @@ type
|
||||
constructor Create;
|
||||
property RefCount;
|
||||
|
||||
function GetSize(out ASize: QWord): Boolean; inline;
|
||||
|
||||
// Kind: determines which types of value are available
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
property FieldFlags: TFpValueFieldFlags read GetFieldFlags;
|
||||
@ -181,9 +190,8 @@ type
|
||||
For pointers, this is the address of the pointed-to data
|
||||
*)
|
||||
property Address: TFpDbgMemLocation read GetAddress;
|
||||
property Size: Integer read GetSize;
|
||||
property DataAddress: TFpDbgMemLocation read GetDataAddress; //
|
||||
property DataSize: Integer read GetDataSize;
|
||||
property DataSize: QWord read GetDataSize;
|
||||
|
||||
property HasBounds: Boolean read GetHasBounds;
|
||||
property OrdLowBound: Int64 read GetOrdLowBound; // need typecast for QuadWord
|
||||
@ -335,14 +343,12 @@ type
|
||||
FKind: TDbgSymbolKind;
|
||||
FSymbolType: TDbgSymbolType;
|
||||
FAddress: TFpDbgMemLocation;
|
||||
FSize: Integer;
|
||||
FTypeInfo: TFpSymbol;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility; // Todo: not cached
|
||||
|
||||
function GetSymbolType: TDbgSymbolType; inline;
|
||||
function GetKind: TDbgSymbolKind; inline;
|
||||
function GetName: String; inline;
|
||||
function GetSize: Integer; inline;
|
||||
function GetAddress: TFpDbgMemLocation; inline;
|
||||
function GetTypeInfo: TFpSymbol; inline;
|
||||
function GetMemberVisibility: TDbgSymbolMemberVisibility; inline;
|
||||
@ -371,7 +377,6 @@ type
|
||||
procedure SetKind(AValue: TDbgSymbolKind); inline;
|
||||
procedure SetSymbolType(AValue: TDbgSymbolType); inline;
|
||||
procedure SetAddress(AValue: TFpDbgMemLocation); inline;
|
||||
procedure SetSize(AValue: Integer); inline;
|
||||
procedure SetTypeInfo(ASymbol: TFpSymbol); inline;
|
||||
procedure SetMemberVisibility(AValue: TDbgSymbolMemberVisibility); inline;
|
||||
|
||||
@ -379,7 +384,7 @@ type
|
||||
procedure NameNeeded; virtual;
|
||||
procedure SymbolTypeNeeded; virtual;
|
||||
procedure AddressNeeded; virtual;
|
||||
procedure SizeNeeded; virtual;
|
||||
function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; virtual;
|
||||
procedure TypeInfoNeeded; virtual;
|
||||
procedure MemberVisibilityNeeded; virtual;
|
||||
//procedure Needed; virtual;
|
||||
@ -392,9 +397,9 @@ type
|
||||
property SymbolType: TDbgSymbolType read GetSymbolType;
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
// Memory; Size is also part of type (byte vs word vs ...)
|
||||
// HasAddress // (register does not have)
|
||||
property Address: TFpDbgMemLocation read GetAddress; // used by Proc/func
|
||||
property Size: Integer read GetSize; // In Bytes
|
||||
// ReadSize: Return False means no value available, and an error may or may not have occurred
|
||||
function ReadSize(const AValueObj: TFpValue; out ASize: QWord{TDbgPtr}): Boolean; inline;
|
||||
// TypeInfo used by
|
||||
// stValue (Variable): Type
|
||||
// stType: Pointer: type pointed to / Array: Element Type / Func: Result / Class: itheritance
|
||||
@ -458,7 +463,7 @@ type
|
||||
procedure KindNeeded; override;
|
||||
procedure NameNeeded; override;
|
||||
procedure SymbolTypeNeeded; override;
|
||||
procedure SizeNeeded; override;
|
||||
function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override;
|
||||
procedure TypeInfoNeeded; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
|
||||
@ -726,7 +731,7 @@ end;
|
||||
|
||||
function TFpValue.GetLastError: TFpError;
|
||||
begin
|
||||
Result := NoError;
|
||||
Result := FLastError;
|
||||
end;
|
||||
|
||||
function TFpValue.GetHasBounds: Boolean;
|
||||
@ -744,6 +749,18 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TFpValue.Reset;
|
||||
begin
|
||||
FEvalFlags := [];
|
||||
FLastError := NoError;
|
||||
end;
|
||||
|
||||
procedure TFpValue.SetLastError(ALastError: TFpError);
|
||||
begin
|
||||
assert(IsError(ALastError), 'TFpValue.SetLastError: IsError(ALastError)');
|
||||
FLastError := ALastError;
|
||||
end;
|
||||
|
||||
function TFpValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skNone;
|
||||
@ -769,19 +786,48 @@ begin
|
||||
Result := InvalidLoc;
|
||||
end;
|
||||
|
||||
function TFpValue.DoGetSize(out ASize: QWord): Boolean;
|
||||
var
|
||||
ti: TFpSymbol;
|
||||
begin
|
||||
Result := False;
|
||||
ti := TypeInfo;
|
||||
if ti = nil then
|
||||
exit;
|
||||
|
||||
Result := ti.ReadSize(Self, ASize);
|
||||
if (not Result) and IsError(ti.LastError) then
|
||||
SetLastError(ti.LastError);
|
||||
end;
|
||||
|
||||
function TFpValue.GetDataAddress: TFpDbgMemLocation;
|
||||
begin
|
||||
Result := Address;
|
||||
end;
|
||||
|
||||
function TFpValue.GetDataSize: Integer;
|
||||
function TFpValue.GetDataSize: QWord;
|
||||
begin
|
||||
Result := Size;
|
||||
GetSize(Result);
|
||||
end;
|
||||
|
||||
function TFpValue.GetSize: Integer;
|
||||
function TFpValue.GetSize(out ASize: QWord): Boolean;
|
||||
begin
|
||||
Result := -1;
|
||||
Result := False;
|
||||
if (efSizeUnavail in FEvalFlags) then // If there was an error, then LastError should still be set
|
||||
exit;
|
||||
|
||||
Result := efSizeDone in FEvalFlags;
|
||||
if Result then begin
|
||||
ASize := FSize;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := DoGetSize(ASize);
|
||||
FSize := ASize;
|
||||
if Result then
|
||||
Include(FEvalFlags, efSizeDone)
|
||||
else
|
||||
Include(FEvalFlags, efSizeUnavail);
|
||||
end;
|
||||
|
||||
function TFpValue.GetAsBool: Boolean;
|
||||
@ -982,6 +1028,12 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFpSymbol.ReadSize(const AValueObj: TFpValue; out ASize: QWord
|
||||
): Boolean;
|
||||
begin
|
||||
Result := DoReadSize(AValueObj, ASize);
|
||||
end;
|
||||
|
||||
function TFpSymbol.GetValueBounds(AValueObj: TFpValue; out ALowBound,
|
||||
AHighBound: Int64): Boolean;
|
||||
begin
|
||||
@ -1047,13 +1099,6 @@ begin
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
function TFpSymbol.GetSize: Integer;
|
||||
begin
|
||||
if not(sfiSize in FEvaluatedFields) then
|
||||
SizeNeeded;
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
function TFpSymbol.GetSymbolType: TDbgSymbolType;
|
||||
begin
|
||||
if not(sfiSymType in FEvaluatedFields) then
|
||||
@ -1114,12 +1159,6 @@ begin
|
||||
Include(FEvaluatedFields, sfiSymType);
|
||||
end;
|
||||
|
||||
procedure TFpSymbol.SetSize(AValue: Integer);
|
||||
begin
|
||||
FSize := AValue;
|
||||
Include(FEvaluatedFields, sfiSize);
|
||||
end;
|
||||
|
||||
procedure TFpSymbol.SetTypeInfo(ASymbol: TFpSymbol);
|
||||
begin
|
||||
if FTypeInfo <> nil then begin
|
||||
@ -1196,9 +1235,11 @@ begin
|
||||
SetAddress(InvalidLoc);
|
||||
end;
|
||||
|
||||
procedure TFpSymbol.SizeNeeded;
|
||||
function TFpSymbol.DoReadSize(const AValueObj: TFpValue; out ASize: QWord
|
||||
): Boolean;
|
||||
begin
|
||||
SetSize(0);
|
||||
ASize := 0;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TFpSymbol.TypeInfoNeeded;
|
||||
@ -1279,15 +1320,16 @@ begin
|
||||
SetSymbolType(stNone); // inherited SymbolTypeNeeded;
|
||||
end;
|
||||
|
||||
procedure TFpSymbolForwarder.SizeNeeded;
|
||||
function TFpSymbolForwarder.DoReadSize(const AValueObj: TFpValue; out
|
||||
ASize: QWord): Boolean;
|
||||
var
|
||||
p: TFpSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
SetSize(p.Size)
|
||||
Result := p.DoReadSize(AValueObj, ASize)
|
||||
else
|
||||
SetSize(0); // inherited SizeNeeded;
|
||||
Result := inherited DoReadSize(AValueObj, ASize);
|
||||
end;
|
||||
|
||||
procedure TFpSymbolForwarder.TypeInfoNeeded;
|
||||
|
||||
@ -759,12 +759,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
procedure DoInt;
|
||||
var
|
||||
n: Integer;
|
||||
ValSize: QWord;
|
||||
begin
|
||||
case ADisplayFormat of
|
||||
wdfUnsigned: APrintedValue := IntToStr(QWord(AValue.AsInteger));
|
||||
wdfHex: begin
|
||||
if svfSize in AValue.FieldFlags then
|
||||
n := AValue.Size * 2
|
||||
if (svfSize in AValue.FieldFlags) and AValue.GetSize(ValSize) then
|
||||
n := ValSize* 2
|
||||
else begin
|
||||
n := 16;
|
||||
if QWord(AValue.AsInteger) <= high(Cardinal) then n := 8;
|
||||
@ -788,12 +789,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
procedure DoCardinal;
|
||||
var
|
||||
n: Integer;
|
||||
ValSize: QWord;
|
||||
begin
|
||||
case ADisplayFormat of
|
||||
wdfDecimal: APrintedValue := IntToStr(Int64(AValue.AsCardinal));
|
||||
wdfHex: begin
|
||||
if svfSize in AValue.FieldFlags then
|
||||
n := AValue.Size * 2
|
||||
if (svfSize in AValue.FieldFlags) and AValue.GetSize(ValSize) then
|
||||
n := ValSize* 2
|
||||
else begin
|
||||
n := 16;
|
||||
if AValue.AsCardinal <= high(Cardinal) then n := 8;
|
||||
@ -1095,6 +1097,7 @@ var
|
||||
MemSize: Integer;
|
||||
MemDest: array of Byte;
|
||||
i: Integer;
|
||||
ValSize: QWord;
|
||||
begin
|
||||
if ADBGTypeInfo <> nil then ADBGTypeInfo^ := nil;
|
||||
if ANestLevel > 0 then begin
|
||||
@ -1111,7 +1114,9 @@ begin
|
||||
else
|
||||
if svfAddress in AValue.FieldFlags then begin
|
||||
MemAddr := AValue.Address;
|
||||
MemSize := AValue.Size;
|
||||
if not AValue.GetSize(ValSize) then
|
||||
ValSize := 256;
|
||||
MemSize := ValSize;
|
||||
end;
|
||||
if MemSize < ARepeatCount then MemSize := ARepeatCount;
|
||||
if MemSize <= 0 then MemSize := 256;
|
||||
|
||||
@ -523,7 +523,7 @@ type
|
||||
protected
|
||||
function GetFieldFlags: TFpValueFieldFlags; override;
|
||||
function GetAddress: TFpDbgMemLocation; override;
|
||||
function GetSize: Integer; override;
|
||||
function DoGetSize(out ASize: QWord): Boolean; override;
|
||||
function GetAsCardinal: QWord; override; // reads men
|
||||
function GetTypeInfo: TFpSymbol; override; // TODO: Cardinal? Why? // TODO: does not handle AOffset
|
||||
public
|
||||
@ -640,6 +640,7 @@ var
|
||||
ti: TFpSymbol;
|
||||
addr: TFpDbgMemLocation;
|
||||
Tmp: TFpValueConstAddress;
|
||||
Size: QWord;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
@ -650,8 +651,15 @@ begin
|
||||
exit;
|
||||
end;
|
||||
{$PUSH}{$R-}{$Q-} // TODO: check overflow
|
||||
if ti <> nil then
|
||||
AIndex := AIndex * ti.Size;
|
||||
if (ti <> nil) and (AIndex <> 0) then begin
|
||||
// Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
|
||||
// TODO: Size of member[0] ?
|
||||
if not ti.ReadSize(nil, Size) then begin
|
||||
SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size']));
|
||||
exit;
|
||||
end;
|
||||
AIndex := AIndex * Size;
|
||||
end;
|
||||
addr.Address := addr.Address + AIndex;
|
||||
{$POP}
|
||||
|
||||
@ -773,16 +781,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpPasParserValueDerefPointer.GetSize: Integer;
|
||||
function TFpPasParserValueDerefPointer.DoGetSize(out ASize: QWord): Boolean;
|
||||
var
|
||||
t: TFpSymbol;
|
||||
begin
|
||||
t := FValue.TypeInfo;
|
||||
if t <> nil then t := t.TypeInfo;
|
||||
if t <> nil then
|
||||
Result := t.Size
|
||||
t.ReadSize(nil, ASize) // TODO: create a value object for the deref
|
||||
else
|
||||
Result := inherited GetSize;
|
||||
Result := inherited DoGetSize(ASize);
|
||||
end;
|
||||
|
||||
function TFpPasParserValueDerefPointer.GetAsCardinal: QWord;
|
||||
@ -901,6 +909,7 @@ var
|
||||
ti: TFpSymbol;
|
||||
addr: TFpDbgMemLocation;
|
||||
Tmp: TFpValueConstAddress;
|
||||
Size: QWord;
|
||||
begin
|
||||
if (AIndex = 0) or (FValue = nil) then begin
|
||||
Result := FValue;
|
||||
@ -915,8 +924,15 @@ begin
|
||||
exit;
|
||||
end;
|
||||
{$PUSH}{$R-}{$Q-} // TODO: check overflow
|
||||
if ti <> nil then
|
||||
AIndex := AIndex * ti.Size;
|
||||
if (ti <> nil) and (AIndex <> 0) then begin
|
||||
// Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
|
||||
// TODO: Size of member[0] ?
|
||||
if not ti.ReadSize(nil, Size) then begin
|
||||
SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size']));
|
||||
exit;
|
||||
end;
|
||||
AIndex := AIndex * Size;
|
||||
end;
|
||||
addr.Address := addr.Address + AIndex;
|
||||
{$POP}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user