paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 16:09:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* correct masking of exceptions in genmath code

Browse Source 
git-svn-id: trunk@5965 -
This commit is contained in:
florian 2007-01-14 10:44:10 +00:00
parent 4f5c8cfe1f
commit b3a1868ff0
9 changed files with 160 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/i386/i386.inc
View File

@ -1206,6 +1206,8 @@ Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
{ setup sse exceptions } { setup sse exceptions }
ldmxcsr mxcsr ldmxcsr mxcsr
end; end;
softfloat_exception_flags:=0;
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
end; end;

3
rtl/inc/generic.inc
View File

@ -1240,7 +1240,8 @@ end;
procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif} procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
begin begin
{ nothing todo } softfloat_exception_flags:=0;
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
end; end;
{$endif FPC_SYSTEM_HAS_SYSRESETFPU} {$endif FPC_SYSTEM_HAS_SYSRESETFPU}

76
rtl/inc/genmath.inc
View File

@ -100,6 +100,33 @@ type
flag = byte; flag = byte;
{$endif FPC_SYSTEM_HAS_flag} {$endif FPC_SYSTEM_HAS_flag}
{*
-------------------------------------------------------------------------------
Raises the exceptions specified by `flags'. Floating-point traps can be
defined here if desired. It is currently not possible for such a trap
to substitute a result value. If traps are not implemented, this routine
should be simply `softfloat_exception_flags |= flags;'.
-------------------------------------------------------------------------------
*}
procedure float_raise( i: shortint );
Begin
softfloat_exception_flags := softfloat_exception_flags or i;
if ((softfloat_exception_flags and not(softfloat_exception_mask)) and float_flag_invalid) <> 0 then
RunError(207)
else
if ((softfloat_exception_flags and not(softfloat_exception_mask)) and float_flag_divbyzero) <> 0 then
RunError(200)
else
if ((softfloat_exception_flags and not(softfloat_exception_mask)) and float_flag_overflow) <> 0 then
RunError(205)
else
if ((softfloat_exception_flags and not(softfloat_exception_mask)) and float_flag_underflow) <> 0 then
RunError(206)
else
if ((softfloat_exception_flags and not(softfloat_exception_mask)) and float_flag_inexact) <> 0 then
RunError(207);
end;
{$ifndef FPC_SYSTEM_HAS_extractFloat64Frac0} {$ifndef FPC_SYSTEM_HAS_extractFloat64Frac0}
Function extractFloat64Frac0(const a: float64): longint; Function extractFloat64Frac0(const a: float64): longint;
@ -156,6 +183,8 @@ type
aExp, shiftCount: smallint; aExp, shiftCount: smallint;
aSig0, aSig1, absZ, aSigExtra: longint; aSig0, aSig1, absZ, aSigExtra: longint;
z: longint; z: longint;
label
invalid;
Begin Begin
aSig1 := extractFloat64Frac1( a ); aSig1 := extractFloat64Frac1( a );
aSig0 := extractFloat64Frac0( a ); aSig0 := extractFloat64Frac0( a );
@ -165,7 +194,7 @@ type
if 0<=shiftCount then if 0<=shiftCount then
Begin Begin
if (aExp=$7FF) and ((aSig0 or aSig1)<>0) then if (aExp=$7FF) and ((aSig0 or aSig1)<>0) then
HandleError(207); goto invalid;
shortShift64Left(aSig0 OR $00100000, aSig1, shiftCount, absZ, aSigExtra ); shortShift64Left(aSig0 OR $00100000, aSig1, shiftCount, absZ, aSigExtra );
End End
else else
@ -184,8 +213,19 @@ type
else else
z:=absZ; z:=absZ;
if ((aSign<>0) xor (z<0)) AND (z<>0) then if ((aSign<>0) xor (z<0)) AND (z<>0) then
HandleError(207); begin
float64_to_int32_round_to_zero := z; invalid:
float_raise(float_flag_invalid);
if (aSign <> 0) then
float64_to_int32_round_to_zero:=$80000000
else
float64_to_int32_round_to_zero:=$7FFFFFFF;
exit;
end;
if ( aSigExtra <> 0) then
float_raise(float_flag_inexact);
float64_to_int32_round_to_zero := z;
End; End;
@ -207,9 +247,17 @@ type
if aExp>=$43e then if aExp>=$43e then
begin begin
if int64(a)<>$C3E0000000000000 then if int64(a)<>$C3E0000000000000 then
HandleError(207); begin
{ pascal doesn't know Inf for int64 } float_raise(float_flag_invalid);
HandleError(207); if (aSign=0) or ((aExp=$7FF) and
(aSig<>$0010000000000000 )) then
begin
result:=$7FFFFFFFFFFFFFFF;
exit;
end;
end;
result:=$8000000000000000;
exit;
end; end;
z:=aSig shl shiftCount; z:=aSig shl shiftCount;
end end
@ -270,13 +318,14 @@ type
Begin Begin
if ( a <> Float32($CF000000) ) then if ( a <> Float32($CF000000) ) then
Begin Begin
float_raise( float_flag_invalid );
if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
Begin Begin
HandleError(207); float32_to_int32_round_to_zero:=$7fffffff;
exit; exit;
end; end;
End; End;
HandleError(207); float32_to_int32_round_to_zero:=$80000000;
exit; exit;
End End
else else
@ -561,8 +610,8 @@ type
begin begin
if( d <= 0.0 ) then if( d <= 0.0 ) then
begin begin
if( d < 0.0 ) then if d < 0.0 then
HandleError(207); d:=0/0;
result := 0.0; result := 0.0;
end end
else else
@ -1005,7 +1054,10 @@ type
Label Ldone; Label Ldone;
begin begin
if( d <= 0.0 ) then if( d <= 0.0 ) then
HandleError(207); begin
float_raise(float_flag_invalid);
exit;
end;
d := frexp( d, e ); d := frexp( d, e );
{ logarithm using log(x) = z + z**3 P(z)/Q(z), { logarithm using log(x) = z + z**3 P(z)/Q(z),
@ -1455,5 +1507,3 @@ function FPower10(val: Extended; Power: Longint): Extended;
end; end;
end; end;
{$endif SUPPORT_EXTENDED} {$endif SUPPORT_EXTENDED}

18
rtl/inc/mathh.inc
View File

@ -24,8 +24,26 @@
function GetSSECSR : dword; function GetSSECSR : dword;
{$endif} {$endif}
const
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point exception flags.
-------------------------------------------------------------------------------
*}
float_flag_invalid = 1;
float_flag_denormal = 2;
float_flag_divbyzero = 4;
float_flag_overflow = 8;
float_flag_underflow = 16;
float_flag_inexact = 32;
{ declarations of the math routines } { declarations of the math routines }
threadvar
softfloat_exception_mask : Byte;
softfloat_exception_flags : Byte;
procedure float_raise(i: shortint);
{$ifdef cpui386} {$ifdef cpui386}
{$define INTERNMATH} {$define INTERNMATH}
{$endif} {$endif}

115
rtl/inc/softfpu.pp
View File

@ -468,17 +468,6 @@ rounded down.
float_round_up = 2; float_round_up = 2;
float_round_to_zero = 3; float_round_to_zero = 3;
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point exception flags.
-------------------------------------------------------------------------------
*}
float_flag_invalid = 1;
float_flag_divbyzero = 4;
float_flag_overflow = 8;
float_flag_underflow = 16;
float_flag_inexact = 32;
{* {*
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
Floating-point rounding mode and exception flags. Floating-point rounding mode and exception flags.
@ -486,7 +475,6 @@ Floating-point rounding mode and exception flags.
*} *}
const const
float_rounding_mode : Byte = float_round_nearest_even; float_rounding_mode : Byte = float_round_nearest_even;
float_exception_flags : Byte = 0;
{* {*
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -505,31 +493,6 @@ implementation
{$if not(defined(fpc_softfpu_interface))} {$if not(defined(fpc_softfpu_interface))}
{*
-------------------------------------------------------------------------------
Raises the exceptions specified by `flags'. Floating-point traps can be
defined here if desired. It is currently not possible for such a trap
to substitute a result value. If traps are not implemented, this routine
should be simply `float_exception_flags |= flags;'.
-------------------------------------------------------------------------------
*}
procedure float_raise( i: shortint );
Begin
float_exception_flags := float_exception_flags or i;
if (float_exception_flags and float_flag_invalid) <> 0 then
RunError(207)
else
if (float_exception_flags and float_flag_divbyzero) <> 0 then
RunError(200)
else
if (float_exception_flags and float_flag_overflow) <> 0 then
RunError(205)
else
if (float_exception_flags and float_flag_underflow) <> 0 then
RunError(206);
end;
(*****************************************************************************) (*****************************************************************************)
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
(* Primitive arithmetic functions, including multi-word arithmetic, and *) (* Primitive arithmetic functions, including multi-word arithmetic, and *)
@ -595,7 +558,7 @@ begin
exit; exit;
end; end;
if ( roundBits<>0 ) then if ( roundBits<>0 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
result:=z; result:=z;
end; end;
@ -658,7 +621,7 @@ begin
result:=int64($7FFFFFFFFFFFFFFF); result:=int64($7FFFFFFFFFFFFFFF);
end; end;
if ( absZ1<>0 ) then if ( absZ1<>0 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
result:=z; result:=z;
end; end;
@ -2169,7 +2132,7 @@ Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : floa
End; End;
End; End;
if ( roundBits )<> 0 then if ( roundBits )<> 0 then
float_exception_flags := float_flag_inexact OR float_exception_flags; softfloat_exception_flags := float_flag_inexact OR softfloat_exception_flags;
zSig := ( zSig + roundIncrement ) shr 7; zSig := ( zSig + roundIncrement ) shr 7;
zSig := zSig AND not bits32( bits32( ( roundBits XOR $40 ) = 0 ) and roundNearestEven ); zSig := zSig AND not bits32( bits32( ( roundBits XOR $40 ) = 0 ) and roundNearestEven );
if ( zSig = 0 ) then zExp := 0; if ( zSig = 0 ) then zExp := 0;
@ -2432,7 +2395,7 @@ Procedure
End; End;
End; End;
if ( zSig2 )<>0 then if ( zSig2 )<>0 then
float_exception_flags := float_exception_flags OR float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags OR float_flag_inexact;
if ( increment )<>0 then if ( increment )<>0 then
Begin Begin
add64( zSig0, zSig1, 0, 1, zSig0, zSig1 ); add64( zSig0, zSig1, 0, 1, zSig0, zSig1 );
@ -2522,7 +2485,7 @@ begin
end end
end; end;
if ( roundBits<>0 ) then if ( roundBits<>0 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
zSig := ( zSig + roundIncrement ) shr 10; zSig := ( zSig + roundIncrement ) shr 10;
zSig := zSig and not( ord( ( roundBits xor $200 ) = 0 ) and roundNearestEven ); zSig := zSig and not( ord( ( roundBits xor $200 ) = 0 ) and roundNearestEven );
if ( zSig = 0 ) then if ( zSig = 0 ) then
@ -2695,7 +2658,7 @@ Function float32_to_int32( a : float32rec) : int32;compilerproc;
z := aSig shr ( - shiftCount ); z := aSig shr ( - shiftCount );
End; End;
if ( aSigExtra<>0 ) then if ( aSigExtra<>0 ) then
float_exception_flags := float_exception_flags softfloat_exception_flags := softfloat_exception_flags
or float_flag_inexact; or float_flag_inexact;
roundingMode := float_rounding_mode; roundingMode := float_rounding_mode;
if ( roundingMode = float_round_nearest_even ) then if ( roundingMode = float_round_nearest_even ) then
@ -2766,8 +2729,8 @@ Function float32_to_int32_round_to_zero( a: Float32rec ): int32;compilerproc;
if ( aExp <= $7E ) then if ( aExp <= $7E ) then
Begin Begin
if ( aExp or aSig )<>0 then if ( aExp or aSig )<>0 then
float_exception_flags := softfloat_exception_flags :=
float_exception_flags or float_flag_inexact; softfloat_exception_flags or float_flag_inexact;
float32_to_int32_round_to_zero := 0; float32_to_int32_round_to_zero := 0;
exit; exit;
End; End;
@ -2775,8 +2738,8 @@ Function float32_to_int32_round_to_zero( a: Float32rec ): int32;compilerproc;
z := aSig shr ( - shiftCount ); z := aSig shr ( - shiftCount );
if ( bits32 ( aSig shl ( shiftCount and 31 ) )<> 0 ) then if ( bits32 ( aSig shl ( shiftCount and 31 ) )<> 0 ) then
Begin Begin
float_exception_flags := softfloat_exception_flags :=
float_exception_flags or float_flag_inexact; softfloat_exception_flags or float_flag_inexact;
End; End;
if ( aSign<>0 ) then z := - z; if ( aSign<>0 ) then z := - z;
float32_to_int32_round_to_zero := z; float32_to_int32_round_to_zero := z;
@ -2859,8 +2822,8 @@ Function float32_round_to_int( a: float32rec): float32rec;compilerproc;
float32_round_to_int:=a; float32_round_to_int:=a;
exit; exit;
end; end;
float_exception_flags softfloat_exception_flags
:= float_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 ( float_rounding_mode ) of
@ -2912,7 +2875,7 @@ Function float32_round_to_int( a: float32rec): float32rec;compilerproc;
End; End;
z := z and not roundBitsMask; z := z and not roundBitsMask;
if ( z <> a.float32 ) then if ( z <> a.float32 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
float32_round_to_int.float32 := z; float32_round_to_int.float32 := z;
End; End;
@ -3820,7 +3783,7 @@ Begin
exit; exit;
End; End;
if ( aSigExtra <> 0) then if ( aSigExtra <> 0) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
float64_to_int32 := z; float64_to_int32 := z;
End; End;
@ -3867,8 +3830,8 @@ Var
Begin Begin
if ( aExp OR aSig0 OR aSig1 )<>0 then if ( aExp OR aSig0 OR aSig1 )<>0 then
Begin Begin
float_exception_flags := softfloat_exception_flags :=
float_exception_flags or float_flag_inexact; softfloat_exception_flags or float_flag_inexact;
End; End;
float64_to_int32_round_to_zero := 0; float64_to_int32_round_to_zero := 0;
exit; exit;
@ -3892,7 +3855,7 @@ Var
exit; exit;
End; End;
if ( aSigExtra <> 0) then if ( aSigExtra <> 0) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
float64_to_int32_round_to_zero := z; float64_to_int32_round_to_zero := z;
End; End;
@ -4010,7 +3973,7 @@ Begin
result := a; result := a;
exit; exit;
End; End;
float_exception_flags := float_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 ( float_rounding_mode ) of
@ -4072,8 +4035,8 @@ Begin
End; End;
if ( ( z.low <> a.low ) OR ( z.high <> a.high ) ) then if ( ( z.low <> a.low ) OR ( z.high <> a.high ) ) then
Begin Begin
float_exception_flags := softfloat_exception_flags :=
float_exception_flags or float_flag_inexact; softfloat_exception_flags or float_flag_inexact;
End; End;
result := z; result := z;
End; End;
@ -5453,7 +5416,7 @@ begin
zExp := 0; zExp := 0;
roundBits := zSig0 and roundMask; roundBits := zSig0 and roundMask;
if ( isTiny and roundBits ) float_raise( float_flag_underflow ); if ( isTiny and roundBits ) float_raise( float_flag_underflow );
if ( roundBits ) float_exception_flags |= float_flag_inexact; if ( roundBits ) softfloat_exception_flags |= float_flag_inexact;
zSig0 += roundIncrement; zSig0 += roundIncrement;
if ( (sbits64) zSig0 < 0 ) zExp := 1; if ( (sbits64) zSig0 < 0 ) zExp := 1;
roundIncrement := roundMask + 1; roundIncrement := roundMask + 1;
@ -5464,7 +5427,7 @@ begin
result:=packFloatx80( zSign, zExp, zSig0 ); result:=packFloatx80( zSign, zExp, zSig0 );
end; end;
end; end;
if ( roundBits ) float_exception_flags |= float_flag_inexact; if ( roundBits ) softfloat_exception_flags |= float_flag_inexact;
zSig0 += roundIncrement; zSig0 += roundIncrement;
if ( zSig0 < roundIncrement ) begin if ( zSig0 < roundIncrement ) begin
++zExp; ++zExp;
@ -5519,7 +5482,7 @@ begin
shift64ExtraRightJamming( zSig0, zSig1, 1 - zExp, &zSig0, &zSig1 ); shift64ExtraRightJamming( zSig0, zSig1, 1 - zExp, &zSig0, &zSig1 );
zExp := 0; zExp := 0;
if ( isTiny and zSig1 ) float_raise( float_flag_underflow ); if ( isTiny and zSig1 ) float_raise( float_flag_underflow );
if ( zSig1 ) float_exception_flags |= float_flag_inexact; if ( zSig1 ) softfloat_exception_flags |= float_flag_inexact;
if ( roundNearestEven ) begin if ( roundNearestEven ) begin
increment := ( (sbits64) zSig1 < 0 ); increment := ( (sbits64) zSig1 < 0 );
end; end;
@ -5540,7 +5503,7 @@ begin
result:=packFloatx80( zSign, zExp, zSig0 ); result:=packFloatx80( zSign, zExp, zSig0 );
end; end;
end; end;
if ( zSig1 ) float_exception_flags |= float_flag_inexact; if ( zSig1 ) softfloat_exception_flags |= float_flag_inexact;
if ( increment ) begin if ( increment ) begin
++zSig0; ++zSig0;
if ( zSig0 = 0 ) begin if ( zSig0 = 0 ) begin
@ -5636,7 +5599,7 @@ begin
goto invalid; goto invalid;
end; end;
else if ( aExp < $3FFF ) begin else if ( aExp < $3FFF ) begin
if ( aExp or aSig ) float_exception_flags or= float_flag_inexact; if ( aExp or aSig ) softfloat_exception_flags or= float_flag_inexact;
result := 0; result := 0;
end; end;
shiftCount := $403E - aExp; shiftCount := $403E - aExp;
@ -5650,7 +5613,7 @@ begin
result := aSign ? (sbits32) $80000000 : $7FFFFFFF; result := aSign ? (sbits32) $80000000 : $7FFFFFFF;
end; end;
if ( ( aSig shl shiftCount ) <> savedASig ) begin if ( ( aSig shl shiftCount ) <> savedASig ) begin
float_exception_flags or= float_flag_inexact; softfloat_exception_flags or= float_flag_inexact;
end; end;
result := z; result := z;
@ -5729,12 +5692,12 @@ begin
result := (sbits64) LIT64( $8000000000000000 ); result := (sbits64) LIT64( $8000000000000000 );
end; end;
else if ( aExp < $3FFF ) begin else if ( aExp < $3FFF ) begin
if ( aExp or aSig ) float_exception_flags or= float_flag_inexact; if ( aExp or aSig ) softfloat_exception_flags or= float_flag_inexact;
result := 0; result := 0;
end; end;
z := aSig>>( - shiftCount ); z := aSig>>( - shiftCount );
if ( (bits64) ( aSig shl ( shiftCount and 63 ) ) ) begin if ( (bits64) ( aSig shl ( shiftCount and 63 ) ) ) begin
float_exception_flags or= float_flag_inexact; softfloat_exception_flags or= float_flag_inexact;
end; end;
if ( aSign ) z := - z; if ( aSign ) z := - z;
result := z; result := z;
@ -5851,7 +5814,7 @@ begin
and ( (bits64) ( extractFloatx80Frac( a ) shl 1 ) = 0 ) ) begin and ( (bits64) ( extractFloatx80Frac( a ) shl 1 ) = 0 ) ) begin
result := a; result := a;
end; end;
float_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 ( float_rounding_mode ) begin
case float_round_nearest_even: case float_round_nearest_even:
@ -5892,7 +5855,7 @@ begin
++z.high; ++z.high;
z.low := LIT64( $8000000000000000 ); z.low := LIT64( $8000000000000000 );
end; end;
if ( z.low <> a.low ) float_exception_flags or= float_flag_inexact; if ( z.low <> a.low ) softfloat_exception_flags or= float_flag_inexact;
result := z; result := z;
end; end;
@ -6789,7 +6752,7 @@ begin
end; end;
end; end;
if ( zSig2<>0 ) then if ( zSig2<>0 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
if ( increment<>0 ) then if ( increment<>0 ) then
begin begin
add128( zSig0, zSig1, 0, 1, zSig0, zSig1 ); add128( zSig0, zSig1, 0, 1, zSig0, zSig1 );
@ -6903,7 +6866,7 @@ begin
else if ( aExp < $3FFF ) then else if ( aExp < $3FFF ) then
begin begin
if ( aExp or aSig0 )<>0 then if ( aExp or aSig0 )<>0 then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
result := 0; result := 0;
exit; exit;
end; end;
@ -6926,7 +6889,7 @@ begin
end; end;
if ( ( aSig0 shl shiftCount ) <> savedASig ) then if ( ( aSig0 shl shiftCount ) <> savedASig ) then
begin begin
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
end; end;
result := z; result := z;
end; end;
@ -7011,7 +6974,7 @@ begin
and ( aSig1 < int64( $0002000000000000 ) ) ) then and ( aSig1 < int64( $0002000000000000 ) ) ) then
begin begin
if ( aSig1<>0 ) then if ( aSig1<>0 ) then
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
end end
else begin else begin
float_raise( float_flag_invalid ); float_raise( float_flag_invalid );
@ -7027,7 +6990,7 @@ begin
z := ( aSig0 shl shiftCount ) or ( aSig1>>( ( - shiftCount ) and 63 ) ); z := ( aSig0 shl shiftCount ) or ( aSig1>>( ( - shiftCount ) and 63 ) );
if ( int64( aSig1 shl shiftCount )<>0 ) then if ( int64( aSig1 shl shiftCount )<>0 ) then
begin begin
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
end; end;
end end
else begin else begin
@ -7035,7 +6998,7 @@ begin
begin begin
if ( aExp or aSig0 or aSig1 )<>0 then if ( aExp or aSig0 or aSig1 )<>0 then
begin begin
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
end; end;
result := 0; result := 0;
exit; exit;
@ -7044,7 +7007,7 @@ begin
if ( (aSig1<>0) if ( (aSig1<>0)
or ( (shiftCount<>0) and (int64( aSig0 shl ( shiftCount and 63 ) )<>0) ) ) then or ( (shiftCount<>0) and (int64( aSig0 shl ( shiftCount and 63 ) )<>0) ) ) then
begin begin
float_exception_flags := float_exception_flags or float_flag_inexact; softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
end; end;
end; end;
if ( aSign<>0 ) then if ( aSign<>0 ) then
@ -7239,7 +7202,7 @@ begin
result := a; result := a;
exit; exit;
end; end;
float_exception_flags := float_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 float_rounding_mode of
float_round_nearest_even: float_round_nearest_even:
@ -7291,7 +7254,7 @@ begin
z.high &= ~ roundBitsMask; z.high &= ~ roundBitsMask;
end; end;
if ( ( z.low <> a.low ) or ( z.high <> a.high ) ) begin if ( ( z.low <> a.low ) or ( z.high <> a.high ) ) begin
float_exception_flags or= float_flag_inexact; softfloat_exception_flags or= float_flag_inexact;
end; end;
result := z; result := z;

23
rtl/powerpc/powerpc.inc
View File

@ -1237,14 +1237,19 @@ end;
{$IFDEF MORPHOS} {$IFDEF MORPHOS}
{ this is only required for MorphOS } { this is only required for MorphOS }
{$define FPC_SYSTEM_HAS_SYSRESETFPU} {$define FPC_SYSTEM_HAS_SYSRESETFPU}
procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} procedure SysResetFPU;$ifdef SYSTEMINLINE}inline;{$endif}
var tmp: array[0..1] of dword; var tmp: array[0..1] of dword;
asm begin
{ setting fpu to round to nearest mode } asm
li r3,0 { setting fpu to round to nearest mode }
stw r3,8(r1) li r3,0
stw r3,12(r1) stw r3,8(r1)
lfd f1,8(r1) stw r3,12(r1)
mtfsf 7,f1 lfd f1,8(r1)
mtfsf 7,f1
end;
{ powerpc might use softfloat code }
softfloat_exception_flags:=0;
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
end; end;
{$ENDIF} {$ENDIF}

3
rtl/win64/system.pp
View File

@ -16,6 +16,9 @@
unit System; unit System;
interface interface
{ $define SYSTEMEXCEPTIONDEBUG}
{$ifdef SYSTEMDEBUG} {$ifdef SYSTEMDEBUG}
{$define SYSTEMEXCEPTIONDEBUG} {$define SYSTEMEXCEPTIONDEBUG}
{$endif SYSTEMDEBUG} {$endif SYSTEMDEBUG}

1
rtl/x86_64/mathu.inc
View File

@ -94,6 +94,7 @@ begin
CtlWord:=Get8087CW; CtlWord:=Get8087CW;
Set8087CW((CtlWord and $FFC0) or Byte(Longint(Mask))); Set8087CW((CtlWord and $FFC0) or Byte(Longint(Mask)));
SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7)); SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));
softfloat_exception_mask:=dword(Mask);
Result:=GetExceptionMask; Result:=GetExceptionMask;
end; end;

