View Issue Details

IDProjectCategoryView StatusLast Update
0032837FPCRTLpublic2018-06-30 12:03
ReporterBart BroersmaAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindowsOS Version10
Product VersionProduct Buildr37573 
Target Version3.2.0Fixed in Version3.1.1 
Summary0032837: TFloatHelper incorrect results
DescriptionTFloatHelper gives incorrect results for Mantissa and Fraction.
(At least it's results differ from Delphi)
Steps To Reproduce    program fl;

{$apptype console}
{$ifdef fpc}
{$mode objfpc}
{$h+}
{$endif}

uses
  SysUtils, Math;

const
  Signs: Array[Boolean] of Char = ('+','-');
  Test = 1.999755859375; //(8192-1)/4096

  function DbgS(E: Extended): String; overload;
  begin
    Result := 'Sign: ' + Signs[E.Sign] +
              ', Mantissa: ' + IntToHex(E.Mantissa, SizeOf(E.Mantissa)*2) +
              ', Exp: ' + IntToHex(E.Exp, SizeOf(E.Exp)*2) +
              ', Frac: ' + IntToHex(E.Frac, SizeOf(E.Frac)*2);
  end;

function DbgS(D: Double): String; overload;
begin
  Result := 'Sign: ' + Signs[D.Sign] +
            ', Mantissa: ' + IntToHex(D.Mantissa, SizeOf(D.Mantissa)*2) +
            ', Exp: ' + IntToHex(D.Exp, SizeOf(D.Exp)*2) +
            ', Frac: ' + IntToHex(D.Frac, SizeOf(D.Frac)*2);
end;

function DbgS(S: Single): String; overload;
begin
  Result := 'Sign: ' + Signs[S.Sign] +
            ', Mantissa: ' + IntToHex(S.Mantissa, SizeOf(S.Mantissa)*2) +
            ', Exp: ' + IntToHex(S.Exp, SizeOf(S.Exp)*2) +
            ', Frac: ' + IntToHex(S.Frac, SizeOf(S.Frac)*2);
end;


procedure TestBreakDown;
var
  E: Extended;
  S: Single;
  D: Double;
begin
  E := Test;
  writeln('E = ',E:20:20,0000032,DbgS(E));
  D := Test;
  writeln('D = ',D:20:20,0000032,DbgS(D));
  S := Test;
  writeln('S = ',S:20:20,0000032,DbgS(S));
end;

begin
  TestBreakDown;
end.

Outputs:

fpc 3.1.1 r37573 32-bit
Mode ObjFpc and Mode Delphi
E = 1.99975585937500000000 Sign: +, Mantissa: 7FF8000000000000, Exp: 0000000000003FFF, Frac: FFF8000000000000
D = 1.99975585937500000000 Sign: +, Mantissa: 000FFF0000000000, Exp: 00000000000003FF, Frac: 001FFF0000000000
S = 1.99975585900000000000 Sign: +, Mantissa: 00000000007FF800, Exp: 000000000000007F, Frac: 00000000087FF800

Delphi 10.2 Version 25.0.26309.314 32-bit
E = 1.99975585937500000000 Sign: +, Mantissa: FFF8000000000000, Exp: 0000000000003FFF, Frac: FFF8000000000000
D = 1.99975585937500000000 Sign: +, Mantissa: 001FFF0000000000, Exp: 00000000000003FF, Frac: 000FFF0000000000
S = 1.99975585937500000000 Sign: +, Mantissa: 0000000000FFF800, Exp: 000000000000007F, Frac: 00000000007FF800
Additional InformationThe test using Delphi was done by rvk in the dutch Delphi forum: http://www.nldelphi.com/showthread.php?42731-TExtendedHelper-BuildUp()
TagsNo tags attached.
Fixed in Revision39346
FPCOldBugId
FPCTarget
Attached Files
  • floathelper.exponent.diff (1,390 bytes)
    Index: rtl/objpas/sysutils/syshelpf.inc
    ===================================================================
    --- rtl/objpas/sysutils/syshelpf.inc	(revision 37573)
    +++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
    @@ -166,7 +166,7 @@
       E:=GetE;
       F:=GetF;
       if (0<E) and (E<$77FF) then
    -    Result:=E-$3FF
    +    Result:=E-Bias
       else if (E=0) and (F<>0) then
         Result:=-1022
     end;
    Index: rtl/objpas/sysutils/syshelph.inc
    ===================================================================
    --- rtl/objpas/sysutils/syshelph.inc	(revision 37573)
    +++ rtl/objpas/sysutils/syshelph.inc	(working copy)
    @@ -178,6 +178,8 @@
     {$IFDEF FPC_HAS_TYPE_SINGLE}
       TSingleHelper = Type Helper for Single
       Private
    +    const
    +      Bias = $7F;
         Function GetB(AIndex: Cardinal): Byte;
         Function GetW(AIndex: Cardinal): Word;
         Function GetE: QWord; inline;
    @@ -240,6 +242,8 @@
     {$IFDEF FPC_HAS_TYPE_DOUBLE}
       TDoubleHelper = Type Helper for Double
       private
    +    const
    +      Bias = $3FF;
         Function GetB(AIndex: Cardinal): Byte;
         Function GetW(AIndex: Cardinal): Word;
         Function GetE: QWord; inline;
    @@ -301,6 +305,8 @@
     {$ifdef FPC_HAS_TYPE_EXTENDED}
       TExtendedHelper = Type Helper for Extended
       private
    +    const
    +      Bias = $3FFF;
         Function GetB(AIndex: Cardinal): Byte;
         Function GetW(AIndex: Cardinal): Word;
         Function GetE: QWord; inline;
    
  • floathelpers.diff (6,807 bytes)
    Index: rtl/inc/genmath.inc
    ===================================================================
    --- rtl/inc/genmath.inc	(revision 37885)
    +++ rtl/inc/genmath.inc	(working copy)
    @@ -1925,7 +1925,7 @@
     {$if defined(SUPPORT_EXTENDED) or defined(FPC_SOFT_FPUX80)}
     function TExtended80Rec.Mantissa : QWord;
       begin
    -    Result:=Frac and $7fffffffffffffff;
    +    Result:=Frac //no hidden bit, the mantissa _is_ the full 64-bit;
       end;
     
     
    @@ -1940,8 +1940,15 @@
     
     
     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,11 +2029,16 @@
           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}
     
     
    @@ -2033,7 +2045,9 @@
     {$ifdef SUPPORT_DOUBLE}
     function TDoubleRec.Mantissa : QWord;
       begin
    -    Result:=Data and $fffffffffffff;
    +    Result:=(Data and $fffffffffffff);
    +    if (Result=0) and (GetExp=0) then Exit;
    +    Result := Result or $10000000000000; //add the hidden bit
       end;
     
     
    @@ -2044,8 +2058,15 @@
     
     
     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 +2096,7 @@
     
     function TDoubleRec.GetFrac : QWord;
       begin
    -    Result:=$10000000000000 or Mantissa;
    +    Result := Data and $fffffffffffff;
       end;
     
     
    @@ -2124,11 +2145,16 @@
           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}
     
     
    @@ -2135,7 +2161,9 @@
     {$ifdef SUPPORT_SINGLE}
     function TSingleRec.Mantissa : QWord;
       begin
    -    Result:=Data and $7fffff;
    +    Result:=(Data and $7fffff);
    +    if (Result=0) and (GetExp=0) then Exit;
    +    Result:=Result or $800000; //add the hidden bit
       end;
     
     
    @@ -2146,8 +2174,15 @@
     
     
     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 +2212,7 @@
     
     function TSingleRec.GetFrac : QWord;
       begin
    -    Result:=$8000000 or Mantissa;
    +    Result:=Data and $7fffff;
       end;
     
     
    @@ -2226,9 +2261,14 @@
           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}
    Index: rtl/inc/mathh.inc
    ===================================================================
    --- rtl/inc/mathh.inc	(revision 37885)
    +++ rtl/inc/mathh.inc	(working copy)
    @@ -138,6 +138,8 @@
     {$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;
    @@ -149,7 +151,7 @@
             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 @@
     {$ifdef SUPPORT_DOUBLE}
           TDoubleRec = packed record
           private
    +      const
    +        Bias = $3FF;
             function GetExp : QWord;
             procedure SetExp(e : QWord);
             function GetSign : Boolean;
    @@ -183,6 +187,7 @@
             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 @@
     {$ifdef SUPPORT_SINGLE}
           TSingleRec = packed record
           private
    +      const
    +        Bias = $7F;
             function GetExp : QWord;
             procedure SetExp(e : QWord);
             function GetSign : Boolean;
    @@ -208,6 +215,7 @@
             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);
    Index: rtl/objpas/sysutils/syshelpf.inc
    ===================================================================
    --- rtl/objpas/sysutils/syshelpf.inc	(revision 37885)
    +++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
    @@ -151,24 +151,13 @@
     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;
    
    floathelpers.diff (6,807 bytes)
  • fl.zip (9,063 bytes)
  • floathelpers.optionalhiddenbit.diff (8,413 bytes)
    Index: rtl/inc/genmath.inc
    ===================================================================
    --- rtl/inc/genmath.inc	(revision 39162)
    +++ rtl/inc/genmath.inc	(working copy)
    @@ -1923,12 +1923,14 @@
     {$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
     {$ifdef SUPPORT_EXTENDED}
    @@ -1940,8 +1942,15 @@
     
     
     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 @@
           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.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 @@
     
     function TDoubleRec.GetFrac : QWord;
       begin
    -    Result:=$10000000000000 or Mantissa;
    +    Result := Data and $fffffffffffff;
       end;
     
     
    @@ -2124,18 +2147,25 @@
           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.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 @@
     
     function TSingleRec.GetFrac : QWord;
       begin
    -    Result:=$8000000 or Mantissa;
    +    Result:=Data and $7fffff;
       end;
     
     
    @@ -2226,9 +2263,14 @@
           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}
    Index: rtl/inc/mathh.inc
    ===================================================================
    --- rtl/inc/mathh.inc	(revision 39162)
    +++ rtl/inc/mathh.inc	(working copy)
    @@ -138,18 +138,20 @@
     {$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 @@
     {$ifdef SUPPORT_DOUBLE}
           TDoubleRec = packed record
           private
    +      const
    +        Bias = $3FF;
             function GetExp : QWord;
             procedure SetExp(e : QWord);
             function GetSign : Boolean;
    @@ -176,7 +180,7 @@
             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;
    @@ -183,6 +187,7 @@
             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 @@
     {$ifdef SUPPORT_SINGLE}
           TSingleRec = packed record
           private
    +      const
    +        Bias = $7F;
             function GetExp : QWord;
             procedure SetExp(e : QWord);
             function GetSign : Boolean;
    @@ -201,7 +208,7 @@
             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;
    @@ -208,6 +215,7 @@
             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);
    Index: rtl/objpas/sysutils/syshelpf.inc
    ===================================================================
    --- rtl/objpas/sysutils/syshelpf.inc	(revision 39162)
    +++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
    @@ -151,24 +151,13 @@
     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 @@
     Function TFLOATHELPER.Mantissa: QWord;
     
     begin
    -  Result:=TFLoatRec(Self).Mantissa;
    +  Result:=TFLoatRec(Self).Mantissa(True);
     end;
     
     Function TFLOATHELPER.SpecialType: TFloatSpecial;
    

