* fixed TranslateMxcsr

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

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@38268 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 88 insertions, 7 deletions

diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc
index c17160792b..10a56a87a8 100644
--- a/rtl/win/syswin.inc
+++ b/rtl/win/syswin.inc
@@ -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;
diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp
index f919619dd6..bb85f9b450 100644
--- a/rtl/win32/system.pp
+++ b/rtl/win32/system.pp
@@ -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
diff --git a/tests/webtbs/tw32671.pp b/tests/webtbs/tw32671.pp
new file mode 100644
index 0000000000..0db0e754de
--- /dev/null
+++ b/tests/webtbs/tw32671.pp
@@ -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.