From d0a3a004df13f8121a45531eff9ed343cb32043b Mon Sep 17 00:00:00 2001 From: Martin Date: Fri, 27 Sep 2024 20:53:25 +0200 Subject: [PATCH] FpDebug: implement 80 bit extended float (soft fpu) for cross debugging a win-32bit target from a 64bit IDE --- components/fpdebug/fpdbgdwarf.pas | 159 +++++++++--- components/fpdebug/fpdbginfo.pas | 54 +++- components/fpdebug/fpdmemorytools.pas | 108 ++++++-- components/fpdebug/fppascalparser.pas | 13 +- components/fpdebug/fpwatchresultdata.pas | 23 +- .../lazdebuggerfp/test/testwatches.pas | 16 +- .../lazdebuggerintf/lazdebuggerintf.lpk | 4 + .../lazdebuggerintf/lazdebuggerintf.pas | 8 +- .../lazdebuggerintffloattypes.pas | 149 +++++++++++ .../lazdebuggerintfpackage.pas | 2 +- ide/packages/idedebugger/debugger.pp | 58 ++++- .../idedebuggerwatchresprinter.pas | 54 ++-- .../idedebugger/idedebuggerwatchresult.pas | 238 ++++++++++++++++-- 13 files changed, 743 insertions(+), 143 deletions(-) create mode 100644 components/lazdebuggers/lazdebuggerintf/lazdebuggerintffloattypes.pas diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 3b827d7783..fa477a2338 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -50,9 +50,9 @@ unit FpDbgDwarf; interface uses - Classes, SysUtils, types, math, FpDbgInfo, FpDbgDwarfDataClasses, - FpdMemoryTools, FpErrorMessages, FpDbgUtil, FpDbgDwarfConst, FpDbgCommon, - DbgIntfBaseTypes, LazUTF8, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses; + Classes, SysUtils, types, math, FpDbgInfo, FpDbgDwarfDataClasses, FpdMemoryTools, + FpErrorMessages, FpDbgUtil, FpDbgDwarfConst, FpDbgCommon, DbgIntfBaseTypes, LazUTF8, + LazLoggerBase, LazClasses, LazDebuggerIntfFloatTypes; type TFpDwarfInfo = FpDbgDwarfDataClasses.TFpDwarfInfo; @@ -270,7 +270,7 @@ type function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; function GetAsInteger: Int64; override; - function GetAsFloat: Extended; override; + function GetAsExtended: TDbgExtended; override; procedure SetAsInteger(AValue: Int64); override; procedure SetAsCardinal(AValue: QWord); override; end; @@ -283,7 +283,7 @@ type protected function GetAsCardinal: QWord; override; function GetAsInteger: Int64; override; - function GetAsFloat: Extended; override; + function GetAsExtended: TDbgExtended; override; procedure SetAsCardinal(AValue: QWord); override; function GetFieldFlags: TFpValueFieldFlags; override; end; @@ -293,10 +293,21 @@ type TFpValueDwarfFloat = class(TFpValueDwarfNumeric) // TDbgDwarfSymbolValue // TODO: typecasts to int should convert private - FValue: Extended; + FFloatPrecission: TFpFloatPrecission; + FValue: record + case TFpFloatPrecission of + fpSingle: ( FValueExt: TDbgExtended; ); + fpDouble: ( FValueDouble: Double; ); + fpExtended: ( FValueSingle: Single; ); + end; protected + procedure ReadFloatValue; function GetFieldFlags: TFpValueFieldFlags; override; - function GetAsFloat: Extended; override; + function GetAsSingle: Single; override; + function GetAsDouble: Double; override; + function GetAsExtended: TDbgExtended; override; + function GetFloatPrecission: TFpFloatPrecission; override; + function GetAsFloat: Extended; override; deprecated; end; { TFpValueDwarfBoolean } @@ -2349,7 +2360,7 @@ begin FIntValue := Result; end; -function TFpValueDwarfInteger.GetAsFloat: Extended; +function TFpValueDwarfInteger.GetAsExtended: TDbgExtended; begin Result := GetAsInteger; end; @@ -2405,7 +2416,7 @@ begin Result := Int64(GetAsCardinal); end; -function TFpValueDwarfCardinal.GetAsFloat: Extended; +function TFpValueDwarfCardinal.GetAsExtended: TDbgExtended; begin Result := GetAsInteger; end; @@ -2436,36 +2447,128 @@ end; { TFpValueDwarfFloat } +procedure TFpValueDwarfFloat.ReadFloatValue; +var + Size: TFpDbgValueSize; + FullSize: Int64; +begin + if doneFloat in FEvaluated then + exit; + Include(FEvaluated, doneFloat); + + FullSize := 0; + if GetSize(Size) and IsByteSize(Size) then + FullSize := SizeToFullBytes(Size); + + FFloatPrecission := fpDouble; + FValue.FValueDouble := 0; + case FullSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: begin + if not Context.ReadExtended(OrdOrDataAddr, Size, FValue.FValueExt) then + SetLastError(Context.LastMemError) + else + FFloatPrecission := fpExtended; + end; + {$ENDIF} + SizeOf(double): begin + if not Context.ReadDouble(OrdOrDataAddr, Size, FValue.FValueDouble) then begin + SetLastError(Context.LastMemError); + FValue.FValueDouble := 0; + end + else + FFloatPrecission := fpDouble; + end; + SizeOf(Single): begin + if not Context.ReadSingle(OrdOrDataAddr, Size, FValue.FValueSingle) then + SetLastError(Context.LastMemError) + else + FFloatPrecission := fpSingle; + end; + SizeOf(Real48): begin + if not Context.ReadDouble(OrdOrDataAddr, Size, FValue.FValueDouble) then begin + SetLastError(Context.LastMemError); + FValue.FValueDouble := 0; + end + else + FFloatPrecission := fpDouble; + end; + else begin + SetLastError(CreateError(fpErrorBadFloatSize)); + end; + end; +end; + function TFpValueDwarfFloat.GetFieldFlags: TFpValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfFloat] - [svfOrdinal]; end; -function TFpValueDwarfFloat.GetAsFloat: Extended; -var - Size: TFpDbgValueSize; +function TFpValueDwarfFloat.GetAsSingle: Single; begin - if doneFloat in FEvaluated then begin - Result := FValue; - exit; + DisableFloatExceptions; + try + ReadFloatValue; + case FFloatPrecission of + fpSingle: Result := FValue.FValueSingle; + fpDouble: Result := FValue.FValueDouble; + fpExtended: Result := FValue.FValueExt; + end; + finally + EnableFloatExceptions; end; - Include(FEvaluated, doneUInt); +end; - if not GetSize(Size) then - Result := 0 - else - if (Size <= 0) or (Size > SizeOf(Result)) then begin - Result := 0; - SetLastError(CreateError(fpErrorBadFloatSize)); - end - else - if not Context.ReadFloat(OrdOrDataAddr, Size, Result) then begin - Result := 0; // TODO: error - SetLastError(Context.LastMemError); +function TFpValueDwarfFloat.GetAsDouble: Double; +begin + DisableFloatExceptions; + try + ReadFloatValue; + case FFloatPrecission of + fpSingle: Result := FValue.FValueSingle; + fpDouble: Result := FValue.FValueDouble; + fpExtended: Result := FValue.FValueExt; + end; + finally + EnableFloatExceptions; end; +end; - FValue := Result; +function TFpValueDwarfFloat.GetAsExtended: TDbgExtended; +begin + DisableFloatExceptions; + try + ReadFloatValue; + case FFloatPrecission of + fpSingle: Result := FValue.FValueSingle; + fpDouble: Result := FValue.FValueDouble; + fpExtended: Result := FValue.FValueExt; + end; + finally + EnableFloatExceptions; + end; +end; + +function TFpValueDwarfFloat.GetFloatPrecission: TFpFloatPrecission; +begin + ReadFloatValue; + Result := FFloatPrecission; +end; + +function TFpValueDwarfFloat.GetAsFloat: Extended; +begin + DisableFloatExceptions; + try + ReadFloatValue; + case FFloatPrecission of + fpSingle: Result := FValue.FValueSingle; + fpDouble: Result := FValue.FValueDouble; + fpExtended: Result := FValue.FValueExt; + end; + finally + EnableFloatExceptions; + end; end; { TFpValueDwarfBoolean } diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index d9b2003c33..6898d9222f 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -44,7 +44,7 @@ uses Classes, SysUtils, DbgIntfBaseTypes, FpDbgLoader, FpdMemoryTools, FpErrorMessages, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses, FpDbgCommon, // Register all image reader classes - FpImgReaderWinPE, FpImgReaderElf, FpImgReaderMacho; + FpImgReaderWinPE, FpImgReaderElf, FpImgReaderMacho, LazDebuggerIntfFloatTypes; type @@ -111,6 +111,8 @@ type ); TFpValueFlags = set of TFpValueFlag; + TFpFloatPrecission = (fpSingle, fpDouble, fpExtended); + TFindExportedSymbolsFlag = (fsfIgnoreEnumVals, fsfMatchUnitName); TFindExportedSymbolsFlags = set of TFindExportedSymbolsFlag; @@ -138,7 +140,11 @@ type function GetAsInteger: Int64; virtual; function GetAsString: AnsiString; virtual; function GetAsWideString: WideString; virtual; - function GetAsFloat: Extended; virtual; + function GetAsSingle: Single; virtual; + function GetAsDouble: Double; virtual; + function GetAsExtended: TDbgExtended; virtual; + function GetFloatPrecission: TFpFloatPrecission; virtual; + function GetAsFloat: Extended; virtual; deprecated; procedure SetAsCardinal(AValue: QWord); virtual; procedure SetAsInteger(AValue: Int64); virtual; @@ -198,7 +204,11 @@ type property AsBool: Boolean read GetAsBool write SetAsBool; property AsString: AnsiString read GetAsString write SetAsString; property AsWideString: WideString read GetAsWideString; - property AsFloat: Extended read GetAsFloat; + property AsSingle: Single read GetAsSingle; + property AsDouble: Double read GetAsDouble; + property AsExtended: TDbgExtended read GetAsExtended; + property FloatPrecission: TFpFloatPrecission read GetFloatPrecission; + property AsFloat: Extended read GetAsFloat; deprecated; (* * Address/Size Address of the variable (as returned by the "@" address of operator @@ -299,7 +309,7 @@ type function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; function GetAsInteger: Int64; override; - function GetAsFloat: Extended; override; + function GetAsExtended: TDbgExtended; override; public constructor Create(AValue: QWord; ASigned: Boolean = True); end; @@ -360,14 +370,14 @@ type TFpValueConstFloat = class(TFpValueConstWithType) private - FValue: Extended; + FValue: TDbgExtended; protected - property Value: Extended read FValue write FValue; + property Value: TDbgExtended read FValue write FValue; function GetKind: TDbgSymbolKind; override; function GetFieldFlags: TFpValueFieldFlags; override; - function GetAsFloat: Extended; override; + function GetAsExtended: TDbgExtended; override; public - constructor Create(AValue: Extended); + constructor Create(AValue: TDbgExtended); end; { TFpValueConstBool} @@ -1027,6 +1037,26 @@ begin Result := ''; end; +function TFpValue.GetAsSingle: Single; +begin + Result := GetAsExtended; +end; + +function TFpValue.GetAsDouble: Double; +begin + Result := GetAsExtended; +end; + +function TFpValue.GetAsExtended: TDbgExtended; +begin + Result := 0; +end; + +function TFpValue.GetFloatPrecission: TFpFloatPrecission; +begin + Result := fpDouble; +end; + function TFpValue.GetDbgSymbol: TFpSymbol; begin Result := nil; @@ -1106,7 +1136,7 @@ end; function TFpValue.GetAsFloat: Extended; begin - Result := 0; + Result := GetAsExtended; end; function TFpValue.GetParentTypeInfo: TFpSymbol; @@ -1428,7 +1458,7 @@ begin {$pop} end; -function TFpValueConstNumber.GetAsFloat: Extended; +function TFpValueConstNumber.GetAsExtended: TDbgExtended; begin Result := GetAsInteger; end; @@ -1453,12 +1483,12 @@ begin Result := Result + inherited GetFieldFlags; end; -function TFpValueConstFloat.GetAsFloat: Extended; +function TFpValueConstFloat.GetAsExtended: TDbgExtended; begin Result := FValue; end; -constructor TFpValueConstFloat.Create(AValue: Extended); +constructor TFpValueConstFloat.Create(AValue: TDbgExtended); begin inherited Create; FValue := AValue; diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index 793748b5a1..ce8ec03ff0 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -28,7 +28,7 @@ interface uses Classes, SysUtils, math, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpErrorMessages, LazClasses, - AVL_Tree, LazDebuggerUtils, + AVL_Tree, LazDebuggerUtils, LazDebuggerIntfFloatTypes, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}; const @@ -220,10 +220,16 @@ type //function ReadSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: TBytes; // AnOpts: TFpDbgMemReadOptions): Boolean; inline; + function ReadSingle (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + out AValue: Single): Boolean; inline; + function ReadDouble (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + out AValue: Double): Boolean; inline; + function ReadExtended (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; + out AValue: TDbgExtended): Boolean; inline; function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; - out AValue: Extended): Boolean; inline; + out AValue: TDbgExtended): Boolean; inline; deprecated; //function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; - // out AValue: Extended; + // out AValue: TDbgExtended; // AnOpts: TFpDbgMemReadOptions): Boolean; inline; function ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: RawByteString; AnIgnoreMaxStringLen: boolean = False): Boolean; @@ -1297,12 +1303,30 @@ begin Result := MemManager.WriteMemory(rdtSet, ALocation, ASize, @AValue[0], Length(AValue), Self); end; -function TFpDbgLocationContext.ReadFloat(const ALocation: TFpDbgMemLocation; - ASize: TFpDbgValueSize; out AValue: Extended): Boolean; +function TFpDbgLocationContext.ReadSingle(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: Single): Boolean; begin Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), Self); end; +function TFpDbgLocationContext.ReadDouble(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: Double): Boolean; +begin + Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), Self); +end; + +function TFpDbgLocationContext.ReadExtended(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: TDbgExtended): Boolean; +begin + Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), DBG_EXTENDED_SIZE), Self); +end; + +function TFpDbgLocationContext.ReadFloat(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: TDbgExtended): Boolean; +begin + Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), DBG_EXTENDED_SIZE), Self); +end; + function TFpDbgLocationContext.ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: RawByteString; AnIgnoreMaxStringLen: boolean): Boolean; begin @@ -1469,10 +1493,14 @@ begin rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtEnum, rdtSet: ; rdtfloat: - // TODO: reading float from register / or mlfConstant...; - Result := IsByteSize(AConvData.SourceSize) and // only support exact size for FLOAT - (AConvData.DestSize = SizeOf(Extended)) and // only can read to extended... TODO (if need more) - ( (AConvData.SourceSize.Size = SizeOf(Extended)) or + Result := IsByteSize(AConvData.SourceSize) and + ( (AConvData.SourceFullSize = AConvData.DestSize) or + ( (AConvData.SourceFullSize = SizeOf(Real48)) and + (AConvData.SourceSize.Size = SizeOf(Double)) + ) + ) and + ( (AConvData.SourceSize.Size = DBG_EXTENDED_SIZE) or + (AConvData.SourceSize.Size = SizeOf(Extended)) or (AConvData.SourceSize.Size = SizeOf(Double)) or (AConvData.SourceSize.Size = SizeOf(Single)) or (AConvData.SourceSize.Size = SizeOf(real48)) @@ -1535,18 +1563,62 @@ begin end; end; rdtfloat: begin - assert((AConvData.DestSize = SizeOf(Extended))); - if (AConvData.SourceFullSize = SizeOf(Extended)) then - // + // Currently we have matching sizes, except for real48 + + if (AConvData.SourceFullSize = DBG_EXTENDED_SIZE) then begin + case AConvData.DestSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PDbgExtended(ADest)^; + {$ENDIF} + SizeOf(double): PDouble(ADest)^ := PDbgExtended(ADest)^; + SizeOf(Single): PSingle(ADest)^ := PDbgExtended(ADest)^; + else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching'); + end; + end else - if (AConvData.SourceFullSize = SizeOf(Double)) then - PExtended(ADest)^ := PDouble(ADest)^ + if (AConvData.SourceFullSize = SizeOf(Extended)) then begin + case AConvData.DestSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PExtended(ADest)^; + {$ENDIF} + SizeOf(double): PDouble(ADest)^ := PExtended(ADest)^; + SizeOf(Single): PSingle(ADest)^ := PExtended(ADest)^; + else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching'); + end; + end else - if (AConvData.SourceFullSize = SizeOf(real48)) then - PExtended(ADest)^ := Preal48(ADest)^ + if (AConvData.SourceFullSize = SizeOf(Double)) then begin + case AConvData.DestSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PDouble(ADest)^; + {$ENDIF} + SizeOf(double): PDouble(ADest)^ := PDouble(ADest)^; + SizeOf(Single): PSingle(ADest)^ := PDouble(ADest)^; + else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching'); + end; + end else - if (AConvData.SourceFullSize = SizeOf(Single)) then - PExtended(ADest)^ := PSingle(ADest)^ + if (AConvData.SourceFullSize = SizeOf(Real48)) then begin + case AConvData.DestSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := double(Preal48(ADest)^); + {$ENDIF} + SizeOf(double): PDouble(ADest)^ := Preal48(ADest)^; + //SizeOf(Single): PSingle(ADest)^ := Preal48(ADest)^; + else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching'); + end; + end + else + if (AConvData.SourceFullSize = SizeOf(Single)) then begin + case AConvData.DestSize of + {$IF DBG_HAS_EXTENDED} + DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PSingle(ADest)^; + {$ENDIF} + SizeOf(double): PDouble(ADest)^ := PSingle(ADest)^; + SizeOf(Single): PSingle(ADest)^ := PSingle(ADest)^; + else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching'); + end; + end else Result := False; end; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index f45fa48462..d6d3fbb2c4 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -34,7 +34,8 @@ unit FpPascalParser; interface uses - Classes, sysutils, math, fgl, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages, + Classes, sysutils, math, fgl, DbgIntfBaseTypes, LazDebuggerIntfFloatTypes, + FpDbgInfo, FpdMemoryTools, FpErrorMessages, FpDbgDwarf, FpWatchResultData, FpDbgClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazClasses; @@ -85,8 +86,6 @@ type TFpPascalExpressionSharedData = class(TRefCountedObject) // Data used while EVALUATING the expression result strict private - FFpuMask: TFPUExceptionMask; - FTextExpression: String; FScope: TFpDbgSymbolScope; FError: TFpError; @@ -4274,8 +4273,7 @@ begin inherited Create; AddReference; - FFpuMask := GetExceptionMask; - SetExceptionMask([low(TFPUExceptionMask)..high(TFPUExceptionMask)]); + DisableFloatExceptions; FTextExpression := ATextExpression; FScope := AScope; @@ -4285,11 +4283,10 @@ end; destructor TFpPascalExpressionSharedData.Destroy; begin + EnableFloatExceptions; + inherited Destroy; FScope.ReleaseReference; - - ClearExceptions(False); - SetExceptionMask(FFpuMask); end; function TFpPascalExpressionSharedData.GetDbgSymbolForIdentifier(AnIdent: String; diff --git a/components/fpdebug/fpwatchresultdata.pas b/components/fpdebug/fpwatchresultdata.pas index 6f2c6f946e..229bdc102a 100644 --- a/components/fpdebug/fpwatchresultdata.pas +++ b/components/fpdebug/fpwatchresultdata.pas @@ -6,9 +6,12 @@ unit FpWatchResultData; interface uses + // DbgIntf + LazDebuggerIntfFloatTypes, DbgIntfBaseTypes, LazDebuggerIntf, + // FpDbgInfo, FpPascalBuilder, FpdMemoryTools, FpErrorMessages, FpDbgDwarf, - FpDbgDwarfDataClasses, DbgIntfBaseTypes, LazClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, fgl, Math, - SysUtils, LazDebuggerIntf; + FpDbgDwarfDataClasses, LazClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, fgl, Math, + SysUtils; type @@ -323,21 +326,13 @@ end; function TFpWatchResultConvertor.FloatToResData(AnFpValue: TFpValue; AnResData: IDbgWatchDataIntf): Boolean; -var - p: TLzDbgFloatPrecission; - s: TFpDbgValueSize; begin Result := True; - - p := dfpSingle; - if AnFpValue.GetSize(s) then begin - if SizeToFullBytes(s) > SizeOf(Double) then - p := dfpExtended - else - if SizeToFullBytes(s) > SizeOf(Single) then - p := dfpDouble + case AnFpValue.FloatPrecission of + fpSingle: AnResData.CreateFloatValue(AnFpValue.AsSingle); + fpDouble: AnResData.CreateFloatValue(AnFpValue.AsDouble); + fpExtended: AnResData.CreateFloatValue(AnFpValue.AsExtended); end; - AnResData.CreateFloatValue(AnFpValue.AsFloat, p); AddTypeNameToResData(AnFpValue, AnResData); end; diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index ab67f073de..9158d69fb5 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -723,10 +723,10 @@ procedure TTestWatches.TestWatchesValue; t.Add(AName, p+'Single'+e, weSingle(100.125+n, x+'Single' )); t.Add(AName, p+'Double'+e, weDouble(1000.125+n, x+'Double' )); t.Add(AName, p+'Extended'+e, weFloat(10000.175+n, '' )); // Double ? - {$IFDEF cpu64} - if Compiler.CpuBitType = cpu32 then // a 64bit debugger does has no 10byte extended type // TODO: check for error - t.Tests[-1]^.AddFlag(ehExpectError); // TODO: check error msg - {$ENDIF} +// {$IFDEF cpu64} +// if Compiler.CpuBitType = cpu32 then // a 64bit debugger does has no 10byte extended type // TODO: check for error +// t.Tests[-1]^.AddFlag(ehExpectError); // TODO: check error msg +// {$ENDIF} //t.Add(p+'Comp'+e, weInteger(150.125+n, 'Comp' )); //TODO: currency // integer is wrong, but lets check it t.Add(AName, p+'Currency'+e, weInteger(1251230+n*10000, x+'Currency', SIZE_8 )) @@ -739,10 +739,10 @@ procedure TTestWatches.TestWatchesValue; t.Add(AName, p+'Single_2'+e, weSingle(-100.125+n, x+'Single' )); t.Add(AName, p+'Double_2'+e, weDouble(-1000.125+n, x+'Double' )); t.Add(AName, p+'Extended_2'+e, weFloat(-10000.175+n, '' )); // Double ? - {$IFDEF cpu64} - if Compiler.CpuBitType = cpu32 then // a 64bit debugger does has no 10byte extended type // TODO: check for error - t.Tests[-1]^.AddFlag(ehExpectError); // TODO: check error msg - {$ENDIF} +// {$IFDEF cpu64} +// if Compiler.CpuBitType = cpu32 then // a 64bit debugger does has no 10byte extended type // TODO: check for error +// t.Tests[-1]^.AddFlag(ehExpectError); // TODO: check error msg +// {$ENDIF} //t.Add(p+'Comp_2'+e, weFloat(-150.125+n, 'Comp' )); t.Add(AName+'-TODO', p+'Currency_2'+e, weFloat(-125.123+n, x+'Currency' ))^.AddFlag([ehNotImplementedData]) .SkipIf(ALoc = tlPointerAny); diff --git a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk index 8cf6b1eb22..700b6b2079 100644 --- a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk +++ b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk @@ -49,6 +49,10 @@ See LCL license for details."/> + + + + diff --git a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas index c8e35eb5b6..d5b19987cb 100644 --- a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas +++ b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas @@ -21,7 +21,8 @@ unit LazDebuggerIntf; interface uses - Classes, SysUtils, Types, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes; + Classes, SysUtils, Types, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes, + LazDebuggerIntfFloatTypes; type TDBGState = LazDebuggerIntfBaseTypes.TDBGState deprecated 'Use LazDebuggerIntfBaseTypes.TDBGState'; @@ -170,7 +171,10 @@ type procedure CreateCharValue(ACharValue: QWord; AByteSize: Integer = 0); procedure CreateNumValue(ANumValue: QWord; ASigned: Boolean; AByteSize: Integer = 0); procedure CreatePointerValue(AnAddrValue: TDbgPtr); - procedure CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); + procedure CreateFloatValue(AFloatValue: Single); + procedure CreateFloatValue(AFloatValue: Double); + procedure CreateFloatValue(AFloatValue: TDbgExtended); + procedure CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); deprecated; procedure CreateBoolValue(AnOrdBoolValue: QWord; AByteSize: Integer = 0); procedure CreateEnumValue(ANumValue: QWord; AName: String; AByteSize: Integer = 0; AnIsEnumIdent: Boolean = False); // //procedure CreateEnumValue(ANumValue: QWord; const ANames: TStringDynArray; const AOrdValues: TIntegerDynArray); diff --git a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintffloattypes.pas b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintffloattypes.pas new file mode 100644 index 0000000000..255a285010 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintffloattypes.pas @@ -0,0 +1,149 @@ +unit LazDebuggerIntfFloatTypes; + +{$mode objfpc}{$H+} + +interface + +{$UNDEF HAS_EXTENDED} +{$UNDEF HAS_SOFT_EXTENDED} +{$UNDEF NO_EXTENDED} + +{$IF sizeof(Extended) = 10} + {$DEFINE HAS_EXTENDED} +{$ELSE} + {$IFDEF windows} + {$IF FPC_Fullversion>30202} + {$DEFINE HAS_SOFT_EXTENDED} + {$ENDIF} + {$ENDIF} + + {$IFnDEF HAS_SOFT_EXTENDED} + {$DEFINE NO_EXTENDED} + {$ENDIF} +{$ENDIF} + + +uses + SysUtils, Math + {$ifdef HAS_SOFT_EXTENDED} , ufloatx80, sfpux80 {$endif} + ; + +const + {$ifdef HAS_EXTENDED} + DBG_HAS_EXTENDED = True; + DBG_EXTENDED_SIZE = 10; + {$endif} + {$ifdef HAS_SOFT_EXTENDED} + DBG_HAS_EXTENDED = True; + DBG_EXTENDED_SIZE = 10; + {$endif} + {$ifdef NO_EXTENDED} + DBG_HAS_EXTENDED = False; + DBG_EXTENDED_SIZE = 0; + {$endif} + +procedure DisableFloatExceptions; +procedure EnableFloatExceptions; + +type + {$ifdef HAS_EXTENDED} + TDbgExtended = extended; + {$endif} + {$ifdef HAS_SOFT_EXTENDED} + TDbgExtended = type floatx80; + {$endif} + {$ifdef NO_EXTENDED} + TDbgExtended = type double; + {$endif} + + PDbgExtended = ^TDbgExtended; + + {$ifdef HAS_SOFT_EXTENDED} + operator+ (const f1,f2 : TDbgExtended) : TDbgExtended;inline; + operator* (const f1,f2 : TDbgExtended) : TDbgExtended;inline; + operator- (const f1,f2 : TDbgExtended) : TDbgExtended;inline; + operator/ (const f1,f2 : TDbgExtended) : TDbgExtended;inline; + + operator :=(const source : double) dest : TDbgExtended;inline; + operator :=(const source : TDbgExtended) dest : double;inline; + operator :=(const source : TDbgExtended) dest : single;inline; + {$endif} + +implementation + +var + EM: TFPUExceptionMask; + {$ifdef HAS_SOFT_EXTENDED} + SEM: TFPUExceptionMask; + {$endif} + FloatExceptionLock: integer = 0; + + +procedure DisableFloatExceptions; +begin + if FloatExceptionLock = 0 then begin + EM := GetExceptionMask; + SetExceptionMask(EM + [exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]); + {$ifdef HAS_SOFT_EXTENDED} + SEM := softfloat_exception_mask; + softfloat_exception_mask := SEM + [exInvalidOp, exDenormalized, exZeroDivide,exOverflow, exUnderflow, exPrecision]; + {$endif} + end; + inc(FloatExceptionLock); +end; + +procedure EnableFloatExceptions; +begin + dec(FloatExceptionLock); + if FloatExceptionLock <= 0 then begin + FloatExceptionLock := 0; + ClearExceptions(False); + SetExceptionMask(EM); + {$ifdef HAS_SOFT_EXTENDED} + softfloat_exception_mask := SEM; + {$endif} + end; + +end; + +{$ifdef HAS_SOFT_EXTENDED} +operator + (const f1, f2: TDbgExtended): TDbgExtended; +begin + floatx80(Result) := floatx80(f1) + floatx80(f2); +end; + +operator * (const f1, f2: TDbgExtended): TDbgExtended; +begin + floatx80(Result) := floatx80(f1) * floatx80(f2); +end; + +operator - (const f1, f2: TDbgExtended): TDbgExtended; +begin + floatx80(Result) := floatx80(f1) - floatx80(f2); +end; + +operator / (const f1, f2: TDbgExtended): TDbgExtended; +begin + floatx80(Result) := floatx80(f1) / floatx80(f2); +end; + +operator := (const source: double)dest: TDbgExtended; +begin + floatx80(Result) := source; +end; + +operator := (const source: TDbgExtended)dest: double; +begin + Result := floatx80(source); +end; + +operator := (const source: TDbgExtended)dest: single; +var d: double; +begin + d := floatx80(source); + Result := d; +end; +{$endif} + +end. + diff --git a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas index 23227aea5f..dea135d0ae 100644 --- a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas +++ b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas @@ -9,7 +9,7 @@ interface uses LazDebuggerIntf, LazDebuggerTemplate, LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, - DbgUtilsTypePatternList, LazDebuggerUtils; + DbgUtilsTypePatternList, LazDebuggerUtils, LazDebuggerIntfFloatTypes; implementation diff --git a/ide/packages/idedebugger/debugger.pp b/ide/packages/idedebugger/debugger.pp index 1dea45a71c..cd59f4e974 100644 --- a/ide/packages/idedebugger/debugger.pp +++ b/ide/packages/idedebugger/debugger.pp @@ -46,7 +46,7 @@ uses // DebuggerIntf DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfDebuggerBase, IdeDebuggerWatchValueIntf, LazDebuggerIntf, LazDebuggerIntfBaseTypes, - LazDebuggerValueConverter, LazDebuggerTemplate, IdeDebuggerBase, + LazDebuggerValueConverter, LazDebuggerTemplate, LazDebuggerIntfFloatTypes, IdeDebuggerBase, IdeDebuggerWatchResult, IdeDebuggerOpts, IdeDebuggerBackendValueConv, IdeDebuggerUtils, IdeDebuggerValueFormatter, IdeDebuggerDisplayFormats, ProjectDebugLink; @@ -723,19 +723,22 @@ type procedure DebugPrint(AText: String); public {%region ***** IDbgWatchDataIntf ***** } - procedure CreatePrePrinted(AVal: String); virtual; // ATypes: TLzDbgWatchDataTypes); - procedure CreateString(AVal: String); virtual;// AnEncoding // "pchar data" - procedure CreateWideString(AVal: WideString); virtual; - procedure CreateCharValue(ACharValue: QWord; AByteSize: Integer = 0); virtual; - procedure CreateNumValue(ANumValue: QWord; ASigned: Boolean; AByteSize: Integer = 0); virtual; - procedure CreatePointerValue(AnAddrValue: TDbgPtr); virtual; - procedure CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); virtual; + procedure CreatePrePrinted(AVal: String); // ATypes: TLzDbgWatchDataTypes); + procedure CreateString(AVal: String); // AnEncoding // "pchar data" + procedure CreateWideString(AVal: WideString); + procedure CreateCharValue(ACharValue: QWord; AByteSize: Integer = 0); + procedure CreateNumValue(ANumValue: QWord; ASigned: Boolean; AByteSize: Integer = 0); + procedure CreatePointerValue(AnAddrValue: TDbgPtr); + procedure CreateFloatValue(AFloatValue: Single); + procedure CreateFloatValue(AFloatValue: Double); + procedure CreateFloatValue(AFloatValue: TDbgExtended); + procedure CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); deprecated; function CreateProcedure(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): IDbgWatchDataIntf; function CreateProcedureRef(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): IDbgWatchDataIntf; function CreateArrayValue(AnArrayType: TLzDbgArrayType; ATotalCount: Integer = 0; ALowIdx: Integer = 0 - ): IDbgWatchDataIntf; virtual; + ): IDbgWatchDataIntf; procedure CreateBoolValue(AnOrdBoolValue: QWord; AByteSize: Integer = 0); procedure CreateEnumValue(ANumValue: QWord; AName: String; AByteSize: Integer = 0; AnIsEnumIdent: Boolean = False); // //procedure CreateEnumValue(ANumValue: QWord; const ANames: TStringDynArray; const AOrdValues: TIntegerDynArray); @@ -750,7 +753,7 @@ type function CreateValueHandlerResult(AValueHandler: ILazDbgValueConverterIntf): IDbgWatchDataIntf; procedure CreateMemDump(AVal: RawByteString); - procedure CreateError(AVal: String); virtual; + procedure CreateError(AVal: String); function SetPCharShouldBeStringValue: IDbgWatchDataIntf; procedure SetTypeName(ATypeName: String); @@ -3785,11 +3788,44 @@ begin AfterDataCreated; end; +procedure TCurrentResData.CreateFloatValue(AFloatValue: Single); +begin + BeforeCreateValue; + assert((FNewResultData=nil) or (FNewResultData is TWatchResultDataSingle), 'TCurrentResData.CreateFloatValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkString)'); + if FNewResultData = nil then + FNewResultData := TWatchResultDataSingle.Create(AFloatValue) + else + TWatchResultDataSingle(FNewResultData).Create(AFloatValue); + AfterDataCreated; +end; + +procedure TCurrentResData.CreateFloatValue(AFloatValue: Double); +begin + BeforeCreateValue; + assert((FNewResultData=nil) or (FNewResultData is TWatchResultDataDouble), 'TCurrentResData.CreateFloatValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkString)'); + if FNewResultData = nil then + FNewResultData := TWatchResultDataDouble.Create(AFloatValue) + else + TWatchResultDataDouble(FNewResultData).Create(AFloatValue); + AfterDataCreated; +end; + +procedure TCurrentResData.CreateFloatValue(AFloatValue: TDbgExtended); +begin + BeforeCreateValue; + assert((FNewResultData=nil) or (FNewResultData is TWatchResultDataExtended), 'TCurrentResData.CreateFloatValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkString)'); + if FNewResultData = nil then + FNewResultData := TWatchResultDataExtended.Create(AFloatValue) + else + TWatchResultDataExtended(FNewResultData).Create(AFloatValue); + AfterDataCreated; +end; + procedure TCurrentResData.CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); begin BeforeCreateValue; - assert((FNewResultData=nil) or (FNewResultData.ValueKind=rdkFloatVal), 'TCurrentResData.CreateFloatValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkString)'); + assert((FNewResultData=nil) or (FNewResultData is TWatchResultDataFloat), 'TCurrentResData.CreateFloatValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkString)'); if FNewResultData = nil then FNewResultData := TWatchResultDataFloat.Create(AFloatValue, APrecission) else diff --git a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas index c69f382b93..736fe40464 100644 --- a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas +++ b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas @@ -8,7 +8,8 @@ interface uses Classes, SysUtils, Math, IdeDebuggerWatchResult, IdeDebuggerUtils, IdeDebuggerDisplayFormats, IdeDebuggerBase, IdeDebuggerStringConstants, IdeDebuggerValueFormatter, IdeDebuggerWatchResUtils, - LazDebuggerIntf, LazUTF8, IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils; + LazDebuggerIntf, LazUTF8, IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils, + LazDebuggerIntfFloatTypes; type @@ -1542,32 +1543,37 @@ function TWatchResultPrinter.PrintWatchValue(AResValue: TWatchResultData; var Res: TStringBuilderPart; begin - FNextValueFormatter := nil; - if FOnlyValueFormatter <> nil then - FDefaultValueFormatter := FOnlyValueFormatter - else - FDefaultValueFormatter := GlobalValueFormatterSelectorList; + DisableFloatExceptions; + try + FNextValueFormatter := nil; + if FOnlyValueFormatter <> nil then + FDefaultValueFormatter := FOnlyValueFormatter + else + FDefaultValueFormatter := GlobalValueFormatterSelectorList; - if rpfSkipValueFormatter in FormatFlags then - FCurrentValueFormatter := nil - else - FCurrentValueFormatter := FDefaultValueFormatter; + if rpfSkipValueFormatter in FormatFlags then + FCurrentValueFormatter := nil + else + FCurrentValueFormatter := FDefaultValueFormatter; - if rpfMultiLine in FFormatFlags then - FLineSeparator := LineEnding - else - FLineSeparator := ' '; + if rpfMultiLine in FFormatFlags then + FLineSeparator := LineEnding + else + FLineSeparator := ' '; - FWatchedVarName := UpperCase(AWatchedExpr); - FParentResValue := nil; - FCurrentResValue := nil; - FElementCount := 0; - FCurrentMultilineLvl := 0; - FDeepestMultilineLvl := 0; - FDeepestArray := 0; - Res := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName); - Result := Res.GetFullString; - Res.FreeAll; + FWatchedVarName := UpperCase(AWatchedExpr); + FParentResValue := nil; + FCurrentResValue := nil; + FElementCount := 0; + FCurrentMultilineLvl := 0; + FDeepestMultilineLvl := 0; + FDeepestArray := 0; + Res := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName); + Result := Res.GetFullString; + Res.FreeAll; + finally + EnableFloatExceptions; + end; end; function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf; diff --git a/ide/packages/idedebugger/idedebuggerwatchresult.pas b/ide/packages/idedebugger/idedebuggerwatchresult.pas index a9f70b00e4..4949de4bcc 100644 --- a/ide/packages/idedebugger/idedebuggerwatchresult.pas +++ b/ide/packages/idedebugger/idedebuggerwatchresult.pas @@ -8,7 +8,7 @@ interface uses Classes, SysUtils, Types, // LazDebuggerIntf - LazDebuggerIntf, LazDebuggerIntfBaseTypes, + LazDebuggerIntf, LazDebuggerIntfBaseTypes, LazDebuggerIntfFloatTypes, // IdeIntf IdeDebuggerWatchValueIntf, // LclBase @@ -33,6 +33,9 @@ type function GetAsWideString: WideString; inline; function GetAsQWord: QWord; inline; function GetAsInt64: Int64; inline; + function GetAsSingle: Single; inline; + function GetAsDouble: Double; inline; + function GetAsExtended: TDbgExtended; inline; function GetAsFloat: Extended; inline; function GetByteSize: Integer; inline; // Int, Enum function GetFloatPrecission: TLzDbgFloatPrecission; inline; @@ -231,15 +234,25 @@ type { TWatchResultValueFloat } - TWatchResultValueFloat = object(TWatchResultValue) + { TWatchResultValueFloatBase } + + { TGenericWatchResultValueFloat } + + generic TGenericWatchResultValueFloat = object(TWatchResultValue) protected const VKind = rdkFloatVal; private - FFloatValue: Extended; + FFloatValue: TFLOAT; protected function GetIsDephtlessData: Boolean; inline; - property GetAsFloat: Extended read FFloatValue; + function GetAsSingle: Single; inline; + function GetAsDouble: Double; inline; + function GetAsExtended: TDbgExtended; inline; + function GetAsFloat: Extended; function GetAsString: RawByteString; inline; + procedure SetFromString(s: string); inline; + + (* Once Saved/Loaded precission may be lowered *) procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string; const AnEntryTemplate: TWatchResultData; var AnOverrideTemplate: TOverrideTemplateData; @@ -247,6 +260,31 @@ type procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean); end; + { TWatchResultValueFloat } + + TWatchResultValueFloat = specialize TGenericWatchResultValueFloat; + + { TWatchResultValueSingle } + + TWatchResultValueSingle = object(specialize TGenericWatchResultValueFloat) + protected + function GetFloatPrecission: TLzDbgFloatPrecission; inline; + end; + + { TWatchResultValueDouble } + + TWatchResultValueDouble = object(specialize TGenericWatchResultValueFloat) + protected + function GetFloatPrecission: TLzDbgFloatPrecission; inline; + end; + + { TWatchResultValueExtended } + + TWatchResultValueExtended = object(specialize TGenericWatchResultValueFloat) + protected + function GetFloatPrecission: TLzDbgFloatPrecission; inline; + end; + { TWatchResultTypeFloat } TWatchResultTypeFloat = object(TWatchResultValue) @@ -765,7 +803,10 @@ type function GetAsWideString: WideString; virtual; abstract; function GetAsQWord: QWord; virtual; abstract; function GetAsInt64: Int64; virtual; abstract; - function GetAsFloat: Extended; virtual; abstract; + function GetAsSingle: Single; virtual; abstract; + function GetAsDouble: Double; virtual; abstract; + function GetAsExtended: TDbgExtended; virtual; abstract; + function GetAsFloat: Extended; virtual; abstract; deprecated; function GetByteSize: Integer; virtual; abstract; function GetFloatPrecission: TLzDbgFloatPrecission; virtual; abstract; @@ -830,7 +871,10 @@ type property AsWideString: WideString read GetAsWideString; property AsQWord: QWord read GetAsQWord; property AsInt64: Int64 read GetAsInt64; - property AsFloat: Extended read GetAsFloat; + property AsSingle: Single read GetAsSingle; + property AsDouble: Double read GetAsDouble; + property AsExtended: TDbgExtended read GetAsExtended; + property AsFloat: Extended read GetAsFloat; deprecated; property ByteSize: Integer read GetByteSize; property FloatPrecission: TLzDbgFloatPrecission read GetFloatPrecission; @@ -1018,7 +1062,10 @@ type function GetAsWideString: WideString; override; function GetAsQWord: QWord; override; function GetAsInt64: Int64; override; - function GetAsFloat: Extended; override; + function GetAsSingle: Single; override; + function GetAsDouble: Double; override; + function GetAsExtended: TDbgExtended; override; + function GetAsFloat: Extended; override; deprecated; function GetByteSize: Integer; override; function GetFloatPrecission: TLzDbgFloatPrecission; override; @@ -1207,6 +1254,35 @@ type constructor Create(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); end; + { TWatchResultDataFloatSized } + + //generic TWatchResultDataFloatSized = class(specialize TGenericWatchResultData >) + generic TWatchResultDataFloatSized<_DATA> = class(specialize TGenericWatchResultData<_DATA>) + private + function GetClassID: TWatchResultDataClassID; override; + end; + + { TWatchResultDataSingle } + + TWatchResultDataSingle = class(specialize TWatchResultDataFloatSized) + public + constructor Create(AFloatValue: Single); + end; + + { TWatchResultDataDouble } + + TWatchResultDataDouble = class(specialize TWatchResultDataFloatSized) + public + constructor Create(AFloatValue: Double); + end; + + { TWatchResultDataExtended } + + TWatchResultDataExtended = class(specialize TWatchResultDataFloatSized) + public + constructor Create(AFloatValue: TDbgExtended); + end; + { TWatchResultDataBoolean } TWatchResultDataBoolean = class(specialize TGenericWatchResultDataSizedNum) @@ -1591,6 +1667,12 @@ type function dbgs(AResKind: TWatchResultDataKind): String; overload; + +function FloatToStr(Value: TDbgExtended; const FormatSettings: TFormatSettings): String; overload; +var + _TGenericWatchResultValueFloat_FPointSettings: TFormatSettings; // generics force this to be in interface + + implementation function dbgs(AResKind: TWatchResultDataKind): String; @@ -1655,6 +1737,21 @@ begin Result := 0; end; +function TWatchResultValue.GetAsSingle: Single; +begin + Result := 0; +end; + +function TWatchResultValue.GetAsDouble: Double; +begin + Result := 0; +end; + +function TWatchResultValue.GetAsExtended: TDbgExtended; +begin + Result := 0; +end; + function TWatchResultValue.GetAsFloat: Extended; begin Result := 0; @@ -2038,32 +2135,91 @@ begin AConfig.DeletePath(APath + 'Deref'); end; -{ TWatchResultValueFloat } +{ TGenericWatchResultValueFloat } -function TWatchResultValueFloat.GetIsDephtlessData: Boolean; +function FloatToStr(Value: TDbgExtended; const FormatSettings: TFormatSettings): String; overload; +begin + {$IF DBG_HAS_EXTENDED} + Result := SysUtils.FloatToStr(double(Value), FormatSettings); + {$ELSE} + Result := SysUtils.FloatToStr(Value, FormatSettings); + {$ENDIF} +end; + +function TGenericWatchResultValueFloat.GetIsDephtlessData: Boolean; begin Result := True; end; -function TWatchResultValueFloat.GetAsString: RawByteString; +function TGenericWatchResultValueFloat.GetAsSingle: Single; begin - Result := FloatToStr(FFloatValue); + Result := FFloatValue; end; -procedure TWatchResultValueFloat.LoadDataFromXMLConfig( - const AConfig: TXMLConfig; const APath: string; - const AnEntryTemplate: TWatchResultData; +function TGenericWatchResultValueFloat.GetAsDouble: Double; +begin + Result := FFloatValue; +end; + +function TGenericWatchResultValueFloat.GetAsExtended: TDbgExtended; +begin + Result := FFloatValue; +end; + +function TGenericWatchResultValueFloat.GetAsFloat: Extended; +begin + Result := FFloatValue; +end; + +function TGenericWatchResultValueFloat.GetAsString: RawByteString; +begin + DisableFloatExceptions; + try + Result := FloatToStr(FFloatValue, _TGenericWatchResultValueFloat_FPointSettings); + finally + EnableFloatExceptions; + end; +end; + +procedure TGenericWatchResultValueFloat.SetFromString(s: string); +begin + FFloatValue := StrToFloatDef(s, 0, _TGenericWatchResultValueFloat_FPointSettings); +end; + +procedure TGenericWatchResultValueFloat.LoadDataFromXMLConfig(const AConfig: TXMLConfig; + const APath: string; const AnEntryTemplate: TWatchResultData; var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean); begin inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto); - FFloatValue := AConfig.GetExtendedValue(APath + 'Value', 0); + SetFromString(AConfig.GetValue(APath + 'Value', '0')); end; -procedure TWatchResultValueFloat.SaveDataToXMLConfig(const AConfig: TXMLConfig; +procedure TGenericWatchResultValueFloat.SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean); begin inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto); - AConfig.SetExtendedValue(APath + 'Value', FFloatValue); + AConfig.SetValue(APath + 'Value', GetAsString); +end; + +{ TWatchResultValueSingle } + +function TWatchResultValueSingle.GetFloatPrecission: TLzDbgFloatPrecission; +begin + Result := dfpSingle; //, dfpDouble, dfpExtended +end; + +{ TWatchResultValueDouble } + +function TWatchResultValueDouble.GetFloatPrecission: TLzDbgFloatPrecission; +begin + Result := dfpDouble; +end; + +{ TWatchResultValueExtended } + +function TWatchResultValueExtended.GetFloatPrecission: TLzDbgFloatPrecission; +begin + Result := dfpExtended; end; { TWatchResultTypeFloat } @@ -3432,6 +3588,21 @@ begin Result := FData.GetAsInt64; end; +function TGenericWatchResultData.GetAsSingle: Single; +begin + Result := FData.GetAsSingle; +end; + +function TGenericWatchResultData.GetAsDouble: Double; +begin + Result := FData.GetAsDouble; +end; + +function TGenericWatchResultData.GetAsExtended: TDbgExtended; +begin + Result := FData.GetAsExtended; +end; + function TGenericWatchResultData.GetAsFloat: Extended; begin Result := FData.GetAsFloat; @@ -3986,6 +4157,34 @@ begin FType.FFloatPrecission := APrecission; end; +{ TWatchResultDataFloatSized } + +function TWatchResultDataFloatSized.GetClassID: TWatchResultDataClassID; +begin + Result := wdFloat; +end; + +{ TWatchResultDataSingle } + +constructor TWatchResultDataSingle.Create(AFloatValue: Single); +begin + FData.FFloatValue := AFloatValue; +end; + +{ TWatchResultDataDouble } + +constructor TWatchResultDataDouble.Create(AFloatValue: Double); +begin + FData.FFloatValue := AFloatValue; +end; + +{ TWatchResultDataExtended } + +constructor TWatchResultDataExtended.Create(AFloatValue: TDbgExtended); +begin + FData.FFloatValue := AFloatValue; +end; + { TWatchResultDataBoolean } function TWatchResultDataBoolean.GetClassID: TWatchResultDataClassID; @@ -5128,5 +5327,10 @@ begin FData.FText := APrintedVal; end; +initialization + _TGenericWatchResultValueFloat_FPointSettings := DefaultFormatSettings; + _TGenericWatchResultValueFloat_FPointSettings.DecimalSeparator := '.'; + _TGenericWatchResultValueFloat_FPointSettings.ThousandSeparator := ','; + end.