|
@@ -13,8 +13,27 @@
|
|
**********************************************************************}
|
|
**********************************************************************}
|
|
|
|
|
|
{ exported by the system unit }
|
|
{ exported by the system unit }
|
|
-//!!!function get_fsr : dword;external name 'FPC_GETFSR';
|
|
|
|
-//!!!procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
|
|
|
|
|
|
+function get_fsr : dword;external name 'FPC_GETFSR';
|
|
|
|
+procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
|
|
|
|
+
|
|
|
|
+const
|
|
|
|
+ { FPU enable exception bits for FCSR register }
|
|
|
|
+ fpu_enable_inexact = $80;
|
|
|
|
+ fpu_enable_underflow = $100;
|
|
|
|
+ fpu_enable_overflow = $200;
|
|
|
|
+ fpu_enable_div_zero = $400;
|
|
|
|
+ fpu_enable_invalid = $800;
|
|
|
|
+ fpu_enable_mask = $F80;
|
|
|
|
+ default_fpu_enable = fpu_enable_div_zero or fpu_enable_invalid;
|
|
|
|
+
|
|
|
|
+ fpu_flags_mask = $7C;
|
|
|
|
+ { FPU rounding mask and values }
|
|
|
|
+ fpu_rounding_mask = $3;
|
|
|
|
+ fpu_rounding_nearest = 0;
|
|
|
|
+ fpu_rounding_towards_zero = 1;
|
|
|
|
+ fpu_rounding_plus_inf = 2;
|
|
|
|
+ fpu_rounding_minus_inf = 3;
|
|
|
|
+
|
|
|
|
|
|
function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
|
|
function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
|
|
begin
|
|
begin
|
|
@@ -35,22 +54,37 @@ end;
|
|
|
|
|
|
function GetRoundMode: TFPURoundingMode;
|
|
function GetRoundMode: TFPURoundingMode;
|
|
begin
|
|
begin
|
|
-//!!! result:=TFPURoundingMode(get_fsr shr 30);
|
|
|
|
|
|
+ result:=TFPURoundingMode(get_fsr and 3);
|
|
end;
|
|
end;
|
|
|
|
|
|
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
|
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
|
|
|
+ var
|
|
|
|
+ fpu_round : longint;
|
|
begin
|
|
begin
|
|
|
|
+
|
|
case (RoundMode) of
|
|
case (RoundMode) of
|
|
rmNearest :
|
|
rmNearest :
|
|
- softfloat_rounding_mode := float_round_nearest_even;
|
|
|
|
|
|
+ begin
|
|
|
|
+ softfloat_rounding_mode := float_round_nearest_even;
|
|
|
|
+ fpu_round:=fpu_rounding_mearest;
|
|
|
|
+ end;
|
|
rmTruncate :
|
|
rmTruncate :
|
|
- softfloat_rounding_mode := float_round_to_zero;
|
|
|
|
- rmUp :
|
|
|
|
- softfloat_rounding_mode := float_round_up;
|
|
|
|
- rmDown :
|
|
|
|
- softfloat_rounding_mode := float_round_down;
|
|
|
|
- end;
|
|
|
|
-//!!! set_fsr((get_fsr and $3fffffff) or (dword(RoundMode) shl 30));
|
|
|
|
|
|
+ begin
|
|
|
|
+ softfloat_rounding_mode := float_round_to_zero;
|
|
|
|
+ fpu_round:=fpu_rounding_towards_zero;
|
|
|
|
+ end;
|
|
|
|
+ rmUp :
|
|
|
|
+ begin
|
|
|
|
+ softfloat_rounding_mode := float_round_up;
|
|
|
|
+ fpu_round:=fpu_rounding_plus_inf;
|
|
|
|
+ end;
|
|
|
|
+ rmDown :
|
|
|
|
+ begin
|
|
|
|
+ softfloat_rounding_mode := float_round_down;
|
|
|
|
+ fpu_round:=fpu_rounding_minus_inf;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ set_fsr((get_fsr and not fpu_rounding_mask) or fpu_round);
|
|
//!!! result:=TFPURoundingMode(get_fsr shr 30);
|
|
//!!! result:=TFPURoundingMode(get_fsr shr 30);
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -71,26 +105,26 @@ function GetExceptionMask: TFPUExceptionMask;
|
|
var
|
|
var
|
|
fsr : dword;
|
|
fsr : dword;
|
|
begin
|
|
begin
|
|
-//!!! fsr:=get_fsr;
|
|
|
|
|
|
+ fsr:=get_fsr;
|
|
result:=[];
|
|
result:=[];
|
|
- { invalid operation: bit 27 }
|
|
|
|
- if (fsr and (1 shl 27))=0 then
|
|
|
|
|
|
+ { invalid operation }
|
|
|
|
+ if (fsr and fpu_enable_invalid)=0 then
|
|
include(result,exInvalidOp);
|
|
include(result,exInvalidOp);
|
|
|
|
|
|
- { zero divide: bit 24 }
|
|
|
|
- if (fsr and (1 shl 24))=0 then
|
|
|
|
- include(result,exInvalidOp);
|
|
|
|
|
|
+ { zero divide }
|
|
|
|
+ if (fsr and fpu_enable_div_zero)=0 then
|
|
|
|
+ include(result,exZeroDivide);
|
|
|
|
|
|
- { overflow: bit 26 }
|
|
|
|
- if (fsr and (1 shl 26))=0 then
|
|
|
|
- include(result,exInvalidOp);
|
|
|
|
|
|
+ { overflow }
|
|
|
|
+ if (fsr and fpu_enable_overflow)=0 then
|
|
|
|
+ include(result,exOverflow);
|
|
|
|
|
|
- { underflow: bit 25 }
|
|
|
|
- if (fsr and (1 shl 25))=0 then
|
|
|
|
|
|
+ { underflow: }
|
|
|
|
+ if (fsr and fpu_enable_underflow)=0 then
|
|
include(result,exUnderflow);
|
|
include(result,exUnderflow);
|
|
|
|
|
|
- { Precision (inexact result): bit 23 }
|
|
|
|
- if (fsr and (1 shl 23))=0 then
|
|
|
|
|
|
+ { Precision (inexact result) }
|
|
|
|
+ if (fsr and fpu_enable_inexact)=0 then
|
|
include(result,exPrecision);
|
|
include(result,exPrecision);
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -100,40 +134,40 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
|
var
|
|
var
|
|
fsr : dword;
|
|
fsr : dword;
|
|
begin
|
|
begin
|
|
-//!!! fsr:=get_fsr;
|
|
|
|
|
|
+ fsr:=get_fsr;
|
|
|
|
|
|
- { invalid operation: bit 27 }
|
|
|
|
|
|
+ { invalid operation }
|
|
if (exInvalidOp in mask) then
|
|
if (exInvalidOp in mask) then
|
|
- fsr:=fsr and not(1 shl 27)
|
|
|
|
|
|
+ fsr:=fsr and not(fpu_enable_invalid)
|
|
else
|
|
else
|
|
- fsr:=fsr or (1 shl 27);
|
|
|
|
|
|
+ fsr:=fsr or (fpu_enable_invalid);
|
|
|
|
|
|
- { zero divide: bit 24 }
|
|
|
|
|
|
+ { zero divide }
|
|
if (exZeroDivide in mask) then
|
|
if (exZeroDivide in mask) then
|
|
- fsr:=fsr and not(1 shl 24)
|
|
|
|
|
|
+ fsr:=fsr and not(fpu_enable_div_zero)
|
|
else
|
|
else
|
|
- fsr:=fsr or (1 shl 24);
|
|
|
|
|
|
+ fsr:=fsr or (fpu_enable_div_zero);
|
|
|
|
|
|
- { overflow: bit 26 }
|
|
|
|
|
|
+ { overflow }
|
|
if (exOverflow in mask) then
|
|
if (exOverflow in mask) then
|
|
- fsr:=fsr and not(1 shl 26)
|
|
|
|
|
|
+ fsr:=fsr and not(fpu_enable_overflow)
|
|
else
|
|
else
|
|
- fsr:=fsr or (1 shl 26);
|
|
|
|
|
|
+ fsr:=fsr or (fpu_enable_overflow);
|
|
|
|
|
|
- { underflow: bit 25 }
|
|
|
|
|
|
+ { underflow }
|
|
if (exUnderflow in mask) then
|
|
if (exUnderflow in mask) then
|
|
- fsr:=fsr and not(1 shl 25)
|
|
|
|
|
|
+ fsr:=fsr and not(fpu_enable_underflow)
|
|
else
|
|
else
|
|
- fsr:=fsr or (1 shl 25);
|
|
|
|
|
|
+ fsr:=fsr or (fpu_enable_underflow);
|
|
|
|
|
|
- { Precision (inexact result): bit 23 }
|
|
|
|
|
|
+ { Precision (inexact result) }
|
|
if (exPrecision in mask) then
|
|
if (exPrecision in mask) then
|
|
- fsr:=fsr and not(1 shl 23)
|
|
|
|
|
|
+ fsr:=fsr and not(fpu_enable_inexact)
|
|
else
|
|
else
|
|
- fsr:=fsr or (1 shl 23);
|
|
|
|
|
|
+ fsr:=fsr or (fpu_enable_inexact);
|
|
|
|
|
|
{ update control register contents }
|
|
{ update control register contents }
|
|
-//!!! set_fsr(fsr);
|
|
|
|
|
|
+ set_fsr(fsr);
|
|
|
|
|
|
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
|
|
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
|
|
end;
|
|
end;
|
|
@@ -141,6 +175,6 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
|
|
|
|
|
procedure ClearExceptions(RaisePending: Boolean =true);
|
|
procedure ClearExceptions(RaisePending: Boolean =true);
|
|
begin
|
|
begin
|
|
-//!!! set_fsr(get_fsr and $fffffc1f);
|
|
|
|
|
|
+ set_fsr(get_fsr and $fffffc1f);
|
|
end;
|
|
end;
|
|
|
|
|