this repo has no description
at fixPythonPipStalling 2852 lines 91 kB view raw
1/* 2 * Copyright (c) 2002 Apple Computer, Inc. All rights reserved. 3 * 4 * @APPLE_LICENSE_HEADER_START@ 5 * 6 * The contents of this file constitute Original Code as defined in and 7 * are subject to the Apple Public Source License Version 1.1 (the 8 * "License"). You may not use this file except in compliance with the 9 * License. Please obtain a copy of the License at 10 * http://www.apple.com/publicsource and read it before using this file. 11 * 12 * This Original Code and all software distributed under the License are 13 * distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER 14 * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, 15 * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, 16 * FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the 17 * License for the specific language governing rights and limitations 18 * under the License. 19 * 20 * @APPLE_LICENSE_HEADER_END@ 21 */ 22/**************************************************************************** 23** File: complex.c 24** 25** Contains: C source code for implementations of floating-point 26** (double) complex functions defined in header file 27** "complex.h" for PowerPC Macintoshes in native mode. 28** Transcendental function algorithms are based on the 29** paper "Branch Cuts for Complex Elementary Functions" 30** by W. Kahan, May 17, 1987, and on Pascal and C source 31** code for the SANE 80-/96-bit extended type by Kenton 32** Hanson and Paul Finlayson, respectively. 33** 34** 35** Written by: Jon Okada, SANEitation Engineer, ext. 4-4838 36** 37** Copyright: c 1987-1993 by Apple Computer, Inc., all rights reserved. 38** 39** Change History (most recent first): 40** 41** 25 Aug 93 ali Changed clog to cLog to avoid clashing with the 42** stream i/o definition clog. 43** 14 Jul 93 ali Added #pragma fenv_access on 44** 22 Feb 93 ali Added a nomaf #pragma. 45** 05 Feb 93 JPO Modified calls to feclearexcept and feraiseexcept 46** to reflect changes in "fenv.h". 47** 18 Dec 92 JPO First created. 48** 49****************************************************************************/ 50 51#include "math.h" 52#include "complex.h" 53#include "fenv.h" 54#include "xmmLibm_prefix.h" 55 56#define Real(z) (__real__ z) 57#define Imag(z) (__imag__ z) 58 59/**************************************************************************** 60 CONSTANTS used by complex functions 61 62#include <stdio.h> 63#include <math.h> 64#include <float.h> 65main() 66{ 67 68float FPKASINHOM4f = asinhf(nextafterf(INFINITY,0.0f))/4.0f; 69float FPKTHETAf = sqrtf(nextafterf(INFINITY,0.0f))/4.0f; 70float FPKRHOf = 1.0f/FPKTHETAf; 71float FPKLOVEREf = FLT_MIN/FLT_EPSILON; 72 73printf("FPKASINHOM4 %16.7e %x\n", FPKASINHOM4f, *(int *)(&FPKASINHOM4f)); 74printf("FPKTHETA %16.7e %x\n", FPKTHETAf, *(int *)(&FPKTHETAf)); 75printf("FPKRHO %16.7e %x\n", FPKRHOf, *(int *)(&FPKRHOf)); 76printf("FPKLOVERE %16.7e %x\n", FPKLOVEREf, *(int *)(&FPKLOVEREf)); 77} 78 79static const // underflow threshold / round threshold 80 hexdouble FPKLOVERE = HEXDOUBLE(0x03600000,0x00000000); 81 82static const // underflow threshold / round threshold 83 hexsingle FPKLOVEREf = { 0xc000000 }; 84 85static const // exp(709.0) 86 hexdouble FPKEXP709 = HEXDOUBLE(0x7fdd422d,0x2be5dc9b); 87 88static const // asinh(nextafterd(+infinity,0.0))/4.0 89 hexdouble FPKASINHOM4 = HEXDOUBLE(0x406633ce,0x8fb9f87e); 90 91static const // asinh(nextafterf(+infinity,0.0))/4.0 92 hexsingle FPKASINHOM4f = { 0x41b2d4fc }; 93 94static const // sqrt(nextafterd(+infinity,0.0))/4.0 95 hexdouble FPKTHETA = HEXDOUBLE(0x5fcfffff,0xffffffff); 96 97static const // sqrt(nextafterf(+infinity,0.0))/4.0 98 hexsingle FPKTHETAf = { 0x5e7fffff }; 99 100static const // 4.0/sqrt(nextafterd(+infinity,0.0)) 101 hexdouble FPKRHO = HEXDOUBLE(0x20100000,0x00000000); 102 103static const // 4.0/sqrt(nextafterf(+infinity,0.0)) 104 hexsingle FPKRHOf = { 0x20800001 }; 105 106****************************************************************************/ 107 108static const double expOverflowThreshold_d = 0x1.62e42fefa39efp+9; 109static const double expOverflowValue_d = 0x1.fffffffffff2ap+1023; // exp(overflowThreshold) 110static const double twiceExpOverflowThresh_d = 0x1.62e42fefa39efp+10; 111 112static const long double expOverflowThreshold_ld = 0xb.17217f7d1cf79abp+10L; 113static const long double expOverflowValue_ld = 0xf.fffffffffffcd87p+16380L; // exp(overflowThreshold) 114static const long double twiceExpOverflowThresh_ld = 0xb.17217f7d1cf79abp+10L; 115 116 117static const double FPKASINHOM4 = 0x1.633ce8fb9f87ep+7; 118static const float FPKASINHOM4f = 0x1.65a9f8p+4f; 119static const double FPKTHETA = 0x1.fffffffffffffp+509; 120static const float FPKTHETAf = 0x1.fffffep+61f; 121static const double FPKRHO = 0x1p-510; 122static const float FPKRHOf = 0x1.000002p-62f; 123 124static 125double complex xdivc( double x, double complex y ) /* returns (real x) / (complex y) */ 126{ 127 double complex z; 128 double r, denom; 129 130 if ( __builtin_fabs(Real(y)) >= __builtin_fabs(Imag(y)) ) { /* |Real(y)| >= |Imag(y)| */ 131 if (__builtin_fabs(Real(y)) == INFINITY) { /* Imag(y) and Real(y) are infinite */ 132 Real(z) = __builtin_copysign(0.0,Real(y)); 133 Imag(z) = __builtin_copysign(0.0,-Imag(y)); 134 } 135 else { /* |Real(y)| >= finite |Imag(y)| */ 136 r = Imag(y)/Real(y); 137 denom = Real(y) + Imag(y)*r; 138 Real(z) = x/denom; 139 Imag(z) = (-x*r)/denom; 140 } 141 } 142 143 else { /* |Real(y)| !>= |Imag(y)| */ 144 r = Real(y)/Imag(y); 145 denom = r*Real(y) + Imag(y); 146 Real(z) = (r*x)/denom; 147 Imag(z) = -x/denom; 148 } 149 150 return z; 151} 152 153static 154float complex xdivcf( float x, float complex y ) /* returns (real x) / (complex y) */ 155{ 156 float complex z; 157 float r, denom; 158 159 if ( __builtin_fabsf(Real(y)) >= __builtin_fabsf(Imag(y)) ) { /* |Real(y)| >= |Imag(y)| */ 160 if (__builtin_fabsf(Real(y)) == INFINITY) { /* Imag(y) and Real(y) are infinite */ 161 Real(z) = __builtin_copysignf(0.0f,Real(y)); 162 Imag(z) = __builtin_copysignf(0.0f,-Imag(y)); 163 } 164 else { /* |Real(y)| >= finite |Imag(y)| */ 165 r = Imag(y)/Real(y); 166 denom = Real(y) + Imag(y)*r; 167 Real(z) = x/denom; 168 Imag(z) = (-x*r)/denom; 169 } 170 } 171 172 else { /* |Real(y)| !>= |Imag(y)| */ 173 r = Real(y)/Imag(y); 174 denom = r*Real(y) + Imag(y); 175 Real(z) = (r*x)/denom; 176 Imag(z) = -x/denom; 177 } 178 179 return z; 180} 181 182static 183long double complex xdivcl( long double x, long double complex y ) /* returns (real x) / (complex y) */ 184{ 185 long double complex z; 186 long double r, denom; 187 188 if ( __builtin_fabsl(Real(y)) >= __builtin_fabsl(Imag(y)) ) { /* |Real(y)| >= |Imag(y)| */ 189 if (__builtin_fabsl(Real(y)) == INFINITY) { /* Imag(y) and Real(y) are infinite */ 190 Real(z) = __builtin_copysignl(0.0L,Real(y)); 191 Imag(z) = __builtin_copysignl(0.0L,-Imag(y)); 192 } 193 else { /* |Real(y)| >= finite |Imag(y)| */ 194 r = Imag(y)/Real(y); 195 denom = Real(y) + Imag(y)*r; 196 Real(z) = x/denom; 197 Imag(z) = (-x*r)/denom; 198 } 199 } 200 201 else { /* |Real(y)| !>= |Imag(y)| */ 202 r = Real(y)/Imag(y); 203 denom = r*Real(y) + Imag(y); 204 Real(z) = (r*x)/denom; 205 Imag(z) = -x/denom; 206 } 207 208 return z; 209} 210 211/**************************************************************************** 212 double cabs(double complex z) returns the absolute value (magnitude) of its 213 complex argument z, avoiding spurious overflow, underflow, and invalid 214 exceptions. The code is identical to hypot[fl]. 215 216 On Intel, the cabs functions reside in hypot[fl].s 217****************************************************************************/ 218 219// PowerPC implementation of cabs is here in the ppc complex.c file 220 221/**************************************************************************** 222 double carg(double complex z) returns the argument (in radians) of its 223 complex argument z. The algorithm is from Kahan's paper. 224 225 The argument of a complex number z = x + i*y is defined as atan2(y,x) 226 for finite x and y. 227 228 CONSTANTS: FPKPI2 = pi/2.0 to double precision 229 FPKPI = pi to double precision 230 231 Calls: fpclassify, copysign, fabs, atan 232****************************************************************************/ 233 234double carg ( double complex z ) { return atan2(Imag(z), Real(z)); } 235 236float cargf ( float complex z ) { return atan2f(Imag(z), Real(z)); } 237 238long double cargl ( long double complex z ) { return atan2l(Imag(z), Real(z)); } 239 240/**************************************************************************** 241 double complex csqrt(double complex z) returns the complex square root of its argument. 242 The algorithm, which is from the Kahan paper, uses the following 243 identities: 244 245 sqrt(x + i*y) = sqrt((|z| + Real(z))/2) + i*sqrt((|z| - Real(z))/2) and 246 sqrt(x - i*y) = sqrt((|z| + Real(z))/2) - i*sqrt((|z| - Real(z))/2), 247 248 where y is positive and x may be positive or negative. 249 250 CONSTANTS: FPKINF = +infinity 251 252 Calls: cssqs, scalb, fabs, sqrt, copysign. 253****************************************************************************/ 254 255/* New Intel code written 9/26/06 by scanon 256 * Uses extra precision to compute |z| instead of cssqs(), saving environment calls. 257 * Note that we could also rescale using bits of the SSE2 code from ian's original intel hypot() routine, and will probably 258 * want to do exactly that in the future, to move away from using x87 for this. 259 */ 260 261double complex csqrt ( double complex z ) 262{ 263 static const double inf = __builtin_inf(); 264 double u,v; 265 266 // Special case for infinite y: 267 if (__builtin_fabs(Imag(z)) == inf) 268 return inf + I*Imag(z); // csqrt(x � i�) = � � i� for all x, including NaN. 269 270 // Special cases for y = NaN: 271 if (Imag(z) != Imag(z)) { 272 if (Real(z) != Real(z)) // csqrt(NaN + iNaN) = NaN + iNaN, quietly. 273 return z; 274 else if (Real(z) == inf) // csqrt(� + iNaN) = � + iNaN 275 return z; 276 else if (Real(z) == -inf) // csqrt(-� � iNaN) = NaN � i�. 277 return Imag(z) + I*__builtin_copysign(inf,Imag(z)); 278 else { // csqrt(x + iNaN) = NaN + iNaN if x is finite. 279 return Imag(z) + I*Imag(z); 280 } 281 } 282 283 // At this point, we know that y is finite. Deal with special cases for x: 284 // Special case for x = NaN: 285 if (Real(z) != Real(z)) { // csqrt(NaN + ix) = NaN + iNaN. 286 return Real(z) + I*__builtin_copysign(Real(z),Imag(z)); 287 } 288 289 // Special cases for x = 0: 290 if (Real(z) == 0.0) { 291 if (Imag(z) == 0.0) // csqrt(�0 + i0) = 0 + i0, csqrt(�0 - i0) = 0 - i0. 292 return I*Imag(z); 293 else { // csqrt(0 � iy) = sqrt(y/2) � i sqrt(y/2). 294 u = __builtin_sqrt(0.5*__builtin_fabs(Imag(z))); 295 return u + I*__builtin_copysign(u, Imag(z) ); 296 } 297 } 298 299 // Special cases for infinte x: 300 if (Real(z) == inf) // csqrt(� � iy) = � � i0 for finite y. 301 return inf + I*__builtin_copysign(0.0,Imag(z)); 302 if (Real(z) == -inf) // csqrt(-� � iy) = 0 � i� for finite y. 303 return I*__builtin_copysign(inf,Imag(z)); 304 305 // At this point, we know that x is finite, non-zero and y is finite. 306 else { 307 // We use extended (80-bit) precision to avoid over- or under-flow in computing |z|. 308 long double x = __builtin_fabsl(Real(z)); 309 long double y = Imag(z); 310 311 /* Compute 312 * +---------------- +---------------- 313 * | |z| + |Re z| Im z | |z| - |Re z| 314 * u = | -------------- v = ------ = � | -------------- 315 * \| 2 2u \| 2 316 * 317 * There is no risk of drastic loss of precision due to cancellation using these formulas, 318 * as there would be if we used the second expression (involving the square root) for v. 319 * 320 * Overflow or Underflow is possible, but only if the actual result does not fit in double width. 321 */ 322 u = (double)__builtin_sqrtl(0.5L*(__builtin_sqrtl(x*x + y*y) + x)); 323 v = 0.5 * (Imag(z) / u); 324 325 /* If x < 0, then sqrt(z) = |v| + I*copysign(u, Im z). 326 * Otherwise, sqrt(z) = u + I*v. 327 */ 328 if (Real(z) < 0.0) { 329 return __builtin_fabs(v) + I*__builtin_copysign(u,Imag(z)); 330 } else { 331 return u + I*v; 332 } 333 } 334} 335 336float complex csqrtf ( float complex z ) 337{ 338 static const float inf = __builtin_inff(); 339 float u,v; 340 341 // Special case for infinite y: 342 if (__builtin_fabsf(Imag(z)) == inf) 343 return inf + I*Imag(z); // csqrt(x � i�) = � � i� for all x, including NaN. 344 345 // Special cases for y = NaN: 346 if (Imag(z) != Imag(z)) { 347 if (Real(z) != Real(z)) // csqrt(NaN + iNaN) = NaN + iNaN, quietly. 348 return z; 349 else if (Real(z) == inf) // csqrt(� + iNaN) = � + iNaN 350 return z; 351 else if (Real(z) == -inf) // csqrt(-� � iNaN) = NaN � i�. 352 return Imag(z) + I*__builtin_copysignf(inf,Imag(z)); 353 else { // csqrt(x + iNaN) = NaN + iNaN if x is finite. 354 return Imag(z) + I*Imag(z); 355 } 356 } 357 358 // At this point, we know that y is finite. Deal with special cases for x: 359 // Special case for x = NaN: 360 if (Real(z) != Real(z)) { // csqrt(NaN + ix) = NaN + iNaN. 361 return Real(z) + I*__builtin_copysignf(Real(z),Imag(z)); 362 } 363 364 // Special cases for x = 0: 365 if (Real(z) == 0.0f) { 366 if (Imag(z) == 0.0f) // csqrt(�0 + i0) = 0 + i0, csqrt(�0 - i0) = 0 - i0. 367 return I*Imag(z); 368 else { // csqrt(0 � iy) = sqrt(y/2) � i sqrt(y/2). 369 u = __builtin_sqrtf(0.5f*__builtin_fabsf(Imag(z))); 370 return u + I*__builtin_copysignf(u, Imag(z) ); 371 } 372 } 373 374 // Special cases for infinte x: 375 if (Real(z) == inf) // csqrt(� � iy) = � � i0 for finite y. 376 return inf + I*__builtin_copysignf(0.0f,Imag(z)); 377 if (Real(z) == -inf) // csqrt(-� � iy) = 0 � i� for finite y. 378 return I*__builtin_copysignf(inf,Imag(z)); 379 380 // At this point, we know that x is finite, non-zero and y is finite. 381 else { 382 // We use double (64-bit) precision to avoid over- or under-flow in computing |z|. 383 double x = __builtin_fabs(Real(z)); 384 double y = Imag(z); 385 386 /* Compute 387 * +---------------- +---------------- 388 * | |z| + |Re z| Im z | |z| - |Re z| 389 * u = | -------------- v = ------ = � | -------------- 390 * \| 2 2u \| 2 391 * 392 * There is no risk of drastic loss of precision due to cancellation using these formulas, 393 * as there would be if we used the second expression (involving the square root) for v. 394 * 395 * Overflow or Underflow is possible, but only if the actual result does not fit in double width. 396 */ 397 u = (float)__builtin_sqrt(0.5*(__builtin_sqrt(x*x + y*y) + x)); 398 v = 0.5f * (Imag(z) / u); 399 400 /* If x < 0, then sqrt(z) = |v| + I*copysign(u, Im z). 401 * Otherwise, sqrt(z) = u + I*v. 402 */ 403 if (Real(z) < 0.0f) { 404 return __builtin_fabsf(v) + I*__builtin_copysignf(u,Imag(z)); 405 } else { 406 return u + I*v; 407 } 408 } 409} 410 411typedef union 412{ 413 long double ld; 414 struct 415 { 416 uint64_t mantissa; 417 int16_t sexp; 418 }; 419}ld_parts; 420 421long double complex csqrtl ( long double complex z ) { 422 423 static const long double inf = __builtin_infl(); 424 static const long double zero = 0.0l; 425 static const long double half = 0.5l; 426 long double u,v; 427 428 // Special case for infinite y: 429 if (__builtin_fabsl(Imag(z)) == inf) 430 return inf + I*Imag(z); // csqrt(x � i�) = � � i� for all x, including NaN. 431 432 // Special cases for y = NaN: 433 if (Imag(z) != Imag(z)) { 434 if (Real(z) != Real(z)) // csqrt(NaN + iNaN) = NaN + iNaN, quietly. 435 return z; 436 else if (Real(z) == inf) // csqrt(� + iNaN) = � + iNaN 437 return z; 438 else if (Real(z) == -inf) // csqrt(-� � iNaN) = NaN � i�. 439 return Imag(z) + I*__builtin_copysignl(inf,Imag(z)); 440 else { // csqrt(x + iNaN) = NaN + iNaN if x is finite. 441 return Imag(z) + I*Imag(z); 442 } 443 } 444 445 // Special cases for y = 0: 446 if (Imag(z) == zero) { 447 if (Real(z) == zero) // csqrt(�0 + i0) = 0 + i0, csqrt(�0 - i0) = 0 - i0. 448 return I*Imag(z); 449 else { 450 u = __builtin_sqrtl(__builtin_fabsl(Real(z))); 451 if (Real(z) < zero) 452 return zero + I*__builtin_copysignl(u,Imag(z)); 453 else 454 return u + I*__builtin_copysignl(zero,Imag(z)); 455 } 456 } 457 458 // At this point, we know that y is finite. Deal with special cases for x: 459 // Special case for x = NaN: 460 if (Real(z) != Real(z)) { // csqrt(NaN + ix) = NaN + iNaN. 461 return Real(z) + I*__builtin_copysignl(Real(z),Imag(z)); 462 } 463 464 // Special cases for x = 0: 465 if (Real(z) == zero) { 466 // csqrt(0 � iy) = sqrt(y/2) � i sqrt(y/2). 467 u = __builtin_sqrtl(half*__builtin_fabsl(Imag(z))); 468 return u + I*__builtin_copysignl(u, Imag(z) ); 469 } 470 471 // Special cases for infinte x: 472 if (Real(z) == inf) // csqrt(� � iy) = � � i0 for finite y. 473 return inf + I*__builtin_copysignl(zero,Imag(z)); 474 if (Real(z) == -inf) // csqrt(-� � iy) = 0 � i� for finite y. 475 return I*__builtin_copysignl(inf,Imag(z)); 476 477 // At this point, we know that x and y are finite, non-zero. 478 else { 479 long double x = __builtin_fabsl(Real(z)); 480 long double y = __builtin_fabsl(Imag(z)); 481 482 /* Compute 483 * +---------------- +---------------- 484 * | |z| + |Re z| Im z | |z| - |Re z| 485 * u = | -------------- v = ------ = � | -------------- 486 * \| 2 2u \| 2 487 * 488 * There is no risk of drastic loss of precision due to cancellation using these formulas, 489 * as there would be if we used the second expression (involving the square root) for v. 490 * 491 */ 492 493 // Scaling code taken from hypotl pretty much wholesale. 494 495 ld_parts *large = (ld_parts*) &x; 496 ld_parts *small = (ld_parts*) &y; 497 if (large->ld < small->ld) { 498 ld_parts *p = large; 499 large = small; 500 small = p; 501 } 502 int lexp = large->sexp; 503 int sexp = small->sexp; 504 if( lexp == 0 ) 505 { 506 large->ld = large->mantissa; 507 lexp = large->sexp - 16445; 508 } 509 if( sexp == 0 ) 510 { 511 small->ld = small->mantissa; 512 sexp = small->sexp - 16445; 513 } 514 large->sexp = 0x3fff; 515 int scale = 0x3fff - lexp; 516 int small_scale = sexp + scale; 517 if( small_scale < 64 ) 518 small_scale = 64; 519 small->sexp = small_scale; 520 521 u = __builtin_sqrtl( large->ld * large->ld + small->ld * small->ld ) + x; 522 if (scale%2) 523 scale = 0x3fff - (scale + 1)/2; 524 else { 525 scale = 0x3fff - (scale/2 + 1); 526 u = u + u; 527 } 528 u = __builtin_sqrtl(u); 529 530 // Rescale result. 531 532 large->sexp = scale; 533 large->mantissa = 0x8000000000000000ULL; 534 u *= large->ld; 535 536 // End scaling code. At this point u = sqrt((|z| + |Re z|) / 2). 537 538 v = Imag(z) / (2.0l * u); 539 540 /* If x < 0, then sqrt(z) = |v| + I*copysign(u, Im z). 541 * Otherwise, sqrt(z) = u + I*v. 542 */ 543 if (Real(z) < zero) { 544 return __builtin_fabsl(v) + I*__builtin_copysignl(u,Imag(z)); 545 } else { 546 return u + I*v; 547 } 548 } 549} 550 551/**************************************************************************** 552 double complex clog(double complex z) returns the complex natural logarithm of its 553 argument, using: 554 555 clog(x + iy) = [ log(x) + 0.5 * log1p(y^2/x^2) ] + I*carg(x + iy) if x > y 556 = [ log(y) + 0.5 * log1p(x^2/y^2) ] + I*carg(x + iy) otherwise 557 558 the real part is "mathematically" equivalent to log |z|, but the alternative form 559 is used to avoid spurious under/overflow. 560 561 Calls: fabs, log1p, log, carg. 562****************************************************************************/ 563 564double complex clog ( double complex z ) 565{ 566 static const double inf = __builtin_inf(); 567 double large, small, temp; 568 double complex w; 569 long double ratio; 570 571 Imag(w) = carg(z); 572 573 // handle x,y = � 574 if ((__builtin_fabs(Real(z)) == inf) || (__builtin_fabs(Imag(z)) == inf)) { 575 Real(w) = inf; 576 return w; 577 } 578 579 // handle x,y = NaN 580 if (Real(z) != Real(z)) return Real(z) + I*__builtin_copysign(Real(z),Imag(z)); 581 if (Imag(z) != Imag(z)) return Imag(z) + I*Imag(z); 582 583 large = __builtin_fabs(Real(z)); 584 small = __builtin_fabs(Imag(z)); 585 if (large < small) { 586 temp = large; 587 large = small; 588 small = temp; 589 } 590 591 Real(w) = log(large); 592 593 // if small == 0, then Re(clog(z)) = log(large). This sets div-by-zero when appropriate (if large is also 0). 594 if (small == 0.0) return w; 595 596 // if large == 1 597 if (large == 1.0) { 598 Real(w) = 0.5*log1p(small*small); // any underflow here is deserved. 599 return w; 600 } 601 602 // compute small/large in long double to avoid undue underflow. 603 ratio = (long double)small / (long double)large; 604 if (ratio > 0x1.0p-53L) { 605 /* if ratio is smaller than 2^-53, then 606 * 1/2 log1p(ratio^2) ~ 2^-106 < 1/2 an ulp of log(large), so it can't affect the final result. 607 */ 608 Real(w) += 0.5*log1p((double)(ratio*ratio)); 609 } 610 611 return w; 612} 613 614float complex clogf ( float complex z ) 615{ 616 static const float inf = __builtin_inff(); 617 float large, small, temp; 618 float complex w; 619 double ratio; 620 621 Imag(w) = cargf(z); 622 623 // handle x,y = � 624 if ((__builtin_fabsf(Real(z)) == inf) || (__builtin_fabsf(Imag(z)) == inf)) { 625 Real(w) = inf; 626 return w; 627 } 628 629 // handle x,y = NaN 630 if (Real(z) != Real(z)) return Real(z) + I*__builtin_copysignf(Real(z),Imag(z)); 631 if (Imag(z) != Imag(z)) return Imag(z) + I*Imag(z); 632 633 large = __builtin_fabsf(Real(z)); 634 small = __builtin_fabsf(Imag(z)); 635 if (large < small) { 636 temp = large; 637 large = small; 638 small = temp; 639 } 640 641 Real(w) = logf(large); 642 643 // if small == 0, then Re(clog(z)) = log(large). This sets div-by-zero when appropriate (if large is also 0). 644 if (small == 0.0f) return w; 645 646 // if large == 1 647 if (large == 1.0f) { 648 Real(w) = 0.5f*log1pf(small*small); // underflow here is deserved. 649 return w; 650 } 651 652 // compute small/large in double to avoid undue underflow. 653 ratio = (double)small / (double)large; 654 if (ratio > 0x1.0p-24) { 655 Real(w) += 0.5f*log1pf((float)(ratio*ratio)); 656 } 657 658 return w; 659} 660 661long double complex clogl ( long double complex z ) 662{ 663 static const long double inf = __builtin_infl(); 664 long double x,y; 665 long double complex w; 666 long double ratio; 667 668 Imag(w) = cargl(z); 669 670 // handle x,y = � 671 if ((__builtin_fabsl(Real(z)) == inf) || (__builtin_fabsl(Imag(z)) == inf)) { 672 Real(w) = inf; 673 return w; 674 } 675 676 // handle x,y = NaN 677 if (Real(z) != Real(z)) return Real(z) + I*__builtin_copysignl(Real(z),Imag(z)); 678 if (Imag(z) != Imag(z)) return Imag(z) + I*Imag(z); 679 680 x = __builtin_fabsl(Real(z)); 681 y = __builtin_fabsl(Imag(z)); 682 683 ld_parts *large = (ld_parts*) &x; 684 ld_parts *small = (ld_parts*) &y; 685 if (large->ld < small->ld) { 686 ld_parts *p = large; 687 large = small; 688 small = p; 689 } 690 691 Real(w) = logl(large->ld); 692 693 // if small == 0, then Re(clog(z)) = log(large). This sets div-by-zero when appropriate (if large is also 0). 694 if (small->ld == 0.0L) return w; 695 696 // if large == 1 697 if (large->ld == 1.0L) { 698 Real(w) = 0.5L*log1pl((small->ld)*(small->ld)); // underflow here is deserved. 699 return w; 700 } 701 702 if (large->sexp - small->sexp < 64) { 703 // if large and small are of roughly comparable magnitude, then the 0.5 * log1p(small^2/large^2) term is 704 // non-negligable. 705 ratio = small->ld / large->ld; 706 Real(w) += 0.5L*log1pl(ratio*ratio); 707 } 708 709 return w; 710} 711 712/**************************************************************************** 713 void cosisin(x, complex *z) 714 returns cos(x) + i sin(x) computed using the x87 fsincos instruction. 715 716 Implemented in s_cosisin.s 717 718 Called by: cexp, csin, ccos, csinh, and ccosh. 719 ****************************************************************************/ 720void cosisin(double x, double complex *z); 721void cosisinf(float x, float complex *z); 722void cosisinl(long double x, long double complex *z); 723 724 725/**************************************************************************** 726 double complex csin(double complex z) returns the complex sine of its argument. 727 728 sin(z) = -i sinh(iz) 729 730 Calls: csinh 731****************************************************************************/ 732 733double complex csin ( double complex z ) 734{ 735 double complex iz, iw, w; 736 Real(iz) = -Imag(z); 737 Imag(iz) = Real(z); 738 iw = csinh(iz); 739 Real(w) = Imag(iw); 740 Imag(w) = -Real(iw); 741 return w; 742} 743 744float complex csinf ( float complex z ) 745{ 746 float complex iz, iw, w; 747 Real(iz) = -Imag(z); 748 Imag(iz) = Real(z); 749 iw = csinhf(iz); 750 Real(w) = Imag(iw); 751 Imag(w) = -Real(iw); 752 return w; 753} 754 755long double complex csinl ( long double complex z ) 756{ 757 long double complex iz, iw, w; 758 Real(iz) = -Imag(z); 759 Imag(iz) = Real(z); 760 iw = csinhl(iz); 761 Real(w) = Imag(iw); 762 Imag(w) = -Real(iw); 763 return w; 764} 765 766/**************************************************************************** 767 double complex ccos(double complex z) returns the complex cosine of its argument. 768 769 cos(z) = cosh(iz) 770 771 Calls: ccosh 772****************************************************************************/ 773 774double complex ccos ( double complex z ) 775{ 776 double complex iz; 777 Real(iz) = -Imag(z); 778 Imag(iz) = Real(z); 779 return ccosh(iz); 780} 781 782float complex ccosf ( float complex z ) 783{ 784 float complex iz; 785 Real(iz) = -Imag(z); 786 Imag(iz) = Real(z); 787 return ccoshf(iz); 788} 789 790long double complex ccosl ( long double complex z ) 791{ 792 long double complex iz; 793 Real(iz) = -Imag(z); 794 Imag(iz) = Real(z); 795 return ccoshl(iz); 796} 797 798 799/**************************************************************************** 800 double complex csinh(double complex z) returns the complex hyperbolic sine of its 801 argument. The algorithm is based upon the identity: 802 803 sinh(x + i*y) = cos(y)*sinh(x) + i*sin(y)*cosh(x). 804 805 Signaling of spurious overflows, underflows, and invalids is avoided where 806 possible. 807 808 Calls: expm1, cosisin 809****************************************************************************/ 810 811double complex csinh ( double complex z ) 812{ 813 static const double INF = __builtin_inf(); 814 double complex w; 815 816 // Handle x = NaN first 817 if (Real(z) != Real(z)) { 818 Real(w) = Real(z); 819 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 820 Imag(w) = Imag(z); 821 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 822 Imag(w) = __builtin_copysign(Real(z), Imag(z)); 823 return w; 824 } 825 826 // At this stage, x � NaN. 827 double absx = __builtin_fabs(Real(z)); 828 double reducedx = absx; 829 830 cosisin(Imag(z), &w); // set w = cos y + i sin y. 831 Real(w) *= __builtin_copysign(1.0, Real(z)); // w = signof(x) cos y + i sin y 832 833 // Handle x = �� cases. 834 if ((absx == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0))) { 835 Real(w) = __builtin_copysign(INF, Real(z)); 836 return w; 837 } 838 839 // Handle x = 0 cases. 840 if (absx == 0.0) { 841 Real(w) = Real(z); // sign of zero needs to be right. 842 return w; 843 } 844 845 // Argument reduction, if need be. (x is now a finite non-zero number) 846 if ((reducedx < twiceExpOverflowThresh_d) && (reducedx > expOverflowThreshold_d)) { 847 reducedx -= expOverflowThreshold_d; // argument reduction, this is exact. 848 Real(w) *= expOverflowValue_d; // not exact, but good enough. 849 Imag(w) *= expOverflowValue_d; // ditto. 850 } 851 852 double exm1 = expm1(reducedx); // any overflow here is deserved. 853 854 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 855 Real(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 856 } 857 858 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 859 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 860 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 861 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 862 if (Imag(z) != 0.0) Imag(w) *= halfExpX; 863 } 864 865 else { // the "normal" case, we need to be careful. 866 double twiceExpX = 2.0 * (exm1 + 1.0); 867 /* we use the following to get cosh(x): 868 * 869 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 870 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 871 * 2*(1 + expm1(x)) 2e^x 2 872 */ 873 Imag(w) *= 1.0 + (exm1*exm1)/twiceExpX; 874 /* we use the following to get sinh(x) (up to sign): 875 * 876 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 877 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 878 * 2 \ 1 + expm1(x) / 2e^x 2 879 */ 880 Real(w) *= 0.5*exm1 + exm1/twiceExpX; 881 } 882 883 return w; 884} 885 886float complex csinhf ( float complex z ) 887{ 888 static const float INFf = __builtin_inff(); 889 static const double INF = __builtin_inf(); 890 float complex w; 891 double complex wd; 892 893 // Handle x = NaN first 894 if (Real(z) != Real(z)) { 895 Real(w) = Real(z); 896 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 897 Imag(w) = Imag(z); 898 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 899 Imag(w) = __builtin_copysignf(Real(z), Imag(z)); 900 return w; 901 } 902 903 // At this stage, x � NaN. 904 double absx = (double)__builtin_fabsf(Real(z)); 905 906 cosisin((double)Imag(z), &wd); // set w = cos y + i sin y. 907 Real(wd) *= __builtin_copysign(1.0, (double)Real(z)); // w = signof(x) cos y + i sin y 908 909 // Handle x = �� cases. 910 if ((absx == INF) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0f))) { 911 Real(w) = __builtin_copysignf(INFf, Real(z)); 912 Imag(w) = (float)Imag(wd); 913 return w; 914 } 915 916 // Handle x = 0 cases. 917 if (absx == 0.0) { 918 Real(w) = Real(z); // sign of zero needs to be right. 919 Imag(w) = (float)Imag(wd); 920 return w; 921 } 922 923 double exm1 = expm1(absx); // any overflow here is deserved. 924 925 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 926 Real(wd) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 927 } 928 929 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 930 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 931 Real(wd) *= halfExpX; // sinh = (e^x - e^-x) / 2. 932 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 933 if (Imag(z) != 0.0f) Imag(wd) *= halfExpX; 934 } 935 936 else { // the "normal" case, we need to be careful. 937 double twiceExpX = 2.0 * (exm1 + 1.0); 938 /* we use the following to get cosh(x): 939 * 940 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 941 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 942 * 2*(1 + expm1(x)) 2e^x 2 943 */ 944 Imag(wd) *= 1.0 + (exm1*exm1)/twiceExpX; 945 /* we use the following to get sinh(x) (up to sign): 946 * 947 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 948 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 949 * 2 \ 1 + expm1(x) / 2e^x 2 950 */ 951 Real(wd) *= 0.5*exm1 + exm1/twiceExpX; 952 } 953 954 Real(w) = (float)Real(wd); 955 Imag(w) = (float)Imag(wd); 956 return w; 957} 958 959long double complex csinhl ( long double complex z ) 960{ 961 static const long double INFl = __builtin_infl(); 962 long double complex w; 963 964 // Handle x = NaN first 965 if (Real(z) != Real(z)) { 966 Real(w) = Real(z); 967 if (Imag(z) == 0.0L) // cexp(NaN + 0i) = NaN + 0i 968 Imag(w) = Imag(z); 969 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 970 Imag(w) = __builtin_copysignl(Real(z), Imag(z)); 971 return w; 972 } 973 974 // At this stage, x � NaN. 975 long double absx = __builtin_fabsl(Real(z)); 976 long double reducedx = absx; 977 978 cosisinl(Imag(z), &w); // set w = cos y + i sin y. 979 Real(w) *= __builtin_copysignl(1.0L, Real(z)); // w = signof(x) cos y + i sin y 980 981 // Handle x = �� cases. 982 if ((absx == INFl) && ((Imag(z) == INFl) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0L))) { 983 Real(w) = __builtin_copysignl(INFl, Real(z)); 984 return w; 985 } 986 987 // Handle x = 0 cases. 988 if (absx == 0.0L) { 989 Real(w) = Real(z); // sign of zero needs to be right. 990 return w; 991 } 992 993 // Argument reduction, if need be. (x is now a finite non-zero number) 994 if ((reducedx < twiceExpOverflowThresh_ld) && (reducedx > expOverflowThreshold_ld)) { 995 reducedx -= expOverflowThreshold_ld; // argument reduction, this is exact. 996 Real(w) *= expOverflowValue_ld; // not exact, but good enough. 997 Imag(w) *= expOverflowValue_ld; // ditto. 998 } 999 1000 long double exm1 = expm1l(reducedx); // any overflow here is deserved. 1001 1002 if (absx < 0x1p-32L) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 1003 Real(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 1004 } 1005 1006 else if (absx > 23L) { // if |x| > 23, then e^-x is less than an ulp of e^x, so the smaller term in 1007 long double halfExpX = 0.5L * (exm1 + 1.0L); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 1008 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 1009 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 1010 if (Imag(z) != 0.0L) Imag(w) *= halfExpX; 1011 } 1012 1013 else { // the "normal" case, we need to be careful. 1014 long double twiceExpX = 2.0L * (exm1 + 1.0L); 1015 /* we use the following to get cosh(x): 1016 * 1017 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 1018 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 1019 * 2*(1 + expm1(x)) 2e^x 2 1020 */ 1021 Imag(w) *= 1.0L + (exm1*exm1)/twiceExpX; 1022 /* we use the following to get sinh(x) (up to sign): 1023 * 1024 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 1025 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 1026 * 2 \ 1 + expm1(x) / 2e^x 2 1027 */ 1028 Real(w) *= 0.5L*exm1 + exm1/twiceExpX; 1029 } 1030 1031 return w; 1032} 1033 1034 1035/**************************************************************************** 1036 double complex ccosh(double complex z) returns the complex hyperbolic cosine of its 1037 argument. The algorithm is based upon the identity: 1038 1039 cosh(x + i*y) = cos(y)*cosh(x) + i*sin(y)*sinh(x). 1040 1041 Signaling of spurious overflows, underflows, and invalids is avoided where 1042 possible. 1043 1044 Calls: expm1, cosisin 1045****************************************************************************/ 1046 1047double complex ccosh ( double complex z ) 1048{ 1049 static const double INF = __builtin_inf(); 1050 double complex w; 1051 1052 // Handle x = NaN first 1053 if (Real(z) != Real(z)) { 1054 Real(w) = Real(z); 1055 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 1056 Imag(w) = Imag(z); 1057 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1058 Imag(w) = __builtin_copysign(Real(z), Imag(z)); 1059 return w; 1060 } 1061 1062 // At this stage, x � NaN. 1063 double absx = __builtin_fabs(Real(z)); 1064 double reducedx = absx; 1065 1066 cosisin(Imag(z), &w); // set w = cos y + i sin y. 1067 Imag(w) *= __builtin_copysign(1.0, Real(z)); // w = cos y + i sin y * signof(x) 1068 1069 // Handle x = �� cases. 1070 if ((absx == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0))) { 1071 Real(w) = INF; 1072 return w; 1073 } 1074 1075 // Handle x = 0 cases. 1076 if (absx == 0.0) { 1077 Imag(w) = Real(z) * __builtin_copysign(1.0, Imag(z)); // finesse the sign of zero. 1078 return w; 1079 } 1080 1081 // Argument reduction, if need be. (x is now a finite non-zero number) 1082 if ((reducedx < twiceExpOverflowThresh_d) && (reducedx > expOverflowThreshold_d)) { 1083 reducedx -= expOverflowThreshold_d; // argument reduction, this is exact. 1084 Real(w) *= expOverflowValue_d; // not exact, but good enough. 1085 Imag(w) *= expOverflowValue_d; // ditto. 1086 } 1087 1088 double exm1 = expm1(reducedx); // any overflow here is deserved. 1089 1090 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 1091 Imag(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 1092 } 1093 1094 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 1095 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 1096 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 1097 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 1098 if (Imag(z) != 0.0) Imag(w) *= halfExpX; 1099 } 1100 1101 else { // the "normal" case, we need to be careful. 1102 double twiceExpX = 2.0 * (exm1 + 1.0); 1103 /* we use the following to get cosh(x): 1104 * 1105 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 1106 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 1107 * 2*(1 + expm1(x)) 2e^x 2 1108 */ 1109 Real(w) *= 1.0 + (exm1*exm1)/twiceExpX; 1110 /* we use the following to get sinh(x) (up to sign): 1111 * 1112 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 1113 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 1114 * 2 \ 1 + expm1(x) / 2e^x 2 1115 */ 1116 Imag(w) *= 0.5*exm1 + exm1/twiceExpX; 1117 } 1118 1119 return w; 1120} 1121 1122float complex ccoshf ( float complex z ) 1123{ 1124 static const float INFf = __builtin_inff(); 1125 static const double INF = __builtin_inf(); 1126 double complex wd; 1127 float complex w; 1128 1129 // Handle x = NaN first 1130 if (Real(z) != Real(z)) { 1131 Real(w) = Real(z); 1132 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 1133 Imag(w) = Imag(z); 1134 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1135 Imag(w) = __builtin_copysignf(Real(z), Imag(z)); 1136 return w; 1137 } 1138 1139 // At this stage, x � NaN. 1140 double absx = (double)__builtin_fabsf(Real(z)); 1141 1142 cosisin((double)Imag(z), &wd); // set w = cos y + i sin y. 1143 Imag(wd) *= __builtin_copysign(1.0, (double)Real(z)); // w = cos y + i sin y * signof(x) 1144 1145 // Handle x = �� cases. 1146 if ((absx == INF) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0f))) { 1147 Real(w) = INFf; 1148 Imag(w) = (float)Imag(wd); 1149 return w; 1150 } 1151 1152 // Handle x = 0 cases. 1153 if (absx == 0.0) { 1154 Imag(w) = Real(z) * __builtin_copysignf(1.0f, Imag(z)); // finesse the sign of zero. 1155 Real(w) = (float)Real(wd); 1156 return w; 1157 } 1158 1159 double exm1 = expm1(absx); // any overflow here is deserved. 1160 1161 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 1162 Imag(wd) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 1163 } 1164 1165 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 1166 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 1167 Real(wd) *= halfExpX; // sinh = (e^x - e^-x) / 2. 1168 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 1169 if (Imag(z) != 0.0) Imag(wd) *= halfExpX; 1170 } 1171 1172 else { // the "normal" case, we need to be careful. 1173 double twiceExpX = 2.0 * (exm1 + 1.0); 1174 /* we use the following to get cosh(x): 1175 * 1176 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 1177 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 1178 * 2*(1 + expm1(x)) 2e^x 2 1179 */ 1180 Real(wd) *= 1.0 + (exm1*exm1)/twiceExpX; 1181 /* we use the following to get sinh(x) (up to sign): 1182 * 1183 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 1184 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 1185 * 2 \ 1 + expm1(x) / 2e^x 2 1186 */ 1187 Imag(wd) *= 0.5*exm1 + exm1/twiceExpX; 1188 } 1189 1190 Real(w) = (float)Real(wd); 1191 Imag(w) = (float)Imag(wd); 1192 return w; 1193} 1194 1195long double complex ccoshl ( long double complex z ) 1196{ 1197 static const long double INFl = __builtin_infl(); 1198 long double complex w; 1199 1200 // Handle x = NaN first 1201 if (Real(z) != Real(z)) { 1202 Real(w) = Real(z); 1203 if (Imag(z) == 0.0L) // cexp(NaN + 0i) = NaN + 0i 1204 Imag(w) = Imag(z); 1205 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1206 Imag(w) = __builtin_copysignl(Real(z), Imag(z)); 1207 return w; 1208 } 1209 1210 // At this stage, x � NaN. 1211 long double absx = __builtin_fabsl(Real(z)); 1212 long double reducedx = absx; 1213 1214 cosisinl(Imag(z), &w); // set w = cos y + i sin y. 1215 Imag(w) *= __builtin_copysignl(1.0, Real(z)); // w = cos y + i sin y * signof(x) 1216 1217 // Handle x = �� cases. 1218 if ((absx == INFl) && ((Imag(z) == INFl) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0L))) { 1219 Real(w) = INFl; 1220 return w; 1221 } 1222 1223 // Handle x = 0 cases. 1224 if (absx == 0.0L) { 1225 Imag(w) = Real(z) * __builtin_copysignl(1.0, Imag(z)); // finesse the sign of zero. 1226 return w; 1227 } 1228 1229 // Argument reduction, if need be. (x is now a finite non-zero number) 1230 if ((reducedx < twiceExpOverflowThresh_ld) && (reducedx > expOverflowThreshold_ld)) { 1231 reducedx -= expOverflowThreshold_ld; // argument reduction, this is exact. 1232 Real(w) *= expOverflowValue_ld; // not exact, but good enough. 1233 Imag(w) *= expOverflowValue_ld; // ditto. 1234 } 1235 1236 long double exm1 = expm1l(reducedx); // any overflow here is deserved. 1237 1238 if (absx < 0x1p-32L) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 1239 Imag(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 1240 } 1241 1242 else if (absx > 23L) { // if |x| > 23, then e^-x is less than an ulp of e^x, so the smaller term in 1243 long double halfExpX = 0.5L * (exm1 + 1.0L); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 1244 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 1245 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 1246 if (Imag(z) != 0.0L) Imag(w) *= halfExpX; 1247 } 1248 1249 else { // the "normal" case, we need to be careful. 1250 long double twiceExpX = 2.0L * (exm1 + 1.0L); 1251 /* we use the following to get cosh(x): 1252 * 1253 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 1254 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 1255 * 2*(1 + expm1(x)) 2e^x 2 1256 */ 1257 Real(w) *= 1.0L + (exm1*exm1)/twiceExpX; 1258 /* we use the following to get sinh(x) (up to sign): 1259 * 1260 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 1261 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 1262 * 2 \ 1 + expm1(x) / 2e^x 2 1263 */ 1264 Imag(w) *= 0.5L*exm1 + exm1/twiceExpX; 1265 } 1266 1267 return w; 1268} 1269 1270 1271/**************************************************************************** 1272 double complex cexp(double complex z) returns the complex exponential of its 1273 argument. The algorithm is based upon the identity: 1274 1275 exp(x + i*y) = cos(y)*exp(x) + i*sin(y)*exp(x). 1276 1277 Signaling of spurious overflows and invalids is avoided where 1278 possible. 1279 1280 CONSTANTS: expOverflowValue_d = exp(709.0) to double precision 1281 1282 Calls: cosisin and exp. 1283****************************************************************************/ 1284 1285double complex cexp ( double complex z ) 1286{ 1287 static const double INF = __builtin_inf(); 1288 double complex w; 1289 1290 // Handle x = NaN first 1291 if (Real(z) != Real(z)) { 1292 Real(w) = Real(z); 1293 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 1294 Imag(w) = Imag(z); 1295 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1296 Imag(w) = __builtin_copysign(Real(z), Imag(z)); 1297 return w; 1298 } 1299 1300 // Handle x = -�, y = � or NaN: 1301 if ((Real(z) == -INF) && ((__builtin_fabs(Imag(z)) == INF) || (Imag(z) != Imag(z)))) { 1302 Real(w) = 0.0; 1303 Imag(w) = __builtin_copysign(0.0, Imag(z)); 1304 return w; 1305 } 1306 1307 if (Imag(z) == 0.0) { // exact exp(x + 0i) case. 1308 Real(w) = exp(Real(z)); 1309 Imag(w) = __builtin_copysign(0.0, Imag(z)); 1310 return w; 1311 } 1312 1313 // At this stage, x � NaN, and extraordinary x = -� cases are sorted. y � 0. 1314 cosisin(Imag(z), &w); // set w = cos(y) + i sin(y) 1315 1316 // Handle x = +� cases. 1317 if ((Real(z) == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)))) { 1318 Real(w) = INF; // cexp(� + yi) = � + NaNi for y = NaN or �. 1319 return w; // cexp(� + yi) for finite y falls through. 1320 } 1321 1322 // At this point, x � NaN, +inf, y � 0, and all remaining cases fall through 1323 double x = Real(z); 1324 1325 if ((x < twiceExpOverflowThresh_d) && (x > expOverflowThreshold_d)) { 1326 x -= expOverflowThreshold_d; // argument reduction, this is exact. 1327 Real(w) *= expOverflowValue_d; // not exact, but good enough. 1328 Imag(w) *= expOverflowValue_d; // ditto. 1329 } 1330 1331 double scale = exp(x); 1332 Real(w) *= scale; 1333 Imag(w) *= scale; 1334 return w; 1335} 1336 1337float complex cexpf ( float complex z ) 1338{ 1339 static const float INFf = __builtin_inff(); 1340 float complex w; 1341 1342 // Handle x = NaN first 1343 if (Real(z) != Real(z)) { 1344 Real(w) = Real(z); 1345 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 1346 Imag(w) = Imag(z); 1347 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1348 Imag(w) = __builtin_copysignf(Real(z), Imag(z)); 1349 return w; 1350 } 1351 1352 // Handle x = -�, y = � or NaN: 1353 if ((Real(z) == -INFf) && ((__builtin_fabsf(Imag(z)) == INFf) || (Imag(z) != Imag(z)))) { 1354 Real(w) = 0.0f; 1355 Imag(w) = __builtin_copysignf(0.0f, Imag(z)); 1356 return w; 1357 } 1358 1359 if (Imag(z) == 0.0f) { // exact exp(x + 0i) case. 1360 Real(w) = expf(Real(z)); 1361 Imag(w) = __builtin_copysignf(0.0f, Imag(z)); 1362 return w; 1363 } 1364 1365 double complex wd; 1366 // At this stage, x � NaN, and extraordinary x = -� cases are sorted. y � 0. 1367 cosisin((double)Imag(z), &wd); // set w = cos(y) + i sin(y) 1368 1369 // Handle x = +� cases. 1370 if ((Real(z) == INFf) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)))) { 1371 Real(w) = INFf; // cexp(� + yi) = � + NaNi for y = NaN or �. 1372 Imag(w) = (float)Imag(wd); 1373 return w; // cexp(� + yi) for finite y falls through. 1374 } 1375 1376 // At this point, x � NaN, +inf, y � 0, and all remaining cases fall through 1377 1378 double scale = exp((double)Real(z)); 1379 Real(w) = (float)(scale*Real(wd)); 1380 Imag(w) = (float)(scale*Imag(wd)); 1381 return w; 1382} 1383 1384long double complex cexpl ( long double complex z ) 1385{ 1386 static const long double INFl = __builtin_infl(); 1387 long double complex w; 1388 1389 // Handle x = NaN first 1390 if (Real(z) != Real(z)) { 1391 Real(w) = Real(z); 1392 if (Imag(z) == 0.0L) // cexp(NaN + 0i) = NaN + 0i 1393 Imag(w) = Imag(z); 1394 else // cexp(NaN + yi) = NaN + NaNi, for y � 0 1395 Imag(w) = __builtin_copysignl(Real(z), Imag(z)); 1396 return w; 1397 } 1398 1399 // Handle x = -�, y = � or NaN: 1400 if ((Real(z) == -INFl) && ((__builtin_fabsl(Imag(z)) == INFl) || (Imag(z) != Imag(z)))) { 1401 Real(w) = 0.0L; 1402 Imag(w) = __builtin_copysignl(0.0L, Imag(z)); 1403 return w; 1404 } 1405 1406 if (Imag(z) == 0.0L) { // exact exp(x + 0i) case. 1407 Real(w) = expl(Real(z)); 1408 Imag(w) = __builtin_copysignl(0.0L, Imag(z)); 1409 return w; 1410 } 1411 1412 // At this stage, x � NaN, and extraordinary x = -� cases are sorted. y � 0. 1413 cosisinl(Imag(z), &w); // set w = cos(y) + i sin(y) 1414 1415 // Handle x = +� cases. 1416 if ((Real(z) == INFl) && ((Imag(z) == INFl) || (Imag(z) != Imag(z)))) { 1417 Real(w) = INFl; // cexp(� + yi) = � + NaNi for y = NaN or �, � + 0i for y = 0. 1418 return w; // cexp(� + yi) for finite y falls through. 1419 } 1420 1421 // At this point, x � NaN, +inf, y � 0, and all remaining cases fall through 1422 long double x = Real(z); 1423 1424 if ((x < twiceExpOverflowThresh_ld) && (x > expOverflowThreshold_ld)) { 1425 x -= expOverflowThreshold_ld; // argument reduction, this is exact. 1426 Real(w) *= expOverflowValue_ld; // not exact, but good enough. 1427 Imag(w) *= expOverflowValue_ld; // ditto. 1428 } 1429 1430 long double scale = expl(x); 1431 Real(w) *= scale; 1432 Imag(w) *= scale; 1433 return w; 1434} 1435 1436/**************************************************************************** 1437 double complex cpow(double complex x, double complex y) returns the complex result of x^y. 1438 The algorithm is based upon the identity: 1439 1440 x^y = cexp(y*clog(x)). 1441 1442 Calls: clog, cexp. 1443****************************************************************************/ 1444 1445double complex cpow ( double complex x, double complex y ) /* (complex x)^(complex y) */ 1446{ 1447 double complex logval,z; 1448 1449 logval = clog(x); /* complex logarithm of x */ 1450 Real(z) = Real(y)*Real(logval) - Imag(y)*Imag(logval); /* multiply by y */ 1451 Imag(z) = Real(y)*Imag(logval) + Imag(y)*Real(logval); 1452 return (cexp(z)); /* return complex exponential */ 1453} 1454 1455float complex cpowf ( float complex x, float complex y ) /* (complex x)^(complex y) */ 1456{ 1457 float complex logval,z; 1458 1459 logval = clogf(x); /* complex logarithm of x */ 1460 Real(z) = Real(y)*Real(logval) - Imag(y)*Imag(logval); /* multiply by y */ 1461 Imag(z) = Real(y)*Imag(logval) + Imag(y)*Real(logval); 1462 return (cexpf(z)); /* return complex exponential */ 1463} 1464 1465long double complex cpowl ( long double complex x, long double complex y ) /* (complex x)^(complex y) */ 1466{ 1467 long double complex logval,z; 1468 1469 logval = clogl(x); /* complex logarithm of x */ 1470 Real(z) = Real(y)*Real(logval) - Imag(y)*Imag(logval); /* multiply by y */ 1471 Imag(z) = Real(y)*Imag(logval) + Imag(y)*Real(logval); 1472 return (cexpl(z)); /* return complex exponential */ 1473} 1474 1475/**************************************************************************** 1476 double complex ctanh(double complex x) returns the complex hyperbolic tangent of its 1477 argument. The algorithm is from Kahan's paper and is based on the 1478 identity: 1479 1480 tanh(x+i*y) = (sinh(2*x) + i*sin(2*y))/(cosh(2*x) + cos(2*y)) 1481 = (cosh(x)*sinh(x)*cscsq + i*tan(y))/(1+cscsq*sinh(x)*sinh(x)), 1482 1483 where cscsq = 1/(cos(y)*cos(y). For large values of ze.re, spurious 1484 overflow and invalid signaling is avoided. 1485 1486 CONSTANTS: FPKASINHOM4 = asinh(nextafterd(+infinity,0.0))/4.0 to double 1487 precision 1488 FPKINF = +infinity 1489 1490 Calls: tan, sinh, sqrt, fabs, feholdexcept, feraiseexcept, feclearexcept, 1491 and feupdateenv. 1492****************************************************************************/ 1493 1494double complex ctanh( double complex z ) 1495{ 1496 static const double INF = __builtin_inf(); 1497 double x = __builtin_fabs(Real(z)); 1498 double y = __builtin_fabs(Imag(z)); 1499 double sinhval, coshval, tanval, exm1, cscsq; 1500 double complex w; 1501 1502 if (x == INF) { 1503 w = 1.0 + I*__builtin_copysign(0.0, sin(2.0*y)); // ctanh(� + iy) = 1.0 � i0 1504 } 1505 1506 else if (Imag(z) != Imag(z) || Real(z) != Real(z)) { 1507 if (Imag(z) == 0.0) { 1508 w = Real(z) + I*0.0; // ctanh(NaN + i0) = NaN + i0 1509 } else { 1510 Real(w) = Real(z) + Imag(z); // ctanh(NaN) = NaN + iNaN 1511 Imag(w) = Real(w); 1512 } 1513 } 1514 1515 else if (y == INF) { 1516 Real(w) = y - y; // ctanh(x + i�) = NaN + iNaN (invalid) 1517 Imag(w) = Real(w); 1518 } 1519 1520 else if (x > 19.0) { 1521 w = 1.0 + I*__builtin_copysign(0.0, sin(2.0*y)); // if x is big, tanh(z) = 1 � i0 1522 } 1523 1524 else { // edge case free! 1525 tanval = tan(y); 1526 cscsq = 1.0 + tanval*tanval; // cscsq = 1/cos^2(y) 1527 1528 if (x < 0x1p-27) { 1529 coshval = 1.0; 1530 sinhval = x; 1531 } else { 1532 exm1 = expm1(x); 1533 coshval = 1.0 + 0.5*(exm1*exm1)/(exm1 + 1.0); 1534 sinhval = 0.5*(exm1 + exm1/(exm1 + 1.0)); 1535 } 1536 1537 Real(w) = cscsq * coshval * sinhval / (1.0 + cscsq * sinhval * sinhval); 1538 Imag(w) = tanval / (1.0 + cscsq * sinhval * sinhval); 1539 } 1540 1541 // Patch up signs of return value 1542 Real(w) = __builtin_copysign(Real(w),Real(z)); 1543 Imag(w) *= __builtin_copysign(1.0,Imag(z)); 1544 1545 return w; 1546} 1547 1548float complex ctanhf( float complex z ) 1549{ 1550 static const float INFf = __builtin_inff(); 1551 float x = __builtin_fabsf(Real(z)); 1552 float y = __builtin_fabsf(Imag(z)); 1553 double sinhval, coshval, tanval, exm1, cscsq; 1554 float complex w; 1555 1556 if (x == INFf) { 1557 w = 1.0f + I*__builtin_copysignf(0.0f, sinf(2.0f*y)); // ctanh(� + iy) = 1.0 � i0 1558 } 1559 1560 else if (Imag(z) != Imag(z) || Real(z) != Real(z)) { 1561 if (Imag(z) == 0.0f) { 1562 w = Real(z) + I*0.0f; // ctanh(NaN + i0) = NaN + i0 1563 } else { 1564 Real(w) = Real(z) + Imag(z); // ctanh(NaN) = NaN + iNaN 1565 Imag(w) = Real(w); 1566 } 1567 } 1568 1569 else if (y == INFf) { 1570 Real(w) = y - y; // ctanh(x + i�) = NaN + iNaN (invalid) 1571 Imag(w) = Real(w); 1572 } 1573 1574 else if (x > 19.0f) { 1575 w = 1.0f + I*__builtin_copysignf(0.0f, sinf(2.0f*y)); // if x is big, tanh(z) = 1 � i0 1576 } 1577 1578 else { // edge case free! 1579 tanval = (double)tanf(y); 1580 cscsq = 1.0 + tanval*tanval; // cscsq = 1/cos^2(y) 1581 1582 if (x < 0x1p-13f) { 1583 coshval = 1.0; 1584 sinhval = x; 1585 } else { 1586 exm1 = (double)expm1f(x); 1587 coshval = 1.0 + 0.5*(exm1*exm1)/(exm1 + 1.0); 1588 sinhval = 0.5*(exm1 + exm1/(exm1 + 1.0)); 1589 } 1590 1591 Real(w) = (float)(cscsq * coshval * sinhval / (1.0 + cscsq * sinhval * sinhval)); 1592 Imag(w) = (float)(tanval / (1.0 + cscsq * sinhval * sinhval)); 1593 } 1594 1595 // Patch up signs of return value 1596 Real(w) = __builtin_copysignf(Real(w),Real(z)); 1597 Imag(w) *= __builtin_copysignf(1.0f,Imag(z)); 1598 1599 return w; 1600} 1601 1602long double complex ctanhl( long double complex z ) 1603{ 1604 static const long double INFl = __builtin_infl(); 1605 long double x = __builtin_fabsl(Real(z)); 1606 long double y = __builtin_fabsl(Imag(z)); 1607 long double sinhval, coshval, tanval, exm1, cscsq; 1608 long double complex w; 1609 1610 if (x == INFl) { 1611 w = 1.0l + I*__builtin_copysignl(0.0l, sinl(2.0l*y)); // ctanh(� + iy) = 1.0 � i0 1612 } 1613 1614 else if (Imag(z) != Imag(z) || Real(z) != Real(z)) { 1615 if (Imag(z) == 0.0l) { 1616 w = Real(z) + I*0.0l; // ctanh(NaN + i0) = NaN + i0 1617 } else { 1618 Real(w) = Real(z) + Imag(z); // ctanh(NaN) = NaN + iNaN 1619 Imag(w) = Real(w); 1620 } 1621 } 1622 1623 else if (y == INFl) { 1624 Real(w) = y - y; // ctanh(x + i�) = NaN + iNaN (invalid) 1625 Imag(w) = Real(w); 1626 } 1627 1628 else if (x > 22.0l) { 1629 w = 1.0l + I*__builtin_copysignl(0.0l, sinl(2.0l*y)); // if x is big, tanh(z) = 1 � i0 1630 } 1631 1632 else { // edge case free! 1633 tanval = tanl(y); 1634 cscsq = 1.0l + tanval*tanval; // cscsq = 1/cos^2(y) 1635 1636 if (x < 0x1p-32l) { 1637 coshval = 1.0l; 1638 sinhval = x; 1639 } else { 1640 exm1 = expm1l(x); 1641 coshval = 1.0l + 0.5l*(exm1*exm1)/(exm1 + 1.0l); 1642 sinhval = 0.5l*(exm1 + exm1/(exm1 + 1.0l)); 1643 } 1644 1645 Real(w) = cscsq * coshval * sinhval / (1.0l + cscsq * sinhval * sinhval); 1646 Imag(w) = tanval / (1.0l + cscsq * sinhval * sinhval); 1647 } 1648 1649 // Patch up signs of return value 1650 Real(w) = __builtin_copysignl(Real(w),Real(z)); 1651 Imag(w) *= __builtin_copysignl(1.0l,Imag(z)); 1652 1653 return w; 1654} 1655 1656/**************************************************************************** 1657 double complex ctan(double complex x) returns the complex hyperbolic tangent of its 1658 argument. Per C99, 1659 1660 i ctan(z) = ctanh(iz) 1661 1662 Calls: ctanh 1663****************************************************************************/ 1664 1665double complex ctan( double complex z ) 1666{ 1667 double complex iz, iw, w; 1668 Real(iz) = -Imag(z); 1669 Imag(iz) = Real(z); 1670 iw = ctanh(iz); 1671 Real(w) = Imag(iw); 1672 Imag(w) = -Real(iw); 1673 return w; 1674} 1675 1676float complex ctanf( float complex z ) 1677{ 1678 float complex iz, iw, w; 1679 Real(iz) = -Imag(z); 1680 Imag(iz) = Real(z); 1681 iw = ctanhf(iz); 1682 Real(w) = Imag(iw); 1683 Imag(w) = -Real(iw); 1684 return w; 1685} 1686 1687long double complex ctanl( long double complex z ) 1688{ 1689 long double complex iz, iw, w; 1690 Real(iz) = -Imag(z); 1691 Imag(iz) = Real(z); 1692 iw = ctanhl(iz); 1693 Real(w) = Imag(iw); 1694 Imag(w) = -Real(iw); 1695 return w; 1696} 1697 1698/**************************************************************************** 1699 double complex casin(double complex z) returns the complex inverse sine of its 1700 argument. The algorithm is from Kahan's paper and is based on the 1701 formulae: 1702 1703 real(casin(z)) = atan (real(z)/real(csqrt(1.0-z)*csqrt(1.0+z))) 1704 imag(casin(z)) = arcsinh(imag(csqrt(1.0-cconj(z))*csqrt(1.0+z))) 1705 1706 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 1707****************************************************************************/ 1708 1709double complex casin ( double complex z ) 1710{ 1711 double complex iz, iw, w; 1712 Real(iz) = -Imag(z); 1713 Imag(iz) = Real(z); 1714 iw = casinh(iz); 1715 Real(w) = Imag(iw); 1716 Imag(w) = -Real(iw); 1717 return w; 1718} 1719 1720float complex casinf ( float complex z ) 1721{ 1722 float complex iz, iw, w; 1723 Real(iz) = -Imag(z); 1724 Imag(iz) = Real(z); 1725 iw = casinhf(iz); 1726 Real(w) = Imag(iw); 1727 Imag(w) = -Real(iw); 1728 return w; 1729} 1730 1731long double complex casinl ( long double complex z ) 1732{ 1733 long double complex iz, iw, w; 1734 Real(iz) = -Imag(z); 1735 Imag(iz) = Real(z); 1736 iw = casinhl(iz); 1737 Real(w) = Imag(iw); 1738 Imag(w) = -Real(iw); 1739 return w; 1740} 1741 1742/**************************************************************************** 1743 double complex casinh(double complex z) returns the complex inverse hyperbolic sine of 1744 its argument. We compute the function only in the upper-right quadrant of the complex 1745 plane, and use the facts that casinh(conj(z)) = conj(casinh(z)) and casinh is odd to 1746 get the values on the rest of the plane. 1747 1748 within the upper-right quadrant, we use: 1749 1750 casinh(z) = z if |z| is small, 1751 ln(2z) if |z| is big, 1752 and a rather complicated expression for other values of z. 1753 1754 Calls: asinh, csqrt, atan2. 1755****************************************************************************/ 1756 1757double complex casinh ( double complex z ) 1758{ 1759 static const double INF = __builtin_inf(); 1760 static const double ln2 = 0x1.62e42fefa39ef358p-1; 1761 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 1762 double complex w; 1763 double x = __builtin_fabs(Real(z)); 1764 double y = __builtin_fabs(Imag(z)); 1765 double u, xSquared, tmp; 1766 double complex sqrt1Plusiz, sqrt1PlusizBar; 1767 1768 // If |z| == inf, then casinh(z) = inf + carg(z) 1769 if ((x == INF) || (y == INF)) { 1770 Real(w) = INF; 1771 Imag(w) = atan2(y,x); 1772 } 1773 1774 // If z = NaN, casinh(z) = NaN, with the special case that casinh(NaN + i0) = NaN + i0. 1775 else if ((x != x) || (y != y)) { 1776 if (y == 0.0) 1777 w = z; 1778 else { 1779 Real(w) = x + y; 1780 Imag(w) = x + y; 1781 } 1782 } 1783 1784 // at this point x,y are finite, non-nan. 1785 else { 1786 // If z is small, then casinh(z) = z - z^3/6 + ... = z within half an ulp 1787 if ((x < 0x1p-27) && (y < 0x1p-27)) { 1788 Real(w) = x; 1789 Imag(w) = y; 1790 } 1791 1792 // If z is big, then casinh(z) = log2 + log(z) + terms smaller than half an ulp 1793 else if ((x > 0x1p27) || (y > 0x1p27)) { 1794 w = clog(x + I*y); 1795 Real(w) += ln2; 1796 } 1797 1798 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1799 * 1800 * Derivation of these formulats boggles the mind, but they are easily verified with the 1801 * Monodromy theorem. 1802 */ 1803 else { 1804 // Compute sqrt1Plusiz = sqrt(1-y + ix) 1805 u = 1.0 - y; 1806 xSquared = (x < 0x1p-106 ? 0.0 : x*x); // Avoid underflows. Faster via mask? 1807 1808 if (u == 0.0) { 1809 Real(sqrt1Plusiz) = sqrt1_2 * __builtin_sqrt(x); // Avoid spurious underflows in this case 1810 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); // by using the simpler formula. 1811 } 1812 1813 else { // No underflow or overflow is possible. 1814 Real(sqrt1Plusiz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + xSquared) + __builtin_fabs(u))); 1815 tmp = 0.5 * (x / Real(sqrt1Plusiz)); 1816 1817 if (u < 0.0) { 1818 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); 1819 Real(sqrt1Plusiz) = tmp; 1820 } else { 1821 Imag(sqrt1Plusiz) = tmp; 1822 } 1823 } 1824 1825 // Compute sqrt1PlusizBar = sqrt(1+y + ix). No underflow or overflow is possible. 1826 u = 1.0 + y; 1827 Real(sqrt1PlusizBar) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + xSquared) + u)); 1828 Imag(sqrt1PlusizBar) = x / (2.0*Real(sqrt1PlusizBar)); 1829 1830 // Magic formulas from Kahan. 1831 Real(w) = asinh(Real(sqrt1Plusiz)*Imag(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Real(sqrt1PlusizBar)); 1832 Imag(w) = atan2(y, Real(sqrt1Plusiz)*Real(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Imag(sqrt1PlusizBar)); 1833 } 1834 } 1835 1836 // Patch up signs to handle z in quadrants II - IV, using symmetry. 1837 Real(w) = __builtin_copysign(Real(w), Real(z)); 1838 Imag(w) = __builtin_copysign(Imag(w), Imag(z)); 1839 1840 return w; 1841} 1842 1843float complex casinhf ( float complex z ) 1844{ 1845 static const float INFf = __builtin_inff(); 1846 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 1847 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 1848 float complex w; 1849 float x = __builtin_fabsf(Real(z)); 1850 float y = __builtin_fabsf(Imag(z)); 1851 float u, xSquared, tmp; 1852 float complex sqrt1Plusiz, sqrt1PlusizBar; 1853 1854 // If |z| == inf, then casinh(z) = inf + carg(z) 1855 if ((x == INFf) || (y == INFf)) { 1856 Real(w) = INFf; 1857 Imag(w) = atan2f(y,x); 1858 } 1859 1860 // If z = NaN, casinh(z) = NaN, with the special case that casinh(NaN + i0) = NaN + i0. 1861 else if ((x != x) || (y != y)) { 1862 if (y == 0.0f) 1863 w = z; 1864 else { 1865 Real(w) = x + y; 1866 Imag(w) = x + y; 1867 } 1868 } 1869 1870 // at this point x,y are finite, non-nan. 1871 else { 1872 // If z is small, then casinhf(z) = z - z^3/6 + ... = z within half an ulp 1873 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 1874 Real(w) = x; 1875 Imag(w) = y; 1876 } 1877 1878 // If z is big, then casinh(z) = log2 + log(z) + terms smaller than half an ulp 1879 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 1880 w = clogf(x + I*y); 1881 Real(w) += ln2f; 1882 } 1883 1884 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1885 * 1886 * Derivation of these formulats boggles the mind, but they are easily verified with the 1887 * Monodromy theorem. 1888 */ 1889 else { 1890 // Compute sqrt1Plusiz = sqrt(1-y + ix) 1891 u = 1.0f - y; 1892 xSquared = (x < 0x1p-52f ? 0.0f : x*x); // Avoid underflows. Faster via mask? 1893 1894 if (u == 0.0f) { 1895 Real(sqrt1Plusiz) = sqrt1_2f * __builtin_sqrtf(x); // Avoid spurious underflows in this case 1896 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); // by using the simpler formula. 1897 } 1898 1899 else { // No underflow or overflow is possible. 1900 Real(sqrt1Plusiz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + xSquared) + __builtin_fabsf(u))); 1901 tmp = 0.5f * (x / Real(sqrt1Plusiz)); 1902 1903 if (u < 0.0f) { 1904 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); 1905 Real(sqrt1Plusiz) = tmp; 1906 } else { 1907 Imag(sqrt1Plusiz) = tmp; 1908 } 1909 } 1910 1911 // Compute sqrt1PlusizBar = sqrt(1+y + ix). No underflow or overflow is possible. 1912 u = 1.0f + y; 1913 Real(sqrt1PlusizBar) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + xSquared) + u)); 1914 Imag(sqrt1PlusizBar) = x / (2.0f*Real(sqrt1PlusizBar)); 1915 1916 // Magic formulas from Kahan. 1917 Real(w) = asinhf(Real(sqrt1Plusiz)*Imag(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Real(sqrt1PlusizBar)); 1918 Imag(w) = atan2f(y, Real(sqrt1Plusiz)*Real(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Imag(sqrt1PlusizBar)); 1919 } 1920 } 1921 1922 // Patch up signs to handle z in quadrants II - IV, using symmetry. 1923 Real(w) = __builtin_copysignf(Real(w), Real(z)); 1924 Imag(w) = __builtin_copysignf(Imag(w), Imag(z)); 1925 1926 return w; 1927} 1928 1929long double complex casinhl ( long double complex z ) 1930{ 1931 static const long double INFl = __builtin_infl(); 1932 static const long double ln2l = 0x1.62e42fefa39ef358p-1L; 1933 static const long double sqrt1_2l = 0x1.6a09e667f3bcc908p-1L; 1934 long double complex w; 1935 long double x = __builtin_fabsl(Real(z)); 1936 long double y = __builtin_fabsl(Imag(z)); 1937 long double u, xSquared, tmp; 1938 long double complex sqrt1Plusiz, sqrt1PlusizBar; 1939 1940 // If |z| == inf, then casinh(z) = inf + carg(z) 1941 if ((x == INFl) || (y == INFl)) { 1942 Real(w) = INFl; 1943 Imag(w) = atan2l(y,x); 1944 } 1945 1946 // If z = NaN, casinh(z) = NaN, with the special case that casinh(NaN + i0) = NaN + i0. 1947 else if ((x != x) || (y != y)) { 1948 if (y == 0.0l) 1949 w = z; 1950 else { 1951 Real(w) = x + y; 1952 Imag(w) = x + y; 1953 } 1954 } 1955 1956 // at this point x,y are finite, non-nan. 1957 else { 1958 // If z is small, then casinhl(z) = z - z^3/6 + ... = z within half an ulp 1959 if ((x < 0x1p-32l) && (y < 0x1p-32l)) { 1960 Real(w) = x; 1961 Imag(w) = y; 1962 } 1963 1964 // If z is big, then casinhl(z) = log2 + log(z) + terms smaller than half an ulp 1965 else if ((x > 0x1p32l) || (y > 0x1p32l)) { 1966 w = clogl(x + I*y); 1967 Real(w) += ln2l; 1968 } 1969 1970 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1971 * 1972 * Derivation of these formulats boggles the mind, but they are easily verified with the 1973 * Monodromy theorem. 1974 */ 1975 else { 1976 u = 1.0l - y; 1977 xSquared = (x < 0x1p-128l ? 0.0l : x*x); // Avoid underflows. Faster via mask? 1978 1979 if (u == 0.0l) { 1980 Real(sqrt1Plusiz) = sqrt1_2l * __builtin_sqrtl(x); // Avoid spurious underflows in this case 1981 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); // by using the simpler formula. 1982 } 1983 1984 else { // No underflow or overflow is possible. 1985 Real(sqrt1Plusiz) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + xSquared) + __builtin_fabsl(u))); 1986 tmp = 0.5 * (x / Real(sqrt1Plusiz)); 1987 1988 if (u < 0.0l) { 1989 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); 1990 Real(sqrt1Plusiz) = tmp; 1991 } else { 1992 Imag(sqrt1Plusiz) = tmp; 1993 } 1994 } 1995 1996 // Compute sqrt1PlusizBar = sqrt(1+y + ix). No underflow or overflow is possible. 1997 u = 1.0l + y; 1998 Real(sqrt1PlusizBar) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + xSquared) + u)); 1999 Imag(sqrt1PlusizBar) = x / (2.0l*Real(sqrt1PlusizBar)); 2000 2001 // Magic formulas from Kahan. 2002 Real(w) = asinhl(Real(sqrt1Plusiz)*Imag(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Real(sqrt1PlusizBar)); 2003 Imag(w) = atan2l(y, Real(sqrt1Plusiz)*Real(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Imag(sqrt1PlusizBar)); 2004 } 2005 } 2006 2007 // Patch up signs to handle z in quadrants II - IV, using symmetry. 2008 Real(w) = __builtin_copysignl(Real(w), Real(z)); 2009 Imag(w) = __builtin_copysignl(Imag(w), Imag(z)); 2010 2011 return w; 2012} 2013 2014/**************************************************************************** 2015 double complex cacos(double complex z) returns the complex inverse cosine of its 2016 argument. The algorithm is from Kahan's paper and is based on the 2017 formulae: 2018 2019 real(cacos(z)) = 2.0*atan(real(csqrt(1.0-z)/real(csqrt(1.0+z)))) 2020 imag(cacos(z)) = arcsinh(imag(csqrt(1.0-z)*csqrt(cconj(1.0+z)))) 2021 2022 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 2023****************************************************************************/ 2024 2025double complex cacos ( double complex z ) 2026{ 2027 static const double INF = __builtin_inf(); 2028 static const double ln2 = 0x1.62e42fefa39ef358p-1; 2029 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 2030 static const double pi2 = 0x1.921fb54442d1846ap0; 2031 2032 double complex w; 2033 double x = __builtin_fabs(Real(z)); 2034 double y = __builtin_fabs(Imag(z)); 2035 double u, ySquared, tmp; 2036 double complex sqrt1Plusz, sqrt1Minusz; 2037 2038 // If |z| == inf, then cacos(z) = carg(z) - inf * I 2039 if ((x == INF) || (y == INF)) { 2040 Imag(w) = -INF; 2041 Real(w) = atan2(y,x); 2042 } 2043 2044 // If z = NaN, cacos(z) = NaN, with the special case that cacos(0 + iNaN) = �/2 + iNaN. 2045 else if ((x != x) || (y != y)) { 2046 if (x == 0.0) 2047 Real(w) = pi2; 2048 else 2049 Real(w) = x + y; 2050 Imag(w) = x + y; 2051 } 2052 2053 // at this point x,y are finite, non-nan. 2054 else { 2055 // If z is small, then cacos(z) = �/2 - z + z^3/6 + ... = �/2 - z within half an ulp 2056 if ((x < 0x1p-27) && (y < 0x1p-27)) { 2057 Real(w) = pi2 - x; 2058 Imag(w) = -y; 2059 } 2060 2061 // If z is big, then cacos(z) = -i * (log2 + log(z)) + terms smaller than half an ulp 2062 else if ((x > 0x1p27) || (y > 0x1p27)) { 2063 w = clog(x + I*y) + ln2; 2064 const double tmp = __real__ w; 2065 __real__ w = __imag__ w; 2066 __imag__ w = -tmp; 2067 } 2068 2069 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2070 * 2071 * Real(w) = 2*atan2( Re(sqrt(1-z)), Re(sqrt(1+z)) ) 2072 * Imag(w) = asinh( Im( sqrt(1-z)*sqrt(1+conj(z)) ) ) 2073 * 2074 * Derivation of these formulats boggles the mind, but they are easily verified with the 2075 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2076 */ 2077 else { 2078 ySquared = (y < 0x1p-106 ? 0.0 : y*y); // Avoid underflows. Faster via mask? 2079 2080 // Compute sqrt1Plusz = sqrt(1+x + iy) 2081 u = 1.0 + x; 2082 Real(sqrt1Plusz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + u)); 2083 Imag(sqrt1Plusz) = 0.5 * (y / Real(sqrt1Plusz)); 2084 2085 // Compute sqrt1Minusz = sqrt(1-x - iy) 2086 u = 1.0 - x; 2087 2088 if (u == 0.0) { 2089 Real(sqrt1Minusz) = sqrt1_2 * __builtin_sqrt(y); // Avoid spurious underflows in this case 2090 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); // by using the simpler formula. 2091 } 2092 2093 else { // No underflow or overflow is possible. 2094 Real(sqrt1Minusz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + __builtin_fabs(u))); 2095 tmp = 0.5 * (y / Real(sqrt1Minusz)); 2096 2097 if (u < 0.0) { 2098 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 2099 Real(sqrt1Minusz) = tmp; 2100 } else { 2101 Imag(sqrt1Minusz) = -tmp; 2102 } 2103 } 2104 2105 // Magic formulas from Kahan. 2106 Real(w) = 2.0 * atan2(Real(sqrt1Minusz), Real(sqrt1Plusz)); 2107 Imag(w) = asinh( Real(sqrt1Plusz)*Imag(sqrt1Minusz) - Imag(sqrt1Plusz)*Real(sqrt1Minusz) ); 2108 } 2109 } 2110 2111 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2112 Imag(w) = __builtin_copysign(Imag(w), -Imag(z)); 2113 2114 if (Real(z) < 0.0) 2115 Real(w) = 2.0 * pi2 - Real(w); // No undue cancellation is possible here - Real(w) < �/2. 2116 2117 return w; 2118} 2119 2120float complex cacosf ( float complex z ) 2121{ 2122 static const float INFf = __builtin_inff(); 2123 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 2124 static const float pi2f = 0x1.921fb54442d1846ap0f; 2125 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 2126 2127 float complex w; 2128 float x = __builtin_fabsf(Real(z)); 2129 float y = __builtin_fabsf(Imag(z)); 2130 float u, ySquared, tmp; 2131 float complex sqrt1Plusz, sqrt1Minusz; 2132 2133 // If |z| == inf, then cacos(z) = carg(z) - inf i 2134 if ((x == INFf) || (y == INFf)) { 2135 Imag(w) = -INFf; 2136 Real(w) = atan2f(y,x); 2137 } 2138 2139 // If z = NaN, cacos(z) = NaN, with the special case that cacos(0 + iNaN) = �/2 + iNaN. 2140 else if ((x != x) || (y != y)) { 2141 2142 if (x == 0.0f) 2143 Real(w) = pi2f; 2144 else 2145 Real(w) = x + y; 2146 2147 Imag(w) = x + y; 2148 } 2149 2150 // at this point x,y are finite, non-nan. 2151 else { 2152 // If z is small, then cacos(z) = �/2 - z + z^3/6 + ... = �/2 - z within half an ulp 2153 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 2154 Real(w) = pi2f - x; 2155 Imag(w) = -y; 2156 } 2157 2158 // If z is big, then cacos(z) = -i * (log2 + log(z)) + terms smaller than half an ulp 2159 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 2160 w = clogf(x + I*y) + ln2f; 2161 const float tmp = __real__ w; 2162 __real__ w = __imag__ w; 2163 __imag__ w = -tmp; 2164 } 2165 2166 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2167 * 2168 * Real(w) = 2*atan2( Re(sqrt(1-z)), Re(sqrt(1+z)) ) 2169 * Imag(w) = asinh( Im( sqrt(1-z)*sqrt(1+conj(z)) ) ) 2170 * 2171 * Derivation of these formulats boggles the mind, but they are easily verified with the 2172 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2173 */ 2174 else { 2175 ySquared = (y < 0x1p-52f ? 0.0f : y*y); // Avoid underflows. Faster via mask? 2176 2177 // Compute sqrt1Plusz = sqrt(1+x + iy) 2178 u = 1.0f + x; 2179 Real(sqrt1Plusz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + u)); 2180 Imag(sqrt1Plusz) = 0.5f * (y / Real(sqrt1Plusz)); 2181 2182 // Compute sqrt1Minusz = sqrt(1-x - iy) 2183 u = 1.0f - x; 2184 2185 if (u == 0.0f) { 2186 Real(sqrt1Minusz) = sqrt1_2f * __builtin_sqrtf(y); 2187 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 2188 } 2189 2190 else { 2191 Real(sqrt1Minusz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + __builtin_fabsf(u))); 2192 tmp = 0.5f * (y / Real(sqrt1Minusz)); 2193 2194 if (u < 0.0f) { 2195 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 2196 Real(sqrt1Minusz) = tmp; 2197 } else { 2198 Imag(sqrt1Minusz) = -tmp; 2199 } 2200 } 2201 2202 // Magic formulas from Kahan. 2203 Real(w) = 2.0f * atan2f(Real(sqrt1Minusz),Real(sqrt1Plusz)); 2204 Imag(w) = asinhf( Real(sqrt1Plusz)*Imag(sqrt1Minusz) - Imag(sqrt1Plusz)*Real(sqrt1Minusz) ); 2205 } 2206 } 2207 2208 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2209 Imag(w) = __builtin_copysignf(Imag(w), -Imag(z)); 2210 2211 if (Real(z) < 0.0f) 2212 Real(w) = 2.0f * pi2f - Real(w); // No undue cancellation is possible here - Real(w) < �/2. 2213 2214 return w; 2215} 2216 2217long double complex cacosl ( long double complex z ) 2218{ 2219 static const long double INFl = __builtin_infl(); 2220 static const long double ln2l = 0x1.62e42fefa39ef358p-1L; 2221 static const long double pi2l = 0x1.921fb54442d1846ap0L; 2222 static const long double sqrt1_2l = 0x1.6a09e667f3bcc908p-1L; 2223 2224 long double complex w; 2225 long double x = __builtin_fabsl(Real(z)); 2226 long double y = __builtin_fabsl(Imag(z)); 2227 long double u, ySquared, tmp; 2228 long double complex sqrt1Plusz, sqrt1Minusz; 2229 2230 // If |z| == inf, then cacos(z) = carg(z) - inf i 2231 if ((x == INFl) || (y == INFl)) { 2232 Imag(w) = -INFl; 2233 Real(w) = atan2l(y,x); 2234 } 2235 2236 // If z = NaN, cacos(z) = NaN, with the special case that cacos(0 + iNaN) = �/2 + iNaN. 2237 else if ((x != x) || (y != y)) { 2238 2239 if (x == 0.0l) 2240 Real(w) = pi2l; 2241 else 2242 Real(w) = x + y; 2243 2244 Imag(w) = x + y; 2245 } 2246 2247 // at this point x,y are finite, non-nan. 2248 else { 2249 // If z is small, then cacos(z) = �/2 - z + z^3/6 + ... = �/2 - z within half an ulp 2250 if ((x < 0x1p-32l) && (y < 0x1p-32l)) { 2251 Real(w) = pi2l - x; 2252 Imag(w) = -y; 2253 } 2254 2255 // If z is big, then cacos(z) = -i * (log2 + log(z)) + terms smaller than half an ulp 2256 else if ((x > 0x1p32l) || (y > 0x1p32l)) { 2257 w = clogl(x + I*y) + ln2l; 2258 const long double tmp = __real__ w; 2259 __real__ w = __imag__ w; 2260 __imag__ w = -tmp; 2261 } 2262 2263 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2264 * 2265 * Real(w) = 2*atan2( Re(sqrt(1-z)), Re(sqrt(1+z)) ) 2266 * Imag(w) = asinh( Im( sqrt(1-z)*sqrt(1+conj(z)) ) ) 2267 * 2268 * Derivation of these formulats boggles the mind, but they are easily verified with the 2269 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2270 */ 2271 else { 2272 ySquared = (y < 0x1p-128l ? 0.0l : y*y); // Avoid underflows. Faster via mask? 2273 2274 // Compute sqrt1Plusz = sqrt(1+x + iy) 2275 u = 1.0l + x; 2276 Real(sqrt1Plusz) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + ySquared) + u)); 2277 Imag(sqrt1Plusz) = 0.5l * (y / Real(sqrt1Plusz)); 2278 2279 // Compute sqrt1Minusz = sqrt(1-x - iy) 2280 u = 1.0l - x; 2281 2282 if (u == 0.0l) { 2283 Real(sqrt1Minusz) = sqrt1_2l * __builtin_sqrt(y); 2284 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 2285 } 2286 2287 else { 2288 Real(sqrt1Minusz) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + ySquared) + __builtin_fabsl(u))); 2289 tmp = 0.5l * (y / Real(sqrt1Minusz)); 2290 2291 if (u < 0.0l) { 2292 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 2293 Real(sqrt1Minusz) = tmp; 2294 } else { 2295 Imag(sqrt1Minusz) = -tmp; 2296 } 2297 } 2298 2299 // Magic formulas from Kahan. 2300 Real(w) = 2.0l * atan2l(Real(sqrt1Minusz), Real(sqrt1Plusz)); 2301 Imag(w) = asinhl( Real(sqrt1Plusz)*Imag(sqrt1Minusz) - Imag(sqrt1Plusz)*Real(sqrt1Minusz) ); 2302 } 2303 } 2304 2305 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2306 Imag(w) = __builtin_copysignl(Imag(w), -Imag(z)); 2307 2308 if (Real(z) < 0.0l) 2309 Real(w) = 2.0l * pi2l - Real(w); // No undue cancellation is possible here - Real(w) < �/2. 2310 2311 return w; 2312} 2313 2314/**************************************************************************** 2315 double complex cacosh(double complex z) returns the complex inverse hyperbolic`cosine 2316 of its argument. The algorithm is from Kahan's paper and is based on the 2317 formulae: 2318 2319 real(cacosh(z)) = arcsinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 2320 imag(cacosh(z)) = 2.0*atan(imag(csqrt(z-1.0)/real(csqrt(z+1.0)))) 2321 2322 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 2323****************************************************************************/ 2324 2325double complex cacosh ( double complex z ) 2326{ 2327 static const double INF = __builtin_inf(); 2328 static const double ln2 = 0x1.62e42fefa39ef358p-1; 2329 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 2330 static const double pi2 = 0x1.921fb54442d1846ap0; 2331 2332 double complex w; 2333 double x = __builtin_fabs(Real(z)); 2334 double y = __builtin_fabs(Imag(z)); 2335 double u, ySquared, tmp; 2336 double complex sqrtzPlus1, sqrtzMinus1; 2337 2338 // If |z| == inf, then cacosh(z) = inf + carg(z) * I 2339 if ((x == INF) || (y == INF)) { 2340 Imag(w) = atan2(y,x); 2341 Real(w) = INF; 2342 } 2343 2344 // If z = NaN, cacosh(z) = NaN. 2345 else if ((x != x) || (y != y)) { 2346 Real(w) = x + y; 2347 Imag(w) = x + y; 2348 } 2349 2350 // at this point x,y are finite, non-nan. 2351 else { 2352 // If z is small, then cacosh(z) = I*(�/2 - z + z^3/6 + ...) = I*(�/2 - z) within half an ulp 2353 if ((x < 0x1p-27) && (y < 0x1p-27)) { 2354 Real(w) = y; 2355 Imag(w) = pi2 - x; 2356 } 2357 2358 // If z is big, then cacosh(z) = (log2 + log(z)) + terms smaller than half an ulp 2359 else if ((x > 0x1p27) || (y > 0x1p27)) { 2360 w = clog(x + I*y) + ln2; 2361 } 2362 2363 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2364 * 2365 * Real(w) = asinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 2366 * Imag(w) = 2.0*atan2(imag(csqrt(z-1.0))/real(csqrt(z+1.0))) 2367 * 2368 * Derivation of these formulats boggles the mind, but they are easily verified with the 2369 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2370 */ 2371 else { 2372 ySquared = (y < 0x1p-106 ? 0.0 : y*y); // Avoid underflows. Faster via mask? 2373 2374 // Compute sqrt1Plusz = sqrt(x+1 + iy) 2375 u = x + 1.0; 2376 Real(sqrtzPlus1) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + u)); 2377 Imag(sqrtzPlus1) = 0.5 * (y / Real(sqrtzPlus1)); 2378 2379 // Compute sqrt1Minusz = sqrt(x-1 + iy) 2380 u = x - 1.0; 2381 2382 if (u == 0.0) { 2383 Real(sqrtzMinus1) = sqrt1_2 * __builtin_sqrt(y); // Avoid spurious underflows in this case 2384 Imag(sqrtzMinus1) = Real(sqrtzMinus1); // by using the simpler formula. 2385 } 2386 2387 else { // No underflow or overflow is possible. 2388 Real(sqrtzMinus1) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + __builtin_fabs(u))); 2389 tmp = 0.5 * (y / Real(sqrtzMinus1)); 2390 2391 if (u < 0.0) { 2392 Imag(sqrtzMinus1) = Real(sqrtzMinus1); 2393 Real(sqrtzMinus1) = tmp; 2394 } else { 2395 Imag(sqrtzMinus1) = tmp; 2396 } 2397 } 2398 2399 // Magic formulas from Kahan. 2400 Real(w) = asinh( Real(sqrtzPlus1)*Real(sqrtzMinus1) + Imag(sqrtzPlus1)*Imag(sqrtzMinus1) ); 2401 Imag(w) = 2.0*atan2( Imag(sqrtzMinus1) , Real(sqrtzPlus1) ); 2402 } 2403 } 2404 2405 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2406 if (Real(z) < 0.0) 2407 Imag(w) = 2.0 * pi2 - Imag(w); // No undue cancellation is possible here - Real(w) < �/2. 2408 2409 Imag(w) = __builtin_copysign(Imag(w), Imag(z)); 2410 2411 return w; 2412} 2413 2414float complex cacoshf ( float complex z ) 2415{ 2416 static const float INFf = __builtin_inff(); 2417 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 2418 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 2419 static const float pi2f = 0x1.921fb54442d1846ap0f; 2420 2421 float complex w; 2422 float x = __builtin_fabsf(Real(z)); 2423 float y = __builtin_fabsf(Imag(z)); 2424 float u, ySquared, tmp; 2425 float complex sqrtzPlus1, sqrtzMinus1; 2426 2427 // If |z| == inf, then cacosh(z) = inf + carg(z) * I 2428 if ((x == INFf) || (y == INFf)) { 2429 Imag(w) = atan2f(y,x); 2430 Real(w) = INFf; 2431 } 2432 2433 // If z = NaN, cacosh(z) = NaN. 2434 else if ((x != x) || (y != y)) { 2435 Real(w) = x + y; 2436 Imag(w) = x + y; 2437 } 2438 2439 // at this point x,y are finite, non-nan. 2440 else { 2441 // If z is small, then cacosh(z) = I*(�/2 - z + z^3/6 + ...) = I*(�/2 - z) within half an ulp 2442 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 2443 Real(w) = y; 2444 Imag(w) = pi2f - x; 2445 } 2446 2447 // If z is big, then cacosh(z) = (log2 + log(z)) + terms smaller than half an ulp 2448 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 2449 w = clogf(x + I*y) + ln2f; 2450 } 2451 2452 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2453 * 2454 * Real(w) = asinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 2455 * Imag(w) = 2.0*atan2(imag(csqrt(z-1.0))/real(csqrt(z+1.0))) 2456 * 2457 * Derivation of these formulats boggles the mind, but they are easily verified with the 2458 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2459 */ 2460 else { 2461 ySquared = (y < 0x1p-52f ? 0.0f : y*y); // Avoid underflows. Faster via mask? 2462 2463 // Compute sqrt1Plusz = sqrt(x+1 + iy) 2464 u = x + 1.0f; 2465 Real(sqrtzPlus1) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + u)); 2466 Imag(sqrtzPlus1) = 0.5f * (y / Real(sqrtzPlus1)); 2467 2468 // Compute sqrt1Minusz = sqrt(x-1 + iy) 2469 u = x - 1.0f; 2470 2471 if (u == 0.0f) { 2472 Real(sqrtzMinus1) = sqrt1_2f * __builtin_sqrtf(y); // Avoid spurious underflows in this case 2473 Imag(sqrtzMinus1) = Real(sqrtzMinus1); // by using the simpler formula. 2474 } 2475 2476 else { // No underflow or overflow is possible. 2477 Real(sqrtzMinus1) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + __builtin_fabsf(u))); 2478 tmp = 0.5f * (y / Real(sqrtzMinus1)); 2479 2480 if (u < 0.0f) { 2481 Imag(sqrtzMinus1) = Real(sqrtzMinus1); 2482 Real(sqrtzMinus1) = tmp; 2483 } else { 2484 Imag(sqrtzMinus1) = tmp; 2485 } 2486 } 2487 2488 // Magic formulas from Kahan. 2489 Real(w) = asinhf( Real(sqrtzPlus1)*Real(sqrtzMinus1) + Imag(sqrtzPlus1)*Imag(sqrtzMinus1) ); 2490 Imag(w) = 2.0f*atan2f( Imag(sqrtzMinus1) , Real(sqrtzPlus1) ); 2491 } 2492 } 2493 2494 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2495 if (Real(z) < 0.0f) 2496 Imag(w) = 2.0f * pi2f - Imag(w); // No undue cancellation is possible here - Real(w) < �/2. 2497 2498 Imag(w) = __builtin_copysignf(Imag(w), Imag(z)); 2499 2500 return w; 2501} 2502 2503long double complex cacoshl ( long double complex z ) 2504{ 2505 static const long double INFl = __builtin_infl(); 2506 static const long double ln2l = 0x1.62e42fefa39ef358p-1L; 2507 static const long double sqrt1_2l = 0x1.6a09e667f3bcc908p-1L; 2508 static const long double pi2l = 0x1.921fb54442d1846ap0L; 2509 2510 long double complex w; 2511 long double x = __builtin_fabsl(Real(z)); 2512 long double y = __builtin_fabsl(Imag(z)); 2513 long double u, ySquared, tmp; 2514 long double complex sqrtzPlus1, sqrtzMinus1; 2515 2516 // If |z| == inf, then cacosh(z) = inf + carg(z) * I 2517 if ((x == INFl) || (y == INFl)) { 2518 Imag(w) = atan2l(y,x); 2519 Real(w) = INFl; 2520 } 2521 2522 // If z = NaN, cacosh(z) = NaN. 2523 else if ((x != x) || (y != y)) { 2524 Real(w) = x + y; 2525 Imag(w) = x + y; 2526 } 2527 2528 // at this point x,y are finite, non-nan. 2529 else { 2530 // If z is small, then cacosh(z) = I*(�/2 - z + z^3/6 + ...) = I*(�/2 - z) within half an ulp 2531 if ((x < 0x1p-32l) && (y < 0x1p-32l)) { 2532 Real(w) = y; 2533 Imag(w) = pi2l - x; 2534 } 2535 2536 // If z is big, then cacosh(z) = (log2 + log(z)) + terms smaller than half an ulp 2537 else if ((x > 0x1p32l) || (y > 0x1p32l)) { 2538 w = clogl(x + I*y) + ln2l; 2539 } 2540 2541 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 2542 * 2543 * Real(w) = asinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 2544 * Imag(w) = 2.0*atan2(imag(csqrt(z-1.0))/real(csqrt(z+1.0))) 2545 * 2546 * Derivation of these formulats boggles the mind, but they are easily verified with the 2547 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 2548 */ 2549 else { 2550 ySquared = (y < 0x1p-128L ? 0.0L : y*y); // Avoid underflows. Faster via mask? 2551 2552 // Compute sqrt1Plusz = sqrt(x+1 + iy) 2553 u = x + 1.0l; 2554 Real(sqrtzPlus1) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + ySquared) + u)); 2555 Imag(sqrtzPlus1) = 0.5l * (y / Real(sqrtzPlus1)); 2556 2557 // Compute sqrt1Minusz = sqrt(x-1 + iy) 2558 u = x - 1.0l; 2559 2560 if (u == 0.0l) { 2561 Real(sqrtzMinus1) = sqrt1_2l * __builtin_sqrtl(y); // Avoid spurious underflows in this case 2562 Imag(sqrtzMinus1) = Real(sqrtzMinus1); // by using the simpler formula. 2563 } 2564 2565 else { // No underflow or overflow is possible. 2566 Real(sqrtzMinus1) = __builtin_sqrtl(0.5l*(__builtin_sqrtl(u*u + ySquared) + __builtin_fabsl(u))); 2567 tmp = 0.5l * (y / Real(sqrtzMinus1)); 2568 2569 if (u < 0.0l) { 2570 Imag(sqrtzMinus1) = Real(sqrtzMinus1); 2571 Real(sqrtzMinus1) = tmp; 2572 } else { 2573 Imag(sqrtzMinus1) = tmp; 2574 } 2575 } 2576 2577 // Magic formulas from Kahan. 2578 Real(w) = asinhl( Real(sqrtzPlus1)*Real(sqrtzMinus1) + Imag(sqrtzPlus1)*Imag(sqrtzMinus1) ); 2579 Imag(w) = 2.0l*atan2l( Imag(sqrtzMinus1) , Real(sqrtzPlus1) ); 2580 } 2581 } 2582 2583 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 2584 if (Real(z) < 0.0l) 2585 Imag(w) = 2.0l * pi2l - Imag(w); // No undue cancellation is possible here - Real(w) < �/2. 2586 2587 Imag(w) = __builtin_copysignl(Imag(w), Imag(z)); 2588 2589 return w; 2590} 2591 2592/**************************************************************************** 2593 double complex catan(double complex z) returns the complex inverse tangent 2594 of its argument. The algorithm is from Kahan's paper and is based on 2595 the formula: 2596 2597 catan(z) = i*(clog(1.0-i*z) - clog(1+i*z))/2.0. 2598 2599 CONSTANTS: FPKTHETA = sqrt(nextafterd(+INF,0.0))/4.0 2600 FPKRHO = 1.0/FPKTHETA 2601 FPKPI2 = pi/2.0 2602 FPKPI = pi 2603 2604 Calls: copysign, fabs, xdivc, sqrt, log, atan, log1p, and carg. 2605****************************************************************************/ 2606 2607double complex catan ( double complex z ) 2608{ 2609 double complex iz, iw, w; 2610 Real(iz) = -Imag(z); 2611 Imag(iz) = Real(z); 2612 iw = catanh(iz); 2613 Real(w) = Imag(iw); 2614 Imag(w) = -Real(iw); 2615 return w; 2616} 2617 2618float complex catanf ( float complex z ) 2619{ 2620 float complex iz, iw, w; 2621 Real(iz) = -Imag(z); 2622 Imag(iz) = Real(z); 2623 iw = catanhf(iz); 2624 Real(w) = Imag(iw); 2625 Imag(w) = -Real(iw); 2626 return w; 2627} 2628 2629long double complex catanl ( long double complex z ) 2630{ 2631 long double complex iz, iw, w; 2632 Real(iz) = -Imag(z); 2633 Imag(iz) = Real(z); 2634 iw = catanhl(iz); 2635 Real(w) = Imag(iw); 2636 Imag(w) = -Real(iw); 2637 return w; 2638} 2639 2640/**************************************************************************** 2641 double complex catanh(double complex z) returns the complex inverse hyperbolic tangent 2642 of its argument. The algorithm is from Kahan's paper and is based on 2643 the formula: 2644 2645 catanh(z) = (clog(1.0 + z) - clog(1 - z))/2.0. 2646 2647 CONSTANTS: FPKTHETA = sqrt(nextafterd(+INF,0.0))/4.0 2648 FPKRHO = 1.0/FPKTHETA 2649 FPKPI2 = pi/2.0 2650 FPKPI = pi 2651 2652 Calls: copysign, fabs, xdivc, sqrt, log, atan, log1p, and carg. 2653****************************************************************************/ 2654 2655double complex catanh( double complex z ) 2656{ 2657 double complex ctemp, w; 2658 double t1, t2, xi, eta, beta; 2659 2660 beta = __builtin_copysign(1.0,Real(z)); /* copes with unsigned zero */ 2661 2662 Imag(z) = -beta*Imag(z); /* transform real & imag components */ 2663 Real(z) = beta*Real(z); 2664 2665 if ((Real(z) > FPKTHETA) || (__builtin_fabs(Imag(z)) > FPKTHETA)) { 2666 eta = __builtin_copysign(M_PI_2,Imag(z)); /* avoid overflow */ 2667 ctemp = xdivc(1.0,z); 2668 xi = Real(ctemp); 2669 } 2670 2671 else if (Real(z) == 1.0) { 2672 t1 = __builtin_fabs(Imag(z)) + FPKRHO; 2673 xi = log(__builtin_sqrt(__builtin_sqrt(4.0 + t1*t1))/__builtin_sqrt(__builtin_fabs(Imag(z)))); 2674 eta = 0.5*__builtin_copysign(M_PI-atan(2.0/(__builtin_fabs(Imag(z))+FPKRHO)),Imag(z)); 2675 } 2676 2677 else { /* usual case */ 2678 t2 = __builtin_fabs(Imag(z)) + FPKRHO; 2679 t1 = 1.0 - Real(z); 2680 t2 = t2*t2; 2681 xi = 0.25*log1p(4.0*Real(z)/(t1*t1 + t2)); 2682 Real(ctemp) = (1.0 - Real(z))*(1.0 + Real(z)) - t2; 2683 Imag(ctemp) = Imag(z) + Imag(z); 2684 eta = 0.5*carg(ctemp); 2685 } 2686 2687 Real(w) = beta*xi; /* fix up signs of result */ 2688 Imag(w) = -beta*eta; 2689 return w; 2690} 2691 2692float complex catanhf( float complex z ) 2693{ 2694 float complex ctemp, w; 2695 float t1, t2, xi, eta, beta; 2696 2697 beta = __builtin_copysignf(1.0f,Real(z)); /* copes with unsigned zero */ 2698 2699 Imag(z) = -beta*Imag(z); /* transform real & imag components */ 2700 Real(z) = beta*Real(z); 2701 2702 if ((Real(z) > FPKTHETAf) || (__builtin_fabsf(Imag(z)) > FPKTHETAf)) { 2703 eta = __builtin_copysignf((float) M_PI_2,Imag(z)); /* avoid overflow */ 2704 ctemp = xdivcf(1.0f,z); 2705 xi = Real(ctemp); 2706 } 2707 2708 else if (Real(z) == 1.0f) { 2709 t1 = __builtin_fabsf(Imag(z)) + FPKRHOf; 2710 xi = logf(__builtin_sqrtf(__builtin_sqrtf(4.0f + t1*t1))/__builtin_sqrtf(__builtin_fabsf(Imag(z)))); 2711 eta = 0.5f*__builtin_copysignf((float)( M_PI-atan(2.0f/(__builtin_fabsf(Imag(z))+FPKRHOf))),Imag(z)); 2712 } 2713 2714 else { /* usual case */ 2715 t2 = __builtin_fabsf(Imag(z)) + FPKRHOf; 2716 t1 = 1.0f - Real(z); 2717 t2 = t2*t2; 2718 xi = 0.25f*log1pf(4.0f*Real(z)/(t1*t1 + t2)); 2719 Real(ctemp) = (1.0f - Real(z))*(1.0f + Real(z)) - t2; 2720 Imag(ctemp) = Imag(z) + Imag(z); 2721 eta = 0.5f*cargf(ctemp); 2722 } 2723 2724 Real(w) = beta*xi; /* fix up signs of result */ 2725 Imag(w) = -beta*eta; 2726 return w; 2727} 2728 2729long double complex catanhl( long double complex z ) 2730{ 2731 long double complex ctemp, w; 2732 long double t1, t2, xi, eta, beta; 2733 2734 beta = __builtin_copysignl(1.0L,Real(z)); /* copes with unsigned zero */ 2735 2736 Imag(z) = -beta*Imag(z); /* transform real & imag components */ 2737 Real(z) = beta*Real(z); 2738 2739 if ((Real(z) > FPKTHETA) || (__builtin_fabsl(Imag(z)) > FPKTHETA)) { 2740 eta = __builtin_copysignl(M_PI_2,Imag(z)); /* avoid overflow */ 2741 ctemp = xdivcl(1.0L,z); 2742 xi = Real(ctemp); 2743 } 2744 2745 else if (Real(z) == 1.0L) { 2746 t1 = __builtin_fabsl(Imag(z)) + FPKRHO; 2747 xi = logl(__builtin_sqrtl(__builtin_sqrtl(4.0L + t1*t1))/__builtin_sqrtl(__builtin_fabsl(Imag(z)))); 2748 eta = 0.5L*__builtin_copysignl(M_PI-atanl(2.0L/(__builtin_fabsl(Imag(z))+FPKRHO)),Imag(z)); 2749 } 2750 2751 else { /* usual case */ 2752 t2 = __builtin_fabsl(Imag(z)) + FPKRHO; 2753 t1 = 1.0L - Real(z); 2754 t2 = t2*t2; 2755 xi = 0.25L*log1pl(4.0L*Real(z)/(t1*t1 + t2)); 2756 Real(ctemp) = (1.0L - Real(z))*(1.0L + Real(z)) - t2; 2757 Imag(ctemp) = Imag(z) + Imag(z); 2758 eta = 0.5L*cargl(ctemp); 2759 } 2760 2761 Real(w) = beta*xi; /* fix up signs of result */ 2762 Imag(w) = -beta*eta; 2763 return w; 2764} 2765 2766/* conj(), creal(), and cimag() are gcc built ins. */ 2767double creal( double complex z ) 2768{ 2769 return __builtin_creal(z); 2770} 2771 2772float crealf( float complex z ) 2773{ 2774 return __builtin_crealf(z); 2775} 2776 2777long double creall( long double complex z ) 2778{ 2779 return __builtin_creall(z); 2780} 2781 2782double cimag( double complex z ) 2783{ 2784 return __builtin_cimag(z); 2785} 2786 2787float cimagf( float complex z ) 2788{ 2789 return __builtin_cimagf(z); 2790} 2791 2792long double cimagl( long double complex z ) 2793{ 2794 return __builtin_cimagl(z); 2795} 2796 2797double complex conj( double complex z ) 2798{ 2799 return __builtin_conj(z); 2800} 2801 2802float complex conjf( float complex z ) 2803{ 2804 return __builtin_conjf(z); 2805} 2806 2807long double complex conjl( long double complex z ) 2808{ 2809 return __builtin_conjl(z); 2810} 2811 2812double complex cproj( double complex z ) 2813{ 2814 static const double inf = __builtin_inf(); 2815 double u = __builtin_fabs(Real(z)); 2816 double v = __builtin_fabs(Imag(z)); 2817 2818 if (EXPECT_FALSE((u == inf) || (v == inf))) { 2819 __real__ z = inf; 2820 __imag__ z = __builtin_copysign(0.0, __imag__ z); 2821 } 2822 2823 return z; 2824} 2825 2826float complex cprojf( float complex z ) 2827{ 2828 static const float inff = __builtin_inff(); 2829 float u = __builtin_fabsf(Real(z)); 2830 float v = __builtin_fabsf(Imag(z)); 2831 2832 if (EXPECT_FALSE((u == inff) || (v == inff))) { 2833 __real__ z = inff; 2834 __imag__ z = __builtin_copysignf(0.0f, __imag__ z); 2835 } 2836 2837 return z; 2838} 2839 2840long double complex cprojl( long double complex z ) 2841{ 2842 static const long double infl = __builtin_infl(); 2843 long double u = __builtin_fabsl(Real(z)); 2844 long double v = __builtin_fabsl(Imag(z)); 2845 2846 if (EXPECT_FALSE((u == infl) || (v == infl))) { 2847 __real__ z = infl; 2848 __imag__ z = __builtin_copysignl(0.0L, __imag__ z); 2849 } 2850 2851 return z; 2852}