paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 17:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved float_rounding_mode to systemh.inc; renamed to softfloat_rounding_mode

Browse Source 
git-svn-id: trunk@11219 -
This commit is contained in:
florian 2008-06-12 20:23:37 +00:00
parent 3f180cf139
commit 4ac1deb50b
2 changed files with 34 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/inc/mathh.inc
View File

@ -36,11 +36,21 @@ Software IEC/IEEE floating-point exception flags.
float_flag_overflow = 8; float_flag_overflow = 8;
float_flag_underflow = 16; float_flag_underflow = 16;
float_flag_inexact = 32; float_flag_inexact = 32;
{ declarations of the math routines }
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point rounding mode.
-------------------------------------------------------------------------------
*}
float_round_nearest_even = 0;
float_round_down = 1;
float_round_up = 2;
float_round_to_zero = 3;
threadvar threadvar
softfloat_exception_mask : Byte; softfloat_exception_mask : Byte;
softfloat_exception_flags : Byte; softfloat_exception_flags : Byte;
softfloat_rounding_mode : Byte;
procedure float_raise(i: shortint); procedure float_raise(i: shortint);

88
rtl/inc/softfpu.pp
View File

@ -463,48 +463,6 @@ Software IEC/IEEE floating-point underflow tininess-detection mode.
float_tininess_after_rounding = 0; float_tininess_after_rounding = 0;
float_tininess_before_rounding = 1; float_tininess_before_rounding = 1;
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point rounding mode.
-------------------------------------------------------------------------------
*}
{
Round to nearest.
This is the default mode. It should be used unless there is a specific
need for one of the others. In this mode results are rounded to the
nearest representable value. If the result is midway between two
representable values, the even representable is chosen. Even here
means the lowest-order bit is zero. This rounding mode prevents
statistical bias and guarantees numeric stability: round-off errors
in a lengthy calculation will remain smaller than half of FLT_EPSILON.
Round toward plus Infinity.
All results are rounded to the smallest representable value which is
greater than the result.
Round toward minus Infinity.
All results are rounded to the largest representable value which is
less than the result.
Round toward zero.
All results are rounded to the largest representable value whose
magnitude is less than that of the result. In other words, if the
result is negative it is rounded up; if it is positive, it is
rounded down.
}
float_round_nearest_even = 0;
float_round_down = 1;
float_round_up = 2;
float_round_to_zero = 3;
{*
-------------------------------------------------------------------------------
Floating-point rounding mode and exception flags.
-------------------------------------------------------------------------------
*}
const
float_rounding_mode : Byte = float_round_nearest_even;
{* {*
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
Underflow tininess-detection mode, statically initialized to default value. Underflow tininess-detection mode, statically initialized to default value.
@ -549,7 +507,7 @@ var
roundIncrement, roundBits: int8; roundIncrement, roundBits: int8;
z: int32; z: int32;
begin begin
roundingMode := float_rounding_mode; roundingMode := softsoftfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even ); roundNearestEven := ord( roundingMode = float_round_nearest_even );
roundIncrement := $40; roundIncrement := $40;
if ( roundNearestEven=0 ) then if ( roundNearestEven=0 ) then
@ -611,7 +569,7 @@ var
label label
overflow; overflow;
begin begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even ); roundNearestEven := ord( roundingMode = float_round_nearest_even );
increment := ord( sbits64(absZ1) < 0 ); increment := ord( sbits64(absZ1) < 0 );
if ( roundNearestEven=0 ) then if ( roundNearestEven=0 ) then
@ -2387,7 +2345,7 @@ Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : floa
roundIncrement, roundBits : BYTE; roundIncrement, roundBits : BYTE;
IsTiny : Flag; IsTiny : Flag;
Begin Begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if (roundingMode = float_round_nearest_even) then if (roundingMode = float_round_nearest_even) then
Begin Begin
roundNearestEven := Flag(TRUE); roundNearestEven := Flag(TRUE);
@ -2637,7 +2595,7 @@ Procedure
roundNearestEven, increment, isTiny : Flag; roundNearestEven, increment, isTiny : Flag;
Begin Begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
roundNearestEven := flag( roundingMode = float_round_nearest_even ); roundNearestEven := flag( roundingMode = float_round_nearest_even );
increment := flag( sbits32 (zSig2) < 0 ); increment := flag( sbits32 (zSig2) < 0 );
if ( roundNearestEven = flag(FALSE) ) then if ( roundNearestEven = flag(FALSE) ) then
@ -2748,7 +2706,7 @@ var
roundIncrement, roundBits: int16; roundIncrement, roundBits: int16;
isTiny: flag; isTiny: flag;
begin begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even ); roundNearestEven := ord( roundingMode = float_round_nearest_even );
roundIncrement := $200; roundIncrement := $200;
if ( roundNearestEven=0 ) then if ( roundNearestEven=0 ) then
@ -2971,7 +2929,7 @@ Function float32_to_int32( a : float32rec) : int32;compilerproc;
if ( aSigExtra<>0 ) then if ( aSigExtra<>0 ) then
softfloat_exception_flags := softfloat_exception_flags softfloat_exception_flags := softfloat_exception_flags
or float_flag_inexact; or float_flag_inexact;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
Begin Begin
if ( sbits32 (aSigExtra) < 0 ) then if ( sbits32 (aSigExtra) < 0 ) then
@ -3137,7 +3095,7 @@ Function float32_round_to_int( a: float32rec): float32rec;compilerproc;
:= softfloat_exception_flags OR float_flag_inexact; := softfloat_exception_flags OR float_flag_inexact;
aSign := extractFloat32Sign( a.float32 ); aSign := extractFloat32Sign( a.float32 );
case ( float_rounding_mode ) of case ( softfloat_rounding_mode ) of
float_round_nearest_even: float_round_nearest_even:
Begin Begin
if ( ( aExp = $7E ) and (extractFloat32Frac( a.float32 )<>0) ) then if ( ( aExp = $7E ) and (extractFloat32Frac( a.float32 )<>0) ) then
@ -3170,7 +3128,7 @@ Function float32_round_to_int( a: float32rec): float32rec;compilerproc;
lastBitMask := lastBitMask shl ($96 - aExp); lastBitMask := lastBitMask shl ($96 - aExp);
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z := a.float32; z := a.float32;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
Begin Begin
z := z + (lastBitMask shr 1); z := z + (lastBitMask shr 1);
@ -3341,7 +3299,7 @@ Function subFloat32Sigs( a:float32; b:float32; zSign:flag ): float32;
End; End;
if ( bSig < aSig ) Then goto aBigger; if ( bSig < aSig ) Then goto aBigger;
if ( aSig < bSig ) Then goto bBigger; if ( aSig < bSig ) Then goto bBigger;
subFloat32Sigs := packFloat32( flag(float_rounding_mode = float_round_down), 0, 0 ); subFloat32Sigs := packFloat32( flag(softfloat_rounding_mode = float_round_down), 0, 0 );
exit; exit;
bExpBigger: bExpBigger:
if ( bExp = $FF ) then if ( bExp = $FF ) then
@ -4056,7 +4014,7 @@ Begin
absZ := aSig0 shr ( - shiftCount ); absZ := aSig0 shr ( - shiftCount );
End; End;
End; End;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
Begin Begin
if ( sbits32(aSigExtra) < 0 ) then if ( sbits32(aSigExtra) < 0 ) then
@ -4246,7 +4204,7 @@ Begin
lastBitMask := ( lastBitMask shl ( $432 - aExp ) ) shl 1; lastBitMask := ( lastBitMask shl ( $432 - aExp ) ) shl 1;
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z := a; z := a;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
Begin Begin
if ( lastBitMask <> 0) then if ( lastBitMask <> 0) then
@ -4287,7 +4245,7 @@ Begin
softfloat_exception_flags := softfloat_exception_flags or softfloat_exception_flags := softfloat_exception_flags or
float_flag_inexact; float_flag_inexact;
aSign := extractFloat64Sign( a ); aSign := extractFloat64Sign( a );
case ( float_rounding_mode ) of case ( softfloat_rounding_mode ) of
float_round_nearest_even: float_round_nearest_even:
Begin Begin
if ( ( aExp = $3FE ) if ( ( aExp = $3FE )
@ -4324,7 +4282,7 @@ Begin
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z.low := 0; z.low := 0;
z.high := a.high; z.high := a.high;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
Begin Begin
z.high := z.high + lastBitMask shr 1; z.high := z.high + lastBitMask shr 1;
@ -4514,7 +4472,7 @@ Begin
if ( aSig0 < bSig0 ) then goto bBigger; if ( aSig0 < bSig0 ) then goto bBigger;
if ( bSig1 < aSig1 ) then goto aBigger; if ( bSig1 < aSig1 ) then goto aBigger;
if ( aSig1 < bSig1 ) then goto bBigger; if ( aSig1 < bSig1 ) then goto bBigger;
packFloat64( flag(float_rounding_mode = float_round_down), 0, 0, 0 , out); packFloat64( flag(softfloat_rounding_mode = float_round_down), 0, 0, 0 , out);
exit; exit;
bExpBigger: bExpBigger:
if ( bExp = $7FF ) then if ( bExp = $7FF ) then
@ -5668,7 +5626,7 @@ var
label label
precision80; precision80;
begin begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
roundNearestEven := flag( roundingMode = float_round_nearest_even ); roundNearestEven := flag( roundingMode = float_round_nearest_even );
if ( roundingPrecision = 80 ) then if ( roundingPrecision = 80 ) then
goto precision80; goto precision80;
@ -6121,7 +6079,7 @@ begin
end; end;
softfloat_exception_flags or= float_flag_inexact; softfloat_exception_flags or= float_flag_inexact;
aSign := extractFloatx80Sign( a ); aSign := extractFloatx80Sign( a );
switch ( float_rounding_mode ) begin switch ( softfloat_rounding_mode ) begin
case float_round_nearest_even: case float_round_nearest_even:
if ( ( aExp = $3FFE ) and (bits64) ( extractFloatx80Frac( a ) shl 1 ) if ( ( aExp = $3FFE ) and (bits64) ( extractFloatx80Frac( a ) shl 1 )
) begin ) begin
@ -6145,7 +6103,7 @@ begin
lastBitMask shl = $403E - aExp; lastBitMask shl = $403E - aExp;
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z := a; z := a;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) begin if ( roundingMode = float_round_nearest_even ) begin
z.low += lastBitMask>>1; z.low += lastBitMask>>1;
if ( ( z.low and roundBitsMask ) = 0 ) z.low = ~ lastBitMask; if ( ( z.low and roundBitsMask ) = 0 ) z.low = ~ lastBitMask;
@ -6269,7 +6227,7 @@ begin
zSig1 := 0; zSig1 := 0;
if ( bSig < aSig ) goto aBigger; if ( bSig < aSig ) goto aBigger;
if ( aSig < bSig ) goto bBigger; if ( aSig < bSig ) goto bBigger;
result := packFloatx80( float_rounding_mode = float_round_down, 0, 0 ); result := packFloatx80( softfloat_rounding_mode = float_round_down, 0, 0 );
bExpBigger: bExpBigger:
if ( bExp = $7FFF ) begin if ( bExp = $7FFF ) begin
if ( (bits64) ( bSig shl 1 ) ) result := propagateFloatx80NaN( a, b ); if ( (bits64) ( bSig shl 1 ) ) result := propagateFloatx80NaN( a, b );
@ -6975,7 +6933,7 @@ var
roundingMode: int8; roundingMode: int8;
roundNearestEven, increment, isTiny: flag; roundNearestEven, increment, isTiny: flag;
begin begin
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even ); roundNearestEven := ord( roundingMode = float_round_nearest_even );
increment := ord( sbits64(zSig2) < 0 ); increment := ord( sbits64(zSig2) < 0 );
if ( roundNearestEven=0 ) then if ( roundNearestEven=0 ) then
@ -7477,7 +7435,7 @@ begin
lastBitMask := ( lastBitMask shl ( $406E - aExp ) ) shl 1; lastBitMask := ( lastBitMask shl ( $406E - aExp ) ) shl 1;
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z := a; z := a;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
begin begin
if ( lastBitMask )<>0 then if ( lastBitMask )<>0 then
@ -7515,7 +7473,7 @@ begin
end; end;
softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
aSign := extractFloat128Sign( a ); aSign := extractFloat128Sign( a );
case float_rounding_mode of case softfloat_rounding_mode of
float_round_nearest_even: float_round_nearest_even:
if ( ( aExp = $3FFE ) if ( ( aExp = $3FFE )
and ( (extractFloat128Frac0( a )<>0) and ( (extractFloat128Frac0( a )<>0)
@ -7551,7 +7509,7 @@ begin
roundBitsMask := lastBitMask - 1; roundBitsMask := lastBitMask - 1;
z.low := 0; z.low := 0;
z.high := a.high; z.high := a.high;
roundingMode := float_rounding_mode; roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then begin if ( roundingMode = float_round_nearest_even ) then begin
inc(z.high,lastBitMask shr 1); inc(z.high,lastBitMask shr 1);
if ( ( ( z.high and roundBitsMask ) or a.low ) = 0 ) then begin if ( ( ( z.high and roundBitsMask ) or a.low ) = 0 ) then begin
@ -7717,7 +7675,7 @@ begin
if ( aSig0 < bSig0 ) then goto bBigger; if ( aSig0 < bSig0 ) then goto bBigger;
if ( bSig1 < aSig1 ) then goto aBigger; if ( bSig1 < aSig1 ) then goto aBigger;
if ( aSig1 < bSig1 ) then goto bBigger; if ( aSig1 < bSig1 ) then goto bBigger;
result := packFloat128( ord(float_rounding_mode = float_round_down), 0, 0, 0 ); result := packFloat128( ord(softfloat_rounding_mode = float_round_down), 0, 0, 0 );
exit; exit;
bExpBigger: bExpBigger:
if ( bExp = $7FFF ) then begin if ( bExp = $7FFF ) then begin