paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@39346 -
This commit is contained in:
michael 2018-06-29 20:51:32 +00:00
parent d4f2a593d4
commit a9205c9fba
3 changed files with 80 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
rtl/inc/genmath.inc
View File

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

16
rtl/inc/mathh.inc
View File

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

17
rtl/objpas/sysutils/syshelpf.inc
View File

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