From a9205c9fba74ca4ec0e608f32448f9dccac48444 Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 29 Jun 2018 20:51:32 +0000 Subject: [PATCH] * Fix bug ID #32837, correct Mantissa and Fraction in float helpers, patch from Bart Broersma git-svn-id: trunk@39346 - --- rtl/inc/genmath.inc | 88 +++++++++++++++++++++++--------- rtl/inc/mathh.inc | 16 ++++-- rtl/objpas/sysutils/syshelpf.inc | 17 ++---- 3 files changed, 80 insertions(+), 41 deletions(-) diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc index 44cd75f483..dc778ab6a9 100644 --- a/rtl/inc/genmath.inc +++ b/rtl/inc/genmath.inc @@ -1923,11 +1923,13 @@ function FPower10(val: Extended; Power: Longint): Extended; {$endif SUPPORT_EXTENDED} {$if defined(SUPPORT_EXTENDED) or defined(FPC_SOFT_FPUX80)} -function TExtended80Rec.Mantissa : QWord; +{$PUSH} +{$WARN 5024 off : Parameter "$1" not used} +function TExtended80Rec.Mantissa(IncludeHiddenBit: Boolean = False) : QWord; begin - Result:=Frac and $7fffffffffffffff; + Result:=Frac //no hidden bit, the mantissa _is_ the full 64-bit; end; - +{$POP} function TExtended80Rec.Fraction : Extended; begin @@ -1940,8 +1942,15 @@ function TExtended80Rec.Fraction : Extended; function TExtended80Rec.Exponent : Longint; + var + E: QWord; begin - Result:=Exp-16383; + Result := 0; + E := GetExp; + if (00) then + Result:=-(Bias-1); end; @@ -2022,18 +2031,25 @@ function TExtended80Rec.SpecialType : TFloatSpecial; end; end; -{ -procedure TExtended80Rec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint); - begin - end; -} +procedure TExtended80Rec.BuildUp(const _Sign: Boolean; const _Mantissa: QWord; const _Exponent: Longint); +begin + Value := 0.0; + if (_Mantissa=0) and (_Exponent=0) then + SetExp(0) + else + SetExp(_Exponent + Bias); + SetSign(_Sign); + Frac := _Mantissa; +end; {$endif SUPPORT_EXTENDED} {$ifdef SUPPORT_DOUBLE} -function TDoubleRec.Mantissa : QWord; +function TDoubleRec.Mantissa(IncludeHiddenBit: Boolean = False) : QWord; begin - Result:=Data and $fffffffffffff; + Result:=(Data and $fffffffffffff); + if (Result=0) and (GetExp=0) then Exit; + if IncludeHiddenBit then Result := Result or $10000000000000; //add the hidden bit end; @@ -2044,8 +2060,15 @@ function TDoubleRec.Fraction : ValReal; function TDoubleRec.Exponent : Longint; + var + E: QWord; begin - Result:=Exp-1023; + Result := 0; + E := GetExp; + if (00) then + Result:=-(Bias-1); end; @@ -2075,7 +2098,7 @@ procedure TDoubleRec.SetSign(s : Boolean); function TDoubleRec.GetFrac : QWord; begin - Result:=$10000000000000 or Mantissa; + Result := Data and $fffffffffffff; end; @@ -2124,18 +2147,25 @@ function TDoubleRec.SpecialType : TFloatSpecial; end; end; -{ -procedure TDoubleRec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint); +procedure TDoubleRec.BuildUp(const _Sign: Boolean; const _Mantissa: QWord; const _Exponent: Longint); begin + Value := 0.0; + SetSign(_Sign); + if (_Mantissa=0) and (_Exponent=0) then + Exit //SetExp(0) + else + SetExp(_Exponent + Bias); + SetFrac(_Mantissa and $fffffffffffff); //clear top bit end; -} {$endif SUPPORT_DOUBLE} {$ifdef SUPPORT_SINGLE} -function TSingleRec.Mantissa : QWord; +function TSingleRec.Mantissa(IncludeHiddenBit: Boolean = False) : QWord; begin - Result:=Data and $7fffff; + Result:=(Data and $7fffff); + if (Result=0) and (GetExp=0) then Exit; + if IncludeHiddenBit then Result:=Result or $800000; //add the hidden bit end; @@ -2146,8 +2176,15 @@ function TSingleRec.Fraction : ValReal; function TSingleRec.Exponent : Longint; + var + E: QWord; begin - Result:=Exp-127; + Result := 0; + E := GetExp; + if (00) then + Result:=-(Bias-1); end; @@ -2177,7 +2214,7 @@ procedure TSingleRec.SetSign(s : Boolean); function TSingleRec.GetFrac : QWord; begin - Result:=$8000000 or Mantissa; + Result:=Data and $7fffff; end; @@ -2226,9 +2263,14 @@ function TSingleRec.SpecialType : TFloatSpecial; end; end; -{ -procedure TSingleRec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint); +procedure TSingleRec.BuildUp(const _Sign: Boolean; const _Mantissa: QWord; const _Exponent: Longint); begin + Value := 0.0; + SetSign(_Sign); + if (_Mantissa=0) and (_Exponent=0) then + Exit //SetExp(0) + else + SetExp(_Exponent + Bias); + SetFrac(_Mantissa and $7fffff); //clear top bit end; -} {$endif SUPPORT_SINGLE} diff --git a/rtl/inc/mathh.inc b/rtl/inc/mathh.inc index a3326db301..86036b5c82 100644 --- a/rtl/inc/mathh.inc +++ b/rtl/inc/mathh.inc @@ -138,18 +138,20 @@ procedure float_raise(i: TFPUExceptionMask); {$if defined(SUPPORT_EXTENDED) or defined(FPC_SOFT_FPUX80)} TExtended80Rec = packed record private + const + Bias = $3FFF; function GetExp : QWord; procedure SetExp(e : QWord); function GetSign : Boolean; procedure SetSign(s : Boolean); public - function Mantissa : QWord; + function Mantissa(IncludeHiddenBit: Boolean = False) : QWord; // unused parameter inserted to have consistent function signature function Fraction : Extended; function Exponent : Longint; property Sign : Boolean read GetSign write SetSign; property Exp : QWord read GetExp write SetExp; function SpecialType : TFloatSpecial; - // procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint); + procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint); case byte of 0: (Bytes : array[0..9] of Byte); 1: (Words : array[0..4] of Word); @@ -169,6 +171,8 @@ procedure float_raise(i: TFPUExceptionMask); {$ifdef SUPPORT_DOUBLE} TDoubleRec = packed record private + const + Bias = $3FF; function GetExp : QWord; procedure SetExp(e : QWord); function GetSign : Boolean; @@ -176,13 +180,14 @@ procedure float_raise(i: TFPUExceptionMask); function GetFrac : QWord; procedure SetFrac(e : QWord); public - function Mantissa : QWord; + function Mantissa(IncludeHiddenBit: Boolean = False) : QWord; function Fraction : ValReal; function Exponent : Longint; property Sign : Boolean read GetSign write SetSign; property Exp : QWord read GetExp write SetExp; property Frac : QWord read Getfrac write SetFrac; function SpecialType : TFloatSpecial; + procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint); case byte of 0: (Bytes : array[0..7] of Byte); 1: (Words : array[0..3] of Word); @@ -194,6 +199,8 @@ procedure float_raise(i: TFPUExceptionMask); {$ifdef SUPPORT_SINGLE} TSingleRec = packed record private + const + Bias = $7F; function GetExp : QWord; procedure SetExp(e : QWord); function GetSign : Boolean; @@ -201,13 +208,14 @@ procedure float_raise(i: TFPUExceptionMask); function GetFrac : QWord; procedure SetFrac(e : QWord); public - function Mantissa : QWord; + function Mantissa(IncludeHiddenBit: Boolean = False) : QWord; function Fraction : ValReal; function Exponent : Longint; property Sign : Boolean read GetSign write SetSign; property Exp : QWord read GetExp write SetExp; property Frac : QWord read Getfrac write SetFrac; function SpecialType : TFloatSpecial; + procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint); case byte of 0: (Bytes : array[0..3] of Byte); 1: (Words : array[0..1] of Word); diff --git a/rtl/objpas/sysutils/syshelpf.inc b/rtl/objpas/sysutils/syshelpf.inc index 10be3b59f1..b8958356b0 100644 --- a/rtl/objpas/sysutils/syshelpf.inc +++ b/rtl/objpas/sysutils/syshelpf.inc @@ -151,24 +151,13 @@ end; Procedure TFLOATHELPER.BuildUp(const ASignFlag: Boolean; const AMantissa: QWord; const AExponent: Integer); begin - Self := 0.0; - SetS(ASignFlag); - SetE(AExponent + $3FF); - SetF(AMantissa and $000FFFFFFFFFFFFF); + TFloatRec(Self).BuildUp(ASignFlag, AMantissa, AExponent); end; Function TFLOATHELPER.Exponent: Integer; -var - F,E : QWord; begin - Result:=0; // Zero, inf, Nan - E:=GetE; - F:=GetF; - if (00) then - Result:=-1022 + Result:=TFloatRec(Self).Exponent; end; Function TFLOATHELPER.Fraction: Extended; @@ -204,7 +193,7 @@ end; Function TFLOATHELPER.Mantissa: QWord; begin - Result:=TFLoatRec(Self).Mantissa; + Result:=TFLoatRec(Self).Mantissa(True); end; Function TFLOATHELPER.SpecialType: TFloatSpecial;