Activities

Bart Broersma

2017-12-16 18:20

reporter   ~0104760

I started investigating this because TFloatHelperBuildUp() seemed not to be reciprocal (i.e. when you decompose a float into Sign, Mantissa and Exp, and then call BuildUp with these values, you do not get the original float value back).

Bart Broersma

2017-12-17 22:31

reporter   ~0104788

Additional: TExtendedHelper.Exponent, TDoubleHelper.Exponent and TSingleHelper.Exponent all have the same implementation (using macro's to define the base type): TFloatHelper.Exponent:

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


The line marked with the *** is wrong.
It is only correct for Double, since the Bias in that case is $3FF.
For extended the Bias is $3FFF, for Single the Bias is $7F.

This is what fpc currently reports for the value 1.99975585937500000000 (E is Extended, D is Double, S is Single):

E = 1.99975585937500000000 Sign: +, Mantissa: 7FF8000000000000, Exp: 3FFF, Exponent: 3C00, Frac: FFF8000000000000
D = 1.99975585937500000000 Sign: +, Mantissa: 000FFF0000000000, Exp: 03FF, Exponent: 0000, Frac: 001FFF0000000000
S = 1.99975585900000000000 Sign: +, Mantissa: 00000000007FF800, Exp: 007F, Exponent: FFFFFC80, Frac: 00000000087FF800

Bart Broersma

2017-12-17 22:51

reporter  

floathelper.exponent.diff (1,390 bytes)
Index: rtl/objpas/sysutils/syshelpf.inc
===================================================================
--- rtl/objpas/sysutils/syshelpf.inc	(revision 37573)
+++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
@@ -166,7 +166,7 @@
   E:=GetE;
   F:=GetF;
   if (0<E) and (E<$77FF) then
-    Result:=E-$3FF
+    Result:=E-Bias
   else if (E=0) and (F<>0) then
     Result:=-1022
 end;
Index: rtl/objpas/sysutils/syshelph.inc
===================================================================
--- rtl/objpas/sysutils/syshelph.inc	(revision 37573)
+++ rtl/objpas/sysutils/syshelph.inc	(working copy)
@@ -178,6 +178,8 @@
 {$IFDEF FPC_HAS_TYPE_SINGLE}
   TSingleHelper = Type Helper for Single
   Private
+    const
+      Bias = $7F;
     Function GetB(AIndex: Cardinal): Byte;
     Function GetW(AIndex: Cardinal): Word;
     Function GetE: QWord; inline;
@@ -240,6 +242,8 @@
 {$IFDEF FPC_HAS_TYPE_DOUBLE}
   TDoubleHelper = Type Helper for Double
   private
+    const
+      Bias = $3FF;
     Function GetB(AIndex: Cardinal): Byte;
     Function GetW(AIndex: Cardinal): Word;
     Function GetE: QWord; inline;
@@ -301,6 +305,8 @@
 {$ifdef FPC_HAS_TYPE_EXTENDED}
   TExtendedHelper = Type Helper for Extended
   private
+    const
+      Bias = $3FFF;
     Function GetB(AIndex: Cardinal): Byte;
     Function GetW(AIndex: Cardinal): Word;
     Function GetE: QWord; inline;

Bart Broersma

2017-12-17 22:52

reporter   ~0104789

Attached patch (floathelper.exponent.diff) fixes this particular bug with TFloatHelper.Exponent.

Please review.

Bart Broersma

2017-12-17 23:10

reporter   ~0104790

Last edited: 2017-12-17 23:27

View 4 revisions

> if (0<E) and (E<$77FF) then

I'm pretty sure that this must be:
$FF for Single
$7FF for Double
$7FFF for Extended

> Result:=-1022
That seems Double specific as well, for Single it should probably be -126, for Extended this rule does not seem to apply.

Source: http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Internal_Data_Formats#The_Single_type (Double and Extended are described below that.)

Bart Broersma

2017-12-17 23:35

reporter   ~0104792

Last edited: 2017-12-17 23:38

View 2 revisions

Probably the constants in TFLOATHELPER.BuildUp are specific to Double as well.

It may probably be easier to just write type-specific implementations (instead of TFLOATHELPER with macro's) for .Exponent and .BuildUp() methods?

Marco van de Voort

2017-12-18 10:28

manager   ~0104797

Shouldn't the if comparison clause (E<$77FF) not be type dependent either ?

Bart Broersma

2017-12-18 13:55

reporter   ~0104802

> Shouldn't the if comparison clause (E<$77FF) not be type dependent either ?

See my remarks in note 0104790.

Maybe we should handle all this in TExtended80Rec etc. and then just call that in TFLOATHELPER?

Max Nazhalov

2017-12-18 15:56

reporter   ~0104807

Last edited: 2017-12-18 16:08

View 3 revisions

> Result:=-1022
> That seems Double specific as well, for Single it should probably be -126, for Extended this rule does not seem to apply.

Applies. Unbiased exponent for subnormals (exp2=0) treated as if it was $0001.
Bias is $7F/$3FF/$3FFF, so the resulting binary exponent is -126/-1022/-16382.

Edit: and, of course, no $77FF -- specials are marked with exp2 field either 0 or $FF/$7FF/$7FFF.

Bart Broersma

2017-12-18 20:40

reporter   ~0104818

@Max Nazhalov: I don't know what you mean by "exp2".

Thaddy de Koning

2017-12-18 21:16

reporter   ~0104821

Last edited: 2017-12-18 21:31

View 4 revisions

exp2 is a function meaning two to the power of <argument>
I can't find it. Should be there.
[edit]
Ok it isn't:
program exponent;
{$mode objfpc}
function Exp2(const x: Integer): Cardinal;
begin
  if x = 0 then
    Result := 1
  else if x = 1 then
    Result := 2
  else
   Result:= 2 * Exp2(x-1); // !.
end;

begin
 writeln(exp2(16));
end.

Or use power to achieve the same.

Bart Broersma

2017-12-18 23:19

reporter   ~0104830

In Thaddy's code exp2 can never be 0.

Max Nazhalov

2017-12-19 01:22

reporter   ~0104835

exp2 is just a field in binary floating point representation.

Thaddy de Koning

2017-12-19 13:43

reporter   ~0104846

Last edited: 2017-12-19 13:46

View 4 revisions

Then it is a rather inconvenient naming. It is pretty much a standard.
And there is just one (1) real exponent.

Bart, ignore my reply. I was confused because of the name clash.
Still exp2 should be added to math, but that is a different issue.

Max Nazhalov

2017-12-19 17:55

reporter   ~0104850

Take on "low-level glasses", it's just a binary pattern conversion issue here. ;-)

Bart Broersma

2017-12-19 19:03

reporter   ~0104853

> exp2 is just a field in binary floating point representation.
OK, I must be blind or stupid. I still have no idea what you mean by that.

Bart Broersma

2017-12-19 19:06

reporter   ~0104854

What about my proposal to implement BuildUp and Exponent in the TExtended80Rec (etc) types?
If I want to start working on a patch, then I need to know if that is an acceptable/bad/good/don't_care idea.

Bart Broersma

2017-12-31 18:25

reporter  

floathelpers.diff (6,807 bytes)
Index: rtl/inc/genmath.inc
===================================================================
--- rtl/inc/genmath.inc	(revision 37885)
+++ rtl/inc/genmath.inc	(working copy)
@@ -1925,7 +1925,7 @@
 {$if defined(SUPPORT_EXTENDED) or defined(FPC_SOFT_FPUX80)}
 function TExtended80Rec.Mantissa : QWord;
   begin
-    Result:=Frac and $7fffffffffffffff;
+    Result:=Frac //no hidden bit, the mantissa _is_ the full 64-bit;
   end;
 
 
@@ -1940,8 +1940,15 @@
 
 
 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,11 +2029,16 @@
       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}
 
 
@@ -2033,7 +2045,9 @@
 {$ifdef SUPPORT_DOUBLE}
 function TDoubleRec.Mantissa : QWord;
   begin
-    Result:=Data and $fffffffffffff;
+    Result:=(Data and $fffffffffffff);
+    if (Result=0) and (GetExp=0) then Exit;
+    Result := Result or $10000000000000; //add the hidden bit
   end;
 
 
@@ -2044,8 +2058,15 @@
 
 
 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 +2096,7 @@
 
 function TDoubleRec.GetFrac : QWord;
   begin
-    Result:=$10000000000000 or Mantissa;
+    Result := Data and $fffffffffffff;
   end;
 
 
@@ -2124,11 +2145,16 @@
       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}
 
 
