diff --git a/.gitattributes b/.gitattributes index 7e188395a3..c2909fcf57 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index bb85f9b450..f96c6bc2fa 100644 --- a/rtl/win32/system.pp +++ b/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 } diff --git a/tests/webtbs/tw32822.pp b/tests/webtbs/tw32822.pp new file mode 100644 index 0000000000..deacdacb70 --- /dev/null +++ b/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.