]> www.ginac.de Git - cln.git/blob - src/float/sfloat/elem/cl_SF_from_RA.cc
* Removed internal gmp/ directory and other traces of it like $GMP_INCLUDES.
[cln.git] / src / float / sfloat / elem / cl_SF_from_RA.cc
1 // cl_RA_to_SF().
2
3 // General includes.
4 #include "cl_sysdep.h"
5
6 // Specification.
7 #include "cl_SF.h"
8
9
10 // Implementation.
11
12 #include "cl_RA.h"
13 #include "cl_integer.h"
14 #include "cl_I.h"
15
16 const cl_SF cl_RA_to_SF (const cl_RA& x)
17 {
18 // Methode:
19 // x ganz -> klar.
20 // x = +/- a/b mit Integers a,b>0:
21 //   Seien n,m so gewählt, daß
22 //     2^(n-1) <= a < 2^n, 2^(m-1) <= b < 2^m.
23 //   Dann ist 2^(n-m-1) < a/b < 2^(n-m+1).
24 //   Berechne n=(integer-length a) und m=(integer-length b) und
25 //   floor(2^(-n+m+18)*a/b) :
26 //   Bei n-m>=18 dividiere a durch (ash b (n-m-18)),
27 //   bei n-m<18 dividiere (ash a (-n+m+18)) durch b.
28 //   Der erste Wert ist >=2^17, <2^19.
29 //   Falls er >=2^18 ist, runde 2 Bits weg,
30 //   falls er <2^18 ist, runde 1 Bit weg.
31       if (integerp(x)) {
32         DeclareType(cl_I,x);
33         return cl_I_to_SF(x);
34       }
35  {    // x Ratio
36       DeclareType(cl_RT,x);
37       var cl_I a = numerator(x); // +/- a
38       var const cl_I& b = denominator(x); // b
39       var cl_signean sign = -(cl_signean)minusp(a); // Vorzeichen
40       if (!(sign==0)) { a = -a; } // Betrag nehmen, liefert a
41       var sintL lendiff = (sintL)integer_length(a) // (integer-length a)
42                           - (sintL)integer_length(b); // (integer-length b)
43       if (lendiff > SF_exp_high-SF_exp_mid) // Exponent >= n-m > Obergrenze ?
44         { cl_error_floating_point_overflow(); } // -> Overflow
45       if (lendiff < SF_exp_low-SF_exp_mid-2) // Exponent <= n-m+2 < Untergrenze ?
46         { if (underflow_allowed())
47             { cl_error_floating_point_underflow(); } // -> Underflow
48             else
49             { return SF_0; }
50         }
51       var cl_I zaehler;
52       var cl_I nenner;
53       if (lendiff >= SF_mant_len+2)
54         // n-m-18>=0
55         { nenner = ash(b,lendiff - (SF_mant_len+2)); // (ash b n-m-18)
56           zaehler = a; // a
57         }
58         else
59         { zaehler = ash(a,(SF_mant_len+2) - lendiff); // (ash a -n+m+18)
60           nenner = b; // b
61         }
62       // Division zaehler/nenner durchführen:
63       var cl_I_div_t q_r = cl_divide(zaehler,nenner);
64       var cl_I& q = q_r.quotient;
65       var cl_I& r = q_r.remainder;
66       // 2^17 <= q < 2^19, also ist q Fixnum.
67       var uint32 mant = FN_to_UL(q);
68       if (mant >= bit(SF_mant_len+2))
69         // 2^18 <= q < 2^19, schiebe um 2 Bits nach rechts
70         { var uintL rounding_bits = mant & (bit(2)-1);
71           lendiff = lendiff+1; // Exponent := n-m+1
72           mant = mant >> 2;
73           if ( (rounding_bits < bit(1)) // 00,01 werden abgerundet
74                || ( (rounding_bits == bit(1)) // 10
75                     && (eq(r,0)) // und genau halbzahlig (r=0)
76                     && ((mant & bit(0)) ==0) // -> round-to-even
77              )    )
78             // abrunden
79             goto ab;
80             else
81             // aufrunden
82             goto auf;
83         }
84         else
85         { var uintL rounding_bit = mant & bit(0);
86           mant = mant >> 1;
87           if ( (rounding_bit == 0) // 0 wird abgerundet
88                || ( (eq(r,0)) // genau halbzahlig (r=0)
89                     && ((mant & bit(0)) ==0) // -> round-to-even
90              )    )
91             // abrunden
92             goto ab;
93             else
94             // aufrunden
95             goto auf;
96         }
97       auf:
98       mant += 1;
99       if (mant >= bit(SF_mant_len+1)) // rounding overflow?
100         { mant = mant>>1; lendiff = lendiff+1; }
101       ab:
102       // Fertig.
103       return encode_SF(sign,lendiff,mant);
104 }}