Browse Source

+ moved cpu dependend code to mathuh.inc and mathu.inc

florian 22 years ago
parent
commit
75fc66fdd4
1 changed files with 55 additions and 73 deletions
  1. 55 73
      rtl/objpas/math.pp

+ 55 - 73
rtl/objpas/math.pp

@@ -27,19 +27,31 @@ unit math;
 interface
 interface
 
 
 {$MODE objfpc}
 {$MODE objfpc}
+{$ifdef VER1_0}
+  { we don't assume cross compiling from 1.0.x-m68k ... }
+  {$define FPC_HAS_TYPE_EXTENDED}
+{$endif VER1_0}
 
 
     uses
     uses
        sysutils;
        sysutils;
 
 
     const { Ranges of the IEEE floating point types, including denormals }
     const { Ranges of the IEEE floating point types, including denormals }
+{$ifdef FPC_HAS_TYPE_SINGLE}
       MinSingle    =  1.5e-45;
       MinSingle    =  1.5e-45;
       MaxSingle    =  3.4e+38;
       MaxSingle    =  3.4e+38;
+{$endif FPC_HAS_TYPE_SINGLE}
+{$ifdef FPC_HAS_TYPE_DOUBLE}
       MinDouble    =  5.0e-324;
       MinDouble    =  5.0e-324;
       MaxDouble    =  1.7e+308;
       MaxDouble    =  1.7e+308;
+{$endif FPC_HAS_TYPE_DOUBLE}
+{$ifdef FPC_HAS_TYPE_EXTENDED}
       MinExtended  =  3.4e-4932;
       MinExtended  =  3.4e-4932;
       MaxExtended  =  1.1e+4932;
       MaxExtended  =  1.1e+4932;
+{$endif FPC_HAS_TYPE_EXTENDED}
+{$ifdef FPC_HAS_TYPE_COMP}
       MinComp      = -9.223372036854775807e+18;
       MinComp      = -9.223372036854775807e+18;
       MaxComp      =  9.223372036854775807e+18;
       MaxComp      =  9.223372036854775807e+18;
+{$endif FPC_HAS_TYPE_COMP}
 
 
     type
     type
        { the original delphi functions use extended as argument, }
        { the original delphi functions use extended as argument, }
@@ -47,7 +59,41 @@ interface
        { natural size for the processor                          }
        { natural size for the processor                          }
        { WARNING : changing float type will                      }
        { WARNING : changing float type will                      }
        { break all assembler code  PM                            }
        { break all assembler code  PM                            }
-       float = extended;
+{$ifdef FPC_HAS_TYPE_FLOAT128}
+         float = float128;
+
+      const
+         MinFloat = MinFloat128;
+         MaxFloat = MaxFloat128;
+{$else FPC_HAS_TYPE_FLOAT128}
+  {$ifdef FPC_HAS_TYPE_EXTENDED}
+         float = extended;
+
+      const
+         MinFloat = MinExtended;
+         MaxFloat = MaxExtended;
+  {$else FPC_HAS_TYPE_EXTENDED}
+    {$ifdef FPC_HAS_TYPE_DOUBLE}
+         float = double;
+
+      const
+         MinFloat = MinDouble;
+         MaxFloat = MaxDouble;
+    {$else FPC_HAS_TYPE_DOUBLE}
+      {$ifdef FPC_HAS_TYPE_SINGLE}
+         float = single;
+
+      const
+         MinFloat = MinSingle;
+         MaxFloat = MaxSingle;
+      {$else FPC_HAS_TYPE_SINGLE}
+        {$error At least one floating point type must be supported}
+      {$endif FPC_HAS_TYPE_SINGLE}
+    {$endif FPC_HAS_TYPE_DOUBLE}
+  {$endif FPC_HAS_TYPE_EXTENDED}
+{$endif FPC_HAS_TYPE_FLOAT128}
+
+    type
        PFloat = ^Float;
        PFloat = ^Float;
        PInteger = ^Integer;
        PInteger = ^Integer;
 
 
@@ -210,23 +256,8 @@ procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
 function norm(const data : array of float) : float;
 function norm(const data : array of float) : float;
 function norm(const data : PFloat; Const N : Integer) : float;
 function norm(const data : PFloat; Const N : Integer) : float;
 
 
-{ i386 fpu control word }
-{$ifdef cpui386}
-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});
-{$endif cpui386}
+{ include cpu specific stuff }
+{$i mathuh.inc}
 
 
 implementation
 implementation
 
 
@@ -950,65 +981,16 @@ begin
     Result := b;
     Result := b;
 end;
 end;
 
 
-{$ifdef cpui386}
-
-function GetRoundMode: TFPURoundingMode;
-begin
-  Result := TFPURoundingMode((Get8087CW shr 10) and 3);
-end;
-
-function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
-var
-  CtlWord: Word;
-begin
-  CtlWord := Get8087CW;
-  Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
-  Result := TFPURoundingMode((CtlWord shr 10) and 3);
-end;
-
-function GetPrecisionMode: TFPUPrecisionMode;
-begin
-  Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
-end;
-
-function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
-var
-  CtlWord: Word;
-begin
-  CtlWord := Get8087CW;
-  Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
-  Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
-end;
-
-function GetExceptionMask: TFPUExceptionMask;
-begin
-  Result := TFPUExceptionMask(Get8087CW and $3F);
-end;
-
-function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
-var
-  CtlWord: Word;
-begin
-  CtlWord := Get8087CW;
-  Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
-  Result := TFPUExceptionMask(CtlWord and $3F);
-end;
-
-procedure ClearExceptions(RaisePending: Boolean);assembler;
-asm
-  cmpb $0,RaisePending
-  je .Lclear
-  fwait
-.Lclear:
-  fnclex
-end;
-
-{$endif cpui386}
+{ include cpu specific stuff }
+{$i mathu.inc}
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.9  2003-01-03 20:34:02  peter
+  Revision 1.10  2003-04-24 09:21:59  florian
+    + moved cpu dependend code to mathuh.inc and mathu.inc
+
+  Revision 1.9  2003/01/03 20:34:02  peter
     * i386 fpu controlword functions added
     * i386 fpu controlword functions added
 
 
   Revision 1.8  2002/09/07 21:06:12  carl
   Revision 1.8  2002/09/07 21:06:12  carl