@@ -2135,7 +2161,9 @@
 {$ifdef SUPPORT_SINGLE}
 function TSingleRec.Mantissa : QWord;
   begin
-    Result:=Data and $7fffff;
+    Result:=(Data and $7fffff);
+    if (Result=0) and (GetExp=0) then Exit;
+    Result:=Result or $800000; //add the hidden bit
   end;
 
 
@@ -2146,8 +2174,15 @@
 
 
 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 +2212,7 @@
 
 function TSingleRec.GetFrac : QWord;
   begin
-    Result:=$8000000 or Mantissa;
+    Result:=Data and $7fffff;
   end;
 
 
@@ -2226,9 +2261,14 @@
       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}
Index: rtl/inc/mathh.inc
===================================================================
--- rtl/inc/mathh.inc	(revision 37885)
+++ rtl/inc/mathh.inc	(working copy)
@@ -138,6 +138,8 @@
 {$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;
@@ -149,7 +151,7 @@
         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 @@
 {$ifdef SUPPORT_DOUBLE}
       TDoubleRec = packed record
       private
+      const
+        Bias = $3FF;
         function GetExp : QWord;
         procedure SetExp(e : QWord);
         function GetSign : Boolean;
@@ -183,6 +187,7 @@
         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 @@
 {$ifdef SUPPORT_SINGLE}
       TSingleRec = packed record
       private
+      const
+        Bias = $7F;
         function GetExp : QWord;
         procedure SetExp(e : QWord);
         function GetSign : Boolean;
@@ -208,6 +215,7 @@
         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);
