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

FPDebug: handle float

Browse Source 
git-svn-id: trunk@44074 -
This commit is contained in:
martin 2014-02-14 18:23:15 +00:00
parent a328c53065
commit 369d6dc630
4 changed files with 110 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
components/fpdebug/fpdbgdwarf.pas
View File

@ -642,7 +642,7 @@ type
TDbgDwarfNumericSymbolValue = class(TDbgDwarfSizedSymbolValue)
protected
FEvaluated: set of (doneUInt, doneInt, doneAddr);
FEvaluated: set of (doneUInt, doneInt, doneAddr, doneFloat);
protected
procedure Reset; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override; // svfOrdinal
@ -675,8 +675,12 @@ type
{ TDbgDwarfFloatSymbolValue }
TDbgDwarfFloatSymbolValue = class(TDbgDwarfNumericSymbolValue) // TDbgDwarfSymbolValue
// TODO: typecasts to int should convert
private
FValue: Extended;
protected
//function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetAsFloat: Extended; override;
end;
{ TDbgDwarfBooleanSymbolValue }
@ -1823,6 +1827,31 @@ begin
end;
end;
{ TDbgDwarfFloatSymbolValue }
function TDbgDwarfFloatSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
Result := Result + [svfFloat] - [svfOrdinal];
end;
function TDbgDwarfFloatSymbolValue.GetAsFloat: Extended;
begin
if doneFloat in FEvaluated then begin
Result := FValue;
exit;
end;
Include(FEvaluated, doneUInt);
if (FSize <= 0) or (FSize > SizeOf(Result)) then
Result := inherited GetAsCardinal
else
if not MemManager.ReadFloat(OrdOrDataAddr, FSize, Result) then
Result := 0; // TODO: error
FValue := Result;
end;
{ TDbgDwarfSymbolValueConstAddress }
procedure TDbgDwarfSymbolValueConstAddress.Update(AnAddress: TFpDbgMemLocation);

11
components/fpdebug/fpdbginfo.pas
View File

@ -117,7 +117,7 @@ type
// svfAddress, svfDataAddress this symbol does have an address, but it may still be nil
svfAddress, svfSize, svfSizeOfPointer,
svfDataAddress, svfDataSize, svfDataSizeOfPointer,
svfInteger, svfCardinal,
svfInteger, svfCardinal, svfFloat,
svfString, svfWideString,
svfBoolean,
svfIdentifier, // returned via AsString: a named value (enum, set-member)
@ -140,6 +140,7 @@ type
function GetAsInteger: Int64; virtual;
function GetAsString: AnsiString; virtual;
function GetAsWideString: WideString; virtual;
function GetAsFloat: Extended; virtual;
function GetAddress: TFpDbgMemLocation; virtual;
function GetSize: Integer; virtual; // returns -1, if not available
@ -169,8 +170,7 @@ type
property AsBool: Boolean read GetAsBool;
property AsString: AnsiString read GetAsString;
property AsWideString: WideString read GetAsWideString;
// complex
// double
property AsFloat: Extended read GetAsFloat;
property Address: TFpDbgMemLocation read GetAddress; // Address of variable
property Size: Integer read GetSize; // Size of variable
@ -582,6 +582,11 @@ begin
Result := 0;
end;
function TDbgSymbolValue.GetAsFloat: Extended;
begin
Result := 0;
end;
function TDbgSymbolValue.GetKind: TDbgSymbolKind;
begin
Result := skNone;

57
components/fpdebug/fpdmemorytools.pas
View File

