]> www.ginac.de Git - cln.git/blob - src/float/misc/cl_F_shortenrel.cc
* Also filter out SCCS subdirs while recursing and searching for
[cln.git] / src / float / misc / cl_F_shortenrel.cc
1 // cl_F_shortenrelative().
2
3 // General includes.
4 #include "cl_sysdep.h"
5
6 // Specification.
7 #include "cl_F.h"
8
9
10 // Implementation.
11
12 #include "cl_LF.h"
13 #include "cln/abort.h"
14
15 namespace cln {
16
17 const cl_F cl_F_shortenrelative (const cl_F& x, const cl_F& y)
18 {
19         // Methode:
20         // x = 0.0 -> Precision egal, return x.
21         // ex := float_exponent(x), ey := float_exponent(y).
22         // dx := float_digits(x), dy := float_digits(y).
23         // 1 ulp(x) = 2^(ex-dx), 1 ulp(y) = 2^(ey-dy).
24         // Falls ex-dx < ey-dy, x von Precision dx auf dy-ey+ex verkürzen.
25         var sintL ey = float_exponent(y);
26         var sintL dy = float_precision(y);
27         if (dy==0) // zerop(y) ?
28                 cl_abort();
29         var sintL ex = float_exponent(x);
30         var sintL dx = float_precision(x);
31         if (dx==0) // zerop(x) ?
32                 return x;
33         var sintL d = ex - ey;
34         if (ex>=0 && ey<0 && d<0) // d overflow?
35                 return x;
36         if (ex<0 && ey>=0 && d>=0) // d underflow?
37                 return cl_F_to_SF(x);
38         if (d >= dx - dy)
39                 return x;
40         var uintL new_dx = dy + d;
41         floatformatcase(new_dx
42         ,       return cl_F_to_SF(x);
43         ,       return cl_F_to_FF(x);
44         ,       return cl_F_to_DF(x);
45         ,       if (intDsize*len < (uintL)dx)
46                         return shorten(The(cl_LF)(x),len);
47                 else
48                         return x;
49         );
50 }
51
52 }  // namespace cln