Index: rtl/objpas/sysutils/syshelpf.inc
===================================================================
--- rtl/objpas/sysutils/syshelpf.inc	(revision 37885)
+++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
@@ -151,24 +151,13 @@
 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;
floathelpers.diff (6,807 bytes)

Bart Broersma

2017-12-31 18:26

reporter  

fl.zip (9,063 bytes)

Bart Broersma

2017-12-31 18:30

reporter   ~0105206

Last edited: 2018-01-09 18:02

View 2 revisions

The attacehed sample program (in fl.zip) demonstrates the issue:

With current implementation the (relevant part of the) output is as follows:

C:\Users\Bart\LazarusProjecten\bugs\Console\floats>fl
Enter float (Q Quits, Default = 1.999755859375):
Extended
Value : 1.99975585937500000000E+0000
Sign : 0
Mantissa : 01111111 11111000 00000000 00000000 00000000 00000000 00000000 00000000 [7FF8000000000000]
**Should be: 11111111 11111000 00000000 00000000 00000000 00000000 00000000 00000000 [FFF8000000000000]
Exponent : 0011110000000000 [3C00] [15360]
**Should be: 0000000000000000 [0000] [0]

Double
Value : 1.9997558593750000E+000
Sign : 0
Mantissa : xxx01111 11111111 00000000 00000000 00000000 00000000 00000000 [000FFF0000000000]
**Should be: xxx11111 11111111 00000000 00000000 00000000 00000000 00000000 [001FFF0000000000]
Exponent : 0000000000000000 [0000] [0]

