diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 32dfd315b2..3a3ce30977 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -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); diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index b604b7b69e..7321ab314d 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -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; diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index d13e904566..cee1a27d80 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -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. diff --git a/components/fpdebug/test/testmemmanager.pas b/components/fpdebug/test/testmemmanager.pas index 9a004dc47c..ca68470983 100644 --- a/components/fpdebug/test/testmemmanager.pas +++ b/components/fpdebug/test/testmemmanager.pas @@ -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;