+ FPU controll routines in math unit

rtl/sparc/mathu.inc

@@ -12,9 +12,117 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{ 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;
+  begin
+    result:=TFPURoundingMode(get_fsr shr 30);
+  end;
+
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+  begin
+    set_fsr((get_fsr and $3fffffff) or (dword(RoundMode) shl 30));
+    result:=TFPURoundingMode(get_fsr shr 30);
+  end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+  begin
+    result:=pmDouble;
+  end;
+  
+  
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+  begin
+    result:=pmDouble;
+  end;
+  
+  
+function GetExceptionMask: TFPUExceptionMask;
+  var
+    fsr : dword;
+  begin
+    fsr:=get_fsr;
+    result:=[];
+    { invalid operation: bit 27 }
+    if (fsr and (1 shl 27))=0 then
+      include(result,exInvalidOp);
+
+    { zero divide: bit 24 }
+    if (fsr and (1 shl 24))=0 then
+      include(result,exInvalidOp);
+
+    { overflow: bit 26 }
+    if (fsr and (1 shl 26))=0 then
+      include(result,exInvalidOp);
+
+    { underflow: bit 25 }
+    if (fsr and (1 shl 25))=0 then
+      include(result,exUnderflow);
+
+    { Precision (inexact result): bit 23 }
+    if (fsr and (1 shl 23))=0 then
+      include(result,exPrecision);
+  end;
+    
+
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+  var
+    fsr : dword;
+  begin
+    fsr:=get_fsr;
+    
+    { 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 }
+    set_fsr(fsr);
+  end;
+  
+
+procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
+  begin
+    set_fsr(get_fsr and $fffffc1f);
+  end;
+
 {
   $Log$
-  Revision 1.1  2003-09-01 20:46:32  peter
+  Revision 1.2  2005-02-13 18:58:27  florian
+    + FPU controll routines in math unit
+
+  Revision 1.1  2003/09/01 20:46:32  peter
     * new dummies
 
   Revision 1.1  2003/04/24 09:14:22  florian

rtl/sparc/mathuh.inc

@@ -12,9 +12,28 @@
     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 {$ifndef VER1_0}=true{$endif});
+
 {
   $Log$
-  Revision 1.1  2003-09-01 20:46:32  peter
+  Revision 1.2  2005-02-13 18:58:27  florian
+    + FPU controll routines in math unit
+
+  Revision 1.1  2003/09/01 20:46:32  peter
     * new dummies
 
   Revision 1.1  2003/04/24 09:14:22  florian

rtl/sparc/sparc.inc

@@ -20,7 +20,7 @@
 {****************************************************************************
                            SPARC specific stuff
 ****************************************************************************}
-function get_fsr : dword;assembler;nostackframe;
+function get_fsr : dword;assembler;nostackframe;[public, alias: 'FPC_GETFSR'];
   var
     fsr : dword;
   asm
@@ -29,14 +29,7 @@ function get_fsr : dword;assembler;nostackframe;
   end;
 
 
-function get_got : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT'];
-  asm
-    retl
-    add %o7,%l7,%l7
-  end;
-
-
-procedure set_fsr(fsr : dword);assembler;
+procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
   var
     _fsr : dword;
   asm
@@ -46,6 +39,13 @@ procedure set_fsr(fsr : dword);assembler;
   end;
 
 
+function get_got : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT'];
+  asm
+    retl
+    add %o7,%l7,%l7
+  end;
+
+
 procedure fpc_cpuinit;
   begin
     { enable div by 0 and invalid operation fpu exceptions }
@@ -362,7 +362,10 @@ end;
 
 {
   $Log$
-  Revision 1.19  2005-02-07 22:17:48  peter
+  Revision 1.20  2005-02-13 18:58:27  florian
+    + FPU controll routines in math unit
+
+  Revision 1.19  2005/02/07 22:17:48  peter
     * add $ifdef for move
 
   Revision 1.18  2005/01/27 21:26:39  florian