@ -57,7 +57,7 @@ type
TFpDbgMemReadDataType = (
rdtAddress, rdtSignedInt, rdtUnsignedInt,
rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtfloat,
rdtEnum, rdtSet
);
@ -228,10 +228,10 @@ type
//function ReadSet (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: TBytes;
// AnOpts: TFpDbgMemReadOptions): Boolean;
function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AValue: Extended): Boolean; inline;
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: Double): Boolean; inline;
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: Double;
// out AValue: Extended;
// AnOpts: TFpDbgMemReadOptions): Boolean;
property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor;
@ -365,15 +365,24 @@ function TFpDbgMemConvertorLittleEndian.PrepareTargetRead(AReadDataType: TFpDbgM
ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal; out
AConvertorData: TFpDbgMemConvData): boolean;
begin
Result := False;
Result := ATargetSize <= ADestSize;
if not Result then
exit;
// just read to begin of data
AConvertorData.NewTargetAddress := ATargetPointer;
AConvertorData.NewDestAddress := ADestPointer;
AConvertorData.NewReadSize := Min(ATargetSize, ADestSize);
case AReadDataType of
rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtEnum, rdtSet: begin
Result := ATargetSize <= ADestSize;
// just read to begin of data
AConvertorData.NewTargetAddress := ATargetPointer;
AConvertorData.NewDestAddress := ADestPointer;
AConvertorData.NewReadSize := Min(ATargetSize, ADestSize);
end;
rdtAddress, rdtSignedInt, rdtUnsignedInt,
rdtEnum, rdtSet: ;
rdtfloat:
Result := (ATargetSize = AConvertorData.NewReadSize) and
(ADestSize = SizeOf(Extended)) and // only can read to extended... TODO (if need more)
( (ATargetSize = SizeOf(Extended)) or
(ATargetSize = SizeOf(Double)) or
(ATargetSize = SizeOf(Single)) or
(ATargetSize = SizeOf(real48))
)
else begin
Assert(False, 'TFpDbgMemConvertorLittleEndian.PrepareTargetRead');
Result := False;
@ -384,6 +393,8 @@ end;
function TFpDbgMemConvertorLittleEndian.FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal;
AConvertorData: TFpDbgMemConvData): boolean;
type
Preal48 = ^real48;
begin
Result := True;
case AReadDataType of
@ -399,6 +410,22 @@ begin
else
FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $00);
end;
rdtfloat: begin
assert((ADestSize = SizeOf(Extended)));
if (ATargetSize = SizeOf(Extended)) then
//
else
if (ATargetSize = SizeOf(Double)) then
PExtended(ADestPointer)^ := PDouble(ADestPointer)^
else
if (ATargetSize = SizeOf(real48)) then
PExtended(ADestPointer)^ := Preal48(ADestPointer)^
else
if (ATargetSize = SizeOf(Single)) then
PExtended(ADestPointer)^ := PSingle(ADestPointer)^
else
Result := False;
end;
else begin
Assert(False, 'TFpDbgMemConvertorLittleEndian.FailedTargetRead');
Result := False;
@ -642,5 +669,11 @@ begin
Result := ReadMemory(rdtSet, ALocation, ASize, @AValue[0], ASize);
end;
function TFpDbgMemManager.ReadFloat(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out
AValue: Extended): Boolean;
begin
Result := ReadMemory(rdtfloat, ALocation, ASize, @AValue, SizeOf(AValue));
end;
end.

27
components/fpdebug/test/testmemmanager.pas
View File

@ -62,11 +62,16 @@ var
i, j: Integer;
TestBaseName: String;
Data: QWord;
DataExt: Extended;
DataDouble: Double;
DataSingle: Single;
MemValue: QWord;
GotRes: Boolean;
GotInt: Int64;
GotUInt: QWord;
GotAddr: TFpDbgMemLocation;
GotAddr: TFpDbgMemLocation;
GotExt: Extended;
procedure SetData(Aval: QWord);
begin
@ -240,6 +245,26 @@ begin
SetData($FF); DoUnsignedIntTests(1, 255);
SetData($0108); DoSignedIntTests(1, 8);
FCurrentTestName := 'Extended';
DataExt := 1.7722;
GotRes := FMemManager.ReadFloat(TargetLoc(TDbgPtr(@DataExt)), SizeOf(Extended), GotExt);
AssertTrue(FCurrentTestName + 'Read OK', GotRes);
AssertEquals(FCurrentTestName + 'target not changed', 1.7722, DataExt);
AssertEquals(FCurrentTestName + 'Val', DataExt, GotExt);
FCurrentTestName := 'Double';
DataDouble := 1.7722;
GotRes := FMemManager.ReadFloat(TargetLoc(TDbgPtr(@DataDouble)), SizeOf(Double), GotExt);
AssertTrue(FCurrentTestName + 'Read OK', GotRes);
AssertEquals(FCurrentTestName + 'target not changed', 1.7722, DataDouble);
AssertEquals(FCurrentTestName + 'Val', DataDouble, GotExt);
FCurrentTestName := 'Single';
DataSingle := 1.7722;
GotRes := FMemManager.ReadFloat(TargetLoc(TDbgPtr(@DataSingle)), SizeOf(Single), GotExt);
AssertTrue(FCurrentTestName + 'Read OK', GotRes);
AssertEquals(FCurrentTestName + 'target not changed', 1.7722, DataSingle);
AssertEquals(FCurrentTestName + 'Val', DataSingle, GotExt);
end;