1 |
/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*- |
2 |
* |
3 |
* ***** BEGIN LICENSE BLOCK ***** |
4 |
* Version: MPL 1.1/GPL 2.0/LGPL 2.1 |
5 |
* |
6 |
* The contents of this file are subject to the Mozilla Public License Version |
7 |
* 1.1 (the "License"); you may not use this file except in compliance with |
8 |
* the License. You may obtain a copy of the License at |
9 |
* http://www.mozilla.org/MPL/ |
10 |
* |
11 |
* Software distributed under the License is distributed on an "AS IS" basis, |
12 |
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License |
13 |
* for the specific language governing rights and limitations under the |
14 |
* License. |
15 |
* |
16 |
* The Original Code is Mozilla Communicator client code, released |
17 |
* March 31, 1998. |
18 |
* |
19 |
* The Initial Developer of the Original Code is |
20 |
* Sun Microsystems, Inc. |
21 |
* Portions created by the Initial Developer are Copyright (C) 1998 |
22 |
* the Initial Developer. All Rights Reserved. |
23 |
* |
24 |
* Contributor(s): |
25 |
* |
26 |
* Alternatively, the contents of this file may be used under the terms of |
27 |
* either of the GNU General Public License Version 2 or later (the "GPL"), |
28 |
* or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), |
29 |
* in which case the provisions of the GPL or the LGPL are applicable instead |
30 |
* of those above. If you wish to allow use of your version of this file only |
31 |
* under the terms of either the GPL or the LGPL, and not to allow others to |
32 |
* use your version of this file under the terms of the MPL, indicate your |
33 |
* decision by deleting the provisions above and replace them with the notice |
34 |
* and other provisions required by the GPL or the LGPL. If you do not delete |
35 |
* the provisions above, a recipient may use your version of this file under |
36 |
* the terms of any one of the MPL, the GPL or the LGPL. |
37 |
* |
38 |
* ***** END LICENSE BLOCK ***** */ |
39 |
|
40 |
/* @(#)e_hypot.c 1.3 95/01/18 */ |
41 |
/* |
42 |
* ==================================================== |
43 |
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. |
44 |
* |
45 |
* Developed at SunSoft, a Sun Microsystems, Inc. business. |
46 |
* Permission to use, copy, modify, and distribute this |
47 |
* software is freely granted, provided that this notice |
48 |
* is preserved. |
49 |
* ==================================================== |
50 |
*/ |
51 |
|
52 |
/* __ieee754_hypot(x,y) |
53 |
* |
54 |
* Method : |
55 |
* If (assume round-to-nearest) z=x*x+y*y |
56 |
* has error less than sqrt(2)/2 ulp, than |
57 |
* sqrt(z) has error less than 1 ulp (exercise). |
58 |
* |
59 |
* So, compute sqrt(x*x+y*y) with some care as |
60 |
* follows to get the error below 1 ulp: |
61 |
* |
62 |
* Assume x>y>0; |
63 |
* (if possible, set rounding to round-to-nearest) |
64 |
* 1. if x > 2y use |
65 |
* x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y |
66 |
* where x1 = x with lower 32 bits cleared, x2 = x-x1; else |
67 |
* 2. if x <= 2y use |
68 |
* t1*y1+((x-y)*(x-y)+(t1*y2+t2*y)) |
69 |
* where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, |
70 |
* y1= y with lower 32 bits chopped, y2 = y-y1. |
71 |
* |
72 |
* NOTE: scaling may be necessary if some argument is too |
73 |
* large or too tiny |
74 |
* |
75 |
* Special cases: |
76 |
* hypot(x,y) is INF if x or y is +INF or -INF; else |
77 |
* hypot(x,y) is NAN if x or y is NAN. |
78 |
* |
79 |
* Accuracy: |
80 |
* hypot(x,y) returns sqrt(x^2+y^2) with error less |
81 |
* than 1 ulps (units in the last place) |
82 |
*/ |
83 |
|
84 |
#include "fdlibm.h" |
85 |
|
86 |
#ifdef __STDC__ |
87 |
double __ieee754_hypot(double x, double y) |
88 |
#else |
89 |
double __ieee754_hypot(x,y) |
90 |
double x, y; |
91 |
#endif |
92 |
{ |
93 |
fd_twoints ux, uy; |
94 |
double a=x,b=y,t1,t2,y1,y2,w; |
95 |
int j,k,ha,hb; |
96 |
|
97 |
ux.d = x; uy.d = y; |
98 |
ha = __HI(ux)&0x7fffffff; /* high word of x */ |
99 |
hb = __HI(uy)&0x7fffffff; /* high word of y */ |
100 |
if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} |
101 |
ux.d = a; uy.d = b; |
102 |
__HI(ux) = ha; /* a <- |a| */ |
103 |
__HI(uy) = hb; /* b <- |b| */ |
104 |
a = ux.d; b = uy.d; |
105 |
if((ha-hb)>0x3c00000) {return a+b;} /* x/y > 2**60 */ |
106 |
k=0; |
107 |
if(ha > 0x5f300000) { /* a>2**500 */ |
108 |
if(ha >= 0x7ff00000) { /* Inf or NaN */ |
109 |
w = a+b; /* for sNaN */ |
110 |
ux.d = a; uy.d = b; |
111 |
if(((ha&0xfffff)|__LO(ux))==0) w = a; |
112 |
if(((hb^0x7ff00000)|__LO(uy))==0) w = b; |
113 |
return w; |
114 |
} |
115 |
/* scale a and b by 2**-600 */ |
116 |
ha -= 0x25800000; hb -= 0x25800000; k += 600; |
117 |
ux.d = a; uy.d = b; |
118 |
__HI(ux) = ha; |
119 |
__HI(uy) = hb; |
120 |
a = ux.d; b = uy.d; |
121 |
} |
122 |
if(hb < 0x20b00000) { /* b < 2**-500 */ |
123 |
if(hb <= 0x000fffff) { /* subnormal b or 0 */ |
124 |
uy.d = b; |
125 |
if((hb|(__LO(uy)))==0) return a; |
126 |
t1=0; |
127 |
ux.d = t1; |
128 |
__HI(ux) = 0x7fd00000; /* t1=2^1022 */ |
129 |
t1 = ux.d; |
130 |
b *= t1; |
131 |
a *= t1; |
132 |
k -= 1022; |
133 |
} else { /* scale a and b by 2^600 */ |
134 |
ha += 0x25800000; /* a *= 2^600 */ |
135 |
hb += 0x25800000; /* b *= 2^600 */ |
136 |
k -= 600; |
137 |
ux.d = a; uy.d = b; |
138 |
__HI(ux) = ha; |
139 |
__HI(uy) = hb; |
140 |
a = ux.d; b = uy.d; |
141 |
} |
142 |
} |
143 |
/* medium size a and b */ |
144 |
w = a-b; |
145 |
if (w>b) { |
146 |
t1 = 0; |
147 |
ux.d = t1; |
148 |
__HI(ux) = ha; |
149 |
t1 = ux.d; |
150 |
t2 = a-t1; |
151 |
w = fd_sqrt(t1*t1-(b*(-b)-t2*(a+t1))); |
152 |
} else { |
153 |
a = a+a; |
154 |
y1 = 0; |
155 |
ux.d = y1; |
156 |
__HI(ux) = hb; |
157 |
y1 = ux.d; |
158 |
y2 = b - y1; |
159 |
t1 = 0; |
160 |
ux.d = t1; |
161 |
__HI(ux) = ha+0x00100000; |
162 |
t1 = ux.d; |
163 |
t2 = a - t1; |
164 |
w = fd_sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b))); |
165 |
} |
166 |
if(k!=0) { |
167 |
t1 = 1.0; |
168 |
ux.d = t1; |
169 |
__HI(ux) += (k<<20); |
170 |
t1 = ux.d; |
171 |
return t1*w; |
172 |
} else return w; |
173 |
} |