31
rtl/x86_64/x86_64.inc
View File

@ -592,22 +592,27 @@ const
mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm; mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm;
{$define FPC_SYSTEM_HAS_SYSRESETFPU} {$define FPC_SYSTEM_HAS_SYSRESETFPU}
Procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} Procedure SysResetFPU;
asm begin
asm
{$ifndef WIN64} {$ifndef WIN64}
{ initialize fpu } { initialize fpu }
fninit fninit
fwait fwait
{$endif WIN64} {$endif WIN64}
{$ifdef FPC_PIC} {$ifdef FPC_PIC}
movq fpucw@GOTPCREL(%rip),%rax movq fpucw@GOTPCREL(%rip),%rax
fldcw (%rax) fldcw (%rax)
{ set sse exceptions } { set sse exceptions }
movq mxcsr@GOTPCREL(%rip),%rax movq mxcsr@GOTPCREL(%rip),%rax
ldmxcsr (%rax) ldmxcsr (%rax)
{$else FPC_PIC} {$else FPC_PIC}
fldcw fpucw fldcw fpucw
{ set sse exceptions } { set sse exceptions }
ldmxcsr mxcsr ldmxcsr mxcsr
{$endif FPC_PIC} {$endif FPC_PIC}
end ['RAX'];
{ x86-64 might use softfloat code }
softfloat_exception_flags:=0;
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
end; end;