* move exception mask initialization to procedure compile

* reset exception mask at compiler exit
* use math routines for exception masking

git-svn-id: trunk@5841 -

compiler/compiler.pas

@@ -34,7 +34,7 @@ uses
     emu387,
 {$endif WATCOM}
 {$IFNDEF USE_FAKE_SYSUTILS}
-  sysutils,
+  sysutils,math,
 {$ELSE}
   fksysutl,
 {$ENDIF}
@@ -219,9 +219,13 @@ var
 {$ifdef SHOWUSEDMEM}
   hstatus : TFPCHeapStatus;
 {$endif SHOWUSEDMEM}
+  ExceptionMask : TFPUExceptionMask;
 begin
   try
     try
+       ExceptionMask:=GetExceptionMask;
+       SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
+                         exOverflow, exUnderflow, exPrecision]);
        { Initialize the compiler }
        InitCompiler(cmd);
 
@@ -270,6 +274,8 @@ begin
      finally
        { no message possible after this !!    }
        DoneCompiler;
+
+       SetExceptionMask(ExceptionMask);
      end;
      DoneVerbose;
   except

compiler/globals.pas

@@ -100,10 +100,6 @@ interface
 {$endif}
 
     type
-       TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
-                        exOverflow, exUnderflow, exPrecision);
-       TFPUExceptionMask = set of TFPUException;
-
        pfileposinfo = ^tfileposinfo;
        tfileposinfo = record
          line      : longint;
@@ -328,7 +324,6 @@ interface
     function  GetEnvPChar(const envname:string):pchar;
     procedure FreeEnvPChar(p:pchar);
 
-    procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
     function is_number_float(d : double) : boolean;
     { discern +0.0 and -0.0 }
     function get_real_sign(r: bestreal): longint;
@@ -693,251 +688,6 @@ implementation
 {$endif hasunix}
 
 {$UNDEF AMIGASHELL}
