]> www.ginac.de Git - cln.git/blob - src/float/lfloat/algebraic/cl_LF_sqrt.cc
c551ca446fb1be7e159f670c9c9f7eb57613687c
[cln.git] / src / float / lfloat / algebraic / cl_LF_sqrt.cc
1 // sqrt().
2
3 // General includes.
4 #include "cl_sysdep.h"
5
6 // Specification.
7 #include "cln/lfloat.h"
8
9
10 // Implementation.
11
12 #include "cl_LF.h"
13 #include "cl_LF_impl.h"
14 #include "cl_F.h"
15 #include "cl_DS.h"
16 #include "cln/abort.h"
17
18 namespace cln {
19
20 const cl_LF sqrt (const cl_LF& x)
21 {
22 // Methode:
23 // x = 0.0 -> Ergebnis 0.0
24 // Ergebnis-Vorzeichen := positiv,
25 // Ergebnis-Exponent := ceiling(e/2),
26 // Ergebnis-Mantisse:
27 //   Erweitere die Mantisse (n Digits) um n+2 Nulldigits nach hinten.
28 //   Bei ungeradem e schiebe dies (oder nur die ersten n+1 Digits davon)
29 //     um 1 Bit nach rechts.
30 //   Bilde daraus die Ganzzahl-Wurzel, eine n+1-Digit-Zahl mit einer
31 //     führenden 1.
32 //   Runde das letzte Digit weg:
33 //     Bit 15 = 0 -> abrunden,
34 //     Bit 15 = 1, Rest =0 und Wurzel exakt -> round-to-even,
35 //     sonst aufrunden.
36 //   Bei rounding overflow Mantisse um 1 Bit nach rechts schieben
37 //     und Exponent incrementieren.
38       var uintL uexp = TheLfloat(x)->expo;
39       if (uexp==0) { return x; } // x=0.0 -> 0.0 als Ergebnis
40       var uintC len = TheLfloat(x)->len;
41       // Radikanden bilden:
42       CL_ALLOCA_STACK;
43       var uintD* r_MSDptr;
44       var uintD* r_LSDptr;
45       var uintL r_len = 2*(uintL)len+2; // Länge des Radikanden
46       num_stack_alloc(r_len, r_MSDptr=,r_LSDptr=);
47       uexp = uexp - LF_exp_mid + 1;
48       if (uexp & bit(0))
49         // Exponent gerade
50         {var uintD* ptr =
51            copy_loop_msp(arrayMSDptr(TheLfloat(x)->data,len),r_MSDptr,len); // n Digits kopieren
52          clear_loop_msp(ptr,len+2); // n+2 Nulldigits anhängen
53         }
54         else
55         // Exponent ungerade
56         {var uintD carry_rechts = // n Digits kopieren und um 1 Bit rechts shiften
57            shiftrightcopy_loop_msp(arrayMSDptr(TheLfloat(x)->data,len),r_MSDptr,len,1,0);
58          var uintD* ptr = r_MSDptr mspop len;
59          msprefnext(ptr) = carry_rechts; // Übertrag und
60          clear_loop_msp(ptr,len+1); // n+1 Nulldigits anhängen
61         }
62       uexp = (sintL)((sintL)uexp >> 1); // Exponent halbieren
63       uexp = uexp + LF_exp_mid;
64       // Ergebnis allozieren:
65       var Lfloat y = allocate_lfloat(len,uexp,0);
66       var uintD* y_mantMSDptr = arrayMSDptr(TheLfloat(y)->data,len);
67       // Wurzel ziehen:
68 #ifndef CL_LF_PEDANTIC
69       if (len > 2900) // This is about 15% faster
70         { // Kehrwert der Wurzel errechnen:
71           var uintD* s_MSDptr;
72           var uintD* s_LSDptr;
73           num_stack_alloc(len+2, s_MSDptr=,s_LSDptr=);
74           cl_UDS_recipsqrt(r_MSDptr,r_len, s_MSDptr,len);
75           // Mit dem Radikanden multiplizieren:
76           var uintD* p_MSDptr;
77           var uintD* p_LSDptr;
78           num_stack_alloc(2*len+3, p_MSDptr=,p_LSDptr=);
79           cl_UDS_mul(r_MSDptr mspop (len+1),len+1,s_LSDptr,len+2,p_LSDptr);
80           // Ablegen und runden:
81           copy_loop_msp(p_MSDptr mspop 1,y_mantMSDptr,len); // NUDS nach y kopieren
82           if (mspref(p_MSDptr,0) == 0)
83             { if ( ((sintD)mspref(p_MSDptr,len+1) >= 0) // nächstes Bit =0 -> abrunden
84                    || ( ((mspref(p_MSDptr,len+1) & ((uintD)bit(intDsize-1)-1)) ==0) // =1 und weitere Bits >0 -> aufrunden
85                         && !test_loop_msp(p_MSDptr mspop (len+2),len+1)
86                         // round-to-even (etwas witzlos, da eh alles ungenau ist)
87                         && ((mspref(p_MSDptr,len) & bit(0)) ==0)
88                  )    )
89                 // abrunden
90                 {}
91                 else
92                 // aufrunden
93                 { if ( inc_loop_lsp(y_mantMSDptr mspop len,len) )
94                     // Übertrag durchs Aufrunden
95                     { mspref(y_mantMSDptr,0) = bit(intDsize-1); // Mantisse := 10...0
96                       (TheLfloat(y)->expo)++; // Exponenten incrementieren
97                 }   }
98             }
99             else
100             // Übertrag durch Rundungsfehler
101             { if (test_loop_msp(y_mantMSDptr,len)) cl_abort();
102               mspref(y_mantMSDptr,0) = bit(intDsize-1); // Mantisse := 10...0
103               (TheLfloat(y)->expo)++; // Exponenten incrementieren
104             }
105           return y;
106         }
107 #endif
108       var DS w;
109       var cl_boolean exactp;
110       UDS_sqrt(r_MSDptr,r_len,r_LSDptr, &w, exactp=);
111       // w ist die Ganzzahl-Wurzel, eine n+1-Digit-Zahl.
112       copy_loop_msp(w.MSDptr,y_mantMSDptr,len); // NUDS nach y kopieren
113       // Runden:
114       if ( ((sintD)lspref(w.LSDptr,0) >= 0) // nächstes Bit =0 -> abrunden
115            || ( ((lspref(w.LSDptr,0) & ((uintD)bit(intDsize-1)-1)) ==0) // =1 und weitere Bits >0 oder Rest >0 -> aufrunden
116                 && exactp
117                 // round-to-even
118                 && ((lspref(w.LSDptr,1) & bit(0)) ==0)
119          )    )
120         // abrunden
121         {}
122         else
123         // aufrunden
124         { if ( inc_loop_lsp(y_mantMSDptr mspop len,len) )
125             // Übertrag durchs Aufrunden
126             { mspref(y_mantMSDptr,0) = bit(intDsize-1); // Mantisse := 10...0
127               (TheLfloat(y)->expo)++; // Exponenten incrementieren
128         }   }
129       return y;
130 }
131 // Bit complexity (N := length(x)): O(M(N)).
132
133 }  // namespace cln