FPU exception mask: generlised system unit interface

rtl/aarch64/aarch64.inc

@@ -39,9 +39,18 @@ function getfpcr: qword; nostackframe; assembler;
   end;
 
 
-procedure setfpcr(val: qword); nostackframe; assembler;
-  asm
-    msr fpcr,x0
+procedure setfpcr(val: qword);
+  begin
+    asm
+      ldr x0,val
+      msr fpcr,x0
+{$if not defined(darwin) or defined(ios) or defined(watchos) or defined(tvos)}
+      // read back the fpcr because on several (non-macOS) platforms it's raz
+      mrs x0,fpcr
+      str x0, val
+{$endif}
+    end;
+    DefaultFPUControlWord:=val;
   end;
 
 
@@ -51,6 +60,18 @@ function getfpsr: qword; nostackframe; assembler;
   end;
 
 
+function GetNativeFPUControlWord: TNativeFPUControlWord;
+  begin
+    result:=getfpcr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
+  begin
+    setfpcr(cw);
+  end;
+
+
 procedure setfpsr(val: qword); nostackframe; assembler;
   asm
     msr fpsr, x0
@@ -129,29 +150,13 @@ procedure SysInitFPU;
     setfpcr(getfpcr and $ff3fffff);
     { clear all "exception happened" flags we care about}
     setfpsr(getfpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift));
-    { enable invalid operations and division by zero exceptions. }
+    { enable invalid operations, overflow and division by zero exceptions. }
     setfpcr(((getfpcr and not(fpu_exception_mask)) or fpu_dze or fpu_ofe or fpu_ioe));
     softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
     softfloat_exception_flags:=[];
   end;
 
 
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-begin
-  softfloat_exception_flags:=[];
-  setfpsr(getfpsr and not(FPSR_EXCEPTIONS));
-end;
-
-
-procedure fpc_cpuinit;
-  begin
-    { don't let libraries influence the FPU cw set by the host program }
-    if not IsLibrary then
-      SysInitFPU;
-  end;
-
-
 {****************************************************************************
                                 Move / Fill
 ****************************************************************************}

rtl/aarch64/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TNativeFPUControlWord = qword;

rtl/aarch64/mathu.inc

@@ -14,18 +14,6 @@
 
 {$asmmode gas}
 
-function getfpcr: qword; nostackframe; assembler;
-  asm
-    mrs x0,fpcr
-  end;
-
-
-procedure setfpcr(val: qword); nostackframe; assembler;
-  asm
-    msr fpcr,x0
-  end;
-
-
 function getfpsr: qword; nostackframe; assembler;
   asm
     mrs x0,fpsr
@@ -42,7 +30,7 @@ function GetRoundMode: TFPURoundingMode;
   const
     bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmUp,rmDown,rmTruncate);
   begin
-    result:=TFPURoundingMode(bits2rm[(getfpcr shr 22) and 3])
+    result:=TFPURoundingMode(bits2rm[(GetNativeFPUControlWord shr 22) and 3])
   end;
 
 
@@ -52,7 +40,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
     softfloat_rounding_mode:=RoundMode;
     SetRoundMode:=GetRoundMode;
-    setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
+    SetNativeFPUControlWord((GetNativeFPUControlWord and $ff3fffff) or (rm2bits[RoundMode] shl 22));
   end;
 
 
@@ -112,9 +100,13 @@ function GetExceptionMask: TFPUExceptionMask;
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
   var
     newfpcr: qword;
+    old_softfloat_exception_mask: TFPUExceptionMask;
   begin
     { clear "exception happened" flags }
     ClearExceptions(false);
+    { as the fpcr flags might be RAZ, the softfloat exception mask
+      is considered as the authoritative mask }
+    result:=softfloat_exception_mask;
     softfloat_exception_mask:=mask;
 
     { at least the ThunderX AArch64 support apparently hardware exceptions,
@@ -133,11 +125,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       newfpcr:=newfpcr and not(fpu_ixe);
     if exDenormalized in Mask then
       newfpcr:=newfpcr and not(fpu_ide);
-    setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
-
-    { as the fpcr flags might be RAZ, the softfloat exception mask
-      is considered as the authoritative mask }
-    result:=softfloat_exception_mask;
+    SetNativeFPUControlWord((GetNativeFPUControlWord and not(fpu_exception_mask)) or newfpcr);
   end;
 
 

rtl/aix/system.pp

@@ -238,25 +238,12 @@ end;
 
 
 const
-  FP_TRAP_SYNC = 1;                { precise fpu exceptions }
-  FP_TRAP_OFF = 0;                 { disable fpu exceptions }
-  FP_TRAP_QUERY = 2;               { current fpu exception state }
-  FP_TRAP_IMP = 3;                 { imprecise non-recoverable fpu exceptions }
-  FP_TRAP_IMP_REC = 4;             { imprecise recoverable fpu exceptions }
-  FP_TRAP_FASTMODE = 128;          { fastest fpu exception state }
-  FP_TRAP_ERROR = -1;
-  FP_TRAP_UNIMPL = -2;
-
   TRP_INVALID     = $00000080;
   TRP_OVERFLOW    = $00000040;
   TRP_UNDERFLOW   = $00000020;
   TRP_DIV_BY_ZERO = $00000010;
   TRP_INEXACT     = $00000008;
 
-
-function fp_trap(flag: longint): longint; cdecl; external;
-procedure fp_enable(Mask: DWord);cdecl;external;
-
 Begin
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);

rtl/arm/arm.inc

@@ -44,16 +44,30 @@ const
 {$endif}
 
 {$if defined(FPUARM_HAS_FPA)}
-Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$define FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+function GetNativeFPUControlWord: TNativeFPUControlWord; assembler;
+asm
+  rfs r0
+end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
 begin