Single
Value : 1.999755859E+00
Sign : 0
Mantissa : 01111111 11111000 00000000 [007FF800]
**Should be: 11111111 11111000 00000000 [00FFF800]
Exponent : 1111110010000000 [FFFFFC80] [-896]
**Should be: 0000000000000000 [0000] [0]

Attached patch floathelpers.diff fixes this.
(the previous patch floathelper.exponent.diff should be ignored.)

I moved the implementation of the BuildUp and Exponent methods to the respective TFloatRec's implementation.
I based my changes on the following information:
https://en.wikipedia.org/wiki/Extended_precision
https://en.wikipedia.org/wiki/Double-precision_floating-point_format
https://en.wikipedia.org/wiki/Single-precision_floating-point_format
https://en.wikipedia.org/wiki/IEEE_754
http://rvelthuis.de/articles/articles-floats.html

Like Delphi does, for Double and Single the Mantissa function returns a value that includes the "hidden" or "implicit" bit.
As far as I have tested the BuildUp function now gives the correct result.
There may still be bugs left (alomost certainly, I guess), especially with the handling of subnormals,
but if that is the case, current implementation also will be wrong.

W.r.t. the test program: since I did most testing on fpc 3.0.4, I replicated the floating point advanced records and
parts of the floating point type helpers. All this is disabled when using fpc trunk. So, just don't look at it.

