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., 51 Franklin Street, Fifth Floor,
  28 Boston, MA 02110-1301, USA.  */
  29
  30 #include "config.h"
  31 #include <sys/types.h>
  32 #include <float.h>
  33 #include <math.h>
  34
  35 #define C99_PROTOS_H WE_DONT_WANT_PROTOS_NOW
  36 #include "libgfortran.h"
  37
  38 /* Tru64's <math.h> declares a non-C99 compliant implementation of cabs,
  39    which takes two floating point arguments instead of a single complex.
  40    To work around this we redirect cabs{,f,l} calls to __gfc_cabs{,f,l}.  */
  41
  42 #ifdef __osf__
  43 #undef HAVE_CABS
  44 #undef HAVE_CABSF
  45 #undef HAVE_CABSL
  46 #define cabs __gfc_cabs
  47 #define cabsf __gfc_cabsf
  48 #define cabsl __gfc_cabsl
  49 #endif
  50
  51 /* Prototypes to silence -Wstrict-prototypes -Wmissing-prototypes.  */
  52
  53 float cabsf(float complex);
  54 double cabs(double complex);
  55 long double cabsl(long double complex);
  56
  57 float cargf(float complex);
  58 double carg(double complex);
  59 long double cargl(long double complex);
  60
  61 float complex clog10f(float complex);
  62 double complex clog10(double complex);
  63 long double complex clog10l(long double complex);
  64
  65
  66 #ifndef HAVE_ACOSF
  67 #define HAVE_ACOSF 1
  68 float
  69 acosf(float x)
  70 {
  71   return (float) acos(x);
  72 }
  73 #endif
  74
  75 #ifndef HAVE_ASINF
  76 #define HAVE_ASINF 1
  77 float
  78 asinf(float x)
  79 {
  80   return (float) asin(x);
  81 }
  82 #endif
  83
  84 #ifndef HAVE_ATAN2F
  85 #define HAVE_ATAN2F 1
  86 float
  87 atan2f(float y, float x)
  88 {
  89   return (float) atan2(y, x);
  90 }
  91 #endif
  92
  93 #ifndef HAVE_ATANF
  94 #define HAVE_ATANF 1
  95 float
  96 atanf(float x)
  97 {
  98   return (float) atan(x);
  99 }
 100 #endif
 101
 102 #ifndef HAVE_CEILF
 103 #define HAVE_CEILF 1
 104 float
 105 ceilf(float x)
 106 {
 107   return (float) ceil(x);
 108 }
 109 #endif
 110
 111 #ifndef HAVE_COPYSIGNF
 112 #define HAVE_COPYSIGNF 1
 113 float
 114 copysignf(float x, float y)
 115 {
 116   return (float) copysign(x, y);
 117 }
 118 #endif
 119
 120 #ifndef HAVE_COSF
 121 #define HAVE_COSF 1
 122 float
 123 cosf(float x)
 124 {
 125   return (float) cos(x);
 126 }
 127 #endif
 128
 129 #ifndef HAVE_COSHF
 130 #define HAVE_COSHF 1
 131 float
 132 coshf(float x)
 133 {
 134   return (float) cosh(x);
 135 }
 136 #endif
 137
 138 #ifndef HAVE_EXPF
 139 #define HAVE_EXPF 1
 140 float
 141 expf(float x)
 142 {
 143   return (float) exp(x);
 144 }
 145 #endif
 146
 147 #ifndef HAVE_FABSF
 148 #define HAVE_FABSF 1
 149 float
 150 fabsf(float x)
 151 {
 152   return (float) fabs(x);
 153 }
 154 #endif
 155
 156 #ifndef HAVE_FLOORF
 157 #define HAVE_FLOORF 1
 158 float
 159 floorf(float x)
 160 {
 161   return (float) floor(x);
 162 }
 163 #endif
 164
 165 #ifndef HAVE_FREXPF
 166 #define HAVE_FREXPF 1
 167 float
 168 frexpf(float x, int *exp)
 169 {
 170   return (float) frexp(x, exp);
 171 }
 172 #endif
 173
 174 #ifndef HAVE_HYPOTF
 175 #define HAVE_HYPOTF 1
 176 float
 177 hypotf(float x, float y)
 178 {
 179   return (float) hypot(x, y);
 180 }
 181 #endif
 182
 183 #ifndef HAVE_LOGF
 184 #define HAVE_LOGF 1
 185 float
 186 logf(float x)
 187 {
 188   return (float) log(x);
 189 }
 190 #endif
 191
 192 #ifndef HAVE_LOG10F
 193 #define HAVE_LOG10F 1
 194 float
 195 log10f(float x)
 196 {
 197   return (float) log10(x);
 198 }
 199 #endif
 200
 201 #ifndef HAVE_SCALBN
 202 #define HAVE_SCALBN 1
 203 double
 204 scalbn(double x, int y)
 205 {
 206   return x * pow(FLT_RADIX, y);
 207 }
 208 #endif
 209
 210 #ifndef HAVE_SCALBNF
 211 #define HAVE_SCALBNF 1
 212 float
 213 scalbnf(float x, int y)
 214 {
 215   return (float) scalbn(x, y);
 216 }
 217 #endif
 218
 219 #ifndef HAVE_SINF
 220 #define HAVE_SINF 1
 221 float
 222 sinf(float x)
 223 {
 224   return (float) sin(x);
 225 }
 226 #endif
 227
 228 #ifndef HAVE_SINHF
 229 #define HAVE_SINHF 1
 230 float
 231 sinhf(float x)
 232 {
 233   return (float) sinh(x);
 234 }
 235 #endif
 236
 237 #ifndef HAVE_SQRTF
 238 #define HAVE_SQRTF 1
 239 float
 240 sqrtf(float x)
 241 {
 242   return (float) sqrt(x);
 243 }
 244 #endif
 245
 246 #ifndef HAVE_TANF
 247 #define HAVE_TANF 1
 248 float
 249 tanf(float x)
 250 {
 251   return (float) tan(x);
 252 }
 253 #endif
 254
 255 #ifndef HAVE_TANHF
 256 #define HAVE_TANHF 1
 257 float
 258 tanhf(float x)
 259 {
 260   return (float) tanh(x);
 261 }
 262 #endif
 263
 264 #ifndef HAVE_TRUNC
 265 #define HAVE_TRUNC 1
 266 double
 267 trunc(double x)
 268 {
 269   if (!isfinite (x))
 270     return x;
 271
 272   if (x < 0.0)
 273     return - floor (-x);
 274   else
 275     return floor (x);
 276 }
 277 #endif
 278
 279 #ifndef HAVE_TRUNCF
 280 #define HAVE_TRUNCF 1
 281 float
 282 truncf(float x)
 283 {
 284   return (float) trunc (x);
 285 }
 286 #endif
 287
 288 #ifndef HAVE_NEXTAFTERF
 289 #define HAVE_NEXTAFTERF 1
 290 /* This is a portable implementation of nextafterf that is intended to be
 291    independent of the floating point format or its in memory representation.
 292    This implementation works correctly with denormalized values.  */
 293 float
 294 nextafterf(float x, float y)
 295 {
 296   /* This variable is marked volatile to avoid excess precision problems
 297      on some platforms, including IA-32.  */
 298   volatile float delta;
 299   float absx, denorm_min;
 300
 301   if (isnan(x) || isnan(y))
 302     return x + y;
 303   if (x == y)
 304     return x;
 305   if (!isfinite (x))
 306     return x > 0 ? __FLT_MAX__ : - __FLT_MAX__;
 307
 308   /* absx = fabsf (x);  */
 309   absx = (x < 0.0) ? -x : x;
 310
 311   /* __FLT_DENORM_MIN__ is non-zero iff the target supports denormals.  */
 312   if (__FLT_DENORM_MIN__ == 0.0f)
 313     denorm_min = __FLT_MIN__;
 314   else
 315     denorm_min = __FLT_DENORM_MIN__;
 316
 317   if (absx < __FLT_MIN__)
 318     delta = denorm_min;
 319   else
 320     {
 321       float frac;
 322       int exp;
 323
 324       /* Discard the fraction from x.  */
 325       frac = frexpf (absx, &exp);
 326       delta = scalbnf (0.5f, exp);
 327
 328       /* Scale x by the epsilon of the representation.  By rights we should
 329          have been able to combine this with scalbnf, but some targets don't
 330          get that correct with denormals.  */
 331       delta *= __FLT_EPSILON__;
 332
 333       /* If we're going to be reducing the absolute value of X, and doing so
 334          would reduce the exponent of X, then the delta to be applied is
 335          one exponent smaller.  */
 336       if (frac == 0.5f && (y < x) == (x > 0))
 337         delta *= 0.5f;
 338
 339       /* If that underflows to zero, then we're back to the minimum.  */
 340       if (delta == 0.0f)
 341         delta = denorm_min;
 342     }
 343
 344   if (y < x)
 345     delta = -delta;
 346
 347   return x + delta;
 348 }
 349 #endif
 350
 351
 352 #ifndef HAVE_POWF
 353 #define HAVE_POWF 1
 354 float
 355 powf(float x, float y)
 356 {
 357   return (float) pow(x, y);
 358 }
 359 #endif
 360
 361 /* Note that if fpclassify is not defined, then NaN is not handled */
 362
 363 /* Algorithm by Steven G. Kargl.  */
 364
 365 #ifndef HAVE_ROUND
 366 #define HAVE_ROUND 1
 367 /* Round to nearest integral value.  If the argument is halfway between two
 368    integral values then round away from zero.  */
 369
 370 double
 371 round(double x)
 372 {
 373    double t;
 374    if (!isfinite (x))
 375      return (x);
 376
 377    if (x >= 0.0)
 378     {
 379       t = ceil(x);
 380       if (t - x > 0.5)
 381         t -= 1.0;
 382       return (t);
 383     }
 384    else
 385     {
 386       t = ceil(-x);
 387       if (t + x > 0.5)
 388         t -= 1.0;
 389       return (-t);
 390     }
 391 }
 392 #endif
 393
 394 #ifndef HAVE_ROUNDF
 395 #define HAVE_ROUNDF 1
 396 /* Round to nearest integral value.  If the argument is halfway between two
 397    integral values then round away from zero.  */
 398
 399 float
 400 roundf(float x)
 401 {
 402    float t;
 403    if (!isfinite (x))
 404      return (x);
 405
 406    if (x >= 0.0)
 407     {
 408       t = ceilf(x);
 409       if (t - x > 0.5)
 410         t -= 1.0;
 411       return (t);
 412     }
 413    else
 414     {
 415       t = ceilf(-x);
 416       if (t + x > 0.5)
 417         t -= 1.0;
 418       return (-t);
 419     }
 420 }
 421 #endif
 422
 423 #ifndef HAVE_LOG10L
 424 #define HAVE_LOG10L 1
 425 /* log10 function for long double variables. The version provided here
 426    reduces the argument until it fits into a double, then use log10.  */
 427 long double
 428 log10l(long double x)
 429 {
 430 #if LDBL_MAX_EXP > DBL_MAX_EXP
 431   if (x > DBL_MAX)
 432     {
 433       double val;
 434       int p2_result = 0;
 435       if (x > 0x1p16383L) { p2_result += 16383; x /= 0x1p16383L; }
 436       if (x > 0x1p8191L) { p2_result += 8191; x /= 0x1p8191L; }
 437       if (x > 0x1p4095L) { p2_result += 4095; x /= 0x1p4095L; }
 438       if (x > 0x1p2047L) { p2_result += 2047; x /= 0x1p2047L; }
 439       if (x > 0x1p1023L) { p2_result += 1023; x /= 0x1p1023L; }
 440       val = log10 ((double) x);
 441       return (val + p2_result * .30102999566398119521373889472449302L);
 442     }
 443 #endif
 444 #if LDBL_MIN_EXP < DBL_MIN_EXP
 445   if (x < DBL_MIN)
 446     {
 447       double val;
 448       int p2_result = 0;
 449       if (x < 0x1p-16380L) { p2_result += 16380; x /= 0x1p-16380L; }
 450       if (x < 0x1p-8189L) { p2_result += 8189; x /= 0x1p-8189L; }
 451       if (x < 0x1p-4093L) { p2_result += 4093; x /= 0x1p-4093L; }
 452       if (x < 0x1p-2045L) { p2_result += 2045; x /= 0x1p-2045L; }
 453       if (x < 0x1p-1021L) { p2_result += 1021; x /= 0x1p-1021L; }
 454       val = fabs(log10 ((double) x));
 455       return (- val - p2_result * .30102999566398119521373889472449302L);
 456     }
 457 #endif
 458     return log10 (x);
 459 }
 460 #endif
 461
 462
 463 #if !defined(HAVE_CABSF)
 464 #define HAVE_CABSF 1
 465 float
 466 cabsf (float complex z)
 467 {
 468   return hypotf (REALPART (z), IMAGPART (z));
 469 }
 470 #endif
 471
 472 #if !defined(HAVE_CABS)
 473 #define HAVE_CABS 1
 474 double
 475 cabs (double complex z)
 476 {
 477   return hypot (REALPART (z), IMAGPART (z));
 478 }
 479 #endif
 480
 481 #if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL)
 482 #define HAVE_CABSL 1
 483 long double
 484 cabsl (long double complex z)
 485 {
 486   return hypotl (REALPART (z), IMAGPART (z));
 487 }
 488 #endif
 489
 490
 491 #if !defined(HAVE_CARGF)
 492 #define HAVE_CARGF 1
 493 float
 494 cargf (float complex z)
 495 {
 496   return atan2f (IMAGPART (z), REALPART (z));
 497 }
 498 #endif
 499
 500 #if !defined(HAVE_CARG)
 501 #define HAVE_CARG 1
 502 double
 503 carg (double complex z)
 504 {
 505   return atan2 (IMAGPART (z), REALPART (z));
 506 }
 507 #endif
 508
 509 #if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L)
 510 #define HAVE_CARGL 1
 511 long double
 512 cargl (long double complex z)
 513 {
 514   return atan2l (IMAGPART (z), REALPART (z));
 515 }
 516 #endif
 517
 518
 519 /* exp(z) = exp(a)*(cos(b) + i sin(b))  */
 520 #if !defined(HAVE_CEXPF)
 521 #define HAVE_CEXPF 1
 522 float complex
 523 cexpf (float complex z)
 524 {
 525   float a, b;
 526   float complex v;
 527
 528   a = REALPART (z);
 529   b = IMAGPART (z);
 530   COMPLEX_ASSIGN (v, cosf (b), sinf (b));
 531   return expf (a) * v;
 532 }
 533 #endif
 534
 535 #if !defined(HAVE_CEXP)
 536 #define HAVE_CEXP 1
 537 double complex
 538 cexp (double complex z)
 539 {
 540   double a, b;
 541   double complex v;
 542
 543   a = REALPART (z);
 544   b = IMAGPART (z);
 545   COMPLEX_ASSIGN (v, cos (b), sin (b));
 546   return exp (a) * v;
 547 }
 548 #endif
 549
 550 #if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL)
 551 #define HAVE_CEXPL 1
 552 long double complex
 553 cexpl (long double complex z)
 554 {
 555   long double a, b;
 556   long double complex v;
 557
 558   a = REALPART (z);
 559   b = IMAGPART (z);
 560   COMPLEX_ASSIGN (v, cosl (b), sinl (b));
 561   return expl (a) * v;
 562 }
 563 #endif
 564
 565
 566 /* log(z) = log (cabs(z)) + i*carg(z)  */
 567 #if !defined(HAVE_CLOGF)
 568 #define HAVE_CLOGF 1
 569 float complex
 570 clogf (float complex z)
 571 {
 572   float complex v;
 573
 574   COMPLEX_ASSIGN (v, logf (cabsf (z)), cargf (z));
 575   return v;
 576 }
 577 #endif
 578
 579 #if !defined(HAVE_CLOG)
 580 #define HAVE_CLOG 1
 581 double complex
 582 clog (double complex z)
 583 {
 584   double complex v;
 585
 586   COMPLEX_ASSIGN (v, log (cabs (z)), carg (z));
 587   return v;
 588 }
 589 #endif
 590
 591 #if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL)
 592 #define HAVE_CLOGL 1
 593 long double complex
 594 clogl (long double complex z)
 595 {
 596   long double complex v;
 597
 598   COMPLEX_ASSIGN (v, logl (cabsl (z)), cargl (z));
 599   return v;
 600 }
 601 #endif
 602
 603
 604 /* log10(z) = log10 (cabs(z)) + i*carg(z)  */
 605 #if !defined(HAVE_CLOG10F)
 606 #define HAVE_CLOG10F 1
 607 float complex
 608 clog10f (float complex z)
 609 {
 610   float complex v;
 611
 612   COMPLEX_ASSIGN (v, log10f (cabsf (z)), cargf (z));
 613   return v;
 614 }
 615 #endif
 616
 617 #if !defined(HAVE_CLOG10)
 618 #define HAVE_CLOG10 1
 619 double complex
 620 clog10 (double complex z)
 621 {
 622   double complex v;
 623
 624   COMPLEX_ASSIGN (v, log10 (cabs (z)), carg (z));
 625   return v;
 626 }
 627 #endif
 628
 629 #if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL)
 630 #define HAVE_CLOG10L 1
 631 long double complex
 632 clog10l (long double complex z)
 633 {
 634   long double complex v;
 635
 636   COMPLEX_ASSIGN (v, log10l (cabsl (z)), cargl (z));
 637   return v;
 638 }
 639 #endif
 640
 641
 642 /* pow(base, power) = cexp (power * clog (base))  */
 643 #if !defined(HAVE_CPOWF)
 644 #define HAVE_CPOWF 1
 645 float complex
 646 cpowf (float complex base, float complex power)
 647 {
 648   return cexpf (power * clogf (base));
 649 }
 650 #endif
 651
 652 #if !defined(HAVE_CPOW)
 653 #define HAVE_CPOW 1
 654 double complex
 655 cpow (double complex base, double complex power)
 656 {
 657   return cexp (power * clog (base));
 658 }
 659 #endif
 660
 661 #if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL)
 662 #define HAVE_CPOWL 1
 663 long double complex
 664 cpowl (long double complex base, long double complex power)
 665 {
 666   return cexpl (power * clogl (base));
 667 }
 668 #endif
 669
 670
 671 /* sqrt(z).  Algorithm pulled from glibc.  */
 672 #if !defined(HAVE_CSQRTF)
 673 #define HAVE_CSQRTF 1
 674 float complex
 675 csqrtf (float complex z)
 676 {
 677   float re, im;
 678   float complex v;
 679
 680   re = REALPART (z);
 681   im = IMAGPART (z);
 682   if (im == 0)
 683     {
 684       if (re < 0)
 685         {
 686           COMPLEX_ASSIGN (v, 0, copysignf (sqrtf (-re), im));
 687         }
 688       else
 689         {
 690           COMPLEX_ASSIGN (v, fabsf (sqrtf (re)), copysignf (0, im));
 691         }
 692     }
 693   else if (re == 0)
 694     {
 695       float r;
 696
 697       r = sqrtf (0.5 * fabsf (im));
 698
 699       COMPLEX_ASSIGN (v, r, copysignf (r, im));
 700     }
 701   else
 702     {
 703       float d, r, s;
 704
 705       d = hypotf (re, im);
 706       /* Use the identity   2  Re res  Im res = Im x
 707          to avoid cancellation error in  d +/- Re x.  */
 708       if (re > 0)
 709         {
 710           r = sqrtf (0.5 * d + 0.5 * re);
 711           s = (0.5 * im) / r;
 712         }
 713       else
 714         {
 715           s = sqrtf (0.5 * d - 0.5 * re);
 716           r = fabsf ((0.5 * im) / s);
 717         }
 718
 719       COMPLEX_ASSIGN (v, r, copysignf (s, im));
 720     }
 721   return v;
 722 }
 723 #endif
 724
 725 #if !defined(HAVE_CSQRT)
 726 #define HAVE_CSQRT 1
 727 double complex
 728 csqrt (double complex z)
 729 {
 730   double re, im;
 731   double complex v;
 732
 733   re = REALPART (z);
 734   im = IMAGPART (z);
 735   if (im == 0)
 736     {
 737       if (re < 0)
 738         {
 739           COMPLEX_ASSIGN (v, 0, copysign (sqrt (-re), im));
 740         }
 741       else
 742         {
 743           COMPLEX_ASSIGN (v, fabs (sqrt (re)), copysign (0, im));
 744         }
 745     }
 746   else if (re == 0)
 747     {
 748       double r;
 749
 750       r = sqrt (0.5 * fabs (im));
 751
 752       COMPLEX_ASSIGN (v, r, copysign (r, im));
 753     }
 754   else
 755     {
 756       double d, r, s;
 757
 758       d = hypot (re, im);
 759       /* Use the identity   2  Re res  Im res = Im x
 760          to avoid cancellation error in  d +/- Re x.  */
 761       if (re > 0)
 762         {
 763           r = sqrt (0.5 * d + 0.5 * re);
 764           s = (0.5 * im) / r;
 765         }
 766       else
 767         {
 768           s = sqrt (0.5 * d - 0.5 * re);
 769           r = fabs ((0.5 * im) / s);
 770         }
 771
 772       COMPLEX_ASSIGN (v, r, copysign (s, im));
 773     }
 774   return v;
 775 }
 776 #endif
 777
 778 #if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL)
 779 #define HAVE_CSQRTL 1
 780 long double complex
 781 csqrtl (long double complex z)
 782 {
 783   long double re, im;
 784   long double complex v;
 785
 786   re = REALPART (z);
 787   im = IMAGPART (z);
 788   if (im == 0)
 789     {
 790       if (re < 0)
 791         {
 792           COMPLEX_ASSIGN (v, 0, copysignl (sqrtl (-re), im));
 793         }
 794       else
 795         {
 796           COMPLEX_ASSIGN (v, fabsl (sqrtl (re)), copysignl (0, im));
 797         }
 798     }
 799   else if (re == 0)
 800     {
 801       long double r;
 802
 803       r = sqrtl (0.5 * fabsl (im));
 804
 805       COMPLEX_ASSIGN (v, copysignl (r, im), r);
 806     }
 807   else
 808     {
 809       long double d, r, s;
 810
 811       d = hypotl (re, im);
 812       /* Use the identity   2  Re res  Im res = Im x
 813          to avoid cancellation error in  d +/- Re x.  */
 814       if (re > 0)
 815         {
 816           r = sqrtl (0.5 * d + 0.5 * re);
 817           s = (0.5 * im) / r;
 818         }
 819       else
 820         {
 821           s = sqrtl (0.5 * d - 0.5 * re);
 822           r = fabsl ((0.5 * im) / s);
 823         }
 824
 825       COMPLEX_ASSIGN (v, r, copysignl (s, im));
 826     }
 827   return v;
 828 }
 829 #endif
 830
 831
 832 /* sinh(a + i b) = sinh(a) cos(b) + i cosh(a) sin(b)  */
 833 #if !defined(HAVE_CSINHF)
 834 #define HAVE_CSINHF 1
 835 float complex
 836 csinhf (float complex a)
 837 {
 838   float r, i;
 839   float complex v;
 840
 841   r = REALPART (a);
 842   i = IMAGPART (a);
 843   COMPLEX_ASSIGN (v, sinhf (r) * cosf (i), coshf (r) * sinf (i));
 844   return v;
 845 }
 846 #endif
 847
 848 #if !defined(HAVE_CSINH)
 849 #define HAVE_CSINH 1
 850 double complex
 851 csinh (double complex a)
 852 {
 853   double r, i;
 854   double complex v;
 855
 856   r = REALPART (a);
 857   i = IMAGPART (a);
 858   COMPLEX_ASSIGN (v, sinh (r) * cos (i), cosh (r) * sin (i));
 859   return v;
 860 }
 861 #endif
 862
 863 #if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL)
 864 #define HAVE_CSINHL 1
 865 long double complex
 866 csinhl (long double complex a)
 867 {
 868   long double r, i;
 869   long double complex v;
 870
 871   r = REALPART (a);
 872   i = IMAGPART (a);
 873   COMPLEX_ASSIGN (v, sinhl (r) * cosl (i), coshl (r) * sinl (i));
 874   return v;
 875 }
 876 #endif
 877
 878
 879 /* cosh(a + i b) = cosh(a) cos(b) - i sinh(a) sin(b)  */
 880 #if !defined(HAVE_CCOSHF)
 881 #define HAVE_CCOSHF 1
 882 float complex
 883 ccoshf (float complex a)
 884 {
 885   float r, i;
 886   float complex v;
 887
 888   r = REALPART (a);
 889   i = IMAGPART (a);
 890   COMPLEX_ASSIGN (v, coshf (r) * cosf (i), - (sinhf (r) * sinf (i)));
 891   return v;
 892 }
 893 #endif
 894
 895 #if !defined(HAVE_CCOSH)
 896 #define HAVE_CCOSH 1
 897 double complex
 898 ccosh (double complex a)
 899 {
 900   double r, i;
 901   double complex v;
 902
 903   r = REALPART (a);
 904   i = IMAGPART (a);
 905   COMPLEX_ASSIGN (v, cosh (r) * cos (i), - (sinh (r) * sin (i)));
 906   return v;
 907 }
 908 #endif
 909
 910 #if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL)
 911 #define HAVE_CCOSHL 1
 912 long double complex
 913 ccoshl (long double complex a)
 914 {
 915   long double r, i;
 916   long double complex v;
 917
 918   r = REALPART (a);
 919   i = IMAGPART (a);
 920   COMPLEX_ASSIGN (v, coshl (r) * cosl (i), - (sinhl (r) * sinl (i)));
 921   return v;
 922 }
 923 #endif
 924
 925
 926 /* tanh(a + i b) = (tanh(a) + i tan(b)) / (1 - i tanh(a) tan(b))  */
 927 #if !defined(HAVE_CTANHF)
 928 #define HAVE_CTANHF 1
 929 float complex
 930 ctanhf (float complex a)
 931 {
 932   float rt, it;
 933   float complex n, d;
 934
 935   rt = tanhf (REALPART (a));
 936   it = tanf (IMAGPART (a));
 937   COMPLEX_ASSIGN (n, rt, it);
 938   COMPLEX_ASSIGN (d, 1, - (rt * it));
 939
 940   return n / d;
 941 }
 942 #endif
 943
 944 #if !defined(HAVE_CTANH)
 945 #define HAVE_CTANH 1
 946 double complex
 947 ctanh (double complex a)
 948 {
 949   double rt, it;
 950   double complex n, d;
 951
 952   rt = tanh (REALPART (a));
 953   it = tan (IMAGPART (a));
 954   COMPLEX_ASSIGN (n, rt, it);
 955   COMPLEX_ASSIGN (d, 1, - (rt * it));
 956
 957   return n / d;
 958 }
 959 #endif
 960
 961 #if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL)
 962 #define HAVE_CTANHL 1
 963 long double complex
 964 ctanhl (long double complex a)
 965 {
 966   long double rt, it;
 967   long double complex n, d;
 968
 969   rt = tanhl (REALPART (a));
 970   it = tanl (IMAGPART (a));
 971   COMPLEX_ASSIGN (n, rt, it);
 972   COMPLEX_ASSIGN (d, 1, - (rt * it));
 973
 974   return n / d;
 975 }
 976 #endif
 977
 978
 979 /* sin(a + i b) = sin(a) cosh(b) + i cos(a) sinh(b)  */
 980 #if !defined(HAVE_CSINF)
 981 #define HAVE_CSINF 1
 982 float complex
 983 csinf (float complex a)
 984 {
 985   float r, i;
 986   float complex v;
 987
 988   r = REALPART (a);
 989   i = IMAGPART (a);
 990   COMPLEX_ASSIGN (v, sinf (r) * coshf (i), cosf (r) * sinhf (i));
 991   return v;
 992 }
 993 #endif
 994
 995 #if !defined(HAVE_CSIN)
 996 #define HAVE_CSIN 1
 997 double complex
 998 csin (double complex a)
 999 {
1000   double r, i;
1001   double complex v;
1002
1003   r = REALPART (a);
1004   i = IMAGPART (a);
1005   COMPLEX_ASSIGN (v, sin (r) * cosh (i), cos (r) * sinh (i));
1006   return v;
1007 }
1008 #endif
1009
1010 #if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL)
1011 #define HAVE_CSINL 1
1012 long double complex
1013 csinl (long double complex a)
1014 {
1015   long double r, i;
1016   long double complex v;
1017
1018   r = REALPART (a);
1019   i = IMAGPART (a);
1020   COMPLEX_ASSIGN (v, sinl (r) * coshl (i), cosl (r) * sinhl (i));
1021   return v;
1022 }
1023 #endif
1024
1025
1026 /* cos(a + i b) = cos(a) cosh(b) - i sin(a) sinh(b)  */
1027 #if !defined(HAVE_CCOSF)
1028 #define HAVE_CCOSF 1
1029 float complex
1030 ccosf (float complex a)
1031 {
1032   float r, i;
1033   float complex v;
1034
1035   r = REALPART (a);
1036   i = IMAGPART (a);
1037   COMPLEX_ASSIGN (v, cosf (r) * coshf (i), - (sinf (r) * sinhf (i)));
1038   return v;
1039 }
1040 #endif
1041
1042 #if !defined(HAVE_CCOS)
1043 #define HAVE_CCOS 1
1044 double complex
1045 ccos (double complex a)
1046 {
1047   double r, i;
1048   double complex v;
1049
1050   r = REALPART (a);
1051   i = IMAGPART (a);
1052   COMPLEX_ASSIGN (v, cos (r) * cosh (i), - (sin (r) * sinh (i)));
1053   return v;
1054 }
1055 #endif
1056
1057 #if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL)
1058 #define HAVE_CCOSL 1
1059 long double complex
1060 ccosl (long double complex a)
1061 {
1062   long double r, i;
1063   long double complex v;
1064
1065   r = REALPART (a);
1066   i = IMAGPART (a);
1067   COMPLEX_ASSIGN (v, cosl (r) * coshl (i), - (sinl (r) * sinhl (i)));
1068   return v;
1069 }
1070 #endif
1071
1072
1073 /* tan(a + i b) = (tan(a) + i tanh(b)) / (1 - i tan(a) tanh(b))  */
1074 #if !defined(HAVE_CTANF)
1075 #define HAVE_CTANF 1
1076 float complex
1077 ctanf (float complex a)
1078 {
1079   float rt, it;
1080   float complex n, d;
1081
1082   rt = tanf (REALPART (a));
1083   it = tanhf (IMAGPART (a));
1084   COMPLEX_ASSIGN (n, rt, it);
1085   COMPLEX_ASSIGN (d, 1, - (rt * it));
1086
1087   return n / d;
1088 }
1089 #endif
1090
1091 #if !defined(HAVE_CTAN)
1092 #define HAVE_CTAN 1
1093 double complex
1094 ctan (double complex a)
1095 {
1096   double rt, it;
1097   double complex n, d;
1098
1099   rt = tan (REALPART (a));
1100   it = tanh (IMAGPART (a));
1101   COMPLEX_ASSIGN (n, rt, it);
1102   COMPLEX_ASSIGN (d, 1, - (rt * it));
1103
1104   return n / d;
1105 }
1106 #endif
1107
1108 #if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL)
1109 #define HAVE_CTANL 1
1110 long double complex
1111 ctanl (long double complex a)
1112 {
1113   long double rt, it;
1114   long double complex n, d;
1115
1116   rt = tanl (REALPART (a));
1117   it = tanhl (IMAGPART (a));
1118   COMPLEX_ASSIGN (n, rt, it);
1119   COMPLEX_ASSIGN (d, 1, - (rt * it));
1120
1121   return n / d;
1122 }
1123 #endif
1124