* fixed ppc fpu exception mask stuff in math unit

+ added test for this functionality

git-svn-id: trunk@3136 -
This commit is contained in:
Jonas Maebe 2006-04-03 11:29:37 +00:00
parent 780089fb26
commit 0517ce08e2
3 changed files with 81 additions and 9 deletions

1
.gitattributes vendored
View File

@ -5771,6 +5771,7 @@ tests/test/units/dos/tidos.pp svneol=native#text/plain
tests/test/units/dos/tidos2.pp svneol=native#text/plain
tests/test/units/dos/tverify.pp svneol=native#text/plain
tests/test/units/dos/tversion.pp svneol=native#text/plain
tests/test/units/math/tmask.pp svneol=native#text/plain
tests/test/units/math/tnaninf.pp svneol=native#text/plain
tests/test/units/math/ttrig1.pp svneol=native#text/plain
tests/test/units/objects/testobj.pp svneol=native#text/plain

View File

@ -21,6 +21,7 @@ const
UnderflowMask = %00100000;
ZeroDivideMask = %00010000;
InexactMask = %00001000;
ExceptionsPendingMask = %11111111111111100000011100000000;
ExceptionMask = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
@ -29,14 +30,14 @@ const
function getFPSCR : DWord; assembler; nostackframe;
asm
mffs f0
stfd f0, -8(r1)
lwz r3, -12(r1)
stfd f0, -12(r1)
lwz r3, -8(r1)
end;
procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
asm
stw r3, -12(r1)
lfd f0, -8(r1)
stw r3, -8(r1)
lfd f0, -12(r1)
mtfsf 255, f0
end;
@ -82,13 +83,13 @@ begin
result := [];
if ((getFPSCR and InvalidOperationMask) <> 0) then
result := result + [exInvalidOp];
if ((getFPSCR and OverflowMask) <> 0) then
if ((getFPSCR and OverflowMask) = 0) then
result := result + [exOverflow];
if ((getFPSCR and UnderflowMask) <> 0) then
if ((getFPSCR and UnderflowMask) = 0) then
result := result + [exUnderflow];
if ((getFPSCR and ZeroDivideMask) <> 0) then
if ((getFPSCR and ZeroDivideMask) = 0) then
result := result + [exZeroDivide];
if ((getFPSCR and InexactMask) <> 0) then
if ((getFPSCR and InexactMask) = 0) then
result := result + [exPrecision];
end;
@ -108,7 +109,7 @@ begin
if (exPrecision in Mask) then
mode := mode or InexactMask;
setFPSCR((getFPSCR and (not ExceptionMask)) or mode);
setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
result := Mask - [exDenormalized];
end;

View File

@ -0,0 +1,70 @@
program fpu;
{$mode delphi}
uses SysUtils,Math;
var
f1,f2 : double;
caught: boolean;
begin
f1:=1.0;
f2:=0.0;
caught := false;
try
writeln('dividing by zero without having disabled FPU Exceptions...');
writeln(f1/f2);
writeln('no exception was raised');
except on E:Exception do
begin
writeln('Exception occured:',E.Message);
caught := true;
end;
end;
if not caught then
halt(1);
writeln('Masking exceptions');
writeln(integer(SetExceptionMask([exDenormalized,exInvalidOp,exOverflow,exPrecision,exUnderflow,exZeroDivide]))); //Returns 61, as expected
writeln(integer(GetExceptionMask)); //Returns 4 - unexpected???
writeln(integer([exZeroDivide])); //Returns 4
caught := false;
try
writeln('dividing by zero with FPU Exceptions disabled...');
writeln(f1/f2);
writeln('no exception was raised');
except on E:Exception do
begin
writeln('Exception occured:',E.Message);
caught := true;
end;
end;
if caught then
halt(2);
writeln(integer(SetExceptionMask([exDenormalized,exInvalidOp,exOverflow,exPrecision,exUnderflow]))); //Returns 61, as expected
writeln(integer(GetExceptionMask)); //Returns 4 - unexpected???
writeln(integer([exZeroDivide])); //Returns 4
caught := false;
try
writeln('dividing by zero without having disabled FPU Exceptions...');
writeln(f1/f2);
writeln('no exception was raised');
except on E:Exception do
begin
writeln('Exception occured:',E.Message);
caught := true;
end;
end;
if not caught then
halt(0);
end.