OSDN Git Service

cp:
[pf3gnuchains/gcc-fork.git] / 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 General Public
8 License as published by the Free Software Foundation; either
9 version 2 of the License, or (at your option) any later version.
10
11 In addition to the permissions in the GNU General Public License, the
12 Free Software Foundation gives you unlimited permission to link the
13 compiled version of this file into combinations with other programs,
14 and to distribute those combinations without any restriction coming
15 from the use of this file.  (The General Public License restrictions
16 do apply in other respects; for example, they cover modification of
17 the file, and distribution when not linked into a combine
18 executable.)
19
20 Libgfortran is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23 GNU General Public License for more details.
24
25 You should have received a copy of the GNU General Public
26 License along with libgfortran; see the file COPYING.  If not,
27 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 Boston, MA 02111-1307, USA.  */
29
30 #include "config.h"
31 #include <sys/types.h>
32 #include <float.h>
33 #include <math.h>
34 #include "libgfortran.h"
35
36
37 #ifndef HAVE_ACOSF
38 float
39 acosf(float x)
40 {
41   return (float) acos(x);
42 }
43 #endif
44
45 #ifndef HAVE_ASINF
46 float
47 asinf(float x)
48 {
49   return (float) asin(x);
50 }
51 #endif
52
53 #ifndef HAVE_ATAN2F
54 float
55 atan2f(float y, float x)
56 {
57   return (float) atan2(y, x);
58 }
59 #endif
60
61 #ifndef HAVE_ATANF
62 float
63 atanf(float x)
64 {
65   return (float) atan(x);
66 }
67 #endif
68
69 #ifndef HAVE_CEILF
70 float
71 ceilf(float x)
72 {
73   return (float) ceil(x);
74 }
75 #endif
76
77 #ifndef HAVE_COPYSIGNF
78 float
79 copysignf(float x, float y)
80 {
81   return (float) copysign(x, y);
82 }
83 #endif
84
85 #ifndef HAVE_COSF
86 float
87 cosf(float x)
88 {
89   return (float) cos(x);
90 }
91 #endif
92
93 #ifndef HAVE_COSHF
94 float
95 coshf(float x)
96 {
97   return (float) cosh(x);
98 }
99 #endif
100
101 #ifndef HAVE_EXPF
102 float
103 expf(float x)
104 {
105   return (float) exp(x);
106 }
107 #endif
108
109 #ifndef HAVE_FABSF
110 float
111 fabsf(float x)
112 {
113   return (float) fabs(x);
114 }
115 #endif
116
117 #ifndef HAVE_FLOORF
118 float
119 floorf(float x)
120 {
121   return (float) floor(x);
122 }
123 #endif
124
125 #ifndef HAVE_FREXPF
126 float
127 frexpf(float x, int *exp)
128 {
129   return (float) frexp(x, exp);
130 }
131 #endif
132
133 #ifndef HAVE_HYPOTF
134 float
135 hypotf(float x, float y)
136 {
137   return (float) hypot(x, y);
138 }
139 #endif
140
141 #ifndef HAVE_LOGF
142 float
143 logf(float x)
144 {
145   return (float) log(x);
146 }
147 #endif
148
149 #ifndef HAVE_LOG10F
150 float
151 log10f(float x)
152 {
153   return (float) log10(x);
154 }
155 #endif
156
157 #ifndef HAVE_SCALBNF
158 float
159 scalbnf(float x, int y)
160 {
161   return (float) scalbn(x, y);
162 }
163 #endif
164
165 #ifndef HAVE_SINF
166 float
167 sinf(float x)
168 {
169   return (float) sin(x);
170 }
171 #endif
172
173 #ifndef HAVE_SINHF
174 float
175 sinhf(float x)
176 {
177   return (float) sinh(x);
178 }
179 #endif
180
181 #ifndef HAVE_SQRTF
182 float
183 sqrtf(float x)
184 {
185   return (float) sqrt(x);
186 }
187 #endif
188
189 #ifndef HAVE_TANF
190 float
191 tanf(float x)
192 {
193   return (float) tan(x);
194 }
195 #endif
196
197 #ifndef HAVE_TANHF
198 float
199 tanhf(float x)
200 {
201   return (float) tanh(x);
202 }
203 #endif
204
205 #ifndef HAVE_TRUNC
206 double
207 trunc(double x)
208 {
209   if (!isfinite (x))
210     return x;
211
212   if (x < 0.0)
213     return - floor (-x);
214   else
215     return floor (x);
216 }
217 #endif
218
219 #ifndef HAVE_TRUNCF
220 float
221 truncf(float x)
222 {
223   return (float) trunc (x);
224 }
225 #endif
226
227 #ifndef HAVE_NEXTAFTERF
228 /* This is a portable implementation of nextafterf that is intended to be
229    independent of the floating point format or its in memory representation.
230    This implementation works correctly with denormalized values.  */
231 float
232 nextafterf(float x, float y)
233 {
234   /* This variable is marked volatile to avoid excess precision problems
235      on some platforms, including IA-32.  */
236   volatile float delta;
237   float absx, denorm_min;
238
239   if (isnan(x) || isnan(y))
240     return x + y;
241   if (x == y)
242     return x;
243   if (!isfinite (x))
244     return x > 0 ? __FLT_MAX__ : - __FLT_MAX__;
245
246   /* absx = fabsf (x);  */
247   absx = (x < 0.0) ? -x : x;
248
249   /* __FLT_DENORM_MIN__ is non-zero iff the target supports denormals.  */
250   if (__FLT_DENORM_MIN__ == 0.0f)
251     denorm_min = __FLT_MIN__;
252   else
253     denorm_min = __FLT_DENORM_MIN__;
254
255   if (absx < __FLT_MIN__)
256     delta = denorm_min;
257   else
258     {
259       float frac;
260       int exp;
261
262       /* Discard the fraction from x.  */
263       frac = frexpf (absx, &exp);
264       delta = scalbnf (0.5f, exp);
265
266       /* Scale x by the epsilon of the representation.  By rights we should
267          have been able to combine this with scalbnf, but some targets don't
268          get that correct with denormals.  */
269       delta *= __FLT_EPSILON__;
270
271       /* If we're going to be reducing the absolute value of X, and doing so
272          would reduce the exponent of X, then the delta to be applied is
273          one exponent smaller.  */
274       if (frac == 0.5f && (y < x) == (x > 0))
275         delta *= 0.5f;
276
277       /* If that underflows to zero, then we're back to the minimum.  */
278       if (delta == 0.0f)
279         delta = denorm_min;
280     }
281
282   if (y < x)
283     delta = -delta;
284
285   return x + delta;
286 }
287 #endif
288
289
290 #ifndef HAVE_POWF
291 float
292 powf(float x, float y)
293 {
294   return (float) pow(x, y);
295 }
296 #endif
297
298 /* Note that if fpclassify is not defined, then NaN is not handled */
299
300 /* Algorithm by Steven G. Kargl.  */
301
302 #ifndef HAVE_ROUND
303 /* Round to nearest integral value.  If the argument is halfway between two
304    integral values then round away from zero.  */
305
306 double
307 round(double x)
308 {
309    double t;
310 #if defined(fpclassify)
311    int i;
312    i = fpclassify(x);
313    if (i == FP_INFINITE || i == FP_NAN)
314      return (x);
315 #endif
316
317    if (x >= 0.0) 
318     {
319       t = ceil(x);
320       if (t - x > 0.5)
321         t -= 1.0;
322       return (t);
323     } 
324    else 
325     {
326       t = ceil(-x);
327       if (t + x > 0.5)
328         t -= 1.0;
329       return (-t);
330     }
331 }
332 #endif
333
334 #ifndef HAVE_ROUNDF
335 /* Round to nearest integral value.  If the argument is halfway between two
336    integral values then round away from zero.  */
337
338 float
339 roundf(float x)
340 {
341    float t;
342 #if defined(fpclassify)
343    int i;
344
345    i = fpclassify(x);
346    if (i == FP_INFINITE || i == FP_NAN)
347      return (x);
348 #endif
349
350    if (x >= 0.0) 
351     {
352       t = ceilf(x);
353       if (t - x > 0.5)
354         t -= 1.0;
355       return (t);
356     } 
357    else 
358     {
359       t = ceilf(-x);
360       if (t + x > 0.5)
361         t -= 1.0;
362       return (-t);
363     }
364 }
365 #endif