mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:39:40 +01:00 
			
		
		
		
	+ handle also STATUS_FLOAT_MULTIPLE_FAULTS, resolves #32822
git-svn-id: trunk@38269 -
This commit is contained in:
		
							parent
							
								
									b421ed0db1
								
							
						
					
					
						commit
						4d63945b8d
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -15989,6 +15989,7 @@ tests/webtbs/tw3274.pp svneol=native#text/plain
 | 
				
			|||||||
tests/webtbs/tw3280.pp svneol=native#text/plain
 | 
					tests/webtbs/tw3280.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw3281.pp svneol=native#text/plain
 | 
					tests/webtbs/tw3281.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw32821.pp svneol=native#text/pascal
 | 
					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/tw3286.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw3292.pp svneol=native#text/plain
 | 
					tests/webtbs/tw3292.pp svneol=native#text/plain
 | 
				
			||||||
tests/webtbs/tw32938.pp svneol=native#text/pascal
 | 
					tests/webtbs/tw32938.pp svneol=native#text/pascal
 | 
				
			||||||
 | 
				
			|||||||
@ -495,6 +495,7 @@ function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;s
 | 
				
			|||||||
            err := 218;
 | 
					            err := 218;
 | 
				
			||||||
            must_reset_fpu := false;
 | 
					            must_reset_fpu := false;
 | 
				
			||||||
          end;
 | 
					          end;
 | 
				
			||||||
 | 
					        STATUS_FLOAT_MULTIPLE_FAULTS,
 | 
				
			||||||
        STATUS_FLOAT_MULTIPLE_TRAPS:
 | 
					        STATUS_FLOAT_MULTIPLE_TRAPS:
 | 
				
			||||||
          begin
 | 
					          begin
 | 
				
			||||||
            { dumping ExtendedRegisters and comparing with the actually value of mxcsr revealed 24 }
 | 
					            { dumping ExtendedRegisters and comparing with the actually value of mxcsr revealed 24 }
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										64
									
								
								tests/webtbs/tw32822.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										64
									
								
								tests/webtbs/tw32822.pp
									
									
									
									
									
										Normal file
									
								
							@ -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.
 | 
				
			||||||
		Loading…
	
		Reference in New Issue
	
	Block a user