mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 12:10:26 +02:00
* Moved declarations of TFPURoundingMode,TFPUExceptionMask and TFPUPrecisionMode to System unit. Declarations in Math unit changed to aliases.
* Changed type of softfloat_exception_mask and softfloat_exception_flags to TFPUExceptionMask, softfloat_rounding_mode to TFPURoundingMode. - Cleaned out numerous conversions happening when getting/setting exception mask and rounding mode. git-svn-id: trunk@27215 -
This commit is contained in:
sergei
parent
842e027a9f
commit
94a045aa3d
@ -12,40 +12,6 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
|
||||
begin
|
||||
result:=0;
|
||||
if exInvalidOp in Mask then
|
||||
result:=result or (1 shl ord(exInvalidOp));
|
||||
if exDenormalized in Mask then
|
||||
result:=result or (1 shl ord(exDenormalized));
|
||||
if exZeroDivide in Mask then
|
||||
result:=result or (1 shl ord(exZeroDivide));
|
||||
if exOverflow in Mask then
|
||||
result:=result or (1 shl ord(exOverflow));
|
||||
if exUnderflow in Mask then
|
||||
result:=result or (1 shl ord(exUnderflow));
|
||||
if exPrecision in Mask then
|
||||
result:=result or (1 shl ord(exPrecision));
|
||||
end;
|
||||
|
||||
function SoftFloatMaskToFPUExceptionMask(const Mask: byte): TFPUExceptionMask;
|
||||
begin
|
||||
result:=[];
|
||||
if (mask and (1 shl ord(exInvalidOp)) <> 0) then
|
||||
include(result,exInvalidOp);
|
||||
if (mask and (1 shl ord(exDenormalized)) <> 0) then
|
||||
include(result,exDenormalized);
|
||||
if (mask and (1 shl ord(exZeroDivide)) <> 0) then
|
||||
include(result,exZeroDivide);
|
||||
if (mask and (1 shl ord(exOverflow)) <> 0) then
|
||||
include(result,exOverflow);
|
||||
if (mask and (1 shl ord(exUnderflow)) <> 0) then
|
||||
include(result,exUnderflow);
|
||||
if (mask and (1 shl ord(exPrecision)) <> 0) then
|
||||
include(result,exPrecision);
|
||||
end;
|
||||
|
||||
{$if defined(wince)}
|
||||
|
||||
const
|
||||
@ -222,26 +188,23 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||
var
|
||||
mode: dword;
|
||||
begin
|
||||
softfloat_rounding_mode:=RoundMode;
|
||||
case (RoundMode) of
|
||||
rmNearest :
|
||||
begin
|
||||
mode := 0;
|
||||
softfloat_rounding_mode := float_round_nearest_even;
|
||||
end;
|
||||
rmUp :
|
||||
begin
|
||||
mode := 1;
|
||||
softfloat_rounding_mode := float_round_up;
|
||||
end;
|
||||
rmDown :
|
||||
begin
|
||||
mode := 2;
|
||||
softfloat_rounding_mode := float_round_down;
|
||||
end;
|
||||
rmTruncate :
|
||||
begin
|
||||
mode := 3;
|
||||
softfloat_rounding_mode := float_round_to_zero;
|
||||
end;
|
||||
end;
|
||||
mode:=mode shl _VFP_ROUNDINGMODE_MASK_SHIFT;
|
||||
@ -318,7 +281,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
||||
VFP_SetCW(cw);
|
||||
result:=Mask;
|
||||
|
||||
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(Mask);
|
||||
softfloat_exception_mask:=Mask;
|
||||
end;
|
||||
|
||||
|
||||
@ -432,39 +395,13 @@ procedure FPU_SetCW(cw : dword); nostackframe; assembler;
|
||||
|
||||
function GetRoundMode: TFPURoundingMode;
|
||||
begin
|
||||
case softfloat_rounding_mode of
|
||||
float_round_nearest_even:
|
||||
GetRoundMode:=rmNearest;
|
||||
float_round_up:
|
||||
GetRoundMode:=rmUp;
|
||||
float_round_down:
|
||||
GetRoundMode:=rmDown;
|
||||
float_round_to_zero:
|
||||
GetRoundMode:=rmTruncate;
|
||||
end;
|
||||
GetRoundMode:=softfloat_rounding_mode;
|
||||
end;
|
||||
|
||||
|
||||
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||
begin
|
||||
case (RoundMode) of
|
||||
rmNearest :
|
||||
begin
|
||||
softfloat_rounding_mode := float_round_nearest_even;
|
||||
end;
|
||||
rmUp :
|
||||
begin
|
||||
softfloat_rounding_mode := float_round_up;
|
||||
end;
|
||||
rmDown :
|
||||
begin
|
||||
softfloat_rounding_mode := float_round_down;
|
||||
end;
|
||||
rmTruncate :
|
||||
begin
|
||||
softfloat_rounding_mode := float_round_to_zero;
|
||||
end;
|
||||
end;
|
||||
softfloat_rounding_mode:=RoundMode;
|
||||
SetRoundMode:=RoundMode;
|
||||
end;
|
||||
|
||||
@ -508,7 +445,7 @@ function GetExceptionMask: TFPUExceptionMask;
|
||||
if (cw and _FPU_MASK_PM)=0 then
|
||||
include(Result,exPrecision);
|
||||
{$else}
|
||||
Result:=SoftFloatMaskToFPUExceptionMask(softfloat_exception_mask);
|
||||
Result:=softfloat_exception_mask;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
@ -540,7 +477,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
||||
|
||||
FPU_SetCW(cw);
|
||||
{$endif}
|
||||
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(Mask);
|
||||
softfloat_exception_mask:=Mask;
|
||||
Result:=Mask;
|
||||
end;
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
||||
Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
|
||||
softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
|
||||
end;
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ end;
|
||||
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
|
||||
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_flags:=0;
|
||||
softfloat_exception_flags:=[];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -61,13 +61,13 @@ function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
|
||||
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
|
||||
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_flags:=0;
|
||||
softfloat_exception_flags:=[];
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
||||
Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
|
||||
softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
|
||||
{ Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
|
||||
{ FPU precision 64 bit, rounding to nearest, affine infinity }
|
||||
_controlfp($000C0003, $030F031F);
|
||||
|
||||
@ -41,27 +41,27 @@
|
||||
procedure checkexcepts;
|
||||
var
|
||||
feres: longint;
|
||||
sfexcepts: shortint;
|
||||
sfexcepts: TFPUExceptionMask;
|
||||
begin
|
||||
feres:=fetestexcept(FE_ALL_EXCEPT);
|
||||
sfexcepts:=0;
|
||||
sfexcepts:=[];
|
||||
if feres<>0 then
|
||||
begin
|
||||
if (feres and FE_DIVBYZERO) <> 0 then
|
||||
sfexcepts:=sfexcepts or float_flag_divbyzero;
|
||||
include(sfexcepts,float_flag_divbyzero);
|
||||
if (feres and FE_INEXACT) <> 0 then
|
||||
sfexcepts:=sfexcepts or float_flag_inexact;
|
||||
include(sfexcepts,float_flag_inexact);
|
||||
if (feres and FE_INVALID) <> 0 then
|
||||
sfexcepts:=sfexcepts or float_flag_invalid;
|
||||
include(sfexcepts,float_flag_invalid);
|
||||
if (feres and FE_OVERFLOW) <> 0 then
|
||||
sfexcepts:=sfexcepts or float_flag_overflow;
|
||||
include(sfexcepts,float_flag_overflow);
|
||||
if (feres and FE_UNDERFLOW) <> 0 then
|
||||
sfexcepts:=sfexcepts or float_flag_underflow;
|
||||
include(sfexcepts,float_flag_underflow);
|
||||
end
|
||||
{ unknown error }
|
||||
else if (geterrno<>0) then
|
||||
sfexcepts:=sfexcepts or float_flag_invalid;
|
||||
if sfexcepts<>0 then
|
||||
include(sfexcepts,float_flag_invalid);
|
||||
if sfexcepts<>[] then
|
||||
float_raise(sfexcepts);
|
||||
end;
|
||||
|
||||
|
||||
@ -1818,7 +1818,7 @@ end;
|
||||
|
||||
procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_flags:=0;
|
||||
softfloat_exception_flags:=[];
|
||||
end;
|
||||
|
||||
{$endif FPC_SYSTEM_HAS_SYSRESETFPU}
|
||||
@ -1827,7 +1827,7 @@ end;
|
||||
|
||||
procedure SysInitFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
|
||||
softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
|
||||
end;
|
||||
|
||||
{$endif FPC_SYSTEM_HAS_SYSINITFPU}
|
||||
|
||||
@ -97,28 +97,33 @@ to substitute a result value. If traps are not implemented, this routine
|
||||
should be simply `softfloat_exception_flags |= flags;'.
|
||||
-------------------------------------------------------------------------------
|
||||
*}
|
||||
procedure float_raise(i: shortint);
|
||||
procedure float_raise(i: TFPUException);
|
||||
begin
|
||||
float_raise([i]);
|
||||
end;
|
||||
|
||||
procedure float_raise(i: TFPUExceptionMask);
|
||||
var
|
||||
pflags: pbyte;
|
||||
unmasked_flags: byte;
|
||||
pflags: ^TFPUExceptionMask;
|
||||
unmasked_flags: TFPUExceptionMask;
|
||||
Begin
|
||||
{ taking address of threadvar produces somewhat more compact code }
|
||||
pflags := @softfloat_exception_flags;
|
||||
pflags^ := pflags^ or i;
|
||||
unmasked_flags := pflags^ and (not softfloat_exception_mask);
|
||||
if (unmasked_flags and float_flag_invalid) <> 0 then
|
||||
pflags^:=pflags^ + i;
|
||||
unmasked_flags := pflags^ - softfloat_exception_mask;
|
||||
if (float_flag_invalid in unmasked_flags) then
|
||||
HandleError(207)
|
||||
else
|
||||
if (unmasked_flags and float_flag_divbyzero) <> 0 then
|
||||
if (float_flag_divbyzero in unmasked_flags) then
|
||||
HandleError(200)
|
||||
else
|
||||
if (unmasked_flags and float_flag_overflow) <> 0 then
|
||||
if (float_flag_overflow in unmasked_flags) then
|
||||
HandleError(205)
|
||||
else
|
||||
if (unmasked_flags and float_flag_underflow) <> 0 then
|
||||
if (float_flag_underflow in unmasked_flags) then
|
||||
HandleError(206)
|
||||
else
|
||||
if (unmasked_flags and float_flag_inexact) <> 0 then
|
||||
if (float_flag_inexact in unmasked_flags) then
|
||||
HandleError(207);
|
||||
end;
|
||||
|
||||
|
||||
@ -26,39 +26,47 @@
|
||||
{$endif not cpui8086}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
|
||||
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
|
||||
TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
|
||||
exOverflow, exUnderflow, exPrecision);
|
||||
TFPUExceptionMask = set of TFPUException;
|
||||
|
||||
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;
|
||||
float_flag_invalid = exInvalidOp;
|
||||
float_flag_denormal = exDenormalized;
|
||||
float_flag_divbyzero = exZeroDivide;
|
||||
float_flag_overflow = exOverflow;
|
||||
float_flag_underflow = exUnderflow;
|
||||
float_flag_inexact = exPrecision;
|
||||
|
||||
{*
|
||||
-------------------------------------------------------------------------------
|
||||
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;
|
||||
float_round_nearest_even = rmNearest;
|
||||
float_round_down = rmDown;
|
||||
float_round_up = rmUp;
|
||||
float_round_to_zero = rmTruncate;
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||
ThreadVar
|
||||
{$else FPC_HAS_FEATURE_THREADING}
|
||||
Var
|
||||
{$endif FPC_HAS_FEATURE_THREADING}
|
||||
softfloat_exception_mask : Byte;
|
||||
softfloat_exception_flags : Byte;
|
||||
softfloat_rounding_mode : Byte;
|
||||
softfloat_exception_mask : TFPUExceptionMask;
|
||||
softfloat_exception_flags : TFPUExceptionMask;
|
||||
softfloat_rounding_mode : TFPURoundingMode;
|
||||
|
||||
procedure float_raise(i: shortint);
|
||||
procedure float_raise(i: TFPUException);
|
||||
procedure float_raise(i: TFPUExceptionMask);
|
||||
|
||||
{$ifdef cpui386}
|
||||
{$define INTERNMATH}
|
||||
|
||||
@ -587,7 +587,7 @@ implementation
|
||||
a threadvar. }
|
||||
procedure set_inexact_flag;
|
||||
begin
|
||||
softfloat_exception_flags := softfloat_exception_flags or float_flag_inexact;
|
||||
include(softfloat_exception_flags,float_flag_inexact);
|
||||
end;
|
||||
|
||||
{*----------------------------------------------------------------------------
|
||||
@ -603,7 +603,7 @@ end;
|
||||
|
||||
function roundAndPackInt32( zSign: flag; absZ : bits64): int32;
|
||||
var
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
roundNearestEven: flag;
|
||||
roundIncrement, roundBits: int8;
|
||||
z: int32;
|
||||
@ -664,7 +664,7 @@ end;
|
||||
|
||||
function roundAndPackInt64( zSign: flag; absZ0: bits64; absZ1 : bits64): int64;
|
||||
var
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
roundNearestEven, increment: flag;
|
||||
z: int64;
|
||||
label
|
||||
@ -2446,7 +2446,7 @@ Binary Floating-Point Arithmetic.
|
||||
*}
|
||||
Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : float32;
|
||||
Var
|
||||
roundingMode : BYTE;
|
||||
roundingMode : TFPURoundingMode;
|
||||
roundNearestEven : Flag;
|
||||
roundIncrement, roundBits : BYTE;
|
||||
IsTiny : Flag;
|
||||
@ -2483,7 +2483,7 @@ Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : floa
|
||||
Begin
|
||||
if (( $FD < zExp ) OR ( zExp = $FD ) AND ( sbits32 ( zSig + roundIncrement ) < 0 ) ) then
|
||||
Begin
|
||||
float_raise( float_flag_overflow OR float_flag_inexact );
|
||||
float_raise( [float_flag_overflow,float_flag_inexact] );
|
||||
roundAndPackFloat32:=packFloat32( zSign, $FF, 0 ) - Flag( roundIncrement = 0 );
|
||||
exit;
|
||||
End;
|
||||
@ -2697,7 +2697,7 @@ Procedure
|
||||
roundAndPackFloat64(
|
||||
zSign: Flag; zExp: Int16; zSig0: Bits32; zSig1: Bits32; zSig2: Bits32; Var c: Float64 );
|
||||
Var
|
||||
roundingMode : Int8;
|
||||
roundingMode : TFPURoundingMode;
|
||||
roundNearestEven, increment, isTiny : Flag;
|
||||
Begin
|
||||
|
||||
@ -2729,7 +2729,7 @@ Procedure
|
||||
)
|
||||
) then
|
||||
Begin
|
||||
float_raise( float_flag_overflow OR float_flag_inexact );
|
||||
float_raise( [float_flag_overflow,float_flag_inexact] );
|
||||
if (( roundingMode = float_round_to_zero )
|
||||
or ( (zSign<>0) and ( roundingMode = float_round_up ) )
|
||||
or ( (zSign = 0) and ( roundingMode = float_round_down ) )
|
||||
@ -2807,7 +2807,7 @@ Procedure
|
||||
|
||||
function roundAndPackFloat64( zSign: flag; zExp: int16; zSig : bits64): float64;
|
||||
var
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
roundNearestEven: flag;
|
||||
roundIncrement, roundBits: int16;
|
||||
isTiny: flag;
|
||||
@ -2842,7 +2842,7 @@ begin
|
||||
and ( sbits64( zSig + roundIncrement ) < 0 ) )
|
||||
) then
|
||||
begin
|
||||
float_raise( float_flag_overflow or float_flag_inexact );
|
||||
float_raise( [float_flag_overflow,float_flag_inexact] );
|
||||
result := float64(qword(packFloat64( zSign, $7FF, 0 )) - ord( roundIncrement = 0 ));
|
||||
exit;
|
||||
end;
|
||||
@ -3060,7 +3060,7 @@ Function float32_to_int32( a : float32rec) : int32;compilerproc;
|
||||
aExp, shiftCount: int16;
|
||||
aSig, aSigExtra: bits32;
|
||||
z: int32;
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
Begin
|
||||
|
||||
aSig := extractFloat32Frac( a.float32 );
|
||||
@ -3420,7 +3420,7 @@ Function float32_round_to_int( a: float32rec): float32rec;compilerproc;
|
||||
aSign: flag;
|
||||
aExp: int16;
|
||||
lastBitMask, roundBitsMask: bits32;
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
z: float32;
|
||||
Begin
|
||||
aExp := extractFloat32Exp( a.float32 );
|
||||
@ -4328,7 +4328,7 @@ var
|
||||
aExp, shiftCount: int16;
|
||||
aSig0, aSig1, absZ, aSigExtra: bits32;
|
||||
z: int32;
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
label invalid;
|
||||
Begin
|
||||
aSig1 := extractFloat64Frac1( a );
|
||||
@ -4664,7 +4664,7 @@ Var
|
||||
aSign: flag;
|
||||
aExp: int16;
|
||||
lastBitMask, roundBitsMask: bits32;
|
||||
roundingMode: int8;
|
||||
roundingMode: TFPURoundingMode;
|
||||
z: float64;
|
||||
Begin
|
||||
aExp := extractFloat64Exp( a );
|
||||
@ -6415,7 +6415,7 @@ begin
|
||||
) then begin
|
||||
roundMask := 0;
|
||||
overflow:
|
||||
float_raise( float_flag_overflow or float_flag_inexact );
|
||||
float_raise( [float_flag_overflow,float_flag_inexact] );
|
||||
if ( ( roundingMode = float_round_to_zero )
|
||||
or ( ( zSign <> 0) and ( roundingMode = float_round_up ) )
|
||||
or ( ( zSign = 0) and ( roundingMode = float_round_down ) )
|
||||
@ -7866,7 +7866,7 @@ begin
|
||||
)
|
||||
)<>0 then
|
||||
begin
|
||||
float_raise( float_flag_overflow or float_flag_inexact );
|
||||
float_raise( [float_flag_overflow,float_flag_inexact] );
|
||||
if ( ord( roundingMode = float_round_to_zero )
|
||||
or ( zSign and ord( roundingMode = float_round_up ) )
|
||||
or ( ord( zSign = 0) and ord( roundingMode = float_round_down ) )
|
||||
|
||||
@ -23,13 +23,13 @@
|
||||
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
||||
Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
|
||||
softfloat_exception_mask:=[float_flag_underflow, float_flag_inexact, float_flag_denormal];
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
|
||||
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_flags:=0;
|
||||
softfloat_exception_flags:=[];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -534,11 +534,10 @@ function RandomFrom(const AValues: array of Int64): Int64; overload;
|
||||
|
||||
{ cpu specific stuff }
|
||||
type
|
||||
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
|
||||
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
|
||||
TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
|
||||
exOverflow, exUnderflow, exPrecision);
|
||||
TFPUExceptionMask = set of TFPUException;
|
||||
TFPURoundingMode = system.TFPURoundingMode;
|
||||
TFPUPrecisionMode = system.TFPUPrecisionMode;
|
||||
TFPUException = system.TFPUException;
|
||||
TFPUExceptionMask = system.TFPUExceptionMask;
|
||||
|
||||
function GetRoundMode: TFPURoundingMode;
|
||||
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||
|
||||
@ -82,26 +82,23 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||
var
|
||||
mode : DWord;
|
||||
begin
|
||||
software_rounding_mode:=RoundMode;
|
||||
case (RoundMode) of
|
||||
rmNearest :
|
||||
begin
|
||||
mode := FP_RND_RN;
|
||||
softfloat_rounding_mode := float_round_nearest_even;
|
||||
end;
|
||||
rmTruncate :
|
||||
begin
|
||||
mode := FP_RND_RZ;
|
||||
softfloat_rounding_mode := float_round_to_zero;
|
||||
end;
|
||||
rmUp :
|
||||
begin
|
||||
mode := FP_RND_RP;
|
||||
softfloat_rounding_mode := float_round_up;
|
||||
end;
|
||||
rmDown :
|
||||
begin
|
||||
mode := FP_RND_RM;
|
||||
softfloat_rounding_mode := float_round_down;
|
||||
end;
|
||||
end;
|
||||
{$ifndef aix}
|
||||
@ -158,35 +155,30 @@ var
|
||||
mode : DWord;
|
||||
begin
|
||||
mode := 0;
|
||||
softfloat_exception_mask := 0;
|
||||
softfloat_exception_mask := mask;
|
||||
if (exInvalidOp in Mask) then
|
||||
begin
|
||||
mode := mode or InvalidOperationMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_invalid;
|
||||
end;
|
||||
if (exOverflow in Mask) then
|
||||
begin
|
||||
mode := mode or OverflowMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_overflow;
|
||||
end;
|
||||
if (exUnderflow in Mask) then
|
||||
begin
|
||||
mode := mode or UnderflowMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_underflow;
|
||||
end;
|
||||
if (exZeroDivide in Mask) then
|
||||
begin
|
||||
mode := mode or ZeroDivideMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_divbyzero;
|
||||
end;
|
||||
if (exPrecision in Mask) then
|
||||
begin
|
||||
mode := mode or InexactMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_inexact;
|
||||
end;
|
||||
|
||||
setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
|
||||
softfloat_exception_flags := 0;;
|
||||
softfloat_exception_flags := [];
|
||||
{ also clear out pending exceptions on AIX }
|
||||
{$ifdef aix}
|
||||
{ clear pending exceptions }
|
||||
@ -206,7 +198,7 @@ begin
|
||||
{ clear pending exceptions }
|
||||
feclearexcept(AllExceptionsMask);
|
||||
{$endif}
|
||||
softfloat_exception_flags := 0;
|
||||
softfloat_exception_flags := [];
|
||||
{ RaisePending has no effect on PPC, always raises them at the correct location }
|
||||
setFPSCR(getFPSCR and (not ExceptionsPendingMask));
|
||||
end;
|
||||
|
||||
@ -1194,14 +1194,14 @@ begin
|
||||
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;
|
||||
softfloat_exception_flags:=[];
|
||||
softfloat_exception_mask:=[float_flag_underflow, float_flag_inexact, float_flag_denormal];
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
|
||||
procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
softfloat_exception_flags:=0;
|
||||
softfloat_exception_flags:=[];
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
@ -82,26 +82,23 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||
var
|
||||
mode : DWord;
|
||||
begin
|
||||
software_rounding_mode:=RoundMode;
|
||||
case (RoundMode) of
|
||||
rmNearest :
|
||||
begin
|
||||
mode := FP_RND_RN;
|
||||
softfloat_rounding_mode := float_round_nearest_even;
|
||||
end;
|
||||
rmTruncate :
|
||||
begin
|
||||
mode := FP_RND_RZ;
|
||||
softfloat_rounding_mode := float_round_to_zero;
|
||||
end;
|
||||
rmUp :
|
||||
begin
|
||||
mode := FP_RND_RP;
|
||||
softfloat_rounding_mode := float_round_up;
|
||||
end;
|
||||
rmDown :
|
||||
begin
|
||||
mode := FP_RND_RM;
|
||||
softfloat_rounding_mode := float_round_down;
|
||||
end;
|
||||
end;
|
||||
{$ifndef aix}
|
||||
@ -158,35 +155,30 @@ var
|
||||
mode : DWord;
|
||||
begin
|
||||
mode := 0;
|
||||
softfloat_exception_mask := 0;
|
||||
softfloat_exception_mask := mask;
|
||||
if (exInvalidOp in Mask) then
|
||||
begin
|
||||
mode := mode or InvalidOperationMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_invalid;
|
||||
end;
|
||||
if (exOverflow in Mask) then
|
||||
begin
|
||||
mode := mode or OverflowMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_overflow;
|
||||
end;
|
||||
if (exUnderflow in Mask) then
|
||||
begin
|
||||
mode := mode or UnderflowMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_underflow;
|
||||
end;
|
||||
if (exZeroDivide in Mask) then
|
||||
begin
|
||||
mode := mode or ZeroDivideMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_divbyzero;
|
||||
end;
|
||||
if (exPrecision in Mask) then
|
||||
begin
|
||||
mode := mode or InexactMask;
|
||||
softfloat_exception_mask := softfloat_exception_mask or float_flag_inexact;
|
||||
end;
|
||||
|
||||
setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
|
||||
softfloat_exception_flags := 0;;
|
||||
softfloat_exception_flags := [];;
|
||||
{ also clear out pending exceptions on AIX }
|
||||
{$ifdef aix}
|
||||
{ clear pending exceptions }
|
||||
@ -206,7 +198,7 @@ begin
|
||||
{ clear pending exceptions }
|
||||
feclearexcept(AllExceptionsMask);
|
||||
{$endif}
|
||||
softfloat_exception_flags := 0;
|
||||
softfloat_exception_flags := [];
|
||||
{ RaisePending has no effect on PPC, always raises them at the correct location }
|
||||
setFPSCR(getFPSCR and (not ExceptionsPendingMask));
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user