libgfortran/intrinsics/c99_functions.c

   1 /* Implementation of various C99 functions
   2    Copyright (C) 2004 Free Software Foundation, Inc.
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or
   7 modify it under the terms of the GNU Lesser General Public
   8 License as published by the Free Software Foundation; either
   9 version 2.1 of the License, or (at your option) any later version.
  10
  11 Libgfortran is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU Lesser General Public License for more details.
  15
  16 You should have received a copy of the GNU Lesser General Public
  17 License along with libgfortran; see the file COPYING.LIB.  If not,
  18 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include "config.h"
  22 #include <sys/types.h>
  23 #include <float.h>
  24 #include <math.h>
  25 #include "libgfortran.h"
  26
  27
  28 #ifndef HAVE_ACOSF
  29 float
  30 acosf(float x)
  31 {
  32   return (float) acos(x);
  33 }
  34 #endif
  35
  36 #ifndef HAVE_ASINF
  37 float
  38 asinf(float x)
  39 {
  40   return (float) asin(x);
  41 }
  42 #endif
  43
  44 #ifndef HAVE_ATAN2F
  45 float
  46 atan2f(float y, float x)
  47 {
  48   return (float) atan2(y, x);
  49 }
  50 #endif
  51
  52 #ifndef HAVE_ATANF
  53 float
  54 atanf(float x)
  55 {
  56   return (float) atan(x);
  57 }
  58 #endif
  59
  60 #ifndef HAVE_CEILF
  61 float
  62 ceilf(float x)
  63 {
  64   return (float) ceil(x);
  65 }
  66 #endif
  67
  68 #ifndef HAVE_COPYSIGNF
  69 float
  70 copysignf(float x, float y)
  71 {
  72   return (float) copysign(x, y);
  73 }
  74 #endif
  75
  76 #ifndef HAVE_COSF
  77 float
  78 cosf(float x)
  79 {
  80   return (float) cos(x);
  81 }
  82 #endif
  83
  84 #ifndef HAVE_COSHF
  85 float
  86 coshf(float x)
  87 {
  88   return (float) cosh(x);
  89 }
  90 #endif
  91
  92 #ifndef HAVE_EXPF
  93 float
  94 expf(float x)
  95 {
  96   return (float) exp(x);
  97 }
  98 #endif
  99
 100 #ifndef HAVE_FLOORF
 101 float
 102 floorf(float x)
 103 {
 104   return (float) floor(x);
 105 }
 106 #endif
 107
 108 #ifndef HAVE_FREXPF
 109 float
 110 frexpf(float x, int *exp)
 111 {
 112   return (float) frexp(x, exp);
 113 }
 114 #endif
 115
 116 #ifndef HAVE_HYPOTF
 117 float
 118 hypotf(float x, float y)
 119 {
 120   return (float) hypot(x, y);
 121 }
 122 #endif
 123
 124 #ifndef HAVE_LOGF
 125 float
 126 logf(float x)
 127 {
 128   return (float) log(x);
 129 }
 130 #endif
 131
 132 #ifndef HAVE_LOG10F
 133 float
 134 log10f(float x)
 135 {
 136   return (float) log10(x);
 137 }
 138 #endif
 139
 140 #ifndef HAVE_SCALBNF
 141 float
 142 scalbnf(float x, int y)
 143 {
 144   return (float) scalbn(x, y);
 145 }
 146 #endif
 147
 148 #ifndef HAVE_SINF
 149 float
 150 sinf(float x)
 151 {
 152   return (float) sin(x);
 153 }
 154 #endif
 155
 156 #ifndef HAVE_SINHF
 157 float
 158 sinhf(float x)
 159 {
 160   return (float) sinh(x);
 161 }
 162 #endif
 163
 164 #ifndef HAVE_SQRTF
 165 float
 166 sqrtf(float x)
 167 {
 168   return (float) sqrt(x);
 169 }
 170 #endif
 171
 172 #ifndef HAVE_TANF
 173 float
 174 tanf(float x)
 175 {
 176   return (float) tan(x);
 177 }
 178 #endif
 179
 180 #ifndef HAVE_TANHF
 181 float
 182 tanhf(float x)
 183 {
 184   return (float) tanh(x);
 185 }
 186 #endif
 187
 188 #ifndef HAVE_NEXTAFTERF
 189 /* This is a portable implementation of nextafterf that is intended to be
 190    independent of the floating point format or its in memory representation.
 191    This implementation skips denormalized values, for example returning
 192    FLT_MIN as the next value after zero, as many target's frexpf, scalbnf
 193    and ldexpf functions don't work as expected with denormalized values.  */
 194 float
 195 nextafterf(float x, float y)
 196 {
 197   int origexp, newexp;
 198
 199   if (isnan(x) || isnan(y))
 200     return x+y;
 201   if (x == y)
 202     return x;
 203
 204   if (x == 0.0f)
 205     return y > 0.0f ? FLT_MIN : -FLT_MIN;
 206
 207   frexpf(x, &origexp);
 208   if (x >= 0.0)
 209     {
 210       if (y > x)
 211         {
 212           if (x < FLT_MIN)
 213             return FLT_MIN;
 214           return x + scalbnf(FLT_EPSILON, origexp-1);
 215         }
 216       else if (x > FLT_MIN)
 217         {
 218           float temp = x - scalbnf(FLT_EPSILON, origexp-1);
 219           frexpf(temp, &newexp);
 220           if (newexp == origexp)
 221             return temp;
 222           return x - scalbnf(FLT_EPSILON, origexp-2);
 223         }
 224       else
 225         return 0.0f;
 226     }
 227   else
 228     {
 229       if (y < x)
 230         {
 231           if (x > -FLT_MIN)
 232             return -FLT_MIN;
 233           return x - scalbnf(FLT_EPSILON, origexp-1);
 234         }
 235       else if (x < -FLT_MIN)
 236         {
 237           float temp = x + scalbnf(FLT_EPSILON, origexp-1);
 238           frexpf(temp, &newexp);
 239           if (newexp == origexp)
 240             return temp;
 241           return x + scalbnf(FLT_EPSILON, origexp-2);
 242         }
 243       else
 244         return 0.0f;
 245     }
 246 }
 247 #endif
 248
 249 /* Note that if HAVE_FPCLASSIFY is not defined, then NaN is not handled */
 250
 251 /* Algorithm by Steven G. Kargl.  */
 252
 253 #ifndef HAVE_ROUND
 254 /* Round to nearest integral value.  If the argument is halfway between two
 255    integral values then round away from zero.  */
 256
 257 double
 258 round(double x)
 259 {
 260    double t;
 261 #ifdef HAVE_FPCLASSIFY
 262    int i;
 263    i = fpclassify(x);
 264    if (i == FP_INFINITE || i == FP_NAN)
 265      return (x);
 266 #endif
 267
 268    if (x >= 0.0)
 269     {
 270       t = ceil(x);
 271       if (t - x > 0.5)
 272         t -= 1.0;
 273       return (t);
 274     }
 275    else
 276     {
 277       t = ceil(-x);
 278       if (t + x > 0.5)
 279         t -= 1.0;
 280       return (-t);
 281     }
 282 }
 283 #endif
 284
 285 #ifndef HAVE_ROUNDF
 286 /* Round to nearest integral value.  If the argument is halfway between two
 287    integral values then round away from zero.  */
 288
 289 float
 290 roundf(float x)
 291 {
 292    float t;
 293 #ifdef HAVE_FPCLASSIFY
 294    int i;
 295
 296    i = fpclassify(x);
 297    if (i == FP_INFINITE || i == FP_NAN)
 298      return (x);
 299 #endif
 300
 301    if (x >= 0.0)
 302     {
 303       t = ceilf(x);
 304       if (t - x > 0.5)
 305         t -= 1.0;
 306       return (t);
 307     }
 308    else
 309     {
 310       t = ceilf(-x);
 311       if (t + x > 0.5)
 312         t -= 1.0;
 313       return (-t);
 314     }
 315 }
 316 #endif
 317