* Fix bug ID #32837, correct Mantissa and Fraction in float helpers, patch from Bart Broersma

git-svn-id: trunk@39346 -

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 (0<E) and (E<2*Bias+1) then
+      Result:=Exp-Bias
+    else if (Exp=0) and (Frac<>0) 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 (0<E) and (E<2*Bias+1) then
+      Result:=Exp-Bias
+    else if (Exp=0) and (Frac<>0) 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 (0<E) and (E<2*Bias+1) then
+      Result:=Exp-Bias
+    else if (Exp=0) and (Frac<>0) 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}

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

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 (0<E) and (E<$77FF) then
-    Result:=E-$3FF
-  else if (E=0) and (F<>0) 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;