The relevant portion of the testing is in the DebugFloat() procedures.
The testing code has no defines to test wether fpc supports the different floating point types, for obvious reasons.
The CalcE, CalcD and CalcS functions aim to mathematically calculate a floating point value,
they can suffer from rounding errors, and are mainly there for my testing purposes. They can be disabled by defining skipcalc.

The DebugFloat procedure basically:
- extracts Sign, Mantissa and Exponent (for comparison with Delphi behaviour) and displays them in a format I found usefull
- tests the BuildUp method with the extracted Sign, mantissa ans Exponent to see if you get back the original value.
  (this will consistenly fail without this patch)

Florian

2018-01-13 20:35

administrator   ~0105753

> Like Delphi does, for Double and Single the Mantissa function returns a value that includes the "hidden" or "implicit" bit.

Delphi docs say something different about the Mantissa function:
http://docwiki.embarcadero.com/Libraries/XE8/en/System.TDoubleRec.Mantissa

Bart Broersma

2018-01-14 00:34

reporter   ~0105760

But it seems it does include it.

Bart Broersma

2018-01-14 00:49

reporter   ~0105761

Last edited: 2018-01-14 00:54

View 4 revisions

From http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.SysUtils.TDoubleHelper

and

http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.SysUtils.TSingleHelper

"The Mantissa is formed from the Fraction with a 1 bit before"

This seems consistent with my initial testing.

With my patch applied, I get the same value for Mantissa for the number 28.0 as in all these 3 pages (Single, Double, Extended).

Florian

2018-01-14 09:45

administrator   ~0105775

True, but for the *Rec, this does apparently not apply: http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.TSingleRec.Mantissa

And those are changed by the patch as well. And since even the compiler depends on this behaviour, it is imo a bad idea to change this without additional fixes or whatever :)

Bart Broersma

2018-01-14 15:05

reporter   ~0105791

You mean that TFloatRec.Mantissa does NOT give the same result as TFloatHelper.Mantissa in Delphi???
If so, WTF?

> And those are changed by the patch as well.
To me it makes more sense to have all calculations in one place.
It also makes it possible to use the TFloatHelper/TFloatRec macro's for all this.

> And since even the compiler depends on this behaviour
In what way?

Bart Broersma

2018-01-14 15:24

reporter   ~0105792

Last edited: 2018-01-14 15:24

View 2 revisions

I found this comment in nadd (function taddnode.simplify):

{ mantissa returns the mantissa/fraction without the hidden 1, so power of two means only the hidden
              bit is set => mantissa must be 0 }

