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