2
0
Эх сурвалжийг харах

* Set softfloat_rounding_mode indise SetRoundMode function for all CPUs.
* SetRoundMode returns previous rounding mode value for all CPUs.

git-svn-id: trunk@48018 -

pierre 4 жил өмнө
parent
commit
3362abb30c

+ 1 - 1
rtl/aarch64/mathu.inc

@@ -51,7 +51,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
     rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
   begin
   begin
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
-    SetRoundMode:=RoundMode;
+    SetRoundMode:=GetRoundMode;
     setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
     setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
   end;
   end;
 
 

+ 2 - 1
rtl/arm/mathu.inc

@@ -62,9 +62,10 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   c: dword;
   c: dword;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
+  Reslut:=GetRoundMode;
   c:=Ord(RoundMode) shl 16;
   c:=Ord(RoundMode) shl 16;
   c:=_controlfp(c, _MCW_RC);
   c:=_controlfp(c, _MCW_RC);
-  Result:=TFPURoundingMode((c shr 16) and 3);
 end;
 end;
 
 
 function GetPrecisionMode: TFPUPrecisionMode;
 function GetPrecisionMode: TFPUPrecisionMode;

+ 1 - 0
rtl/i386/mathu.inc

@@ -147,6 +147,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   CtlWord: Word;
   CtlWord: Word;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
   CtlWord := Get8087CW;
   CtlWord := Get8087CW;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   if has_sse_support then
   if has_sse_support then

+ 1 - 0
rtl/i8086/mathu.inc

@@ -155,6 +155,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   CtlWord: Word;
   CtlWord: Word;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
   CtlWord := Get8087CW;
   CtlWord := Get8087CW;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
 {  if has_sse_support then
 {  if has_sse_support then

+ 1 - 1
rtl/m68k/mathu.inc

@@ -137,10 +137,10 @@ const
 var
 var
   FPCR: DWord;
   FPCR: DWord;
 begin
 begin
+  Result:=GetRoundMode;
   FPCR:=GetFPCR and not FPU68K_ROUND_MASK;
   FPCR:=GetFPCR and not FPU68K_ROUND_MASK;
   SetFPCR(FPCR or FPCToFPURoundingMode[RoundMode]);
   SetFPCR(FPCR or FPCToFPURoundingMode[RoundMode]);
   softfloat_rounding_mode:=RoundMode;
   softfloat_rounding_mode:=RoundMode;
-  Result:=RoundMode;
 end;
 end;
 
 
 function GetPrecisionMode: TFPUPrecisionMode;
 function GetPrecisionMode: TFPUPrecisionMode;

+ 1 - 0
rtl/mips/mathu.inc

@@ -62,6 +62,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
   begin
     fsr:=get_fsr;
     fsr:=get_fsr;
     result:=fsr2roundmode[fsr and fpu_rounding_mask];
     result:=fsr2roundmode[fsr and fpu_rounding_mask];
+    softfloat_rounding_mode:=RoundMode;
     set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
     set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
   end;
   end;
 
 

+ 1 - 1
rtl/powerpc/mathu.inc

@@ -101,12 +101,12 @@ begin
         mode := FP_RND_RM;
         mode := FP_RND_RM;
       end;
       end;
   end;
   end;
+  result := GetRoundMode;
 {$ifndef aix}
 {$ifndef aix}
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
 {$else not aix}
 {$else not aix}
   fp_swap_rnd(mode);
   fp_swap_rnd(mode);
 {$endif not aix}
 {$endif not aix}
-  result := RoundMode;
 end;
 end;
 
 
 
 

+ 1 - 1
rtl/powerpc64/mathu.inc

@@ -109,12 +109,12 @@ begin
         mode := FP_RND_RM;
         mode := FP_RND_RM;
       end;
       end;
   end;
   end;
+  result := GetRoundMode;
 {$ifndef aix}
 {$ifndef aix}
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
 {$else not aix}
 {$else not aix}
   fp_swap_rnd(mode);
   fp_swap_rnd(mode);
 {$endif not aix}
 {$endif not aix}
-  result := RoundMode;
 end;
 end;
 
 
 
 

+ 1 - 1
rtl/riscv64/mathu.inc

@@ -50,7 +50,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
     rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
   begin
   begin
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
-    SetRoundMode:=RoundMode;
+    SetRoundMode:=GetRoundMode;
     setrm(rm2bits[RoundMode]);
     setrm(rm2bits[RoundMode]);
   end;
   end;
 
 

+ 1 - 0
rtl/sparc/mathu.inc

@@ -32,6 +32,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     cw: dword;
     cw: dword;
   begin
   begin
     cw:=get_fsr;
     cw:=get_fsr;
+    softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
     result:=TFPURoundingMode(cw shr 30);
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
   end;

+ 1 - 0
rtl/sparc64/mathu.inc

@@ -31,6 +31,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     cw: dword;
     cw: dword;
   begin
   begin
     cw:=get_fsr;
     cw:=get_fsr;
+    softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
     result:=TFPURoundingMode(cw shr 30);
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
   end;

+ 1 - 0
rtl/x86_64/mathu.inc

@@ -201,6 +201,7 @@ var
 begin
 begin
   CtlWord:=Get8087CW;
   CtlWord:=Get8087CW;
   SSECSR:=GetMXCSR;
   SSECSR:=GetMXCSR;
+  softfloat_rounding_mode:=RoundMode;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
   SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 {$ifdef FPC_HAS_TYPE_EXTENDED}

+ 1 - 0
rtl/xtensa/mathu.inc

@@ -20,6 +20,7 @@ function GetRoundMode: TFPURoundingMode;
 
 
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
   begin
+    SetRoundMode:=softfloat_rounding_mode;
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
   end;
   end;
 
 

+ 15 - 2
tests/test/units/math/trndcurr.pp

@@ -1,13 +1,20 @@
 uses
 uses
   Math;
   Math;
 
 
+
+const
+  failure_count : longint = 0;
+  first_error : longint = 0;
+
 {$ifndef SKIP_CURRENCY_TEST}
 {$ifndef SKIP_CURRENCY_TEST}
 procedure testround(const c, expected: currency; error: longint);
 procedure testround(const c, expected: currency; error: longint);
 begin
 begin
   if round(c)<>expected then
   if round(c)<>expected then
     begin
     begin
       writeln('round(',c,') = ',round(c),' instead of ', expected);
       writeln('round(',c,') = ',round(c),' instead of ', expected);
-      halt(error);
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=error;
     end;
     end;
 end;
 end;
 
 
@@ -31,7 +38,11 @@ begin
   testround(-1.4,-1.0,154);
   testround(-1.4,-1.0,154);
 
 
   writeln('Rounding mode: rmUp');
   writeln('Rounding mode: rmUp');
-  SetRoundMode(rmUp);
+  if SetRoundMode(rmUp)<>rmNearest then
+    writeln('Warning: previous mode was not rmNearest');
+  if GetRoundMode <> rmUp then
+    begin
+    end;
   testround(0.5,1.0,5);
   testround(0.5,1.0,5);
   testround(1.5,2.0,6);
   testround(1.5,2.0,6);
   testround(-0.5,0.0,7);
   testround(-0.5,0.0,7);
@@ -75,4 +86,6 @@ begin
   testround(-0.4,0.0,165);
   testround(-0.4,0.0,165);
   testround(-1.4,-1.0,166);
   testround(-1.4,-1.0,166);
 {$endif}
 {$endif}
+  if failure_count>0 then
+    halt(first_error);
 end.
 end.