]> www.ginac.de Git - cln.git/blob - src/float/lfloat/misc/cl_LF_shortenrel.cc
* All Files have been modified for inclusion of namespace cln;
[cln.git] / src / float / lfloat / misc / cl_LF_shortenrel.cc
1 // cl_LF_shortenrelative().
2
3 // General includes.
4 #include "cl_sysdep.h"
5
6 // Specification.
7 #include "cl_LF.h"
8
9
10 // Implementation.
11
12 #include "cln/abort.h"
13
14 #undef MAYBE_INLINE2
15 #define MAYBE_INLINE2 inline
16 #include "cl_LF_precision.cc"
17 #undef MAYBE_INLINE
18 #define MAYBE_INLINE inline
19 #include "cl_LF_exponent.cc"
20
21 namespace cln {
22
23 const cl_LF cl_LF_shortenrelative (const cl_LF& x, const cl_LF& y)
24 {
25         // Methode:
26         // x = 0.0 -> Precision egal, return x.
27         // ex := float_exponent(x), ey := float_exponent(y).
28         // dx := float_digits(x), dy := float_digits(y).
29         // 1 ulp(x) = 2^(ex-dx), 1 ulp(y) = 2^(ey-dy).
30         // Falls ex-dx < ey-dy, x von Precision dx auf dy-ey+ex verkürzen.
31         var sintL ey = float_exponent(y);
32         var sintL dy = float_precision(y);
33         if (dy==0) // zerop(y) ?
34                 cl_abort();
35         var sintL ex = float_exponent(x);
36         var sintL dx = float_precision(x);
37         if (dx==0) // zerop(x) ?
38                 return x;
39         var sintL d = ex - ey;
40         if (ex>=0 && ey<0 && d<0) // d overflow?
41                 return x;
42         if (ex<0 && ey>=0 && d>=0) // d underflow?
43                 return LF_to_LF(x,LF_minlen);
44         if (d >= dx - dy)
45                 return x;
46         var uintL new_dx = dy + d;
47         var uintL len = ceiling(new_dx,intDsize);
48         if (len < LF_minlen)
49                 len = LF_minlen;
50         if (intDsize*len < (uintL)dx)
51                 return shorten(x,len);
52         else
53                 return x;
54 }
55
56 }  // namespace cln