src/cpfront/generic/System/Mod/SMath.cp

   1 MODULE SMath;
   2
   3   IMPORT SYSTEM;
   4
   5   VAR
   6     eps, e: SHORTREAL;
   7
   8   PROCEDURE [code] IncludeMATH "#include <math.h>";
   9   PROCEDURE [code] M_PI (): SHORTREAL "M_PI";
  10   PROCEDURE [code] sqrtf (x: SHORTREAL): SHORTREAL "sqrtf(x)";
  11   PROCEDURE [code] expf (x: SHORTREAL): SHORTREAL "expf(x)";
  12   PROCEDURE [code] logf (x: SHORTREAL): SHORTREAL "logf(x)";
  13   PROCEDURE [code] log10f (x: SHORTREAL): SHORTREAL "log10f(x)";
  14   PROCEDURE [code] powf (x, y: SHORTREAL): SHORTREAL "powf(x, y)";
  15   PROCEDURE [code] sinf (x: SHORTREAL): SHORTREAL "sinf(x)";
  16   PROCEDURE [code] cosf (x: SHORTREAL): SHORTREAL "cosf(x)";
  17   PROCEDURE [code] tanf (x: SHORTREAL): SHORTREAL "tanf(x)";
  18   PROCEDURE [code] asinf (x: SHORTREAL): SHORTREAL "asinf(x)";
  19   PROCEDURE [code] acosf (x: SHORTREAL): SHORTREAL "acosf(x)";
  20   PROCEDURE [code] atanf (x: SHORTREAL): SHORTREAL "atanf(x)";
  21   PROCEDURE [code] atan2f (y, x: SHORTREAL): SHORTREAL "atan2f(y, x)";
  22   PROCEDURE [code] sinhf (x: SHORTREAL): SHORTREAL "sinhf(x)";
  23   PROCEDURE [code] coshf (x: SHORTREAL): SHORTREAL "coshf(x)";
  24   PROCEDURE [code] tanhf (x: SHORTREAL): SHORTREAL "tanhf(x)";
  25   PROCEDURE [code] asinhf (x: SHORTREAL): SHORTREAL "asinhf(x)";
  26   PROCEDURE [code] acoshf (x: SHORTREAL): SHORTREAL "acoshf(x)";
  27   PROCEDURE [code] atanhf (x: SHORTREAL): SHORTREAL "atanhf(x)";
  28   PROCEDURE [code] floorf (x: SHORTREAL): SHORTREAL "floorf(x)";
  29   PROCEDURE [code] ceilf (x: SHORTREAL): SHORTREAL "ceilf(x)";
  30   PROCEDURE [code] roundf (x: SHORTREAL): SHORTREAL "roundf(x)";
  31   PROCEDURE [code] truncf (x: SHORTREAL): SHORTREAL "truncf(x)";
  32   PROCEDURE [code] copysignf (x, y: SHORTREAL): SHORTREAL "copysignf(x, y)";
  33   PROCEDURE [code] frexpf (x: SHORTREAL; OUT exp: INTEGER): SHORTREAL "frexpf(x, exp)";
  34   PROCEDURE [code] ldexpf (x: SHORTREAL; exp: INTEGER): SHORTREAL "ldexpf(x, exp)";
  35
  36   PROCEDURE Pi* (): SHORTREAL;
  37   BEGIN
  38     RETURN M_PI()
  39   END Pi;
  40
  41   PROCEDURE Eps* (): SHORTREAL;
  42   BEGIN
  43     RETURN eps
  44   END Eps;
  45
  46   PROCEDURE Sqrt* (x: SHORTREAL): SHORTREAL;
  47   BEGIN
  48     RETURN sqrtf(x)
  49   END Sqrt;
  50
  51   PROCEDURE Exp* (x: SHORTREAL): SHORTREAL;
  52   BEGIN
  53     RETURN expf(x)
  54   END Exp;
  55
  56   PROCEDURE Ln* (x: SHORTREAL): SHORTREAL;
  57   BEGIN
  58     RETURN logf(x)
  59   END Ln;
  60
  61   PROCEDURE Log* (x: SHORTREAL): SHORTREAL;
  62   BEGIN
  63     RETURN log10f(x)
  64   END Log;
  65
  66   PROCEDURE Power* (x, y: SHORTREAL): SHORTREAL;
  67   BEGIN
  68     RETURN powf(x, y)
  69   END Power;
  70
  71   PROCEDURE IntPower* (x: SHORTREAL; n: INTEGER): SHORTREAL;
  72     VAR y: SHORTREAL;
  73   BEGIN
  74     IF n = MIN(INTEGER) THEN RETURN IntPower(x, n + 1) / x END;
  75     y := 1.0;
  76     IF n < 0 THEN x := 1.0 / x; n := -n END;
  77     WHILE n > 0 DO
  78       IF ODD(n) THEN y := y * x; DEC(n)
  79       ELSE x := x * x; n := n DIV 2
  80       END
  81     END;
  82     RETURN y
  83   END IntPower;
  84
  85   PROCEDURE Sin* (x: SHORTREAL): SHORTREAL;
  86   BEGIN
  87     RETURN sinf(x)
  88   END Sin;
  89
  90   PROCEDURE Cos* (x: SHORTREAL): SHORTREAL;
  91   BEGIN
  92     RETURN cosf(x)
  93   END Cos;
  94
  95   PROCEDURE Tan* (x: SHORTREAL): SHORTREAL;
  96   BEGIN
  97     RETURN tanf(x)
  98   END Tan;
  99
 100   PROCEDURE SinCos* (x: SHORTREAL; OUT s, c: SHORTREAL);
 101   BEGIN
 102     s := sinf(x); c := cosf(x)
 103   END SinCos;
 104
 105   PROCEDURE ArcSin* (x: SHORTREAL): SHORTREAL;
 106   BEGIN
 107     RETURN asinf(x)
 108   END ArcSin;
 109
 110   PROCEDURE ArcCos* (x: SHORTREAL): SHORTREAL;
 111   BEGIN
 112     RETURN acosf(x)
 113   END ArcCos;
 114
 115   PROCEDURE ArcTan* (x: SHORTREAL): SHORTREAL;
 116   BEGIN
 117     RETURN atanf(x)
 118   END ArcTan;
 119
 120   PROCEDURE ArcTan2* (y, x: SHORTREAL): SHORTREAL;
 121   BEGIN
 122     RETURN atan2f(y, x)
 123   END ArcTan2;
 124
 125   PROCEDURE Sinh* (x: SHORTREAL): SHORTREAL;
 126   BEGIN
 127     RETURN sinhf(x)
 128   END Sinh;
 129
 130   PROCEDURE Cosh* (x: SHORTREAL): SHORTREAL;
 131   BEGIN
 132     RETURN coshf(x)
 133   END Cosh;
 134
 135   PROCEDURE Tanh* (x: SHORTREAL): SHORTREAL;
 136   BEGIN
 137     RETURN tanhf(x)
 138   END Tanh;
 139
 140   PROCEDURE ArcSinh* (x: SHORTREAL): SHORTREAL;
 141   BEGIN
 142     RETURN asinhf(x)
 143   END ArcSinh;
 144
 145   PROCEDURE ArcCosh* (x: SHORTREAL): SHORTREAL;
 146   BEGIN
 147     RETURN acoshf(x)
 148   END ArcCosh;
 149
 150   PROCEDURE ArcTanh* (x: SHORTREAL): SHORTREAL;
 151   BEGIN
 152     RETURN atanhf(x)
 153   END ArcTanh;
 154
 155   PROCEDURE Floor* (x: SHORTREAL): SHORTREAL;
 156   BEGIN
 157     RETURN floorf(x)
 158   END Floor;
 159
 160   PROCEDURE Ceiling* (x: SHORTREAL): SHORTREAL;
 161   BEGIN
 162     RETURN ceilf(x)
 163   END Ceiling;
 164
 165   PROCEDURE Round* (x: SHORTREAL): SHORTREAL;
 166   BEGIN
 167     RETURN roundf(x)
 168   END Round;
 169
 170   PROCEDURE Trunc* (x: SHORTREAL): SHORTREAL;
 171   BEGIN
 172     RETURN truncf(x)
 173   END Trunc;
 174
 175   PROCEDURE Frac* (x: SHORTREAL): SHORTREAL;
 176   BEGIN
 177     IF x >= 0 THEN RETURN x - ENTIER(x)
 178     ELSE RETURN x + ENTIER(-x)
 179     END
 180   END Frac;
 181
 182   PROCEDURE Mod1* (x: SHORTREAL): SHORTREAL;
 183   BEGIN
 184     RETURN x - ENTIER(x)
 185   END Mod1;
 186
 187   PROCEDURE Sign* (x: SHORTREAL): SHORTREAL;
 188   BEGIN
 189     IF x > 0 THEN RETURN 1
 190     ELSIF x < 0 THEN RETURN -1
 191     ELSE RETURN x
 192     END
 193   END Sign;
 194
 195   PROCEDURE SignBit* (x: SHORTREAL): BOOLEAN;
 196   BEGIN
 197     RETURN copysignf(1.0, x) > 0
 198   END SignBit;
 199
 200   PROCEDURE CopySign* (x, y: SHORTREAL): SHORTREAL;
 201   BEGIN
 202     RETURN copysignf(x, y)
 203   END CopySign;
 204
 205   PROCEDURE Mantissa* (x: SHORTREAL): SHORTREAL;
 206     VAR e: INTEGER;
 207   BEGIN
 208     RETURN frexpf(x, e);
 209   END Mantissa;
 210
 211   PROCEDURE Exponent* (x: SHORTREAL): INTEGER;
 212     VAR m: SHORTREAL; e: INTEGER;
 213   BEGIN
 214     m := frexpf(x, e);
 215     RETURN e
 216   END Exponent;
 217
 218   PROCEDURE Real* (m: SHORTREAL; e: INTEGER): SHORTREAL;
 219   BEGIN
 220     RETURN ldexpf(m, e)
 221   END Real;
 222
 223 BEGIN
 224   eps := 1.0E+0;
 225   e := 2.0E+0;
 226   WHILE e > 1.0E+0 DO
 227     eps := eps/2.0E+0;
 228     e := 1.0E+0 + eps
 229   END;
 230   eps := 2.0E+0 * eps
 231 END SMath.