-
-{$ifdef CPUI386}
-  {$asmmode att}
-
-  {$define HASSETFPUEXCEPTIONMASK}
-      { later, this should be replaced by the math unit }
-      const
-        Default8087CW : word = $1332;
-
-      procedure Set8087CW(cw:word);assembler;
-        asm
-          movw cw,%ax
-          movw %ax,default8087cw
-          fnclex
-          fldcw default8087cw
-        end;
-
-
-      function Get8087CW:word;assembler;
-        asm
-          pushl $0
-          fnstcw (%esp)
-          popl %eax
-        end;
-
-
-      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
-        var
-          CtlWord: Word;
-        begin
-          CtlWord:=Get8087CW;
-          Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
-        end;
-{$endif CPUI386}
-
-{$ifdef CPUX86_64}
-  {$define HASSETFPUEXCEPTIONMASK}
-      { later, this should be replaced by the math unit }
-      const
-        Default8087CW : word = $1332;
-
-      procedure Set8087CW(cw:word);assembler;
-        asm
-          movw cw,%ax
-          movw %ax,default8087cw
-          fnclex
-          fldcw default8087cw
-        end;
-
-
-      function Get8087CW:word;assembler;
-        asm
-          pushq $0
-          fnstcw (%rsp)
-          popq %rax
-        end;
-
-
-      procedure SetSSECSR(w : dword);
-        var
-          _w : dword;
-        begin
-          _w:=w;
-          asm
-            ldmxcsr _w
-          end;
-        end;
-
-
-      function GetSSECSR : dword;
-          var
-            _w : dword;
-          begin
-            asm
-              stmxcsr _w
-            end;
-            result:=_w;
-          end;
-
-
-      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
-        var
-          CtlWord: Word;
-          newmask : dword;
-        const
-          MM_MaskInvalidOp = %0000000010000000;
-          MM_MaskDenorm    = %0000000100000000;
-          MM_MaskDivZero   = %0000001000000000;
-          MM_MaskOverflow  = %0000010000000000;
-          MM_MaskUnderflow = %0000100000000000;
-          MM_MaskPrecision = %0001000000000000;
-        begin
-          { classic FPU }
-          CtlWord:=Get8087CW;
-          Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
-
-          { SSE }
-
-          newmask:=GetSSECSR;
-
-          { invalid operation }
-          if (exInvalidOp in mask) then
-            newmask:=newmask or MM_MaskInvalidOp
-          else
-            newmask:=newmask and not(MM_MaskInvalidOp);
-
-          { denormals }
-          if (exDenormalized in mask) then
-            newmask:=newmask or MM_MaskDenorm
-          else
-            newmask:=newmask and not(MM_MaskDenorm);
-
-          { zero divide }
-          if (exZeroDivide in mask) then
-            newmask:=newmask or MM_MaskDivZero
-          else
-            newmask:=newmask and not(MM_MaskDivZero);
-
-          { overflow }
-          if (exOverflow in mask) then
-            newmask:=newmask or MM_MaskOverflow
-          else
-            newmask:=newmask and not(MM_MaskOverflow);
-
-          { underflow }
-          if (exUnderflow in mask) then
-            newmask:=newmask or MM_MaskUnderflow
-          else
-            newmask:=newmask and not(MM_MaskUnderflow);
-
-          { Precision (inexact result) }
-          if (exPrecision in mask) then
-            newmask:=newmask or MM_MaskPrecision
-          else
-            newmask:=newmask and not(MM_MaskPrecision);
-          SetSSECSR(newmask);
-        end;
-{$endif CPUX86_64}
-
-{$ifdef CPUPOWERPC}
-  {$define HASSETFPUEXCEPTIONMASK}
-      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
-        var
-          newmask: record
-            case byte of
-               1: (d: double);
-               2: (a,b: cardinal);
-            end;
-        begin
-          { load current control register contents }
-          asm
-            mffs f0
-            stfd f0,newmask.d
-          end;
-          { invalid operation: bit 24 (big endian, bit 0 = left-most bit) }
-          if (exInvalidOp in mask) then
-            newmask.b := newmask.b and not(1 shl (31-24))
-          else
-            newmask.b := newmask.b or (1 shl (31-24));
-
-          { denormals can not cause exceptions on the PPC }
-
-          { zero divide: bit 27 }
-          if (exZeroDivide in mask) then
-            newmask.b := newmask.b and not(1 shl (31-27))
-          else
-            newmask.b := newmask.b or (1 shl (31-27));
-
-          { overflow: bit 25 }
-          if (exOverflow in mask) then
-            newmask.b := newmask.b and not(1 shl (31-25))
-          else
-            newmask.b := newmask.b or (1 shl (31-25));
-
-          { underflow: bit 26 }
-          if (exUnderflow in mask) then
-            newmask.b := newmask.b and not(1 shl (31-26))
-          else
-            newmask.b := newmask.b or (1 shl (31-26));
-
-          { Precision (inexact result): bit 28 }
-          if (exPrecision in mask) then
-            newmask.b := newmask.b and not(1 shl (31-28))
-          else
-            newmask.b := newmask.b or (1 shl (31-28));
-          { update control register contents }
-          asm
-            lfd   f0, newmask.d
-            mtfsf 255,f0
-          end;
-        end;
-{$endif CPUPOWERPC}
-
-{$ifdef CPUSPARC}
-  {$define HASSETFPUEXCEPTIONMASK}
-      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
-        var
-          fsr : cardinal;
-        begin
-          { load current control register contents }
-          asm
-            st %fsr,fsr
-          end;
-          { invalid operation: bit 27 }
-          if (exInvalidOp in mask) then
-            fsr:=fsr and not(1 shl 27)
-          else
-            fsr:=fsr or (1 shl 27);
-
-          { zero divide: bit 24 }
-          if (exZeroDivide in mask) then
-            fsr:=fsr and not(1 shl 24)
-          else
-            fsr:=fsr or (1 shl 24);
-
-          { overflow: bit 26 }
-          if (exOverflow in mask) then
-            fsr:=fsr and not(1 shl 26)
-          else
-            fsr:=fsr or (1 shl 26);
-
-          { underflow: bit 25 }
-          if (exUnderflow in mask) then
-            fsr:=fsr and not(1 shl 25)
-          else
-            fsr:=fsr or (1 shl 25);
-
-          { Precision (inexact result): bit 23 }
-          if (exPrecision in mask) then
-            fsr:=fsr and not(1 shl 23)
-          else
-            fsr:=fsr or (1 shl 23);
-          { update control register contents }
-          asm
-            ld fsr,%fsr
-          end;
-        end;
-{$endif CPUSPARC}
-
-{$ifndef HASSETFPUEXCEPTIONMASK}
-      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
-        begin
-        end;
-{$endif HASSETFPUEXCEPTIONMASK}
-
       function is_number_float(d : double) : boolean;
         var
            bytearray : array[0..7] of byte;

compiler/pp.pas

@@ -203,8 +203,6 @@ begin
 {$ifdef extheaptrc}
   keepreleased:=true;
 {$endif extheaptrc}
-  SetFPUExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
-                        exOverflow, exUnderflow, exPrecision]);
 { Call the compiler with empty command, so it will take the parameters }
   Halt(compiler.Compile(''));
 end.