Merged revisions 11820-11821 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r11820 | florian | 2008-09-25 21:15:54 +0200 (Do, 25 Sep 2008) | 1 line
  
  * reset FPU properly after an exception, resolves #12214
........
  r11821 | florian | 2008-09-25 21:31:16 +0200 (Do, 25 Sep 2008) | 1 line
  
  + applied a fix similar to 11820 to x86-64
........

git-svn-id: branches/fixes_2_2@11822 -

.gitattributes

@@ -8056,6 +8056,7 @@ tests/webtbs/tw1204.pp svneol=native#text/plain
 tests/webtbs/tw12051.pp svneol=native#text/plain
 tests/webtbs/tw1207.pp svneol=native#text/plain
 tests/webtbs/tw12186.pp svneol=native#text/plain
+tests/webtbs/tw12214.pp svneol=native#text/plain
 tests/webtbs/tw1222.pp svneol=native#text/plain
 tests/webtbs/tw1223.pp svneol=native#text/plain
 tests/webtbs/tw1228.pp svneol=native#text/plain

rtl/i386/i386.inc

@@ -1261,6 +1261,7 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
     localfpucw:=Default8087CW;
     asm
+      fninit
       fldcw   localfpucw
       fwait
     end;
@@ -1278,11 +1279,25 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+  var
+    { these locals are so we don't have to hack pic code in the assembler }
+    localmxcsr: dword;
+    localfpucw: word;
   begin
+    localfpucw:=Default8087CW;
     asm
-      fnclex
+      fninit
       fwait
+      fldcw   localfpucw
     end;
+    if has_sse_support then
+      begin
+        localmxcsr:=mxcsr;
+        asm
+          { setup sse exceptions }
+          ldmxcsr localmxcsr
+        end;
+      end;
     softfloat_exception_flags:=0;
   end;
 

rtl/i386/math.inc

@@ -38,12 +38,10 @@
       
 
     procedure SetSSECSR(w : dword);
-      var
-        _w : dword;
       begin
-        _w:=w;
+        mxcsr:=w;
         asm
-          ldmxcsr _w
+          ldmxcsr w
         end;
       end;
     

rtl/x86_64/math.inc

@@ -61,12 +61,10 @@ FPC_ABSMASK_DOUBLE:
     
     
     procedure SetSSECSR(w : dword);
-      var
-        _w : dword;
       begin
-        _w:=w;
+        mxcsr:=w;
         asm
-          ldmxcsr _w
+          ldmxcsr w
         end;
       end;
     

rtl/x86_64/x86_64.inc

@@ -616,15 +616,23 @@ end;
 
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;
-begin
-  asm
-    { initialize fpu }
-    fnclex
-    fwait
+  var
+    { these locals are so we don't have to hack pic code in the assembler }
+    localmxcsr: dword;
+    localfpucw: word;
+  begin
+    localfpucw:=Default8087CW;
+    localmxcsr:=mxcsr;
+    asm
+      fninit
+      fwait
+      fldcw   localfpucw
+      ldmxcsr localmxcsr
+    end;
+    { x86-64 might use softfloat code }
+    softfloat_exception_flags:=0;
   end;
-  { x86-64 might use softfloat code }
-  softfloat_exception_flags:=0;
-end;
+
 
 {$ifndef FPC_SYSTEM_HAS_MEM_BARRIER}
 {$define FPC_SYSTEM_HAS_MEM_BARRIER}

tests/webtbs/tw12214.pp

@@ -0,0 +1,38 @@
+{$mode objfpc}
+program test_raise;
+
+uses Math;
+
+var
+  X, Y: double;
+  I: Integer;
+  SomeFloat, SomeOtherFloat: Double;
+begin
+  X := -10.0;
+
+  SomeFloat := 1.0; { any value }
+  SomeOtherFloat := 1.0; { any value }
+
+  for I := 0 to 20 do
+  begin
+    { This line does *any* valid float operation, just to show that
+      floating-point exception (that should be raised, catched and silenced
+      by try..except below) somehow arrived here. }
+    SomeFloat := I * SomeOtherFloat;
+
+    try
+      { Any invalid fp operation. Tested on Sqrt(-10.0), Ln(-10.0).
+        I use variable X to trick FPC into calculating this at run-time,
+        otherwise "Error: Illegal constant passed to internal math function". }
+      Y := Sqrt(X);      
+      ClearExceptions(false);
+    except
+      Writeln('silenced exception');
+      { Here I silence eventual exception raised by ClearExceptions.
+        (Yes, I could just do ClearExceptions(false) do achieve the same,
+        but imagine that this is embedded in some complicated code
+        where I really want to raise exception to jump outside
+        in case of problems.) }
+    end;
+  end;
+end.