Back to index

glibc  2.9
e_hypotl.c
Go to the documentation of this file.
00001 /* @(#)e_hypotl.c 5.1 93/09/24 */
00002 /*
00003  * ====================================================
00004  * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
00005  *
00006  * Developed at SunPro, a Sun Microsystems, Inc. business.
00007  * Permission to use, copy, modify, and distribute this
00008  * software is freely granted, provided that this notice
00009  * is preserved.
00010  * ====================================================
00011  */
00012 
00013 #if defined(LIBM_SCCS) && !defined(lint)
00014 static char rcsid[] = "$NetBSD: e_hypotl.c,v 1.9 1995/05/12 04:57:27 jtc Exp $";
00015 #endif
00016 
00017 /* __ieee754_hypotl(x,y)
00018  *
00019  * Method :
00020  *     If (assume round-to-nearest) z=x*x+y*y
00021  *     has error less than sqrtl(2)/2 ulp, than
00022  *     sqrtl(z) has error less than 1 ulp (exercise).
00023  *
00024  *     So, compute sqrtl(x*x+y*y) with some care as
00025  *     follows to get the error below 1 ulp:
00026  *
00027  *     Assume x>y>0;
00028  *     (if possible, set rounding to round-to-nearest)
00029  *     1. if x > 2y  use
00030  *            x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y
00031  *     where x1 = x with lower 53 bits cleared, x2 = x-x1; else
00032  *     2. if x <= 2y use
00033  *            t1*y1+((x-y)*(x-y)+(t1*y2+t2*y))
00034  *     where t1 = 2x with lower 53 bits cleared, t2 = 2x-t1,
00035  *     y1= y with lower 53 bits chopped, y2 = y-y1.
00036  *
00037  *     NOTE: scaling may be necessary if some argument is too
00038  *           large or too tiny
00039  *
00040  * Special cases:
00041  *     hypotl(x,y) is INF if x or y is +INF or -INF; else
00042  *     hypotl(x,y) is NAN if x or y is NAN.
00043  *
00044  * Accuracy:
00045  *     hypotl(x,y) returns sqrtl(x^2+y^2) with error less
00046  *     than 1 ulps (units in the last place)
00047  */
00048 
00049 #include "math.h"
00050 #include "math_private.h"
00051 
00052 static const long double two600 = 0x1.0p+600L;
00053 static const long double two1022 = 0x1.0p+1022L;
00054 
00055 #ifdef __STDC__
00056        long double __ieee754_hypotl(long double x, long double y)
00057 #else
00058        long double __ieee754_hypotl(x,y)
00059        long double x, y;
00060 #endif
00061 {
00062        long double a,b,t1,t2,y1,y2,w,kld;
00063        int64_t j,k,ha,hb;
00064 
00065        GET_LDOUBLE_MSW64(ha,x);
00066        ha &= 0x7fffffffffffffffLL;
00067        GET_LDOUBLE_MSW64(hb,y);
00068        hb &= 0x7fffffffffffffffLL;
00069        if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;}
00070        a = fabsl(a); /* a <- |a| */
00071        b = fabsl(b); /* b <- |b| */
00072        if((ha-hb)>0x3c0000000000000LL) {return a+b;} /* x/y > 2**60 */
00073        k=0;
00074        kld = 1.0L;
00075        if(ha > 0x5f30000000000000LL) {    /* a>2**500 */
00076           if(ha >= 0x7ff0000000000000LL) {       /* Inf or NaN */
00077               u_int64_t low;
00078               w = a+b;                    /* for sNaN */
00079               GET_LDOUBLE_LSW64(low,a);
00080               if(((ha&0xfffffffffffffLL)|(low&0x7fffffffffffffffLL))==0)
00081                w = a;
00082               GET_LDOUBLE_LSW64(low,b);
00083               if(((hb^0x7ff0000000000000LL)|(low&0x7fffffffffffffffLL))==0)
00084                w = b;
00085               return w;
00086           }
00087           /* scale a and b by 2**-600 */
00088           ha -= 0x2580000000000000LL; hb -= 0x2580000000000000LL; k += 600;
00089           a /= two600;
00090           b /= two600;
00091           k += 600;
00092           kld = two600;
00093        }
00094        if(hb < 0x20b0000000000000LL) {    /* b < 2**-500 */
00095            if(hb <= 0x000fffffffffffffLL) {      /* subnormal b or 0 */
00096                u_int64_t low;
00097               GET_LDOUBLE_LSW64(low,b);
00098               if((hb|(low&0x7fffffffffffffffLL))==0) return a;
00099               t1=two1022;   /* t1=2^1022 */
00100               b *= t1;
00101               a *= t1;
00102               k -= 1022;
00103               kld = kld / two1022;
00104            } else {         /* scale a and b by 2^600 */
00105                ha += 0x2580000000000000LL;       /* a *= 2^600 */
00106               hb += 0x2580000000000000LL; /* b *= 2^600 */
00107               k -= 600;
00108               a *= two600;
00109               b *= two600;
00110               kld = kld / two600;
00111            }
00112        }
00113     /* medium size a and b */
00114        w = a-b;
00115        if (w>b) {
00116            SET_LDOUBLE_WORDS64(t1,ha,0);
00117            t2 = a-t1;
00118            w  = __ieee754_sqrtl(t1*t1-(b*(-b)-t2*(a+t1)));
00119        } else {
00120            a  = a+a;
00121            SET_LDOUBLE_WORDS64(y1,hb,0);
00122            y2 = b - y1;
00123            SET_LDOUBLE_WORDS64(t1,ha+0x0010000000000000LL,0);
00124            t2 = a - t1;
00125            w  = __ieee754_sqrtl(t1*y1-(w*(-w)-(t1*y2+t2*b)));
00126        }
00127        if(k!=0)
00128            return w*kld;
00129        else
00130            return w;
00131 }