From what I have understood from the matter, this statement is wrong for the extended (80-bit) type. This type does NOT have a hidden bit at all.

Anyhow, IMHO preserving the inconsistency between *rec.mantissa and *helper.mantissa is wrong and plain confusing.

Bart Broersma

2018-01-14 15:50

reporter   ~0105794

The *rec.Mantissa function could be changed to have a boolean IncludeHiddenBit parameter, which defaults to False?

Bart Broersma

2018-01-14 16:03

reporter   ~0105795

The fact that the *rec.Mantissa in Delphi does not include the hidden bit (at least according to documentation, I cannot actually test), is even more WTF, since the use of these records is deprecated in Delphi: "deprecated 'Use TSingleHelper';", which then includes the hiden bit.

Bart Broersma

2018-06-03 13:17

reporter   ~0108662

> The *rec.Mantissa function could be changed to have a boolean IncludeHiddenBit
> parameter, which defaults to False?

Would that be acceptable?

Michael Van Canneyt

2018-06-03 13:20

administrator   ~0108663

Yes, I think this is a good idea.

Bart Broersma

2018-06-03 14:25

reporter  

floathelpers.optionalhiddenbit.diff (8,413 bytes)
Index: rtl/inc/genmath.inc
===================================================================
--- rtl/inc/genmath.inc	(revision 39162)
+++ rtl/inc/genmath.inc	(working copy)
@@ -1923,12 +1923,14 @@
 {$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
 {$ifdef SUPPORT_EXTENDED}
@@ -1940,8 +1942,15 @@
 
 
 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 @@
       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.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 @@
 
 function TDoubleRec.GetFrac : QWord;
   begin
-    Result:=$10000000000000 or Mantissa;
+    Result := Data and $fffffffffffff;
   end;
 
 
@@ -2124,18 +2147,25 @@
       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.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 @@
 
 function TSingleRec.GetFrac : QWord;
   begin
-    Result:=$8000000 or Mantissa;
+    Result:=Data and $7fffff;
   end;
 
 
@@ -2226,9 +2263,14 @@
       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}
Index: rtl/inc/mathh.inc
===================================================================
--- rtl/inc/mathh.inc	(revision 39162)
+++ rtl/inc/mathh.inc	(working copy)
@@ -138,18 +138,20 @@
 {$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 @@
 {$ifdef SUPPORT_DOUBLE}
       TDoubleRec = packed record
       private
+      const
+        Bias = $3FF;
         function GetExp : QWord;
         procedure SetExp(e : QWord);
         function GetSign : Boolean;
@@ -176,7 +180,7 @@
         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;
@@ -183,6 +187,7 @@
         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 @@
 {$ifdef SUPPORT_SINGLE}
       TSingleRec = packed record
       private
+      const
+        Bias = $7F;
         function GetExp : QWord;
         procedure SetExp(e : QWord);
         function GetSign : Boolean;
@@ -201,7 +208,7 @@
         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;
@@ -208,6 +215,7 @@
         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);
Index: rtl/objpas/sysutils/syshelpf.inc
===================================================================
--- rtl/objpas/sysutils/syshelpf.inc	(revision 39162)
+++ rtl/objpas/sysutils/syshelpf.inc	(working copy)
@@ -151,24 +151,13 @@
 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 @@
 Function TFLOATHELPER.Mantissa: QWord;
 
 begin
-  Result:=TFLoatRec(Self).Mantissa;
+  Result:=TFLoatRec(Self).Mantissa(True);
 end;
 
 Function TFLOATHELPER.SpecialType: TFloatSpecial;

Bart Broersma

2018-06-03 14:32

reporter   ~0108665

Attached patch floathelpers.optionalhiddenbit.diff implements a solution as suggested above.
TDoubleRec.Mantissa/TSingleRec.Mantissa now by default return the Mantissa without the implicit (hidden) bit set, as they did before.
The Mantissa of type Extended does not have this feature (the Mantissa is the full 64 bits), so this behaviour was changed (the previous implementation was wrong).

Note: TExtended80Rec.Mantissa also has the IncludeHiddenBit parameter, even though this is ignored.
I did this so all 3 functions have the same signature, so we can have a single TFLOATHELPER.MANTISSA macro/function.

Michael Van Canneyt

2018-06-29 22:52

administrator   ~0109131

Checked helper changed, Checked other changes with Florian, applied the patch.

Thank you very much !

Issue History