-  { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
+  DefaultFPUControlWord:=cw;
   asm
-    rfs r0
-    and r0,r0,#0xffe0ffff
-    orr r0,r0,#0x00070000
+    ldr r0, cw
     wfs r0
   end;
 end;
+
+Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
+  SetNativeFPUControlWord((GetNativeFPUControlWord and $ffe0ffff) or $00070000);
+  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
+end;
+
 {$elseif defined(FPUARM_HAS_VFP_EXTENSION)}
 
 
@@ -64,26 +78,41 @@ const
   fpu_dz = 1 shl 3;
   fpu_nv = 1 shl 4;
 
-function getfpscr: sizeuint; nostackframe; assembler;
+  FPSCR_IOC = 1;
+  FPSCR_DZC = 1 shl 1;
+  FPSCR_OFC = 1 shl 2;
+  FPSCR_UFC = 1 shl 3;
+  FPSCR_IXC = 1 shl 4;
+  FPSCR_IDC = 1 shl 7;
+  FPSCR_EXCEPTIONS = FPSCR_IOC or FPSCR_DZC or FPSCR_OFC or FPSCR_UFC or FPSCR_IXC or FPSCR_IDC;
+
+function getfpscr: sizeuint; nostackframe; assembler; nostackframe;
   asm
     fmrx r0,fpscr
   end;
 
 
-procedure setfpscr(flags : sizeuint); nostackframe; assembler;
-  asm
-    fmxr fpscr,r0
+procedure setfpscr(flags : sizeuint);
+  begin
+    DefaultFPUControlWord:=flags and not(FPSCR_EXCEPTIONS);
+    asm
+      ldr r0, flags
+      fmxr fpscr,r0
+    end;
   end;
 
+{$define FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=getfpscr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    setfpscr(cw);
+  end;
 
-const
-  FPSCR_IOC = 1;
-  FPSCR_DZC = 1 shl 1;
-  FPSCR_OFC = 1 shl 2;
-  FPSCR_UFC = 1 shl 3;
-  FPSCR_IXC = 1 shl 4;
-  FPSCR_IDC = 1 shl 7;
-  FPSCR_EXCEPTIONS = FPSCR_IOC or FPSCR_DZC or FPSCR_OFC or FPSCR_UFC or FPSCR_IXC or FPSCR_IDC;
 
 procedure RaisePendingExceptions;
   var
@@ -165,23 +194,8 @@ begin
   softfloat_exception_flags:=[];
 end;
 
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-begin
-  softfloat_exception_flags:=[];
-  setfpscr(getfpscr and not(FPSCR_EXCEPTIONS));
-end;
-
-
-{$endif}
-{$endif}
-
-procedure fpc_cpuinit;
-begin
-  { don't let libraries influence the FPU cw set by the host program }
-  if not IsLibrary then
-    SysInitFPU;
-end;
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
+{$endif not(defined(wince)) and not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
 
 {$ifdef wince}
 function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
@@ -189,6 +203,7 @@ function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
+  softfloat_exception_flags:=[];
 end;
 
 {$define FPC_SYSTEM_HAS_SYSINITFPU}
@@ -197,9 +212,35 @@ begin
   { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
   { FPU precision 64 bit, rounding to nearest, affine infinity }
   _controlfp($000C0003, $030F031F);
+  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
 end;
+
+{$define FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+function GetNativeFPUControlWord: TNativeFPUControlWord;
+  begin
+    result:=_controlfp(0,0);
+  end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
+  begin
+    _controlfp(cw,$ffffffff);
+  end;
+
 {$endif wince}
 
+{$ifndef FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+{$define FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=0;
+  end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+  end;
+{$endif}
+
 {$ifdef linux}
 function fpc_read_tp : pointer; [public, alias: 'fpc_read_tp'];assembler; nostackframe;
 asm

rtl/arm/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TNativeFPUControlWord = dword;

rtl/arm/mathu.inc

@@ -388,19 +388,7 @@ const
   _FPU_MASK_DM  =  $00000000;      { denormalized operation }
   _FPU_MASK_ALL =  $001f0000;      { mask for all flags     }
 
-function FPU_GetCW : dword; nostackframe; assembler;
-  asm
-    rfs r0
-  end;
-
-
-procedure FPU_SetCW(cw : dword); nostackframe; assembler;
-  asm
-    wfs r0
-  end;
-
-
-function FPUCw2ExceptionMask(cw: dword): TFPUExceptionMask;
+function FPUCw2ExceptionMask(cw: TNativeFPUControlWord): TFPUExceptionMask;
   begin
     Result:=[];
 
@@ -454,7 +442,7 @@ function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode
 function GetExceptionMask: TFPUExceptionMask;
   begin
 {$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
-    Result:=FPUCw2ExceptionMask(FPU_GetCW);
+    Result:=FPUCw2ExceptionMask(GetNativeFPUControlWord);
 {$else}
     Result:=softfloat_exception_mask;
 {$endif}
@@ -464,11 +452,11 @@ function GetExceptionMask: TFPUExceptionMask;
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 {$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
   var
-    cw : dword;
+    cw : TNativeFPUControlWord;
 {$endif}
   begin
 {$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
-    cw:=FPU_GetCW;
+    cw:=GetNativeFPUControlWord;
     Result:=FPUCw2ExceptionMask(cw);
     cw:=cw or _FPU_MASK_ALL;
 
@@ -490,7 +478,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
     if exPrecision in Mask then
       cw:=cw and not(_FPU_MASK_PM);
 
-    FPU_SetCW(cw);
+    SetNativeFPUControlWord(cw);
 {$else}
     Result:=softfloat_exception_mask;
 {$endif}

rtl/arm/thumb.inc

@@ -25,14 +25,6 @@ begin
 end;
 
 
-procedure fpc_cpuinit;
-begin
-{$ifndef FPUNONE}
-  SysInitFPU;
-{$endif FPUNONE}
-end;
-
-
 procedure fpc_cpucodeinit;
 begin
 end;

rtl/arm/thumb2.inc

@@ -33,28 +33,17 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
   asm
-{$if defined(FPUFPA) or defined(FPUFPA10) or defined(FPUFPA11)}
-
-    rfs r0
-    and r0,r0,#0xffe0ffff
-    orr r0,r0,#0x00070000
-    wfs r0
-{$else}
     movw r0, #(0xed88)
     movt r0, #(0xe000)
     ldr r1, [r0]
     orr r1, r1, #(0xF << 20)
     str r1, [r0]
-{$endif}
   end;
+  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
 end;
 {$endif}
 
-procedure fpc_cpuinit;
-begin
-  SysInitFPU;
-end;
-
 {$ifdef wince}
 function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
 
@@ -68,12 +57,25 @@ end;
 Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
   { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
   { FPU precision 64 bit, rounding to nearest, affine infinity }
   _controlfp($000C0003, $030F031F);
 end;
 {$endif wince}
 
+{$define FPC_SYSTEM_HAS_GETSETNATIVEFPUCONTROLWORD}
+function GetNativeFPUControlWord: TNativeFPUControlWord;
+  begin
+    result:=_controlfp(0,0);
+  end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
+  begin
+    _controlfp(cw,$ffffffff);
+  end;
+
+
 {****************************************************************************
                        stack frame related stuff
 ****************************************************************************}

rtl/avr/avr.inc

@@ -25,7 +25,7 @@ function avr_save: byte;[INTERNPROC: in_avr_save];
 { Restores SREG }
 procedure avr_restore(old_sreg: byte); [INTERNPROC: in_avr_restore];
 
-
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
   end;

rtl/i386/cpuh.inc

@@ -47,3 +47,8 @@ function fpc_x86_get_gs:longint;[internproc:fpc_in_x86_get_gs];
 { $i cpummprocs.inc}
 {$endif not VER3_0 and not VER3_2}
 
+type
+  TNativeFPUControlWord = record
+    cw8087: word;
+    MXCSR: dword;
+  end;

rtl/i386/i386.inc

@@ -56,6 +56,7 @@ function cpuid_support : boolean;assembler;nostackframe;
 {$endif FPC_SYSTEM_HAS_MOVE}
 {$endif FPC_PIC}
 
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;
   begin
     { because of the brain dead sse detection on x86, this test is post poned to fpc_cpucodeinit which

rtl/i386/math.inc

@@ -114,6 +114,24 @@ const
       end;
 
 
+    function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+      begin
+        result.cw8087:=Get8087CW;
+        if has_sse_support then
+          result.MXCSR:=GetMXCSR
+        else
+          result.MXCSR:=-1;
+      end;
+
+
+    procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+      begin
+        Set8087CW(cw.cw8087);
+        if cw.MXCSR<>-1 then
+          SetMXCSR(cw.MXCSR);
+      end;
+
+
     procedure SetSSECSR(w : dword);
       begin
         SetMXCSR(w);

rtl/i8086/cpuh.inc

@@ -40,3 +40,6 @@ function fpc_x86_get_ds:word;[internproc:fpc_in_x86_get_ds];
 function fpc_x86_get_es:word;[internproc:fpc_in_x86_get_es];
 function fpc_x86_get_fs:word;[internproc:fpc_in_x86_get_fs];
 function fpc_x86_get_gs:word;[internproc:fpc_in_x86_get_gs];
+
+type
+  TNativeFPUControlWord = word;

rtl/i8086/i8086.inc

@@ -14,6 +14,7 @@
 
  **********************************************************************}
 
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;
   begin
   end;

rtl/i8086/math.inc

@@ -39,6 +39,18 @@
 	pop ax
       end;
 
+    function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+      begin
+        result:=Get8087CW;
+      end;
+
+
+    procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+      begin
+        Set8087CW(cw);
+      end;
+
+
     procedure Handle_I8086_Error(InterruptNumber : dword); public name 'FPC_HANDLE_I8086_ERROR';
       var
         FpuStatus : word;

rtl/inc/dynlib.inc

@@ -23,34 +23,25 @@ Function DoSafeLoadLibrary(const Name : RawByteString) : TLibHandle;
 {$else not FPCRTL_FILESYSTEM_TWO_BYTE_API}
 Function DoSafeLoadLibrary(const Name : UnicodeString) : TLibHandle;
 {$endif not FPCRTL_FILESYSTEM_TWO_BYTE_API}
-{$if defined(cpui386) or defined(cpux86_64)}
+{$ifndef FPUNONE}
   var
-    fpucw : Word;
-    ssecw : DWord;
-{$endif}
+    fpucw: TNativeFPUControlWord;
   begin
     try
-{$if defined(cpui386) or defined(cpux86_64)}
-      fpucw:=Get8087CW;
-{$ifdef cpui386}
-      if has_sse_support then
-{$endif cpui386}
-        ssecw:=GetMXCSR;
+      fpucw:=GetNativeFPUControlWord;
+{$else}
+  begin
 {$endif}
 {$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
       Result:=CurrentDLM.LoadLibraryA(Name);
 {$else FPCRTL_FILESYSTEM_TWO_BYTE_API}
       Result:=CurrentDLM.LoadLibraryU(Name);
 {$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
-      finally
-{$if defined(cpui386) or defined(cpux86_64)}
-      Set8087CW(fpucw);
-{$ifdef cpui386}
-      if has_sse_support then
-{$endif cpui386}
-        SetMXCSR(ssecw);
-{$endif}
+{$ifndef FPUNONE}
+    finally
+      SetNativeFPUControlWord(fpucw);
     end;
+{$endif}
   end;
 
 Function LoadLibrary(const Name : RawByteString) : TLibHandle;

rtl/inc/generic.inc

@@ -2646,6 +2646,9 @@ end;
 procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   softfloat_exception_flags:=[];
+{$if declared(DefaultFPUControlWord)}
+  SetNativeFPUControlWord(DefaultFPUControlWord);
+{$endif}
 end;
 
 {$endif FPC_SYSTEM_HAS_SYSRESETFPU}
@@ -2655,11 +2658,28 @@ end;
 procedure SysInitFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
 end;
 
 {$endif FPC_SYSTEM_HAS_SYSINITFPU}
 {$endif}
 
+{$ifndef FPC_SYSTEM_HAS_FPC_CPUINIT}
+procedure fpc_cpuinit;
+  begin
+{$ifndef FPUNONE}
+{$ifdef FPC_HAS_FEATURE_DYNLIBS}
+    if not IsLibrary then
+{$endif}
+      SysInitFPU;
+{$if declared(DefaultFPUControlWord)}
+    DefaultFPUControlWord:=GetNativeFPUControlWord;
+{$endif}
+    SysResetFPU;
+{$endif}
+  end;
+{$endif}
+
 {$ifndef FPC_SYSTEM_HAS_SWAPENDIAN}
 function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin

rtl/inc/mathh.inc

@@ -15,6 +15,7 @@
    { i386 FPU Controlword }
 
 {$if defined(cpui8086) or defined(cpui386) or defined(cpux86_64)}
+    {$define FPC_SYSTEM_FPU_CUSTOM_CONTROL_WORD}
     const
       Default8087CW : word = $1332;
 
@@ -23,6 +24,7 @@
 {$endif}
 
 {$if defined (cpui386) or defined(cpux86_64)}
+    {$define FPC_SYSTEM_FPU_CUSTOM_CONTROL_WORD}
     const
       DefaultMXCSR: dword = $1900;
 
@@ -33,6 +35,7 @@
 {$endif}
 
 {$if defined(cpum68k)}
+    {$define FPC_SYSTEM_FPU_CUSTOM_CONTROL_WORD}
 {$if defined(fpu68881) or defined(fpucoldfire)}
     const
     {$ifdef FPC_68K_SYSTEM_HAS_FPU_EXCEPTIONS}
@@ -45,9 +48,20 @@
     procedure SetFPSR(x: DWord);
     function GetFPCR: DWord;
     function GetFPSR: DWord;
+{$else}
+    {$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+{$endif}
 {$endif}
+
+{$if (defined(FPC_SYSTEM_FPUCW_IMMUTABLE) or defined(FPU_NONE)) and not declared(TNativeFPUControlWord)}
+  type
+    TNativeFPUControlWord = record
+    end;
 {$endif}
 
+    function GetNativeFPUControlWord: TNativeFPUControlWord; {$if (defined(FPC_SYSTEM_FPUCW_IMMUTABLE) or defined(FPUNONE)) and defined(SYSTEMINLINE)}inline;{$endif}
+    procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if (defined(FPC_SYSTEM_FPUCW_IMMUTABLE) or defined(FPUNONE)) and defined(SYSTEMINLINE)}inline;{$endif}
+
   type
     TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
     TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
@@ -83,8 +97,11 @@ ThreadVar
 {$else FPC_HAS_FEATURE_THREADING}
 Var
 {$endif FPC_HAS_FEATURE_THREADING}
-  softfloat_exception_mask : TFPUExceptionMask;
   softfloat_exception_flags : TFPUExceptionMask;
+
+{ global/shared just like the native ones }
+var
+  softfloat_exception_mask : TFPUExceptionMask;
   softfloat_rounding_mode : TFPURoundingMode;
 
 procedure float_raise(i: TFPUException);

rtl/inc/system.inc

@@ -101,6 +101,20 @@ begin
 end;
 {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 
+{$if not defined(FPC_SYSTEM_FPU_CUSTOM_CONTROL_WORD) and not defined(FPUNONE) and not defined(FPC_SYSTEM_FPUCW_IMMUTABLE)}
+var
+  { Control word of the fpu that determes which exceptions will be thrown and
+    potentially other flags (precision, exception-happened flags, ... Used to
+    initialise the FPU when starting a new thread (in SysResetFPU).
+
+    Some platforms already have a legacy/existing global variable holding this
+    information (FPC_SYSTEM_FPU_CUSTOM_CONTROL_WORD). In case of FPU_NONE,
+    we don't support floating point at all. And in case of
+    FPC_SYSTEM_FPUCW_IMMUTABLE, either the control word cannot be changed
+    (e.g. wasm), or FPU operations are supported by only as softfloat }
+  DefaultFPUControlWord: TNativeFPUControlWord;
+{$endif}
+
 { checks whether the given suggested size for the stack of the current
  thread is acceptable. If this is the case, returns it unaltered.
  Otherwise it should return an acceptable value.
@@ -1138,6 +1152,22 @@ begin
 end;
 {$endif FPC_INIT_FINAL_UNITS_BY_CALLS}
 
+
+{*****************************************************************************
+                        FPU Exceptions state
+*****************************************************************************}
+
+{$if defined(FPC_SYSTEM_FPUCW_IMMUTABLE) or defined(FPU_NONE)}
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+begin
+  result:=default(TNativeFPUControlWord);
+end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+begin
+end;
+{$endif}
+
 {*****************************************************************************
                           Error / Exit / ExitProc
 *****************************************************************************}

rtl/inc/thread.inc

@@ -36,7 +36,6 @@ Var
       begin
 {$ifndef FPUNONE}
         SysResetFPU;
-        SysInitFPU;
 {$endif}
 {$ifndef HAS_MEMORYMANAGER}
 {$ifndef FPC_NO_DEFAULT_HEAP}

rtl/java/jsystem.inc

@@ -920,6 +920,21 @@ begin
    end;
 end;
 *)
+
+{*****************************************************************************
+                        FPU Exceptions state
+*****************************************************************************}
+
+{$if defined(FPC_SYSTEM_FPUCW_IMMUTABLE) or defined(FPU_NONE)}
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+begin
+  result:=default(TNativeFPUControlWord);
+end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+begin
+end;
+{$endif}
 {*****************************************************************************
                           Error / Exit / ExitProc
 *****************************************************************************}

rtl/java/jsystemh.inc

@@ -18,6 +18,9 @@
                         Processor specific routines
 ****************************************************************************}
 
+{ CPU specific stuff }
+{$i cpuh.inc}
+
 {$ifdef FPC_USE_LIBC}
   {$ifdef SYSTEMINLINE}
     {$define INLINEGENERICS}

rtl/jvm/cpuh.inc

@@ -13,3 +13,5 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{$define FPC_SYSTEM_FPUCW_IMMUTABLE}

rtl/jvm/jvm.inc

@@ -33,14 +33,6 @@ Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
   end;
 
 
-procedure fpc_cpuinit;
-  begin
-    SysResetFPU;
-    if not(IsLibrary) then
-      SysInitFPU;
-  end;
-
-
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
 function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
   begin

rtl/linux/powerpc/sighnd.inc

@@ -23,7 +23,7 @@ begin
   res:=0;
 {$ifndef FPUNONE}
   { exception flags are turned off by kernel }
-  fpc_enable_ppc_fpu_exceptions;
+  SysResetFpu;
 {$endif}
   case sig of
     SIGFPE :

rtl/linux/powerpc64/sighnd.inc

@@ -22,7 +22,7 @@ begin
   res:=0;
 
   { exception flags are turned off by kernel }
-  fpc_enable_ppc_fpu_exceptions;
+  SysResetFpu;
   case sig of
     SIGFPE :
       { distuingish between different FPU exceptions }

rtl/m68k/cpuh.inc

@@ -18,3 +18,5 @@
    Test68000 : byte = 0;      { Must be determined at startup for both }
    Test68881 : byte = 0;
 
+ type
+   TNativeFPUControlWord = dword;

rtl/m68k/m68k.inc

@@ -40,9 +40,12 @@ asm
   fmove.l fpsr, d0
 end;
 
-procedure SetFPCR(x: DWord); assembler; nostackframe;
-asm
-  fmove.l x, fpcr
+procedure SetFPCR(x: DWord);
+begin
+  Default68kFPCR:=x;
+  asm
+    fmove.l x, fpcr
+  end;
 end;
 
 procedure SetFPSR(x: DWord); assembler; nostackframe;
@@ -50,9 +53,20 @@ asm
   fmove.l x, fpsr
 end;
 
+function GetNativeFPUControlWord: TNativeFPUControlWord;
+  begin
+    result:=GetFPCR;
+  end;
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
+  begin
+    SetFPCR(cw);
+  end;
+
 {$DEFINE FPC_SYSTEM_HAS_SYSRESETFPU}
 procedure SysResetFPU;
 begin
+  softfloat_exception_flags:=[];
   SetFPCR(Default68KFPCR);
   SetFPSR(0);
 end;
@@ -60,29 +74,12 @@ end;
 {$DEFINE FPC_SYSTEM_HAS_SYSINITFPU}
 procedure SysInitFPU;
 begin
+  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
+  SetFPSR(0);
 end;
 
-procedure fpc_cpuinit;
-  begin
-    if IsLibrary then
-      begin
-        Default68kFPCR:=GetFPCR;
-      end;
-    SysResetFPU;
-  end;
-
-{$ELSE}
-
-procedure fpc_cpuinit;
-  begin
-{$IFNDEF FPUNONE}
-    SysResetFPU;
-    if (not IsLibrary) then
-      SysInitFPU;
-{$ENDIF}
-  end;
-
-{$ENDIF}
+{$endif}
 
 {$ifndef INTERNAL_BACKTRACE}
 {$define FPC_SYSTEM_HAS_GET_FRAME}

rtl/mips/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TNativeFPUControlWord = dword;

rtl/mips/mathu.inc

@@ -12,10 +12,6 @@
 
  **********************************************************************}
 
-{ exported by the system unit }
-function get_fsr : dword;external name 'FPC_GETFSR';
-procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
-
 const
   { FPU enable exception bits for FCSR register }
   fpu_enable_inexact   =  $80;
@@ -53,17 +49,17 @@ const
 
 function GetRoundMode: TFPURoundingMode;
   begin
-    result:=fsr2roundmode[get_fsr and fpu_rounding_mask];
+    result:=fsr2roundmode[GetNativeFPUControlWord and fpu_rounding_mask];
   end;
 
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   var
-    fsr: longword;
+    fsr: TNativeFPUControlWord;
   begin
-    fsr:=get_fsr;
+    fsr:=GetNativeFPUControlWord;
     result:=fsr2roundmode[fsr and fpu_rounding_mask];
     softfloat_rounding_mode:=RoundMode;
-    set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
+    SetNativeFPUControlWord((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
   end;
 
 
@@ -79,7 +75,7 @@ function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode
   end;
 
 
-function fsr2ExceptionMask(fsr: longword): TFPUExceptionMask;
+function fsr2ExceptionMask(fsr: TNativeFPUControlWord): TFPUExceptionMask;
   begin
     result:=[];
     { invalid operation }
@@ -106,15 +102,15 @@ function fsr2ExceptionMask(fsr: longword): TFPUExceptionMask;
 
 function GetExceptionMask: TFPUExceptionMask;
   begin
-    result:=fsr2ExceptionMask(get_fsr);
+    result:=fsr2ExceptionMask(GetNativeFPUControlWord);
   end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
   var
-    fsr : longword;
+    fsr : TNativeFPUControlWord;
   begin
-    fsr:=get_fsr;
+    fsr:=GetNativeFPUControlWord;
     result:=fsr2ExceptionMask(fsr);
 
     { Reset flags, cause and enables }
@@ -141,12 +137,12 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       fsr:=fsr or (fpu_enable_inexact);
 
     { update control register contents }
-    set_fsr(fsr);
+    SetNativeFPUControlWord(fsr);
   end;
 
 
 procedure ClearExceptions(RaisePending: Boolean =true);
   begin
-    set_fsr(get_fsr and not (fpu_flags_mask or fpu_cause_mask));
+    SetNativeFPUControlWord(GetNativeFPUControlWord and not (fpu_flags_mask or fpu_cause_mask));
   end;
 

rtl/mips/mips.inc

@@ -22,9 +22,25 @@ function get_fsr : dword;assembler;nostackframe;[public, alias: 'FPC_GETFSR'];
   end;
 
 
-procedure set_fsr(fsr : dword);assembler;nostackframe;[public, alias: 'FPC_SETFSR'];
-  asm
-    ctc1 $4,$31
+procedure set_fsr(fsr : dword);[public, alias: 'FPC_SETFSR'];
+  begin
+    DefaultFPUControlWord:=fsr;
+    asm
+      lw $4,fsr
+      ctc1 $4,$31
+    end;
+  end;
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=get_fsr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    set_fsr(cw);
   end;
 
 
@@ -60,26 +76,12 @@ const
 procedure SysInitFPU;
   begin
     set_fsr(get_fsr and (not fpu_all_bits) or (default_fpu_enable or fpu_rounding_nearest));
-  end;
-
-
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-procedure SysResetFPU;
-  begin
+    softfloat_exception_mask:=[float_flag_inexact,float_flag_denormal];
+    softfloat_exception_flags:=[];
   end;
 {$endif FPUMIPS2 or FPUMIPS3}
 
 
-procedure fpc_cpuinit;
-  begin
-{$ifndef FPUNONE}
-    SysResetFPU;
-    if (not IsLibrary) then
-      SysInitFPU;
-{$endif FPUNONE}
-  end;
-
-
 {$ifndef INTERNAL_BACKTRACE}
 {$define FPC_SYSTEM_HAS_GET_FRAME}
 function get_frame:pointer;assembler;nostackframe;

rtl/mips64/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TNativeFPUControlWord = dword;

rtl/powerpc/cpuh.inc

@@ -13,3 +13,12 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+type
+{$ifndef aix}
+  TNativeFPUControlWord = dword;
+{$else aix}
+  TNativeFPUControlWord = record
+    rndmode: word;
+    exceptionmask: byte;
+  end;
+{$endif}

rtl/powerpc/mathu.inc

@@ -1,205 +1 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2005 by Thomas Schatzl
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-  RoundModeMask        = %00000011;
-  NonIEEEModeMask      = %00000100;
-
-  InvalidOperationMask = %10000000;
-  OverflowMask         = %01000000;
-  UnderflowMask        = %00100000;
-  ZeroDivideMask       = %00010000;
-  InexactMask          = %00001000;
-  AllExceptionsMask    = %11111000;
-  ExceptionsPendingMask = %11111111111111100000011100000000;
-
-  ExceptionMask        = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
-
-  AllConfigBits        = ExceptionMask or NonIEEEModeMask or RoundModeMask;
-
-function getFPSCR : DWord; assembler; nostackframe;
-asm
-  mffs f0
-  stfd f0, -12(r1)
-  lwz r3, -8(r1)
-end;
-
-procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
-asm
-  stw r3, -8(r1)
-  lfd f0, -12(r1)
-  mtfsf 255, f0
-end;
-
-{$ifdef aix}
-const
-  FP_RND_RZ = 0;
-  FP_RND_RN = 1;
-  FP_RND_RP = 2;
-  FP_RND_RM = 3;
-
-function fp_is_enabled(Mask: DWord): boolean;cdecl;external;
-procedure fp_enable(Mask: DWord);cdecl;external;
-function feclearexcept(Mask: DWord):DWord;cdecl;external;
-procedure fp_disable(Mask: DWord);cdecl;external;
-function fp_read_rnd: word;cdecl;external;
-function fp_swap_rnd(RoundMode: word): word;cdecl;external;
-
-{$else aix}
-const
-  FP_RND_RZ = 1;
-  FP_RND_RN = 0;
-  FP_RND_RP = 2;
-  FP_RND_RM = 3;
-{$endif aix}
-
-function GetRoundMode: TFPURoundingMode;
-begin
-{$ifndef aix}
-  case (getFPSCR and RoundModeMask) of
-{$else not aix}
-  case fp_read_rnd of
-{$endif not aix}
-    FP_RND_RN : result := rmNearest;
-    FP_RND_RZ : result := rmTruncate;
-    FP_RND_RP : result := rmUp;
-    FP_RND_RM : result := rmDown;
-  end;
-end;
-
-function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
-var
-  mode : DWord;
-begin
-  softfloat_rounding_mode:=RoundMode;
-  case (RoundMode) of
-    rmNearest :
-      begin
-        mode := FP_RND_RN;
-      end;
-    rmTruncate :
-      begin
-        mode := FP_RND_RZ;
-      end;
-    rmUp :
-      begin
-        mode := FP_RND_RP;
-      end;
-    rmDown :
-      begin
-        mode := FP_RND_RM;
-      end;
-  end;
-  result := GetRoundMode;
-{$ifndef aix}
-  setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
-{$else not aix}
-  fp_swap_rnd(mode);
-{$endif not aix}
-end;
-
-
-function GetPrecisionMode: TFPUPrecisionMode;
-begin
-  result := pmDouble;
-end;
-
-function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
-begin
-  { nothing to do, not supported }
-  result := pmDouble;
-end;
-
-
-function GetExceptionMask: TFPUExceptionMask;
-begin
-  result := [];
-{$ifndef aix}
-  if ((getFPSCR and InvalidOperationMask) = 0) then 
-    result := result + [exInvalidOp];
-  if ((getFPSCR and OverflowMask) = 0) then 
-    result := result + [exOverflow];
-  if ((getFPSCR and UnderflowMask) = 0) then 
-    result := result + [exUnderflow];
-  if ((getFPSCR and ZeroDivideMask) = 0) then 
-    result := result + [exZeroDivide];
-  if ((getFPSCR and InexactMask) = 0) then 
-    result := result + [exPrecision];
-{$else not aix}
-  if not fp_is_enabled(InvalidOperationMask) then
-    result := result + [exInvalidOp];
-  if not fp_is_enabled(OverflowMask) then
-    result := result + [exOverflow];
-  if not fp_is_enabled(UnderflowMask) then
-    result := result + [exUnderflow];
-  if not fp_is_enabled(ZeroDivideMask) then
-    result := result + [exZeroDivide];
-  if not fp_is_enabled(InexactMask) then
-    result := result + [exPrecision];
-{$endif not aix}
-end;
-
-function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
-var
-  mode : DWord;
-begin
-  mode := 0;
-  softfloat_exception_mask := mask;
-  if (exInvalidOp in Mask) then
-    begin
-      mode := mode or InvalidOperationMask;
-    end;
-  if (exOverflow in Mask) then
-    begin
-      mode := mode or OverflowMask;
-    end;
-  if (exUnderflow in Mask) then
-    begin
-      mode := mode or UnderflowMask;
-    end;
-  if (exZeroDivide in Mask) then
-    begin
-      mode := mode or ZeroDivideMask;
-    end;
-  if (exPrecision in Mask) then
-    begin
-      mode := mode or InexactMask;
-    end;
-
-  setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
-  softfloat_exception_flags := [];
-  { also clear out pending exceptions on AIX }
-{$ifdef aix}
-  { clear pending exceptions }
-  feclearexcept(AllExceptionsMask);
-  { enable the exceptions that are not disabled }
-  fp_enable(mode xor AllExceptionsMask);
-  { and disable the rest }
-  fp_disable(mode);
-{$endif}
-  result := Mask - [exDenormalized];
-end;
-
-
-procedure ClearExceptions(RaisePending: Boolean = true);
-begin
-{$ifdef aix}
-  { clear pending exceptions }
-  feclearexcept(AllExceptionsMask);
-{$endif}
-  softfloat_exception_flags := [];
-  { RaisePending has no effect on PPC, always raises them at the correct location }
-  setFPSCR(getFPSCR and (not ExceptionsPendingMask));
-end;
-
+{$i ../ppcgen/ppcmathu.inc}

rtl/powerpc/powerpc.inc

@@ -30,61 +30,10 @@
 {****************************************************************************
                            PowerPC specific stuff
 ****************************************************************************}
-{
 
-const
-  ppc_fpu_overflow     = (1 shl (32-3));
-  ppc_fpu_underflow    = (1 shl (32-4));
-  ppc_fpu_divbyzero    = (1 shl (32-5));
-  ppc_fpu_inexact      = (1 shl (32-6));
-  ppc_fpu_invalid_snan = (1 shl (32-7));
-}
+{$i ../ppcgen/ppcfpuex.inc}
 
 {$ifndef FPUNONE}
-
-procedure fpc_enable_ppc_fpu_exceptions;
-assembler; nostackframe;
-asm
-  { clear all "exception happened" flags we care about}
-  mtfsfi 0,0
-  mtfsfi 1,0
-  mtfsfi 2,0
-  mtfsfi 3,0
-  mtfsb0 21
-  mtfsb0 22
-  mtfsb0 23
-
-  { enable invalid operations and division by zero exceptions. }
-  { No overflow/underflow, since those give some spurious      }
-  { exceptions                                                 }
-  mtfsfi 6,9
-end;
-
-procedure fpc_cpuinit;
-begin
-  { don't let libraries influence the FPU cw set by the host program }
-  if not IsLibrary then
-    fpc_enable_ppc_fpu_exceptions;
-end;
-
-
-function fpc_get_ppc_fpscr: cardinal;
-assembler;
-var
-  temp: record a,b:longint; end;
-asm
-  mffs f0
-  stfd f0,temp
-  lwz  r3,temp.b
-  { clear all exception flags }
-{
-  rlwinm r4,r3,0,16,31
-  stw  r4,temp.b
-  lfd  f0,temp
-  a_mtfsf f0
-}
-end;
-
 { This function is never called directly, it's a dummy to hold the register save/
   load subroutines
 }
@@ -215,13 +164,7 @@ _restfpr_31_l:  lwz     r0, 4(r11)
 end;
 {$endif MACOS}
 
-{$else}
-
-procedure fpc_cpuinit;
-begin
-end;
-
-{$endif}
+{$endif NOT FPUNONE}
 
 {****************************************************************************
                                 Move / Fill
@@ -1230,32 +1173,6 @@ asm
   mr     r3, r10
 end;
 
-{$IFDEF MORPHOS}
-{ this is only required for MorphOS }
-{$define FPC_SYSTEM_HAS_SYSINITFPU}
-procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-  var tmp: array[0..1] of dword;
-begin
-  asm
-     { setting fpu to round to nearest mode }
-     li r3,0
-     stw r3,8(r1)
-     stw r3,12(r1)
-     lfd f1,8(r1)
-     mtfsf 7,f1
-  end;
-  { powerpc might use softfloat code }
-  softfloat_exception_flags:=[];
-  softfloat_exception_mask:=[float_flag_underflow, float_flag_inexact, float_flag_denormal];
-end;
-
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-begin
-  softfloat_exception_flags:=[];
-end;
-{$ENDIF}
-
 {$ifndef FPC_SYSTEM_HAS_MEM_BARRIER}
 {$define FPC_SYSTEM_HAS_MEM_BARRIER}
 

rtl/powerpc64/cpuh.inc

@@ -13,3 +13,13 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+{$ifndef aix}
+  TNativeFPUControlWord = dword;
+{$else aix}
+  TNativeFPUControlWord = record
+    rndmode: word;
+    exceptionmask: byte;
+  end;
+{$endif}

rtl/powerpc64/mathu.inc

@@ -1,213 +1 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2005 by Thomas Schatzl
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-  RoundModeMask        = %00000011;
-  NonIEEEModeMask      = %00000100;
-
-  InvalidOperationMask = %10000000;
-  OverflowMask         = %01000000;
-  UnderflowMask        = %00100000;
-  ZeroDivideMask       = %00010000;
-  InexactMask          = %00001000;
-  AllExceptionsMask    = %11111000;
-  ExceptionsPendingMask = %11111111111111100000011100000000;
-
-  ExceptionMask        = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
-
-  AllConfigBits        = ExceptionMask or NonIEEEModeMask or RoundModeMask;
-
-function getFPSCR : DWord; assembler; nostackframe;
-asm
-  mffs f0
-  stfd f0, -16(r1)
-{$ifdef FPC_BIG_ENDIAN}
-  lwz r3, -12(r1)
-{$else}
-  lwz r3, -16(r1)
-{$endif}
-end;
-
-procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
-asm
-{$ifdef FPC_BIG_ENDIAN}
-  stw r3, -12(r1)
-{$else}
-  stw r3, -16(r1)
-{$endif}
-  lfd f0, -16(r1)
-  mtfsf 255, f0
-end;
-
-{$ifdef aix}
-const
-  FP_RND_RZ = 0;
-  FP_RND_RN = 1;
-  FP_RND_RP = 2;
-  FP_RND_RM = 3;
-
-function fp_is_enabled(Mask: DWord): boolean;cdecl;external;
-procedure fp_enable(Mask: DWord);cdecl;external;
-function feclearexcept(Mask: DWord):DWord;cdecl;external;
-procedure fp_disable(Mask: DWord);cdecl;external;
-function fp_read_rnd: word;cdecl;external;
-function fp_swap_rnd(RoundMode: word): word;cdecl;external;
-
-{$else aix}
-const
-  FP_RND_RZ = 1;
-  FP_RND_RN = 0;
-  FP_RND_RP = 2;
-  FP_RND_RM = 3;
-{$endif aix}
-
-function GetRoundMode: TFPURoundingMode;
-begin
-{$ifndef aix}
-  case (getFPSCR and RoundModeMask) of
-{$else not aix}
-  case fp_read_rnd of
-{$endif not aix}
-    FP_RND_RN : result := rmNearest;
-    FP_RND_RZ : result := rmTruncate;
-    FP_RND_RP : result := rmUp;
-    FP_RND_RM : result := rmDown;
-  end;
-end;
-
-function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
-var
-  mode : DWord;
-begin
-  softfloat_rounding_mode:=RoundMode;
-  case (RoundMode) of
-    rmNearest :
-      begin
-        mode := FP_RND_RN;
-      end;
-    rmTruncate :
-      begin
-        mode := FP_RND_RZ;
-      end;
-    rmUp :
-      begin
-        mode := FP_RND_RP;
-      end;
-    rmDown :
-      begin
-        mode := FP_RND_RM;
-      end;
-  end;
-  result := GetRoundMode;
-{$ifndef aix}
-  setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
-{$else not aix}
-  fp_swap_rnd(mode);
-{$endif not aix}
-end;
-
-
-function GetPrecisionMode: TFPUPrecisionMode;
-begin
-  result := pmDouble;
-end;
-
-function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
-begin
-  { nothing to do, not supported }
-  result := pmDouble;
-end;
-
-
-function GetExceptionMask: TFPUExceptionMask;
-begin
-  result := [];
-{$ifndef aix}
-  if ((getFPSCR and InvalidOperationMask) = 0) then
-    result := result + [exInvalidOp];
-  if ((getFPSCR and OverflowMask) = 0) then
-    result := result + [exOverflow];
-  if ((getFPSCR and UnderflowMask) = 0) then
-    result := result + [exUnderflow];
-  if ((getFPSCR and ZeroDivideMask) = 0) then
-    result := result + [exZeroDivide];
-  if ((getFPSCR and InexactMask) = 0) then
-    result := result + [exPrecision];
-{$else not aix}
-  if not fp_is_enabled(InvalidOperationMask) then
-    result := result + [exInvalidOp];
-  if not fp_is_enabled(OverflowMask) then
-    result := result + [exOverflow];
-  if not fp_is_enabled(UnderflowMask) then
-    result := result + [exUnderflow];
-  if not fp_is_enabled(ZeroDivideMask) then
-    result := result + [exZeroDivide];
-  if not fp_is_enabled(InexactMask) then
-    result := result + [exPrecision];
-{$endif not aix}
-end;
-
-function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
-var
-  mode : DWord;
-begin
-  mode := 0;
-  softfloat_exception_mask := mask;
-  if (exInvalidOp in Mask) then
-    begin
-      mode := mode or InvalidOperationMask;
-    end;
-  if (exOverflow in Mask) then
-    begin
-      mode := mode or OverflowMask;
-    end;
-  if (exUnderflow in Mask) then
-    begin
-      mode := mode or UnderflowMask;
-    end;
-  if (exZeroDivide in Mask) then
-    begin
-      mode := mode or ZeroDivideMask;
-    end;
-  if (exPrecision in Mask) then
-    begin
-      mode := mode or InexactMask;
-    end;
-
-  setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
-  softfloat_exception_flags := [];;
-  { also clear out pending exceptions on AIX }
-{$ifdef aix}
-  { clear pending exceptions }
-  feclearexcept(AllExceptionsMask);
-  { enable the exceptions that are not disabled }
-  fp_enable(mode xor AllExceptionsMask);
-  { and disable the rest }
-  fp_disable(mode);
-{$endif}
-  result := Mask - [exDenormalized];
-end;
-
-
-procedure ClearExceptions(RaisePending: Boolean = true);
-begin
-{$ifdef aix}
-  { clear pending exceptions }
-  feclearexcept(AllExceptionsMask);
-{$endif}
-  softfloat_exception_flags := [];
-  { RaisePending has no effect on PPC, always raises them at the correct location }
-  setFPSCR(getFPSCR and (not ExceptionsPendingMask));
-end;
-
+{$i ../ppcgen/ppcmathu.inc}

rtl/powerpc64/powerpc64.inc

@@ -21,32 +21,7 @@
                            PowerPC specific stuff
 ****************************************************************************}
 
-procedure fpc_enable_ppc_fpu_exceptions; assembler; nostackframe;
-asm
-  { clear all "exception happened" flags we care about}
-  mtfsfi 0,0
-  mtfsfi 1,0
-  mtfsfi 2,0
-  mtfsfi 3,0
-{$ifdef fpc_mtfsb0_corrected}
-  mtfsb0 21
-  mtfsb0 22
-  mtfsb0 23
-{$endif fpc_mtfsb0_corrected}
-
-  { enable invalid operations and division by zero exceptions. }
-  { No overflow/underflow, since those give some spurious      }
-  { exceptions                                                 }
-  mtfsfi 6,9
-end;
-
-
-procedure fpc_cpuinit;
-begin
-  { don't let libraries influence the FPU cw set by the host program }
-  if not IsLibrary then
-    fpc_enable_ppc_fpu_exceptions;
-end;
+{$i ../ppcgen/ppcfpuex.inc}
 
 {****************************************************************************
                                 Move / Fill
@@ -726,6 +701,7 @@ asm
   mr     r3, r10
 end;
 
+
 function InterLockedDecrement64(var Target: Int64) : Int64; assembler; nostackframe;
 { input:  address of target in r3 }
 { output: target-1 in r3          }

rtl/ppcgen/ppcfpuex.inc

@@ -0,0 +1,170 @@
+{$ifndef FPUNONE}
+
+const
+  InvalidOperationMask = %10000000;
+  OverflowMask         = %01000000;
+  UnderflowMask        = %00100000;
+  ZeroDivideMask       = %00010000;
+  InexactMask          = %00001000;
+
+{$ifndef aix}
+
+const
+  FP_RND_RZ = 1;
+  FP_RND_RN = 0;
+  FP_RND_RP = 2;
+  FP_RND_RM = 3;
+  FP_RND_SHIFT = 28;
+  FP_RND_MASK = 3;
+
+procedure fpc_setup_fpu;
+var
+  cw: TNativeFPUControlWord;
+begin
+  asm
+    { clear all "exception happened" flags we care about}
+    mtfsfi 0,0
+    mtfsfi 1,0
+    mtfsfi 2,0
+    mtfsfi 3,0
+    mtfsb0 21
+    mtfsb0 22
+    mtfsb0 23
+  end;
+  cw:=GetNativeFPUControlWord;
+  cw:=(cw and not(OverflowMask or UnderflowMask or InexactMask or (FP_RND_MASK shl FP_RND_SHIFT))) or InvalidOperationMask or ZeroDivideMask or (FP_RND_RN shl FP_RND_SHIFT);
+  SetNativeFPUControlWord(cw);
+end;
+
+
+function fpc_get_ppc_fpscr: TNativeFPUControlWord;
+assembler;
+var
+  temp: record a,b:longint; end;
+asm
+  mffs f0
+  stfd f0,temp
+  lwz  r3,temp.b
+end;
+
+procedure fpc_set_ppc_fpsrc(cw: TNativeFPUControlWord);
+var
+  cwtemp: qword;
+begin
+  DefaultFPUControlWord:=cw;
+  cwtemp:=cw;
+  asm
+    lfd f0, cwtemp
+    mtfsf 255, f0
+  end
+end;
+{$else aix}
+const
+  FP_RND_RZ = 0;
+  FP_RND_RN = 1;
+  FP_RND_RP = 2;
+  FP_RND_RM = 3;
+
+  FP_TRAP_SYNC         =  1;       { precise trapping on }
+  FP_TRAP_OFF          =  0;       { trapping off        }
+  FP_TRAP_QUERY        =  2;       { query trapping mode }
+  FP_TRAP_IMP          =  3;       { non-recoverable imprecise trapping on }
+  FP_TRAP_IMP_REC      =  4;       { recoverable imprecise trapping on }
+  FP_TRAP_FASTMODE     =  128;     { select fastest available mode }
+  FP_TRAP_ERROR        = -1;       { error condition }
+  FP_TRAP_UNIMPL       = -2;       { requested mode not available }
+
+function fp_is_enabled(Mask: DWord): boolean;cdecl;external;
+procedure fp_enable(Mask: DWord);cdecl;external;
+function feclearexcept(Mask: DWord):DWord;cdecl;external;
+procedure fp_disable(Mask: DWord);cdecl;external;
+function fp_read_rnd: word;cdecl;external;
+function fp_swap_rnd(RoundMode: word): word;cdecl;external;
+function fp_trap(flag: longint): longint;cdecl; external;
+
+procedure fpc_setup_fpu;
+var
+  cw: TNativeFPUControlWord;
+begin
+  feclearexcept(InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask);
+  if fp_trap(FP_TRAP_SYNC)<0 then
+    fp_trap(FP_TRAP_IMP_REC);
+  cw:=GetNativeFPUControlWord;
+  cw.rndmode:=FP_RND_RN;
+  cw.exceptionmask:=InvalidOperationMask or ZeroDivideMask;
+  SetNativeFPUControlWord(cw);
+end;
+
+
+function fpc_get_ppc_fpscr: TNativeFPUControlWord;
+begin
+  result.rndmode:=fp_read_rnd;
+  result.exceptionmask:=0;
+  if not fp_is_enabled(InvalidOperationMask) then
+    result.exceptionmask:=result.exceptionmask or InvalidOperationMask;
+  if not fp_is_enabled(OverflowMask) then
+    result.exceptionmask:=result.exceptionmask or OverflowMask;
+  if not fp_is_enabled(UnderflowMask) then
+    result.exceptionmask:=result.exceptionmask or UnderflowMask;
+  if not fp_is_enabled(InvalidOperationMask) then
+    result.exceptionmask:=result.exceptionmask or ZeroDivideMask;
+  if not fp_is_enabled(InexactMask) then
+    result.exceptionmask:=result.exceptionmask or InexactMask;
+end;
+
+
+procedure fpc_set_ppc_fpsrc(cw: TNativeFPUControlWord);
+var
+  enablemask, disablemask: dword;
+begin
+  fp_swap_rnd(cw.rndmode);
+  enablemask:=0;
+  disablemask:=0;
+  if (cw.exceptionmask and InvalidOperationMask)<>0 then
+    disablemask:=disablemask or InvalidOperationMask
+  else
+    enablemask:=enablemask or InvalidOperationMask;
+  if (cw.exceptionmask and OverflowMask)<>0 then
+    disablemask:=disablemask or OverflowMask
+  else
+    enablemask:=enablemask or OverflowMask;
+  if (cw.exceptionmask and UnderflowMask)<>0 then
+    disablemask:=disablemask or UnderflowMask
+  else
+    enablemask:=enablemask or UnderflowMask;
+  if (cw.exceptionmask and ZeroDivideMask)<>0 then
+    disablemask:=disablemask or ZeroDivideMask
+  else
+    enablemask:=enablemask or ZeroDivideMask;
+  if (cw.exceptionmask and InexactMask)<>0 then
+    disablemask:=disablemask or InexactMask
+  else
+    enablemask:=enablemask or InexactMask;
+  fp_enable(enablemask);
+  fp_disable(disablemask);
+  DefaultFPUControlWord:=cw;
+end;
+{$endif}
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=fpc_get_ppc_fpscr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    fpc_set_ppc_fpsrc(cw);
+  end;
+
+
+{$define FPC_SYSTEM_HAS_SYSINITFPU}
+procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  { powerpc might use softfloat code }
+  softfloat_exception_flags:=[];
+  softfloat_exception_mask:=[float_flag_underflow, float_flag_overflow, float_flag_inexact, float_flag_denormal];
+  fpc_setup_fpu;
+end;
+{$endif NOT FPU_NONE}

rtl/ppcgen/ppcmathu.inc

@@ -0,0 +1,186 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Thomas Schatzl
+    member of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+  RoundModeMask        = %00000011;
+  NonIEEEModeMask      = %00000100;
+
+  InvalidOperationMask = %10000000;
+  OverflowMask         = %01000000;
+  UnderflowMask        = %00100000;
+  ZeroDivideMask       = %00010000;
+  InexactMask          = %00001000;
+  AllExceptionsMask    = %11111000;
+  ExceptionsPendingMask = %11111111111111100000011100000000;
+
+  ExceptionMask        = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
+
+  AllConfigBits        = ExceptionMask or NonIEEEModeMask or RoundModeMask;
+
+{$ifdef aix}
+const
+  FP_RND_RZ = 0;
+  FP_RND_RN = 1;
+  FP_RND_RP = 2;
+  FP_RND_RM = 3;
+
+function feclearexcept(Mask: DWord):DWord;cdecl;external;
+
+{$else aix}
+const
+  FP_RND_RZ = 1;
+  FP_RND_RN = 0;
+  FP_RND_RP = 2;
+  FP_RND_RM = 3;
+{$endif aix}
+
+function GetRoundMode: TFPURoundingMode;
+begin
+{$ifndef aix}
+  case GetNativeFPUControlWord and RoundModeMask of
+{$else not aix}
+  case GetNativeFPUControlWord.rndmode of
+{$endif not aix}
+    FP_RND_RN : result := rmNearest;
+    FP_RND_RZ : result := rmTruncate;
+    FP_RND_RP : result := rmUp;
+    FP_RND_RM : result := rmDown;
+  end;
+end;
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+var
+  mode : DWord;
+  currentcw: TNativeFPUControlWord;
+begin
+  softfloat_rounding_mode:=RoundMode;
+  case (RoundMode) of
+    rmNearest :
+      begin
+        mode := FP_RND_RN;
+      end;
+    rmTruncate :
+      begin
+        mode := FP_RND_RZ;
+      end;
+    rmUp :
+      begin
+        mode := FP_RND_RP;
+      end;
+    rmDown :
+      begin
+        mode := FP_RND_RM;
+      end;
+  end;
+  result := GetRoundMode;
+  currentcw:=GetNativeFPUControlWord;
+{$ifndef aix}
+  SetNativeFPUControlWord((currentcw and (not RoundModeMask)) or mode);
+{$else not aix}
+  currentcw.rndmode:=mode;
+  SetNativeFPUControlWord(currentcw);
+{$endif not aix}
+end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+begin
+  result := pmDouble;
+end;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+begin
+  { nothing to do, not supported }
+  result := pmDouble;
+end;
+
+
+function GetExceptionMask: TFPUExceptionMask;
+var
+  currentExceptionMask: cardinal;
+begin
+  result := [];
+{$ifndef aix}
+  currentExceptionMask:=GetNativeFPUControlWord;
+{$else}
+  currentExceptionMask:=GetNativeFPUControlWord.exceptionmask;
+{$endif}
+  if ((currentExceptionMask and InvalidOperationMask) = 0) then
+    result := result + [exInvalidOp];
+  if ((currentExceptionMask and OverflowMask) = 0) then
+    result := result + [exOverflow];
+  if ((currentExceptionMask and UnderflowMask) = 0) then
+    result := result + [exUnderflow];
+  if ((currentExceptionMask and ZeroDivideMask) = 0) then
+    result := result + [exZeroDivide];
+  if ((currentExceptionMask and InexactMask) = 0) then
+    result := result + [exPrecision];
+end;
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+var
+  mode : DWord;
+  currentcw: TNativeFPUControlWord;
+begin
+  mode := 0;
+  softfloat_exception_mask := mask;
+  if (exInvalidOp in Mask) then
+    begin
+      mode := mode or InvalidOperationMask;
+    end;
+  if (exOverflow in Mask) then
+    begin
+      mode := mode or OverflowMask;
+    end;
+  if (exUnderflow in Mask) then
+    begin
+      mode := mode or UnderflowMask;
+    end;
+  if (exZeroDivide in Mask) then
+    begin
+      mode := mode or ZeroDivideMask;
+    end;
+  if (exPrecision in Mask) then
+    begin
+      mode := mode or InexactMask;
+    end;
+
+  softfloat_exception_flags := [];
+  currentcw:=GetNativeFPUControlWord;
+{$ifdef aix}
+  currentcw.exceptionmask:=mode;
+{$else}
+  currentcw:=(currentcw or ExceptionMask) and not mode and not ExceptionsPendingMask;
+{$endif}
+  SetNativeFPUControlWord(currentcw);
+  { also clear out pending exceptions on AIX }
+{$ifdef aix}
+  { clear pending exceptions }
+  feclearexcept(AllExceptionsMask);
+{$endif}
+  result := Mask - [exDenormalized];
+end;
+
+
+procedure ClearExceptions(RaisePending: Boolean = true);
+begin
+{$ifdef aix}
+  { clear pending exceptions }
+  feclearexcept(AllExceptionsMask);
+{$else}
+  { RaisePending has no effect on PPC, always raises them at the correct location }
+  SetNativeFPUControlWord(GetNativeFPUControlWord and (not ExceptionsPendingMask));
+{$endif}
+  softfloat_exception_flags := [];
+end;

rtl/riscv/riscv.inc

@@ -33,9 +33,46 @@ function getfflags: sizeuint; nostackframe; assembler;
   end;
 
 
-procedure setfflags(flags : sizeuint); nostackframe; assembler;
+procedure setfflags(flags : sizeuint);
+  begin
+    DefaultFPUControlWord.cw:=flags;
+    asm
+{$ifdef cpuriscv32}
+      lw a0, flags
+{$else}
+      ld a0, flags
+{$endif}
+      fsflags a0
+    end;
+  end;
+
+function getrm: dword; nostackframe; assembler;
   asm
-    fsflags a0
+    frrm a0
+  end;
+
+
+procedure setrm(val: dword);
+begin
+  DefaultFPUControlWord.cw:=val;
+  asm
+    lw a0, val
+    fsrm a0
+  end;
+end;
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result.cw:=getfflags;
+    result.rndmode:=getrm;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    setfflags(cw.cw);
+    setrm(cw.rndmode);
   end;
 
 
@@ -82,8 +119,3 @@ procedure fpc_throwfpuexception;[public,alias:'FPC_THROWFPUEXCEPTION'];
       RaisePendingExceptions;
   end;
 {$endif FPUFD}
-
-procedure fpc_cpuinit;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    softfloat_exception_mask:=[exPrecision,exUnderflow];
-  end;

rtl/riscv32/cpuh.inc

@@ -13,3 +13,13 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{$ifdef FPUFD}
+type
+  TNativeFPUControlWord = record
+    cw: sizeuint;
+    rndmode: dword;
+  end;
+{$else}
+  {$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+{$endif}

rtl/riscv32/riscv32.inc

@@ -79,3 +79,23 @@ function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint
     inc(Target,Source);
   end;
 
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifdef FPUFD}
+var
+  cw: TNativeFPUControlWord;
+{$endif}
+begin
+  softfloat_exception_flags:=[];
+  softfloat_exception_mask:=[exPrecision,exUnderflow];
+{$ifdef FPUFD}
+  cw:=GetNativeFPUControlWord;
+  { riscv does not support triggering exceptoins when FPU exceptions happen;
+    it merely records which exceptions have happened until now -> clear }
+  cw.cw:=0;
+  { round to nearest }
+  cw.rndmode:=0;
+  SetNativeFPUControlWord(cw);
+{$endif}
+end;
+

rtl/riscv64/cpuh.inc

@@ -13,3 +13,13 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{$ifdef FPUFD}
+type
+  TNativeFPUControlWord = record
+    cw: sizeuint;
+    rndmode: dword;
+  end;
+{$else}
+  {$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+{$endif}

rtl/riscv64/mathu.inc

@@ -13,45 +13,25 @@
 **********************************************************************}
 
 {$ifdef FPUFD}
-function getrm: dword; nostackframe; assembler;
-  asm
-    frrm a0
-  end;
-
-
-procedure setrm(val: dword); nostackframe; assembler;
-  asm
-    fsrm a0
-  end;
-
-
-function getfflags: dword; nostackframe; assembler;
-  asm
-    frflags a0
-  end;
-
-
-procedure setfflags(flags : dword); nostackframe; assembler;
-  asm
-    fsflags a0
-  end;
-
-
 function GetRoundMode: TFPURoundingMode;
   const
     bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmTruncate,rmDown,rmUp);
   begin
-    result:=TFPURoundingMode(bits2rm[getrm])
+    result:=TFPURoundingMode(bits2rm[GetNativeFPUControlWord.rndmode])
   end;
 
 
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   const
     rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
+  var
+    cw: TNativeFPUControlWord;
   begin
     softfloat_rounding_mode:=RoundMode;
     SetRoundMode:=GetRoundMode;
-    setrm(rm2bits[RoundMode]);
+    cw:=GetNativeFPUControlWord;
+    cw.rndmode:=rm2bits[RoundMode];
+    SetNativeFPUControlWord(cw);
   end;
 
 
@@ -94,7 +74,7 @@ procedure RaisePendingExceptions;
     fflags : dword;
     f: TFPUException;
   begin
-    fflags:=getfflags;
+    fflags:=GetNativeFPUControlWord.cw;
     if (fflags and fpu_dz) <> 0 then
       float_raise(exZeroDivide);
     if (fflags and fpu_of) <> 0 then
@@ -112,11 +92,15 @@ procedure RaisePendingExceptions;
 
 
 procedure ClearExceptions(RaisePending: Boolean);
+  var
+    cw: TNativeFPUControlWord;
   begin
     if raisepending then
       RaisePendingExceptions;
     softfloat_exception_flags:=[];
-    setfflags(0);
+    cw:=GetNativeFPUControlWord;
+    cw.cw:=0;
+    SetNativeFPUControlWord(cw);
   end;
 {$else}
 function GetRoundMode: TFPURoundingMode;

rtl/riscv64/riscv64.inc

@@ -252,3 +252,23 @@ procedure WriteBarrier; assembler; nostackframe;
   asm
     fence ow, ow
   end;
+
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifdef FPUFD}
+var
+  cw: TNativeFPUControlWord;
+{$endif}
+begin
+  softfloat_exception_flags:=[];
+  softfloat_exception_mask:=[exPrecision,exUnderflow];
+{$ifdef FPUFD}
+  cw:=GetNativeFPUControlWord;
+  { riscv does not support triggering exceptoins when FPU exceptions happen;
+    it merely records which exceptions have happened until now -> clear }
+  cw.cw:=0;
+  { round to nearest }
+  cw.rndmode:=0;
+  SetNativeFPUControlWord(cw);
+{$endif}
+end;

rtl/sparc/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TNativeFPUControlWord = dword;

rtl/sparc/mathu.inc

@@ -12,16 +12,11 @@
 
  **********************************************************************}
 
-{ exported by the system unit }
-function get_fsr : dword;external name 'FPC_GETFSR';
-procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
-
-
 function GetRoundMode: TFPURoundingMode;
   const
     bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmTruncate,rmUp,rmDown);
   begin
-    result:=TFPURoundingMode(bits2rm[(get_fsr shr 30) and 3])
+    result:=TFPURoundingMode(bits2rm[(GetNativeFPUControlWord shr 30) and 3])
   end;
 
 
@@ -29,12 +24,12 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   const
     rm2bits: array[TFPURoundingMode] of byte = (0,3,2,1);
   var
-    cw: dword;
+    cw: TNativeFPUControlWord;
   begin
-    cw:=get_fsr;
+    cw:=GetNativeFPUControlWord;
     softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
-    set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
+    SetNativeFPUControlWord((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
 
 function GetPrecisionMode: TFPUPrecisionMode;
@@ -49,7 +44,7 @@ function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode
   end;
 
 
-function FSR2ExceptionMask(fsr: dword): TFPUExceptionMask;
+function FSR2ExceptionMask(fsr: TNativeFPUControlWord): TFPUExceptionMask;
   begin
     result:=[];
     { invalid operation: bit 27 }
@@ -76,15 +71,15 @@ function FSR2ExceptionMask(fsr: dword): TFPUExceptionMask;
 
 function GetExceptionMask: TFPUExceptionMask;
   begin
-    result:=FSR2ExceptionMask(get_fsr);
+    result:=FSR2ExceptionMask(GetNativeFPUControlWord);
   end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
   var
-    fsr : dword;
+    fsr : TNativeFPUControlWord;
   begin
-    fsr:=get_fsr;
+    fsr:=GetNativeFPUControlWord;
     result:=FSR2ExceptionMask(fsr);
 
     { invalid operation: bit 27 }
@@ -118,12 +113,12 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       fsr:=fsr or (1 shl 23);
 
     { update control register contents }
-    set_fsr(fsr);
+    SetNativeFPUControlWord(fsr);
   end;
 
 
 procedure ClearExceptions(RaisePending: Boolean =true);
   begin
-    set_fsr(get_fsr and $fffffc1f);
+    SetNativeFPUControlWord(GetNativeFPUControlWord and $fffffc1f);
   end;
 

rtl/sparc/sparc.inc

@@ -29,13 +29,24 @@ function get_fsr : dword;assembler;[public, alias: 'FPC_GETFSR'];
   end;
 
 
-procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
-  var
-    _fsr : dword;
-  asm
-    // force memory location
-    st fsr,_fsr
-    ld _fsr,%fsr
+procedure set_fsr(fsr : dword);[public, alias: 'FPC_SETFSR'];
+  begin
+    DefaultFPUControlWord:=fsr;
+    asm
+      ld fsr,%fsr
+    end;
+  end;
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=get_fsr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    set_fsr(cw);
   end;
 
 
@@ -52,19 +63,8 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
     { enable div by 0 and invalid operation fpu exceptions
       round towards zero; ieee compliant arithmetics }
     set_fsr((get_fsr and $3fbfffff) or $09000000);
-  end;
-
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-  end;
-
-
-procedure fpc_cpuinit;
-  begin
-    SysResetFPU;
-    if not(IsLibrary) then
-      SysInitFPU;
+    softfloat_exception_mask:=[float_flag_underflow,float_flag_overflow,float_flag_inexact,float_flag_denormal];
+    softfloat_exception_flags:=[];
   end;
 
 

rtl/sparc64/cpuh.inc

@@ -16,3 +16,5 @@
  const
    STACK_BIAS = 2047;
 
+ type
+   TNativeFPUControlWord = dword;

rtl/sparc64/mathu.inc

@@ -12,15 +12,11 @@
 
  **********************************************************************}
 
-{ exported by the system unit }
-function get_fsr : dword;external name 'FPC_GETFSR';
-procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
-
 function GetRoundMode: TFPURoundingMode;
   const
     bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmTruncate,rmUp,rmDown);
   begin
-    result:=TFPURoundingMode(bits2rm[(get_fsr shr 30) and 3])
+    result:=TFPURoundingMode(bits2rm[(GetNativeFPUControlWord shr 30) and 3])
   end;
 
 
@@ -28,12 +24,12 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   const
     rm2bits: array[TFPURoundingMode] of byte = (0,3,2,1);
   var
-    cw: dword;
+    cw: TNativeFPUControlWord;
   begin
-    cw:=get_fsr;
+    cw:=GetNativeFPUControlWord;
     softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
-    set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
+    SetNativeFPUControlWord((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
 
 
@@ -49,7 +45,7 @@ function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode
   end;
 
 
-function FSR2ExceptionMask(fsr: dword): TFPUExceptionMask;
+function FSR2ExceptionMask(fsr: TNativeFPUControlWord): TFPUExceptionMask;
   begin
     result:=[];
     { invalid operation: bit 27 }
@@ -76,15 +72,15 @@ function FSR2ExceptionMask(fsr: dword): TFPUExceptionMask;
 
 function GetExceptionMask: TFPUExceptionMask;
   begin
-    result:=FSR2ExceptionMask(get_fsr);
+    result:=FSR2ExceptionMask(GetNativeFPUControlWord);
   end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
   var
-    fsr : dword;
+    fsr : TNativeFPUControlWord;
   begin
-    fsr:=get_fsr;
+    fsr:=GetNativeFPUControlWord;
     result:=FSR2ExceptionMask(fsr);
 
     { invalid operation: bit 27 }
@@ -118,12 +114,12 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       fsr:=fsr or (1 shl 23);
 
     { update control register contents }
-    set_fsr(fsr);
+    SetNativeFPUControlWord(fsr);
   end;
 
 
 procedure ClearExceptions(RaisePending: Boolean =true);
   begin
-    set_fsr(get_fsr and $fffffc1f);
+    SetNativeFPUControlWord(GetNativeFPUControlWord and $fffffc1f);
   end;
 

rtl/sparc64/sparc64.inc

@@ -29,13 +29,24 @@ function get_fsr : dword;assembler;[public, alias: 'FPC_GETFSR'];
   end;
 
 
-procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
-  var
-    _fsr : dword;
-  asm
-    // force memory location
-    st fsr,_fsr
-    ld _fsr,%fsr
+procedure set_fsr(fsr : dword);[public, alias: 'FPC_SETFSR'];
+  begin
+    DefaultFPUControlWord:=fsr;
+    asm
+      ld fsr,%fsr
+    end;
+  end;
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    result:=get_fsr;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+  begin
+    set_fsr(cw);
   end;
 
 
@@ -52,19 +63,8 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
     { enable div by 0 and invalid operation fpu exceptions
       round towards zero; ieee compliant arithmetics }
     set_fsr((get_fsr and $3fbfffff) or $09000000);
-  end;
-
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-  end;
-
-
-procedure fpc_cpuinit;
-  begin
-    SysResetFPU;
-    if not(IsLibrary) then
-      SysInitFPU;
+    softfloat_exception_mask:=[float_flag_overflow,float_flag_underflow,float_flag_inexact,float_flag_denormal];
+    softfloat_exception_flags:=[];
   end;
 
 

rtl/wasm32/cpuh.inc

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+{$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+
 const
   {$I cpuinnr.inc}
 

rtl/wasm32/wasm32.inc

@@ -19,6 +19,7 @@
 procedure fpc_wasm32_init_tls(memory: Pointer);external name '__wasm_init_tls';
 {$endif FPC_WASM_THREADS}
 
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;
   begin
   end;

rtl/x86_64/cpuh.inc

@@ -37,3 +37,9 @@ function fpc_x86_get_gs:longint;[internproc:fpc_in_x86_get_gs];
 { do not active yet, they are not usable yet neither is the naming fixed }
 { $i cpummprocs.inc}
 {$endif not VER3_0 and not VER3_2}
+
+type
+  TNativeFPUControlWord = record
+    cw8087: word;
+    MXCSR: dword;
+  end;

rtl/x86_64/math.inc

@@ -95,10 +95,24 @@ const
       end;
 
 
-    procedure SetSSECSR(w : dword);
-      begin
-        SetMXCSR(w);
-      end;
+      function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
+        begin
+          result.cw8087:=Get8087CW;
+          result.MXCSR:=GetMXCSR
+        end;
+
+
+      procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
+        begin
+          Set8087CW(cw.cw8087);
+          SetMXCSR(cw.MXCSR);
+        end;
+
+
+      procedure SetSSECSR(w : dword);
+        begin
+          SetMXCSR(w);
+        end;
 
 
     function GetSSECSR: dword;

rtl/x86_64/x86_64.inc

@@ -962,6 +962,7 @@ const
   MM_MaskUnderflow = %0000100000000000;
   MM_MaskPrecision = %0001000000000000;
 
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;
   begin
     { don't let libraries influence the FPU cw set by the host program }

rtl/xtensa/cpuh.inc

@@ -13,3 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{ no hardware fpu }
+{$define FPC_SYSTEM_FPUCW_IMMUTABLE}

rtl/xtensa/xtensa.inc

@@ -17,18 +17,14 @@
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
+  softfloat_exception_flags:=[];
 end;
 
 {$define FPC_SYSTEM_HAS_SYSINITFPU}
 Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
-end;
-
-procedure fpc_cpuinit;
-begin
-  { don't let libraries influence the FPU cw set by the host program }
-  if not IsLibrary then
-    SysInitFPU;
+  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
+  softfloat_exception_flags:=[];
 end;
 
 {$ifdef fpc_abi_windowed}

rtl/z80/cpuh.inc

@@ -14,6 +14,10 @@
 
  **********************************************************************}
 
+{$ifndef FPUNONE}
+{$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+{$endif}
+
 const
   {$I cpuinnr.inc}
 

rtl/z80/z80.inc

@@ -19,6 +19,7 @@
 var
   z80_save_hl: Word; public name 'FPC_Z80_SAVE_HL';
 
+{$define FPC_SYSTEM_HAS_FPC_CPUINIT}
 procedure fpc_cpuinit;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
   end;

tests/webtbs/tw38230.pp

@@ -0,0 +1,84 @@
+{$mode objfpc}
+
+uses
+  {$ifdef unix}cthreads,{$endif} math, classes;
+
+type
+  tmythread = class(tthread)
+    constructor create; reintroduce;
+    procedure execute; override;
+  end;
+
+  tmychildthread = class(tmythread)
+    procedure execute; override;
+  end;
+
+var
+  e: TFPUException;
+  expectedfpumask: tfpuexceptionmask;
+
+constructor tmythread.create;
+  begin
+    inherited create(true);
+  end;
+
+procedure tmythread.execute;
+  var
+    e: TFPUException;
+  begin
+    write('thread: ');
+    for e in GetExceptionMask do
+      write(e,', ');
+    writeln;
+    if GetExceptionMask<>expectedfpumask then
+      begin
+        writeln(hexstr(cardinal(GetExceptionMask),8));
+        writeln(hexstr(cardinal(expectedfpumask),8));
+        halt(1);
+      end;
+    with tmychildthread.create do
+      begin
+        start;
+        waitfor;
+        free;
+        SetExceptionMask([ExDenormalized]);
+        // in case custom masks are not supported, get the actual new mask
+        expectedfpumask:=GetExceptionMask;
+        write('after setting ExDenormalized mask: ');
+        for e in expectedfpumask do
+          write(e,', ');
+        writeln;
+      end;
+  end;
+
+procedure tmychildthread.execute;
+  var
+    e: TFPUException;
+  begin
+    write('child thread: ');
+    for e in GetExceptionMask do
+      write(e,', ');
+    writeln;
+    if GetExceptionMask<>expectedfpumask then
+      halt(2);
+  end;
+
+begin
+    write('main: ');
+    for e in GetExceptionMask do
+      write(e,', ');
+    writeln;
+  expectedfpumask:=GetExceptionMask;
+  with tmythread.create do
+    begin
+      start;
+      waitfor;
+      free;
+    end;
+  with tmythread.create do
+    begin
+      start;
+      waitfor;
+      free;
+    end;
+end.