1 1.1 christos /*- 2 1.1 christos * Copyright (c) 2017-2023 Steven G. Kargl 3 1.1 christos * All rights reserved. 4 1.1 christos * 5 1.1 christos * Redistribution and use in source and binary forms, with or without 6 1.1 christos * modification, are permitted provided that the following conditions 7 1.1 christos * are met: 8 1.1 christos * 1. Redistributions of source code must retain the above copyright 9 1.1 christos * notice unmodified, this list of conditions, and the following 10 1.1 christos * disclaimer. 11 1.1 christos * 2. Redistributions in binary form must reproduce the above copyright 12 1.1 christos * notice, this list of conditions and the following disclaimer in the 13 1.1 christos * documentation and/or other materials provided with the distribution. 14 1.1 christos * 15 1.1 christos * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 16 1.1 christos * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 1.1 christos * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 1.1 christos * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 19 1.1 christos * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 1.1 christos * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 1.1 christos * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 1.1 christos * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 1.1 christos * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 1.1 christos * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 1.1 christos */ 26 1.1 christos 27 1.1 christos /* 28 1.1 christos * See ../src/s_tanpi.c for implementation details. 29 1.1 christos */ 30 1.1 christos 31 1.1 christos #include "math.h" 32 1.1 christos #include "math_private.h" 33 1.1 christos 34 1.1 christos /* 35 1.1 christos * pi_hi contains the leading 56 bits of a 169 bit approximation for pi. 36 1.1 christos */ 37 1.1 christos static const long double 38 1.1 christos pi_hi = 3.14159265358979322702026593105983920e+00L, 39 1.1 christos pi_lo = 1.14423774522196636802434264184180742e-17L; 40 1.1 christos 41 1.1 christos static inline long double 42 1.1 christos __kernel_tanpil(long double x) 43 1.1 christos { 44 1.1 christos long double hi, lo, t; 45 1.1 christos 46 1.1 christos if (x < 0.25) { 47 1.1 christos hi = (double)x; 48 1.1 christos lo = x - hi; 49 1.1 christos lo = lo * (pi_lo + pi_hi) + hi * pi_lo; 50 1.1 christos hi *= pi_hi; 51 1.1 christos _2sumF(hi, lo); 52 1.1 christos t = __kernel_tanl(hi, lo, -1); 53 1.1 christos } else if (x > 0.25) { 54 1.1 christos x = 0.5 - x; 55 1.1 christos hi = (double)x; 56 1.1 christos lo = x - hi; 57 1.1 christos lo = lo * (pi_lo + pi_hi) + hi * pi_lo; 58 1.1 christos hi *= pi_hi; 59 1.1 christos _2sumF(hi, lo); 60 1.1 christos t = - __kernel_tanl(hi, lo, 1); 61 1.1 christos } else 62 1.1 christos t = 1; 63 1.1 christos 64 1.1 christos return (t); 65 1.1 christos } 66 1.1 christos 67 1.1 christos static volatile const double vzero = 0; 68 1.1 christos 69 1.1 christos long double 70 1.1 christos tanpil(long double x) 71 1.1 christos { 72 1.1 christos long double ai, ar, ax, hi, lo, t; 73 1.1 christos double odd; 74 1.1 christos 75 1.1 christos ax = fabsl(x); 76 1.1 christos 77 1.1 christos if (ax < 1) { 78 1.1 christos if (ax < 0.5) { 79 1.1 christos if (ax < 0x1p-60) { 80 1.1 christos if (x == 0) 81 1.1 christos return (x); 82 1.1 christos hi = (double)x; 83 1.1 christos hi *= 0x1p113L; 84 1.1 christos lo = x * 0x1p113L - hi; 85 1.1 christos t = (pi_lo + pi_hi) * lo + pi_lo * lo + 86 1.1 christos pi_hi * hi; 87 1.1 christos return (t * 0x1p-113L); 88 1.1 christos } 89 1.1 christos t = __kernel_tanpil(ax); 90 1.1 christos } else if (ax == 0.5) 91 1.1 christos t = 1 / vzero; 92 1.1 christos else 93 1.1 christos t = -__kernel_tanpil(1 - ax); 94 1.1 christos return (x < 0 ? -t : t); 95 1.1 christos } 96 1.1 christos 97 1.1 christos if (ax < 0x1p112) { 98 1.1 christos /* Split ax = ai + ar with 0 <= ar < 1. */ 99 1.1 christos FFLOORL128(ax, ai, ar); 100 1.1 christos odd = fmodl(ai, 2.L) == 0 ? 1 : -1; 101 1.1 christos if (ar < 0.5) 102 1.1 christos t = ar == 0 ? copysign(0., odd) : __kernel_tanpil(ar); 103 1.1 christos else if (ar == 0.5) 104 1.1 christos t = odd / vzero; 105 1.1 christos else 106 1.1 christos t = -__kernel_tanpil(1 - ar); 107 1.1 christos return (x < 0 ? -t : t); 108 1.1 christos } 109 1.1 christos 110 1.1 christos /* x = +-inf or nan. */ 111 1.1 christos if (isinf(x) || isnan(x)) 112 1.1 christos return (vzero / vzero); 113 1.1 christos 114 1.1 christos /* 115 1.1 christos * For 0x1p112 <= |x| < 0x1p113 need to determine if x is an even 116 1.1 christos * or odd integer to set t = +0 or -0. 117 1.1 christos * For |x| >= 0x1p113, it is always an even integer, so t = 0. 118 1.1 christos */ 119 1.1 christos t = fmodl(ax,2.L) == 0 ? 0 : copysign(0., -1.); 120 1.1 christos return (copysignl(t, x)); 121 1.1 christos } 122