mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 07:49:32 +01:00
* fixed TranslateMxcsr
+ correctly handle sse exceptions on i386, resolves #32671 + test git-svn-id: trunk@38268 -
This commit is contained in:
parent
5eb59196d5
commit
b421ed0db1
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
56
tests/webtbs/tw32671.pp
Normal 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.
|
||||
Loading…
Reference in New Issue
Block a user