m68k: support FFU exception settings, also reworked FPU initalization

git-svn-id: trunk@36618 -

rtl/amiga/system.pp

@@ -301,9 +301,6 @@ end;
 
 begin
   IsConsole := TRUE;
-  SysResetFPU;
-  if not(IsLibrary) then
-    SysInitFPU;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
 { OS specific startup }

rtl/inc/mathh.inc

@@ -32,6 +32,22 @@
     function GetSSECSR : dword; deprecated 'Renamed to GetMXCSR';
 {$endif}
 
+{$if defined(cpum68k)}
+{$if defined(fpu68881) or defined(fpucoldfire)}
+    const
+    {$ifdef FPC_68K_SYSTEM_HAS_FPU_EXCEPTIONS}
+       Default68KFPCR: DWord = $3400; { Enable OVFL, OPERR and DZ, round to nearest, default precision }
+    {$else}
+       Default68KFPCR: DWord = 0;
+    {$endif}
+
+    procedure SetFPCR(x: DWord);
+    procedure SetFPSR(x: DWord);
+    function GetFPCR: DWord;
+    function GetFPSR: DWord;
+{$endif}
+{$endif}
+
   type
     TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
     TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);

rtl/m68k/m68k.inc

@@ -29,23 +29,49 @@
 {****************************************************************************}
 
 
-{$IFDEF FPU68881}
-{$DEFINE FPC_SYSTEM_HAS_SYSRESETFPU}
-procedure SysResetFPU; assembler;
+{$IF DEFINED(FPU68881) OR DEFINED(FPUCOLDFIRE)}
+function GetFPCR: DWord; assembler; nostackframe;
 asm
-  clr.l    d0
-  fmove.l  d0,fpcr
+  fmove.l fpcr,d0
 end;
 
-{$DEFINE FPC_SYSTEM_HAS_SYSINITFPU}
-procedure SysInitFPU; assembler;
+function GetFPSR: DWord; assembler; nostackframe;
 asm
-  clr.l   d0
-  // FIX ME:
-  // move.w 0,d0 // enable a sane set of exception flags here
-  fmove.l d0,fpcr
+  fmove.l fpsr, d0
+end;
+
+procedure SetFPCR(x: DWord); assembler; nostackframe;
+asm
+  fmove.l x, fpcr
+end;
+
+procedure SetFPSR(x: DWord); assembler; nostackframe;
+asm
+  fmove.l x, fpsr
+end;
+
+{$DEFINE FPC_SYSTEM_HAS_SYSRESETFPU}
+procedure SysResetFPU;
+begin
+  SetFPCR(Default68KFPCR);
+  SetFPSR(0);
+end;
+
+{$DEFINE FPC_SYSTEM_HAS_SYSINITFPU}
+procedure SysInitFPU;
+begin
 end;
-{$ENDIF}
+
+procedure fpc_cpuinit;
+  begin
+    if IsLibrary then
+      begin
+        Default68kFPCR:=GetFPCR;
+      end;
+    SysResetFPU;
+  end;
+
+{$ELSE}
 
 procedure fpc_cpuinit;
   begin
@@ -54,6 +80,8 @@ procedure fpc_cpuinit;
       SysInitFPU;
   end;
 
+{$ENDIF}
+
 {$ifndef INTERNAL_BACKTRACE}
 {$define FPC_SYSTEM_HAS_GET_FRAME}
 function get_frame : pointer; assembler;nostackframe;

rtl/m68k/mathu.inc

@@ -66,16 +66,19 @@ const
   FPU68K_PREC_SINGLE      = 1 shl FPU68K_PREC_MASK_SHIFT;
   FPU68K_PREC_DOUBLE      = 2 shl FPU68K_PREC_MASK_SHIFT;
 
+const
+  FPU68K_EXCEPT_MASK_SHIFT = 8;
+  FPU68K_EXCEPT_MASK       = 255 shl FPU68K_EXCEPT_MASK_SHIFT;
 
-function GetFPCR: DWord; assembler; nostackframe;
-asm
-  fmove.l fpcr,d0
-end;
+  FPU68K_EXCEPT_INEX1      = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 0);
+  FPU68K_EXCEPT_INEX2      = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 1);
+  FPU68K_EXCEPT_DZ         = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 2);
+  FPU68K_EXCEPT_UNFL       = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 3);
+  FPU68K_EXCEPT_OVFL       = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 4);
+  FPU68K_EXCEPT_OPERR      = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 5);
+  FPU68K_EXCEPT_SNAN       = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 6);
+  FPU68K_EXCEPT_BSUN       = 1 shl (FPU68K_EXCEPT_MASK_SHIFt + 7);
 
-function SetFPCR(x: DWord): DWord; assembler; nostackframe;
-asm
-  fmove.l x, fpcr
-end;
 
 function GetExceptionMask: TFPUExceptionMask;
 begin
@@ -83,8 +86,28 @@ begin
 end;
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+const
+  FPCToFPUExceptionFlags: array[TFPUException] of DWord =
+      ( FPU68K_EXCEPT_OPERR, 0, FPU68K_EXCEPT_DZ, FPU68K_EXCEPT_OVFL, FPU68K_EXCEPT_UNFL, FPU68K_EXCEPT_INEX2 );
+  FPUToFPCExceptionFlags: array[0..7] of TFPUExceptionMask =
+      ( [], [exPrecision], [exZeroDivide], [exUnderflow], [exOverflow], [exInvalidOp], [], [] );
+var
+  oldMode, Mode: DWord;
+  e: TFPUException;
+  i: longint;
 begin
-  result:=softfloat_exception_mask;
+  result:=[];
+
+  oldMode:=(GetFPCR and FPU68K_EXCEPT_MASK) shr FPU68K_EXCEPT_MASK_SHIFT;
+  for i:=low(FPUToFPCExceptionFlags) to high(FPUToFPCExceptionFlags) do
+    if ((1 shl i) and oldMode) > 0 then
+      result:=result+FPUToFPCExceptionFlags[i];
+
+  mode:=0;
+  for e in Mask do
+    mode:=mode or FPCToFPUExceptionFlags[e];
+
+  SetFPCR((GetFPCR and not FPU68K_EXCEPT_MASK) or (mode shl FPU68K_EXCEPT_MASK_SHIFT));
   softfloat_exception_mask:=mask;
 end;
 
@@ -120,9 +143,10 @@ end;
 
 procedure ClearExceptions(RaisePending: Boolean);
 begin
+  SetFPCR(GetFPCR and not FPU68K_EXCEPT_MASK);
+  SetFPSR(0);
   softfloat_exception_flags:=[];
 end;
-
 {$else}
 
 function GetExceptionMask: TFPUExceptionMask;