1 /**
2  * Provides a D implementation of the standard C function `strold` (String to long double).
3  *
4  * Copyright:   Copyright (C) 1985-1998 by Symantec
5  *              Copyright (C) 2000-2020 by The D Language Foundation, All Rights Reserved
6  * Authors:     $(LINK2 http://www.digitalmars.com, Walter Bright)
7  * License:     $(LINK2 http://www.boost.org/LICENSE_1_0.txt, Boost License 1.0)
8  * Source:      $(LINK2 https://github.com/dlang/dmd/blob/master/src/dmd/backend/strtold.c, backend/strtold.c)
9  */
10 
11 module dmd.root.strtold;
12 
13 import dmd.root.longdouble;
14 import core.stdc.ctype;
15 import core.stdc.errno;
16 
17 version(CRuntime_Microsoft):
18 @nogc:
19 nothrow:
20 
21 static if (false)
22 {
23 /* This is for compilers that support 80-bit floats,
24  * and also makes it clearer what constants we're trying to use.
25  */
26 
27 static const longdouble[14]  negtab =
28 [
29     1e-4096L, 1e-2048L, 1e-1024L, 1e-512L,
30     1e-256L, 1e-128L, 1e-64L, 1e-32L, 1e-16L, 1e-8L, 1e-4L, 1e-2L, 1e-1L, 1.0L
31 ];
32 
33 static const longdouble[14]  postab =
34 [
35     1e+4096L, 1e+2048L, 1e+1024L, 1e+512L,
36     1e+256L, 1e+128L, 1e+64L, 1e+32L, 1e+16L, 1e+8L, 1e+4L, 1e+2L, 1e+1L
37 ];
38 }
39 else
40 {
41 // Precaclulated values for the negtab/postab arrays
42 
43 static const ubyte[longdouble.sizeof][14] _negtab_bytes =
44 [
45     [ 0xDE,0x9F,0xCE,0xD2,0xC8,0x04,0xDD,0xA6,0xD8,0x0A ],
46     [ 0xE4,0x2D,0x36,0x34,0x4F,0x53,0xAE,0xCE,0x6B,0x25 ],
47     [ 0xBE,0xC0,0x57,0xDA,0xA5,0x82,0xA6,0xA2,0xB5,0x32 ],
48     [ 0x1C,0xD2,0x23,0xDB,0x32,0xEE,0x49,0x90,0x5A,0x39 ],
49     [ 0x3A,0x19,0x7A,0x63,0x25,0x43,0x31,0xC0,0xAC,0x3C ],
50     [ 0xA1,0xE4,0xBC,0x64,0x7C,0x46,0xD0,0xDD,0x55,0x3E ],
51     [ 0xA5,0xE9,0x39,0xA5,0x27,0xEA,0x7F,0xA8,0x2A,0x3F ],
52     [ 0xBA,0x94,0x39,0x45,0xAD,0x1E,0xB1,0xCF,0x94,0x3F ],
53     [ 0x5B,0xE1,0x4D,0xC4,0xBE,0x94,0x95,0xE6,0xC9,0x3F ],
54     [ 0xFD,0xCE,0x61,0x84,0x11,0x77,0xCC,0xAB,0xE4,0x3F ],
55     [ 0x2C,0x65,0x19,0xE2,0x58,0x17,0xB7,0xD1,0xF1,0x3F ],
56     [ 0x0A,0xD7,0xA3,0x70,0x3D,0x0A,0xD7,0xA3,0xF8,0x3F ],
57     [ 0xCD,0xCC,0xCC,0xCC,0xCC,0xCC,0xCC,0xCC,0xFB,0x3F ],
58     [ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xFF,0x3F ]
59 ];
60 
61 static const ubyte[longdouble.sizeof][14] _postab_bytes =
62 [
63     [ 0x9B,0x97,0x20,0x8A,0x02,0x52,0x60,0xC4,0x25,0x75 ],
64     [ 0xE5,0x5D,0x3D,0xC5,0x5D,0x3B,0x8B,0x9E,0x92,0x5A ],
65     [ 0x17,0x0C,0x75,0x81,0x86,0x75,0x76,0xC9,0x48,0x4D ],
66     [ 0xC7,0x91,0x0E,0xA6,0xAE,0xA0,0x19,0xE3,0xA3,0x46 ],
67     [ 0x8E,0xDE,0xF9,0x9D,0xFB,0xEB,0x7E,0xAA,0x51,0x43 ],
68     [ 0xE0,0x8C,0xE9,0x80,0xC9,0x47,0xBA,0x93,0xA8,0x41 ],
69     [ 0xD5,0xA6,0xCF,0xFF,0x49,0x1F,0x78,0xC2,0xD3,0x40 ],
70     [ 0x9E,0xB5,0x70,0x2B,0xA8,0xAD,0xC5,0x9D,0x69,0x40 ],
71     [ 0x00,0x00,0x00,0x04,0xBF,0xC9,0x1B,0x8E,0x34,0x40 ],
72     [ 0x00,0x00,0x00,0x00,0x00,0x20,0xBC,0xBE,0x19,0x40 ],
73     [ 0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x9C,0x0C,0x40 ],
74     [ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xC8,0x05,0x40 ],
75     [ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xA0,0x02,0x40 ],
76     [ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xFF,0x3F ]
77 ];
78 
79 auto negtab() { return cast(const longdouble *) _negtab_bytes.ptr; }
80 auto postab() { return cast(const longdouble *) _postab_bytes.ptr; }
81 
82 }
83 
84 /*************************
85  * Convert string to double.
86  * Terminates on first unrecognized character.
87  */
88 
89 longdouble_soft strtold_dm(const(char) *p, char **endp)
90 {
91     longdouble_soft ldval;
92     int  exp;
93     long msdec,lsdec;
94     uint msscale;
95     char  dot,sign;
96     int  pow;
97     int  ndigits;
98     const(char) *pinit = p;
99 
100     while (isspace(*p))
101         p++;
102     sign = 0;                       /* indicating +                 */
103     switch (*p)
104     {
105     case '-':
106         sign++;
107         goto case;
108     case '+':
109         p++;
110         break;
111     default: break;
112     }
113     ldval = 0.0;
114     dot = 0;                        /* if decimal point has been seen */
115     exp = 0;
116     msdec = lsdec = 0;
117     msscale = 1;
118     ndigits = 0;
119 
120     if (*p == '0' && (p[1] == 'x' || p[1] == 'X'))
121     {
122         int  guard = 0;
123         int  anydigits = 0;
124 
125         p += 2;
126         while (1)
127         {
128             int  i = *p;
129 
130             while (isxdigit(i))
131             {
132                 anydigits = 1;
133                 i = isalpha(i) ? ((i & ~0x20) - ('A' - 10)) : i - '0';
134                 if (ndigits < 16)
135                 {
136                     msdec = msdec * 16 + i;
137                     if (msdec)
138                         ndigits++;
139                 }
140                 else  if (ndigits == 16)
141                 {
142                     while (msdec >= 0)
143                     {
144                         exp--;
145                         msdec <<= 1;
146                         i <<= 1;
147                         if (i & 0x10)
148                             msdec |= 1;
149                     }
150                     guard = i << 4;
151                     ndigits++;
152                     exp += 4;
153                 }
154                 else
155                 {
156                     guard |= i;
157                     exp += 4;
158                 }
159                 exp -= dot;
160                 i = *++p;
161             }
162             if (i == '.' && !dot)
163             {
164                 p++;
165                 dot = 4;
166             }
167             else
168                 break;
169         }
170 
171         // Round up if (guard && (sticky || odd))
172         if (guard & 0x80 && (guard & 0x7F || msdec & 1))
173         {
174             msdec++;
175             if (msdec == 0)                 // overflow
176             {
177                 msdec = 0x8000000000000000L;
178                 exp++;
179             }
180         }
181 
182         if (anydigits == 0)         // if error (no digits seen)
183             goto Lerr;
184         if (*p == 'p' || *p == 'P')
185         {
186             char  sexp;
187             int  e;
188 
189             sexp = 0;
190             switch (*++p)
191             {
192             case '-':
193                 sexp++;
194                 goto case;
195             case '+':
196                 p++;
197                 break;
198             default:
199                 break;
200             }
201             ndigits = 0;
202             e = 0;
203             while (isdigit(*p))
204             {
205                 if (e < 0x7FFFFFFF / 10 - 10) // prevent integer overflow
206                 {
207                     e = e * 10 + *p - '0';
208                 }
209                 p++;
210                 ndigits = 1;
211             }
212             exp += sexp ? -e : e;
213             if (!ndigits)           // if no digits in exponent
214                 goto Lerr;
215 
216             if (msdec)
217             {
218                 int  e2 = 0x3FFF + 63;
219 
220                 // left justify mantissa
221                 while (msdec >= 0)
222                 {
223                     msdec <<= 1;
224                     e2--;
225                 }
226 
227                 // Stuff mantissa directly into long double
228                 union U
229                 {
230                     longdouble_soft ld;
231                     struct S
232                     {
233                         long mantissa;
234                         ushort exp;
235                     }
236                     S s;
237                 }
238 
239                 // Stuff mantissa directly into long double
240                 U  u;
241                 u.s.mantissa = msdec;
242                 u.s.exp = cast(short) e2;
243                 ldval = u.ld;
244 
245                 static if (0)
246                 {
247                     printf("msdec = x%llx, ldval = %Lg\n", msdec, ldval);
248                     for (int i = 0; i < 5; i++)
249                         printf("%04x ",(cast(ushort *)&ldval)[i]);
250                     printf("\n");
251                     printf("%llx\n",ldval);
252                 }
253 
254                 // Exponent is power of 2, not power of 10
255                 ldval = ldexpl(ldval,exp);
256             }
257             goto L6;
258         }
259         else
260             goto Lerr;              // exponent is required
261     }
262     else
263     {
264         while (1)
265         {
266             int  i = *p;
267 
268             while (isdigit(i))
269             {
270                 ndigits = 1;        /* must have at least 1 digit   */
271                 if (msdec < (0x7FFFFFFFFFFFL-10)/10)
272                     msdec = msdec * 10 + (i - '0');
273                 else  if (msscale < (0xFFFFFFFF-10)/10)
274                 {
275                     lsdec = lsdec * 10 + (i - '0');
276                     msscale *= 10;
277                 }
278                 else
279                 {
280                     exp++;
281                 }
282                 exp -= dot;
283                 i = *++p;
284             }
285             if (i == '.' && !dot)
286             {
287                 p++;
288                 dot++;
289             }
290             else
291                 break;
292         }
293         if (!ndigits)               // if error (no digits seen)
294             goto Lerr;              // return 0.0
295     }
296     if (*p == 'e' || *p == 'E')
297     {
298         char  sexp;
299         int  e;
300 
301         sexp = 0;
302         switch (*++p)
303         {
304         case '-':
305             sexp++;
306             goto case;
307         case '+':
308             p++;
309             break;
310         default:
311             break;
312         }
313         ndigits = 0;
314         e = 0;
315         while (isdigit(*p))
316         {
317             if (e < 0x7FFFFFFF / 10 - 10)   // prevent integer overflow
318             {
319                 e = e * 10 + *p - '0';
320             }
321             p++;
322             ndigits = 1;
323         }
324         exp += sexp ? -e : e;
325         if (!ndigits)               // if no digits in exponent
326             goto Lerr;              // return 0.0
327     }
328 
329     ldval = msdec;
330     if (msscale != 1)               /* if stuff was accumulated in lsdec */
331         ldval = ldval * msscale + lsdec;
332     if (ldval)
333     {
334         uint u = 0;
335         pow = 4096;
336 
337         while (exp > 0)
338         {
339             while (exp >= pow)
340             {
341                 ldval = ldval * postab[u];
342                 exp -= pow;
343             }
344             pow >>= 1;
345             u++;
346         }
347         while (exp < 0)
348         {
349             while (exp <= -pow)
350             {
351                 ldval = ldval * negtab[u];
352                 if (ldval == 0)
353                     errno = ERANGE;
354                 exp += pow;
355             }
356             pow >>= 1;
357             u++;
358         }
359         static if(0) {
360             for (int i = 0; i < 5; i++)
361                 printf("%04x ",ldval.value[i]);
362             printf("\n");
363             printf("%llx\n",dval);
364         }
365     }
366 L6: // if overflow occurred
367     if (ldval == longdouble_soft.infinity)
368         errno = ERANGE;
369 
370 L1:
371     if (endp)
372     {
373         *endp = cast(char *) p;
374     }
375     return  sign ? -ldval : ldval;
376 
377 Lerr:
378     p = pinit;
379     goto L1;
380 }
381 
382 /************************* Test ************************************/
383 static if (0)
384 {
385 
386 struct  longdouble_test
387 {
388     ushort[5] value;
389 }
390 
391 void  main()
392 {
393     import core.stdc.stdio;
394 
395     longdouble_soft ld;
396     longdouble_test x;
397     int  i;
398 
399     errno = 0;
400 //  ld = strtold_dm("0x1.FFFFFFFFFFFFFFFEp16383", NULL);
401     ld = strtold_dm("0x1.FFFFFFFFFFFFFFFEp-16382", null);
402     x = *cast(longdouble_test *)&ld;
403     for (i = 4; i >= 0; i--)
404     {
405         printf("%04x ", x.value[i]);
406     }
407     printf("\t%d\n", errno);
408 
409     ld = strtold_dm("1.0e5", null);
410     x = *cast(longdouble_test *)&ld;
411     for (i = 4; i >= 0; i--)
412     {
413         printf("%04x ", x.value[i]);
414     }
415     printf("\n");
416 }
417 
418 }
419 
420 /************************* Bigint ************************************/
421 
422 static if (0) {
423 
424 /* This program computes powers of 10 exactly.
425  * Used to generate postab[].
426  */
427 
428 import core.stdc.stdio;
429 import core.stdc..string;
430 
431 enum  NDIGITS = 4096;
432 
433 void  times10(uint *a)
434 {
435     int  i;
436 
437     for (i = 0; i < NDIGITS; i++)
438     {
439         a[i] *= 10;
440         if (i)
441         {
442             a[i] += a[i - 1] >> 8;
443             a[i - 1] &= 0xFF;
444         }
445     }
446 }
447 
448 void  print(uint *a)
449 {
450     int  i;
451     int  p;
452     int  j;
453 
454     for (i = NDIGITS; i; )
455     {
456         --i;
457         if (a[i])
458             break;
459     }
460 
461     printf("0x%x.", a[i]);
462     p = i * 8;
463     i--;
464     for (j = 0; j < i; j++)
465         if (a[j])
466             break;
467     for (; i >= j; i--)
468     {
469         printf("%02x", a[i]);
470     }
471     printf("p+%d", p);
472 }
473 
474 void  main()
475 {
476     uint[NDIGITS] a;
477     int  i;
478     int  j;
479 
480     static longdouble[13] tab =
481     [
482         0x62.30290145104bcd64a60a9fc025254932bb0fd922271133eeae7be4a2f9151ffff868e970c234d8f51c5563f48bd2b496d868b27518ae42404964046f87cc1d213d5d0b54f74eb9281bb6c6e435fcb457200c03a5bca35f7792959da22e8d623b3e7b21e2b6100fab123cd8a1a75409f23956d4b941c759f83557de068edd2d00bcdd9d4a52ec8721ac7867f9e974996fb03d7ecd2fdc6349af06940d48741a6c2ed4684e5ab8d9c7bd7991dc03b4f63b8afd6b25ff66e42caeee333b7000a51987ec7038aec29e6ee8cac982a4ba47440496fcbe00d313d584e857fd214495bbdf373f41fd86fe49b70a5c7d2b17e0b2544f10cd4d8bfa89d0d73df29d0176cca7c234f4e6d2767113fd01c8c1a08a138c4ef80456c02d9a0ff4f1d4e3e51cb9255858325ed8d2399faddd9e9985a2df904ff6bf5c4f2ef0650ebc692c5508c2cbd6667097aced8e437b3d7fe03b2b6341a4c954108b89bc108f19ade5b533458e0dd75a53400d03119534074e89541bae9641fdd6266a3fdcbf778900fc509ba674343dd6769f3b72b882e7282566fbc6cc3f8d6b0dd9bc96119b31a96ddeff35e836b5d298f9994b8c90918e7b9a73491260806f233b7c94ab6feba2ebd6c1d9960e2d73a130d84c4a74fde9ce4724ed5bf546a03f40a8fb126ab1c32da38338eb3acc1a67778cfbe8b12acf1b23504dcd6cd995aca6a8b492ed8aa19adb95484971870239f4cea6e9cfda20c33857b32c450c3fecb534b71bd1a45b060904788f6e50fe78d6823613c8509ee3352c90ca19cfe90afb779eea37c8ab8db59a0a80627ce41d3cc425971d582dfe6d97ee63302b8e13e25feeaf19e63d326a7eb6d1c7bf2608c4cf1cc939c1307641d9b2c39497a8fcd8e0cd9e8d7c3172826ac9df13cb3d04e8d2fca26a9ff7d8b57e27ecf57bbb9373f46fee7aab86deb3f078787e2ab608b89572dac789bf627ede440b3f251f2b2322ab312bb95893d4b850be10e02d2408206e7bb8272181327ec8fa2e8a37a2d4390caea134c53c0adf9462ea75ecf9b5d0ed4d542dc19e1faf7a872e74f984d83e2dd8d92580152f18390a2b295138753d1fa8fd5d59c89f1b095edc162e2690f3cd8f62ff42923bbd87d1cde840b464a0e137d5e9a4eb8f8cde35c88baf63b71292baf1deeca19beb77fb8af6176ca776743074fa7021b97a1e0a68173c20ee69e79dadf7eb83cadbdfea5242a8329761ffe062053ccb5b92ac50b9c175a697b2b5341743c994a4503b9af26b398c6fed037d19eef4090ee8ae0725b1655fec303297cd0c2bd9cc1110c4e9968738b909454eb2a0dcfe388f15b8c898d3967a1b6dc3a5b4811a4f04f3618ac0280f4d3295a842bcfd82373a3f8ec72af2acd5071a8309cb2130504dd97d9556a1ebcad7947e0d0e30c7ae41eb659fb878f061814f6cea9c441c2d473bfe167b1a1c304e7613b22454ab9c41ff0b0905bc13176168dde6d488052f8cf8169c84cb4bf982870097012c23481161959127142e0e80cab3e6d7af6a25743dbeabcd0f237f1a016b67b2c2dfae78e341be10d6bfdf759b8ba1e81d1f4cce7c4823da7e1e7c34c0591cc245155e93b86ae5be806c0ed3f0da6146e599574efb29b172506be82913b1bb5154e05154ef084117f89a1e908efe7ae7d4724e8d2a67c001p+13600L,
483         0x9.e8b3b5dc53d5de4a74d28ce329ace526a3197bbebe3034f77154ce2bcba19648b21c11eb962b1b61b93cf2ee5ca6f7e928e61d08e2d694222771e50f30278c9836230af908b40a753b7d77cd8c6be7151aab4efac5dcd83e49d6907855eeb028af623f6f7024d2c36fa9ce9d04a487fa1fb992be221ef1bd0ad5f775677ce0de08402ad3fa140eac7d56c7c9dee0bedd8a6c038f9245b2e87c348ad803ecca8f0070f8dbb57a6a445f278b3d5cf42915e818415c7f3ef82df84658ccf45cfad379433f3389a4408f43c513ef5a83fb8886fbf56d9d4bd5f860792e55ecee70beb1810d76ce39de9ec24bcf99d01953761abd9d7389c0a244de3c195355d84eeebeee6f46eadb56c6815b785ce6b7b125ac8edb0708fd8f6cae5f5715f7915b33eb417bf03c19d7917c7ba1fc6b9681428c85744695f0e866d7efc9ac375d77c1a42f40660460944545ff87a7dc62d752f7a66a57b1ab730f203c1aa9f44484d80e2e5fc5a04779c56b8a9e110c7bcbea4ca7982da4663cfe491d0dbd21feab49869733554c36685e5510c4a656654419bd438e48ff35d6c7d6ab91bac974fb1264b4f111821fa2bca416afe609c313b41e449952fbed5a151440967abbb3a8281ed6a8f16f9210c17f94e3892ee98074ff01e3cb64f32dbb6643a7a8289c8c6c54de34c101349713b44938209ce1f3861ce0fb7fedcc235552eb57a7842d71c7fd8f66912e4ad2f869c29279498719342c12866ed6f1c850dabc98342c9e51b78db2ea50d142fd8277732ed56d55a5e5a191368b8abbb6067584ee87e354ec2e472149e28dcfb27d4d3fe30968651333e001p+6800L,
484         0x3.25d9d61a05d4305d9434f4a3c62d433949ae6209d4926c3f5bd2db49ef47187094c1a6970ca7e6bd2a73c5534936a8de061e8d4649f4f3235e005b80411640114a88bc491b9fc4ed520190fba035faaba6c356e38a31b5653f445975836cb0b6c975a351a28e4262ce3ce3a0b8df68368ae26a7b7e976a3310fc8f1f9031eb0f669a20288280bda5a580d98089dc1a47fe6b7595fb101a3616b6f4654b31fb6bfdf56deeecb1b896bc8fc51a16bf3fdeb3d814b505ba34c4118ad822a51abe1de3045b7a748e1042c462be695a9f9f2a07a7e89431922bbb9fc96359861c5cd134f451218b65dc60d7233e55c7231d2b9c9fce837d1e43f61f7de16cfb896634ee0ed1440ecc2cd8194c7d1e1a140ac53515c51a88991c4e871ec29f866e7c215bf55b2b722919f001p+3400L,
485         0x1c.633415d4c1d238d98cab8a978a0b1f138cb07303a269974845a71d46b099bc817343afac69be5b0e9449775c1366732a93abade4b2908ee0f95f635e85a91924c3fc0695e7fc7153329c57aebfa3edac96e14f5dbc51fb2eb21a2f221e25cfea703ed321aa1da1bf28f8733b4475b579c88976c194e6574746c40513c31e1ad9b83a8a975d96976f8f9546dc77f27267fc6cf801p+1696L,
486         0x5.53f75fdcefcef46eeddc80dcc7f755bc28f265f9ef17cc5573c063ff540e3c42d35a1d153624adc666b026b2716ed595d80fcf4a6e706bde50c612152f87d8d99f72bed3875b982e7c01p+848L,
487         0x2.4ee91f2603a6337f19bccdb0dac404dc08d3cff5ec2374e42f0f1538fd03df99092e953e01p+424L,
488         0x18.4f03e93ff9f4daa797ed6e38ed64bf6a1f01p+208L,
489         0x4.ee2d6d415b85acef81p+104L,
490         0x23.86f26fc1p+48L,
491         0x5.f5e1p+24L,
492         0x27.10p+8L,
493         0x64.0p+0L,
494         0xa.0p+0L,
495     ];
496 
497     for (j = 1; j <= 4096; j *= 2)
498     {
499         printf("%4d: ", j);
500         memset(a.ptr, 0, a.sizeof);
501         a[0] = 1;
502         for (i = 0; i < j; i++)
503             times10(a.ptr);
504         print(a.ptr);
505         printf("L,\n");
506     }
507 
508     for (i = 0; i < 13; i++)
509     {
510         printf("tab[%d] = %Lg\n", i, tab[i]);
511     }
512 }
513 
514 }