paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 09:07:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed unportable soft float mask handling which broke on big endian

Browse Source 
systems after yesterday's set changes

git-svn-id: trunk@7402 -
This commit is contained in:
Jonas Maebe 2007-05-20 10:25:48 +00:00
parent d375ae6f7f
commit 7d44ca0113
2 changed files with 55 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
rtl/arm/mathu.inc
View File

@ -12,6 +12,40 @@
**********************************************************************}
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;
{$ifdef wince}
const
@ -126,7 +160,7 @@ begin
c:=c or _EM_INEXACT;
c:=_controlfp(c, _MCW_EM);
Result:=ConvertExceptionMask(c);
softfloat_exception_mask:=dword(Mask);
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
end;
procedure ClearExceptions(RaisePending: Boolean =true);
@ -285,7 +319,7 @@ function GetExceptionMask: TFPUExceptionMask;
if (cw and _FPU_MASK_PM)=0 then
include(Result,exPrecision);
{$else}
dword(Result):=softfloat_exception_mask;
Result:=SoftFloatMaskToFPUExceptionMask(softfloat_exception_mask);
{$endif}
end;
@ -317,7 +351,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
FPU_SetCW(cw);
{$endif}
softfloat_exception_mask:=dword(Mask);
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(Mask);
end;

19
rtl/sparc/mathu.inc
View File

@ -16,6 +16,23 @@
function get_fsr : dword;external name 'FPC_GETFSR';
procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
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 GetRoundMode: TFPURoundingMode;
begin
result:=TFPURoundingMode(get_fsr shr 30);
@ -108,7 +125,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
{ update control register contents }
set_fsr(fsr);
softfloat_exception_mask:=dword(Mask);
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
end;