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."/>
<Filename Value="lazdebuggerutils.pas"/>
<UnitName Value="LazDebuggerUtils"/>
</Item>
+ <Item>
+ <Filename Value="lazdebuggerintffloattypes.pas"/>
+ <UnitName Value="LazDebuggerIntfFloatTypes"/>
+ </Item>
</Files>
<LazDoc Paths="docs"/>
<RequiredPkgs>
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<TFLOAT> = 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<Extended>;
+
+ { TWatchResultValueSingle }
+
+ TWatchResultValueSingle = object(specialize TGenericWatchResultValueFloat<Single>)
+ protected
+ function GetFloatPrecission: TLzDbgFloatPrecission; inline;
+ end;
+
+ { TWatchResultValueDouble }
+
+ TWatchResultValueDouble = object(specialize TGenericWatchResultValueFloat<Double>)
+ protected
+ function GetFloatPrecission: TLzDbgFloatPrecission; inline;
+ end;
+
+ { TWatchResultValueExtended }
+
+ TWatchResultValueExtended = object(specialize TGenericWatchResultValueFloat<TDbgExtended>)
+ 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<TFLOAT> = class(specialize TGenericWatchResultData<specialize TGenericWatchResultValueFloat<TFLOAT> >)
+ generic TWatchResultDataFloatSized<_DATA> = class(specialize TGenericWatchResultData<_DATA>)
+ private
+ function GetClassID: TWatchResultDataClassID; override;
+ end;
+
+ { TWatchResultDataSingle }
+
+ TWatchResultDataSingle = class(specialize TWatchResultDataFloatSized<TWatchResultValueSingle>)
+ public
+ constructor Create(AFloatValue: Single);
+ end;
+
+ { TWatchResultDataDouble }
+
+ TWatchResultDataDouble = class(specialize TWatchResultDataFloatSized<TWatchResultValueDouble>)
+ public
+ constructor Create(AFloatValue: Double);
+ end;
+
+ { TWatchResultDataExtended }
+
+ TWatchResultDataExtended = class(specialize TWatchResultDataFloatSized<TWatchResultValueExtended>)
+ public
+ constructor Create(AFloatValue: TDbgExtended);
+ end;
+
{ TWatchResultDataBoolean }
TWatchResultDataBoolean = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueBoolean>)
@@ -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.