paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: implement 80 bit extended float (soft fpu) for cross debugging a win-32bit target from a 64bit IDE

Browse Source
This commit is contained in:
Martin 2024-09-27 20:53:25 +02:00
parent 7d011b8465
commit d0a3a004df
13 changed files with 743 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
components/fpdebug/fpdbgdwarf.pas
View File

@ -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 }

54
components/fpdebug/fpdbginfo.pas
View File

@ -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;

108
components/fpdebug/fpdmemorytools.pas
View File

@ -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;

13
components/fpdebug/fppascalparser.pas
View File

@ -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;

23
components/fpdebug/fpwatchresultdata.pas
View File

@ -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;

16
components/lazdebuggers/lazdebuggerfp/test/testwatches.pas
View File

@ -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);

4
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk
View File

@ -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>

8
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas
View File

@ -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);

149
components/lazdebuggers/lazdebuggerintf/lazdebuggerintffloattypes.pas Normal file
View File

@ -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.

2
components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas
View File

@ -9,7 +9,7 @@ interface
uses
LazDebuggerIntf, LazDebuggerTemplate, LazDebuggerIntfBaseTypes, LazDebuggerValueConverter,
DbgUtilsTypePatternList, LazDebuggerUtils;
DbgUtilsTypePatternList, LazDebuggerUtils, LazDebuggerIntfFloatTypes;
implementation

58
ide/packages/idedebugger/debugger.pp
View File

@ -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

54
ide/packages/idedebugger/idedebuggerwatchresprinter.pas
View File

@ -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;

238
ide/packages/idedebugger/idedebuggerwatchresult.pas
View File

@ -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.