浏览代码

+ handle also STATUS_FLOAT_MULTIPLE_FAULTS, resolves #32822

git-svn-id: trunk@38269 -
florian 7 年之前
父节点
当前提交
4d63945b8d
共有 3 个文件被更改,包括 66 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 1 0
      rtl/win32/system.pp
  3. 64 0
      tests/webtbs/tw32822.pp

+ 1 - 0
.gitattributes

@@ -15989,6 +15989,7 @@ tests/webtbs/tw3274.pp svneol=native#text/plain
 tests/webtbs/tw3280.pp svneol=native#text/plain
 tests/webtbs/tw3281.pp svneol=native#text/plain
 tests/webtbs/tw32821.pp svneol=native#text/pascal
+tests/webtbs/tw32822.pp svneol=native#text/pascal
 tests/webtbs/tw3286.pp svneol=native#text/plain
 tests/webtbs/tw3292.pp svneol=native#text/plain
 tests/webtbs/tw32938.pp svneol=native#text/pascal

+ 1 - 0
rtl/win32/system.pp

@@ -495,6 +495,7 @@ function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;s
             err := 218;
             must_reset_fpu := false;
           end;
+        STATUS_FLOAT_MULTIPLE_FAULTS,
         STATUS_FLOAT_MULTIPLE_TRAPS:
           begin
             { dumping ExtendedRegisters and comparing with the actually value of mxcsr revealed 24 }

+ 64 - 0
tests/webtbs/tw32822.pp

@@ -0,0 +1,64 @@
+{ %CPU=i386 }
+{$mode delphi}
+program controlc;
+
+{$ASMMODE intel}
+
+uses
+  Windows,
+  SysUtils, Math;
+
+type
+  TSSE=record
+    sse1,sse2,sse3,sse4:single;
+  end;
+
+  {.$codealign recordmin=16}
+  {.$align 16}{.$packrecords 16}
+  TSSE2=record
+    prefix:longint;
+    sse: TSSE;
+  end;
+
+  TTestProc = procedure; cdecl;
+
+
+var
+  a: TSSE2 = ( prefix: 0; sse: (sse1: 3.4E38; sse2: 3.4E38; sse3: 3.0; sse4: 4.0));
+  b: TSSE2 = (prefix: 0; sse: (sse1: 3.4E38; sse2: 3.4E38; sse3: 0.0; sse4: 0.0));
+  c: TSSE2 = (prefix: 0; sse: (sse1: 0.0; sse2: 0.0; sse3: 0.0; sse4: 0.0));
+
+procedure FailureCode; cdecl; assembler;
+asm
+  movups xmm0, A.sse
+  movups xmm1, B.sse
+// divps xmm0, xmm1
+  mulps xmm0, xmm1 // must be overflow but STATUS_FLOAT_MULTIPLE_FAULTS
+  movups c.sse, xmm0
+end;
+
+procedure TestSafe(AProc: TTestProc);
+begin
+  Writeln('-- begin safe ---');
+  try
+    AProc;
+  except
+    on E: EOverflow do
+    begin
+      WriteLn(E.ClassName + ': ' + E.Message);
+    end;
+    on E : Exception do
+      halt(1);
+  end;
+  Writeln('-- end safe ---');
+end;
+
+begin
+  Writeln('== Default masking ===');
+  TestSafe( FailureCode );
+
+  Writeln('== Unmasked ===');
+  SetExceptionMask( [] );
+  TestSafe( FailureCode );
+  writeln('ok');
+end.