* fixed TranslateMxcsr

+ correctly handle sse exceptions on i386, resolves #32671
+ test

git-svn-id: trunk@38268 -
This commit is contained in:
florian 2018-02-17 15:40:49 +00:00
parent 5eb59196d5
commit b421ed0db1
4 changed files with 89 additions and 7 deletions

1
.gitattributes vendored
View File

@ -15982,6 +15982,7 @@ tests/webtbs/tw3263.pp svneol=native#text/plain
tests/webtbs/tw32645.pp -text svneol=native#text/plain
tests/webtbs/tw32645a.pp -text svneol=native#text/plain
tests/webtbs/tw3265.pp svneol=native#text/plain
tests/webtbs/tw32671.pp svneol=native#text/pascal
tests/webtbs/tw3272.pp svneol=native#text/plain
tests/webtbs/tw3272b.pp svneol=native#text/pascal
tests/webtbs/tw3274.pp svneol=native#text/plain

View File

@ -166,12 +166,27 @@ end;
procedure TranslateMxcsr(mxcsr: longword; var code: longint);
begin
case (mxcsr and $3f) of
1,32: code:=-207; { InvalidOp, Precision }
2,16: code:=-206; { Denormal, Underflow }
4: code:=-208; { !!reZeroDivide }
8: code:=-205; { reOverflow }
end;
{ we can return only one value, further one's are lost }
{ InvalidOp }
if (mxcsr and 1)<>0 then
code:=-207
{ Denormal }
else if (mxcsr and 2)<>0 then
code:=-206
{ !!reZeroDivide }
else if (mxcsr and 4)<>0 then
code:=-208
{ reOverflow }
else if (mxcsr and 8)<>0 then
code:=-205
{ Underflow }
else if (mxcsr and 16)<>0 then
code:=-206
{ Precision }
else if (mxcsr and 32)<>0 then
code:=-207
else { this should not happen }
code:=-255
end;
function FilterException(var rec:TExceptionRecord; imagebase: PtrUInt; filterRva: DWord; errcode: Longint): Pointer;

View File

@ -424,7 +424,7 @@ procedure JumpToHandleErrorFrame;
function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
var
res: longint;
res,ssecode: longint;
err: byte;
must_reset_fpu: boolean;
begin
@ -495,6 +495,16 @@ function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;s
err := 218;
must_reset_fpu := false;
end;
STATUS_FLOAT_MULTIPLE_TRAPS:
begin
{ dumping ExtendedRegisters and comparing with the actually value of mxcsr revealed 24 }
TranslateMxcsr(excep^.ContextRecord^.ExtendedRegisters[24],ssecode);
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then
Writeln(stderr,'MXSR: ',hexstr(excep^.ContextRecord^.ExtendedRegisters[24], 2),' SSECODE: ',ssecode);
{$endif SYSTEMEXCEPTIONDEBUG}
err:=-ssecode;
end;
else
begin
if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then

56
tests/webtbs/tw32671.pp Normal file
View File

@ -0,0 +1,56 @@
{ %CPU=i386 }
{ %OPT=-Cfsse2 }
program test;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses math,sysutils;
var
e : exception;
procedure initLut();
const
width = 640;
height = 480;
var
Lut : array[0..width*height-1] of longword;
i,j : longint;
x,y,w,r,a,u,v,s : single;
iu,iv,iw : longint;
begin
for j:=height div 2 to height div 2+1 do
for i:=width div 2 to width div 2+1 do
begin
x := -1.0 + i*(2.0/width);
y := 1.0 - j*(2.0/height);
r := sqrt( x*x+y*y );
a := arctan2( y, x );
writeln(r);
u := 1.0/r;
v := a*(3.0/3.14159);
w := r*r;
if( w>1.0 ) then w := 1.0;
iu := round(u*255.0);
iv := round(v*255.0);
iw := round(w*255.0);
Lut[width*j+i] := ((iw and 255)<<16) or ((iv and 255)<<8) or (iu and 255);
end;
end;
begin
try
initLut();
except
on e : EZeroDivide do
begin
writeln('ok');
halt(0);
end;
end;
{ no exception is also ok, if the exception occurs, depends on rounding during expression evaluation }
writeln('ok');
end.