Date Modified Username Field Change
2017-12-16 18:15 Bart Broersma New Issue
2017-12-16 18:20 Bart Broersma Note Added: 0104760
2017-12-17 22:31 Bart Broersma Note Added: 0104788
2017-12-17 22:51 Bart Broersma File Added: floathelper.exponent.diff
2017-12-17 22:52 Bart Broersma Note Added: 0104789
2017-12-17 23:10 Bart Broersma Note Added: 0104790
2017-12-17 23:22 Bart Broersma Note Edited: 0104790 View Revisions
2017-12-17 23:26 Bart Broersma Note Edited: 0104790 View Revisions
2017-12-17 23:27 Bart Broersma Note Edited: 0104790 View Revisions
2017-12-17 23:35 Bart Broersma Note Added: 0104792
2017-12-17 23:38 Bart Broersma Note Edited: 0104792 View Revisions
2017-12-18 10:28 Marco van de Voort Note Added: 0104797
2017-12-18 13:55 Bart Broersma Note Added: 0104802
2017-12-18 15:56 Max Nazhalov Note Added: 0104807
2017-12-18 15:57 Max Nazhalov Note Edited: 0104807 View Revisions
2017-12-18 16:08 Max Nazhalov Note Edited: 0104807 View Revisions
2017-12-18 20:40 Bart Broersma Note Added: 0104818
2017-12-18 21:16 Thaddy de Koning Note Added: 0104821
2017-12-18 21:19 Thaddy de Koning Note Edited: 0104821 View Revisions
2017-12-18 21:28 Thaddy de Koning Note Edited: 0104821 View Revisions
2017-12-18 21:31 Thaddy de Koning Note Edited: 0104821 View Revisions
2017-12-18 23:19 Bart Broersma Note Added: 0104830
2017-12-19 01:22 Max Nazhalov Note Added: 0104835
2017-12-19 13:43 Thaddy de Koning Note Added: 0104846
2017-12-19 13:44 Thaddy de Koning Note Edited: 0104846 View Revisions
2017-12-19 13:45 Thaddy de Koning Note Edited: 0104846 View Revisions
2017-12-19 13:46 Thaddy de Koning Note Edited: 0104846 View Revisions
2017-12-19 17:55 Max Nazhalov Note Added: 0104850
2017-12-19 19:03 Bart Broersma Note Added: 0104853
2017-12-19 19:06 Bart Broersma Note Added: 0104854
2017-12-31 18:25 Bart Broersma File Added: floathelpers.diff
2017-12-31 18:26 Bart Broersma File Added: fl.zip
2017-12-31 18:30 Bart Broersma Note Added: 0105206
2018-01-09 18:02 Bart Broersma Note Edited: 0105206 View Revisions
2018-01-11 23:13 Michael Van Canneyt Assigned To => Michael Van Canneyt
2018-01-11 23:13 Michael Van Canneyt Status new => assigned
2018-01-13 20:35 Florian Note Added: 0105753
2018-01-14 00:34 Bart Broersma Note Added: 0105760
2018-01-14 00:49 Bart Broersma Note Added: 0105761
2018-01-14 00:50 Bart Broersma Note Edited: 0105761 View Revisions
2018-01-14 00:53 Bart Broersma Note Edited: 0105761 View Revisions
2018-01-14 00:54 Bart Broersma Note Edited: 0105761 View Revisions
2018-01-14 09:45 Florian Note Added: 0105775
2018-01-14 15:05 Bart Broersma Note Added: 0105791
2018-01-14 15:24 Bart Broersma Note Added: 0105792
2018-01-14 15:24 Bart Broersma Note Edited: 0105792 View Revisions
2018-01-14 15:50 Bart Broersma Note Added: 0105794
2018-01-14 16:03 Bart Broersma Note Added: 0105795
2018-06-03 13:17 Bart Broersma Note Added: 0108662
2018-06-03 13:20 Michael Van Canneyt Note Added: 0108663
2018-06-03 14:25 Bart Broersma File Added: floathelpers.optionalhiddenbit.diff
2018-06-03 14:32 Bart Broersma Note Added: 0108665
2018-06-29 22:52 Michael Van Canneyt Fixed in Revision => 39346
2018-06-29 22:52 Michael Van Canneyt Note Added: 0109131
2018-06-29 22:52 Michael Van Canneyt Status assigned => resolved
2018-06-29 22:52 Michael Van Canneyt Fixed in Version => 3.1.1
2018-06-29 22:52 Michael Van Canneyt Resolution open => fixed
2018-06-29 22:52 Michael Van Canneyt Target Version => 3.2.0
2018-06-30 12:03 Bart Broersma Status resolved => closed