* ppc32: added FPU configuration code in math unit (fixes tw3161)

git-svn-id: trunk@1787 -

rtl/powerpc/mathu.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
+    Copyright (c) 2005 by Thomas Schatzl
     member of the Free Pascal development team
 
     See the file COPYING.FPC, included in this distribution,
@@ -11,3 +11,110 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+const
+  RoundModeMask        = %00000011;
+  NonIEEEModeMask      = %00000100;
+
+  InvalidOperationMask = %10000000;
+  OverflowMask         = %01000000;
+  UnderflowMask        = %00100000;
+  ZeroDivideMask       = %00010000;
+  InexactMask          = %00001000;
+
+  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, -8(r1)
+  lwz r3, -12(r1)
+end;
+
+procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
+asm
+  stw r3, -12(r1)
+  lfd f0, -8(r1)
+  mtfsf 255, f0
+end;
+
+function GetRoundMode: TFPURoundingMode;
+begin
+  case (getFPSCR and RoundModeMask) of
+    0 : result := rmNearest;
+    1 : result := rmTruncate;
+    2 : result := rmUp;
+    3 : result := rmDown;
+  end;
+end;
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+var
+  mode : DWord;
+begin
+  case (RoundMode) of
+    rmNearest : mode := 0;
+    rmTruncate : mode := 1;
+    rmUp : mode := 2;
+    rmDown : mode := 3;
+  end;
+  setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
+  result := RoundMode;
+end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+begin
+  result := pmDouble;
+end;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+begin
+  { nothing to do, not supported }
+end;
+
+
+function GetExceptionMask: TFPUExceptionMask;
+begin
+  result := [];
+  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];
+end;
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+var
+  mode : DWord;
+begin
+  mode := 0;
+  if (exInvalidOp in Mask) then
+    mode := mode or InvalidOperationMask;
+  if (exOverflow in Mask) then
+    mode := mode or OverflowMask;
+  if (exUnderflow in Mask) then
+    mode := mode or UnderflowMask;
+  if (exZeroDivide in Mask) then
+    mode := mode or ZeroDivideMask;
+  if (exPrecision in Mask) then
+    mode := mode or InexactMask;
+  
+  setFPSCR((getFPSCR and (not ExceptionMask)) or mode);
+  result := Mask - [exDenormalized];
+end;
+
+
+procedure ClearExceptions(RaisePending: Boolean = true);
+begin
+  { RaisePending has no effect on PPC, always raises them at the correct location }
+  setFPSCR(getFPSCR and (not AllConfigBits));
+end;
+

rtl/powerpc/mathuh.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
+    Copyright (c) 1999-2005 by Florian Klaempfl
     member of the Free Pascal development team
 
     See the file COPYING.FPC, included in this distribution,
@@ -11,3 +11,23 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+type
+  TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
+  TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
+  TFPUException = (
+    exInvalidOp, exDenormalized, exZeroDivide,
+    exOverflow, exUnderflow, exPrecision);
+  TFPUExceptionMask = set of TFPUException;
+
+function GetRoundMode: TFPURoundingMode;
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+
+function GetPrecisionMode: TFPUPrecisionMode;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+function GetExceptionMask: TFPUExceptionMask;
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+
+procedure ClearExceptions(RaisePending: Boolean = true);
+