paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 22:47:59 +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_underflow = 16;
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
softfloat_exception_mask : Byte;
softfloat_exception_flags : Byte;
softfloat_rounding_mode : Byte;
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_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.
@ -549,7 +507,7 @@ var
roundIncrement, roundBits: int8;
z: int32;
begin
roundingMode := float_rounding_mode;
roundingMode := softsoftfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even );
roundIncrement := $40;
if ( roundNearestEven=0 ) then
@ -611,7 +569,7 @@ var
label
overflow;
begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even );
increment := ord( sbits64(absZ1) < 0 );
if ( roundNearestEven=0 ) then
@ -2387,7 +2345,7 @@ Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : floa
roundIncrement, roundBits : BYTE;
IsTiny : Flag;
Begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if (roundingMode = float_round_nearest_even) then
Begin
roundNearestEven := Flag(TRUE);
@ -2637,7 +2595,7 @@ Procedure
roundNearestEven, increment, isTiny : Flag;
Begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
roundNearestEven := flag( roundingMode = float_round_nearest_even );
increment := flag( sbits32 (zSig2) < 0 );
if ( roundNearestEven = flag(FALSE) ) then
@ -2748,7 +2706,7 @@ var
roundIncrement, roundBits: int16;
isTiny: flag;
begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even );
roundIncrement := $200;
if ( roundNearestEven=0 ) then
@ -2971,7 +2929,7 @@ Function float32_to_int32( a : float32rec) : int32;compilerproc;
if ( aSigExtra<>0 ) then
softfloat_exception_flags := softfloat_exception_flags
or float_flag_inexact;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
Begin
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;
aSign := extractFloat32Sign( a.float32 );
case ( float_rounding_mode ) of
case ( softfloat_rounding_mode ) of
float_round_nearest_even:
Begin
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);
roundBitsMask := lastBitMask - 1;
z := a.float32;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
Begin
z := z + (lastBitMask shr 1);
@ -3341,7 +3299,7 @@ Function subFloat32Sigs( a:float32; b:float32; zSign:flag ): float32;
End;
if ( bSig < aSig ) Then goto aBigger;
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;
bExpBigger:
if ( bExp = $FF ) then
@ -4056,7 +4014,7 @@ Begin
absZ := aSig0 shr ( - shiftCount );
End;
End;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
Begin
if ( sbits32(aSigExtra) < 0 ) then
@ -4246,7 +4204,7 @@ Begin
lastBitMask := ( lastBitMask shl ( $432 - aExp ) ) shl 1;
roundBitsMask := lastBitMask - 1;
z := a;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
Begin
if ( lastBitMask <> 0) then
@ -4287,7 +4245,7 @@ Begin
softfloat_exception_flags := softfloat_exception_flags or
float_flag_inexact;
aSign := extractFloat64Sign( a );
case ( float_rounding_mode ) of
case ( softfloat_rounding_mode ) of
float_round_nearest_even:
Begin
if ( ( aExp = $3FE )
@ -4324,7 +4282,7 @@ Begin
roundBitsMask := lastBitMask - 1;
z.low := 0;
z.high := a.high;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
Begin
z.high := z.high + lastBitMask shr 1;
@ -4514,7 +4472,7 @@ Begin
if ( aSig0 < bSig0 ) then goto bBigger;
if ( bSig1 < aSig1 ) then goto aBigger;
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;
bExpBigger:
if ( bExp = $7FF ) then
@ -5668,7 +5626,7 @@ var
label
precision80;
begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
roundNearestEven := flag( roundingMode = float_round_nearest_even );
if ( roundingPrecision = 80 ) then
goto precision80;
@ -6121,7 +6079,7 @@ begin
end;
softfloat_exception_flags or= float_flag_inexact;
aSign := extractFloatx80Sign( a );
switch ( float_rounding_mode ) begin
switch ( softfloat_rounding_mode ) begin
case float_round_nearest_even:
if ( ( aExp = $3FFE ) and (bits64) ( extractFloatx80Frac( a ) shl 1 )
) begin
@ -6145,7 +6103,7 @@ begin
lastBitMask shl = $403E - aExp;
roundBitsMask := lastBitMask - 1;
z := a;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) begin
z.low += lastBitMask>>1;
if ( ( z.low and roundBitsMask ) = 0 ) z.low = ~ lastBitMask;
@ -6269,7 +6227,7 @@ begin
zSig1 := 0;
if ( bSig < aSig ) goto aBigger;
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:
if ( bExp = $7FFF ) begin
if ( (bits64) ( bSig shl 1 ) ) result := propagateFloatx80NaN( a, b );
@ -6975,7 +6933,7 @@ var
roundingMode: int8;
roundNearestEven, increment, isTiny: flag;
begin
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
roundNearestEven := ord( roundingMode = float_round_nearest_even );
increment := ord( sbits64(zSig2) < 0 );
if ( roundNearestEven=0 ) then
@ -7477,7 +7435,7 @@ begin
lastBitMask := ( lastBitMask shl ( $406E - aExp ) ) shl 1;
roundBitsMask := lastBitMask - 1;
z := a;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then
begin
if ( lastBitMask )<>0 then
@ -7515,7 +7473,7 @@ begin
end;
softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
aSign := extractFloat128Sign( a );
case float_rounding_mode of
case softfloat_rounding_mode of
float_round_nearest_even:
if ( ( aExp = $3FFE )
and ( (extractFloat128Frac0( a )<>0)
@ -7551,7 +7509,7 @@ begin
roundBitsMask := lastBitMask - 1;
z.low := 0;
z.high := a.high;
roundingMode := float_rounding_mode;
roundingMode := softfloat_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then begin
inc(z.high,lastBitMask shr 1);
if ( ( ( z.high and roundBitsMask ) or a.low ) = 0 ) then begin
@ -7717,7 +7675,7 @@ begin
if ( aSig0 < bSig0 ) then goto bBigger;
if ( bSig1 < aSig1 ) then goto aBigger;
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;
bExpBigger:
if ( bExp = $7FFF ) then begin