libgfortran/io/write_float.def

   1 /* Copyright (C) 2007 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3    Write float code factoring to this file by Jerry DeLisle
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public License
  27 along with Libgfortran; see the file COPYING.  If not, write to
  28 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  29 Boston, MA 02110-1301, USA.  */
  30
  31 #include "config.h"
  32
  33 typedef enum
  34 { SIGN_NONE, SIGN_MINUS, SIGN_PLUS }
  35 sign_t;
  36
  37 /* Given a flag that indicates if a value is negative or not, return a
  38    sign_t that gives the sign that we need to produce.  */
  39
  40 static sign_t
  41 calculate_sign (st_parameter_dt *dtp, int negative_flag)
  42 {
  43   sign_t s = SIGN_NONE;
  44
  45   if (negative_flag)
  46     s = SIGN_MINUS;
  47   else
  48     switch (dtp->u.p.sign_status)
  49       {
  50       case SIGN_SP:
  51         s = SIGN_PLUS;
  52         break;
  53       case SIGN_SS:
  54         s = SIGN_NONE;
  55         break;
  56       case SIGN_S:
  57         s = options.optional_plus ? SIGN_PLUS : SIGN_NONE;
  58         break;
  59       }
  60
  61   return s;
  62 }
  63
  64
  65 /* Output a real number according to its format which is FMT_G free.  */
  66
  67 static void
  68 output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
  69               int sign_bit, bool zero_flag, int ndigits, int edigits)
  70 {
  71   char *out;
  72   char *digits;
  73   int e;
  74   char expchar;
  75   format_token ft;
  76   int w;
  77   int d;
  78   /* Number of digits before the decimal point.  */
  79   int nbefore;
  80   /* Number of zeros after the decimal point.  */
  81   int nzero;
  82   /* Number of digits after the decimal point.  */
  83   int nafter;
  84   /* Number of zeros after the decimal point, whatever the precision.  */
  85   int nzero_real;
  86   int leadzero;
  87   int nblanks;
  88   int i;
  89   sign_t sign;
  90
  91   ft = f->format;
  92   w = f->u.real.w;
  93   d = f->u.real.d;
  94
  95   nzero_real = -1;
  96
  97   /* We should always know the field width and precision.  */
  98   if (d < 0)
  99     internal_error (&dtp->common, "Unspecified precision");
 100
 101   /* Use sprintf to print the number in the format +D.DDDDe+ddd
 102      For an N digit exponent, this gives us (MIN_FIELD_WIDTH-5)-N digits
 103      after the decimal point, plus another one before the decimal point.  */
 104
 105   sign = calculate_sign (dtp, sign_bit);
 106
 107   /* #   The result will always contain a decimal point, even if no
 108    *     digits follow it
 109    *
 110    * -   The converted value is to be left adjusted on the field boundary
 111    *
 112    * +   A sign (+ or -) always be placed before a number
 113    *
 114    * MIN_FIELD_WIDTH  minimum field width
 115    *
 116    * *   (ndigits-1) is used as the precision
 117    *
 118    *   e format: [-]d.dddeÂ±dd where there is one digit before the
 119    *   decimal-point character and the number of digits after it is
 120    *   equal to the precision. The exponent always contains at least two
 121    *   digits; if the value is zero, the exponent is 00.
 122    */
 123
 124   /* Check the given string has punctuation in the correct places.  */
 125   if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e'))
 126       internal_error (&dtp->common, "printf is broken");
 127
 128   /* Read the exponent back in.  */
 129   e = atoi (&buffer[ndigits + 3]) + 1;
 130
 131   /* Make sure zero comes out as 0.0e0.   */
 132   if (zero_flag)
 133     {
 134       e = 0;
 135       if (compile_options.sign_zero == 1)
 136         sign = calculate_sign (dtp, sign_bit);
 137       else
 138         sign = calculate_sign (dtp, 0);
 139     }
 140
 141   /* Normalize the fractional component.  */
 142   buffer[2] = buffer[1];
 143   digits = &buffer[2];
 144
 145   /* Figure out where to place the decimal point.  */
 146   switch (ft)
 147     {
 148     case FMT_F:
 149       nbefore = e + dtp->u.p.scale_factor;
 150       if (nbefore < 0)
 151         {
 152           nzero = -nbefore;
 153           nzero_real = nzero;
 154           if (nzero > d)
 155             nzero = d;
 156           nafter = d - nzero;
 157           nbefore = 0;
 158         }
 159       else
 160         {
 161           nzero = 0;
 162           nafter = d;
 163         }
 164       expchar = 0;
 165       break;
 166
 167     case FMT_E:
 168     case FMT_D:
 169       i = dtp->u.p.scale_factor;
 170       if (!zero_flag)
 171         e -= i;
 172       if (i < 0)
 173         {
 174           nbefore = 0;
 175           nzero = -i;
 176           nafter = d + i;
 177         }
 178       else if (i > 0)
 179         {
 180           nbefore = i;
 181           nzero = 0;
 182           nafter = (d - i) + 1;
 183         }
 184       else /* i == 0 */
 185         {
 186           nbefore = 0;
 187           nzero = 0;
 188           nafter = d;
 189         }
 190
 191       if (ft == FMT_E)
 192         expchar = 'E';
 193       else
 194         expchar = 'D';
 195       break;
 196
 197     case FMT_EN:
 198       /* The exponent must be a multiple of three, with 1-3 digits before
 199          the decimal point.  */
 200       if (!zero_flag)
 201         e--;
 202       if (e >= 0)
 203         nbefore = e % 3;
 204       else
 205         {
 206           nbefore = (-e) % 3;
 207           if (nbefore != 0)
 208             nbefore = 3 - nbefore;
 209         }
 210       e -= nbefore;
 211       nbefore++;
 212       nzero = 0;
 213       nafter = d;
 214       expchar = 'E';
 215       break;
 216
 217     case FMT_ES:
 218       if (!zero_flag)
 219         e--;
 220       nbefore = 1;
 221       nzero = 0;
 222       nafter = d;
 223       expchar = 'E';
 224       break;
 225
 226     default:
 227       /* Should never happen.  */
 228       internal_error (&dtp->common, "Unexpected format token");
 229     }
 230
 231   /* Round the value.  */
 232   if (nbefore + nafter == 0)
 233     {
 234       ndigits = 0;
 235       if (nzero_real == d && digits[0] >= '5')
 236         {
 237           /* We rounded to zero but shouldn't have */
 238           nzero--;
 239           nafter = 1;
 240           digits[0] = '1';
 241           ndigits = 1;
 242         }
 243     }
 244   else if (nbefore + nafter < ndigits)
 245     {
 246       ndigits = nbefore + nafter;
 247       i = ndigits;
 248       if (digits[i] >= '5')
 249         {
 250           /* Propagate the carry.  */
 251           for (i--; i >= 0; i--)
 252             {
 253               if (digits[i] != '9')
 254                 {
 255                   digits[i]++;
 256                   break;
 257                 }
 258               digits[i] = '0';
 259             }
 260
 261           if (i < 0)
 262             {
 263               /* The carry overflowed.  Fortunately we have some spare space
 264                  at the start of the buffer.  We may discard some digits, but
 265                  this is ok because we already know they are zero.  */
 266               digits--;
 267               digits[0] = '1';
 268               if (ft == FMT_F)
 269                 {
 270                   if (nzero > 0)
 271                     {
 272                       nzero--;
 273                       nafter++;
 274                     }
 275                   else
 276                     nbefore++;
 277                 }
 278               else if (ft == FMT_EN)
 279                 {
 280                   nbefore++;
 281                   if (nbefore == 4)
 282                     {
 283                       nbefore = 1;
 284                       e += 3;
 285                     }
 286                 }
 287               else
 288                 e++;
 289             }
 290         }
 291     }
 292
 293   /* Calculate the format of the exponent field.  */
 294   if (expchar)
 295     {
 296       edigits = 1;
 297       for (i = abs (e); i >= 10; i /= 10)
 298         edigits++;
 299
 300       if (f->u.real.e < 0)
 301         {
 302           /* Width not specified.  Must be no more than 3 digits.  */
 303           if (e > 999 || e < -999)
 304             edigits = -1;
 305           else
 306             {
 307               edigits = 4;
 308               if (e > 99 || e < -99)
 309                 expchar = ' ';
 310             }
 311         }
 312       else
 313         {
 314           /* Exponent width specified, check it is wide enough.  */
 315           if (edigits > f->u.real.e)
 316             edigits = -1;
 317           else
 318             edigits = f->u.real.e + 2;
 319         }
 320     }
 321   else
 322     edigits = 0;
 323
 324   /* Pick a field size if none was specified.  */
 325   if (w <= 0)
 326     w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
 327
 328   /* Create the ouput buffer.  */
 329   out = write_block (dtp, w);
 330   if (out == NULL)
 331     return;
 332
 333   /* Zero values always output as positive, even if the value was negative
 334      before rounding.  */
 335   for (i = 0; i < ndigits; i++)
 336     {
 337       if (digits[i] != '0')
 338         break;
 339     }
 340   if (i == ndigits)
 341     {
 342       /* The output is zero, so set the sign according to the sign bit unless
 343          -fno-sign-zero was specified.  */
 344       if (compile_options.sign_zero == 1)
 345         sign = calculate_sign (dtp, sign_bit);
 346       else
 347         sign = calculate_sign (dtp, 0);
 348     }
 349
 350   /* Work out how much padding is needed.  */
 351   nblanks = w - (nbefore + nzero + nafter + edigits + 1);
 352   if (sign != SIGN_NONE)
 353     nblanks--;
 354
 355   /* Check the value fits in the specified field width.  */
 356   if (nblanks < 0 || edigits == -1)
 357     {
 358       star_fill (out, w);
 359       return;
 360     }
 361
 362   /* See if we have space for a zero before the decimal point.  */
 363   if (nbefore == 0 && nblanks > 0)
 364     {
 365       leadzero = 1;
 366       nblanks--;
 367     }
 368   else
 369     leadzero = 0;
 370
 371   /* Pad to full field width.  */
 372
 373   if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
 374     {
 375       memset (out, ' ', nblanks);
 376       out += nblanks;
 377     }
 378
 379   /* Output the initial sign (if any).  */
 380   if (sign == SIGN_PLUS)
 381     *(out++) = '+';
 382   else if (sign == SIGN_MINUS)
 383     *(out++) = '-';
 384
 385   /* Output an optional leading zero.  */
 386   if (leadzero)
 387     *(out++) = '0';
 388
 389   /* Output the part before the decimal point, padding with zeros.  */
 390   if (nbefore > 0)
 391     {
 392       if (nbefore > ndigits)
 393         {
 394           i = ndigits;
 395           memcpy (out, digits, i);
 396           ndigits = 0;
 397           while (i < nbefore)
 398             out[i++] = '0';
 399         }
 400       else
 401         {
 402           i = nbefore;
 403           memcpy (out, digits, i);
 404           ndigits -= i;
 405         }
 406
 407       digits += i;
 408       out += nbefore;
 409     }
 410   /* Output the decimal point.  */
 411   *(out++) = '.';
 412
 413   /* Output leading zeros after the decimal point.  */
 414   if (nzero > 0)
 415     {
 416       for (i = 0; i < nzero; i++)
 417         *(out++) = '0';
 418     }
 419
 420   /* Output digits after the decimal point, padding with zeros.  */
 421   if (nafter > 0)
 422     {
 423       if (nafter > ndigits)
 424         i = ndigits;
 425       else
 426         i = nafter;
 427
 428       memcpy (out, digits, i);
 429       while (i < nafter)
 430         out[i++] = '0';
 431
 432       digits += i;
 433       ndigits -= i;
 434       out += nafter;
 435     }
 436
 437   /* Output the exponent.  */
 438   if (expchar)
 439     {
 440       if (expchar != ' ')
 441         {
 442           *(out++) = expchar;
 443           edigits--;
 444         }
 445 #if HAVE_SNPRINTF
 446       snprintf (buffer, size, "%+0*d", edigits, e);
 447 #else
 448       sprintf (buffer, "%+0*d", edigits, e);
 449 #endif
 450       memcpy (out, buffer, edigits);
 451     }
 452   if (dtp->u.p.no_leading_blank)
 453     {
 454       out += edigits;
 455       memset( out , ' ' , nblanks );
 456       dtp->u.p.no_leading_blank = 0;
 457     }
 458 #undef STR
 459 #undef STR1
 460 #undef MIN_FIELD_WIDTH
 461 }
 462
 463
 464 /* Write "Infinite" or "Nan" as appropriate for the given format.  */
 465
 466 static void
 467 write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit)
 468 {
 469   char * p, fin;
 470   int nb = 0;
 471
 472   if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
 473     {
 474           nb =  f->u.real.w;
 475
 476           /* If the field width is zero, the processor must select a width
 477              not zero.  4 is chosen to allow output of '-Inf' or '+Inf' */
 478
 479           if (nb == 0) nb = 4;
 480           p = write_block (dtp, nb);
 481           if (p == NULL)
 482             return;
 483           if (nb < 3)
 484             {
 485               memset (p, '*',nb);
 486               return;
 487             }
 488
 489           memset(p, ' ', nb);
 490           if (!isnan_flag)
 491             {
 492               if (sign_bit)
 493                 {
 494
 495                   /* If the sign is negative and the width is 3, there is
 496                      insufficient room to output '-Inf', so output asterisks */
 497
 498                   if (nb == 3)
 499                     {
 500                       memset (p, '*',nb);
 501                       return;
 502                     }
 503
 504                   /* The negative sign is mandatory */
 505
 506                   fin = '-';
 507                 }
 508               else
 509
 510                   /* The positive sign is optional, but we output it for
 511                      consistency */
 512                   fin = '+';
 513
 514               if (nb > 8)
 515
 516                 /* We have room, so output 'Infinity' */
 517                 memcpy(p + nb - 8, "Infinity", 8);
 518               else
 519
 520                 /* For the case of width equals 8, there is not enough room
 521                    for the sign and 'Infinity' so we go with 'Inf' */
 522                 memcpy(p + nb - 3, "Inf", 3);
 523
 524               if (nb < 9 && nb > 3)
 525                 p[nb - 4] = fin;  /* Put the sign in front of Inf */
 526               else if (nb > 8)
 527                 p[nb - 9] = fin;  /* Put the sign in front of Infinity */
 528             }
 529           else
 530             memcpy(p + nb - 3, "NaN", 3);
 531           return;
 532         }
 533     }
 534
 535
 536 /* Returns the value of 10**d.  */
 537
 538 #define CALCULATE_EXP(x) \
 539 inline static GFC_REAL_ ## x \
 540 calculate_exp_ ## x  (int d)\
 541 {\
 542   int i;\
 543   GFC_REAL_ ## x r = 1.0;\
 544   for (i = 0; i< (d >= 0 ? d : -d); i++)\
 545     r *= 10;\
 546   r = (d >= 0) ? r : 1.0 / r;\
 547   return r;\
 548 }
 549
 550 CALCULATE_EXP(4)
 551
 552 CALCULATE_EXP(8)
 553
 554 #ifdef HAVE_GFC_REAL_10
 555 CALCULATE_EXP(10)
 556 #endif
 557
 558 #ifdef HAVE_GFC_REAL_16
 559 CALCULATE_EXP(16)
 560 #endif
 561 #undef CALCULATE_EXP
 562
 563 /* Generate corresponding I/O format for FMT_G and output.
 564    The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
 565    LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
 566
 567    Data Magnitude                              Equivalent Conversion
 568    0< m < 0.1-0.5*10**(-d-1)                   Ew.d[Ee]
 569    m = 0                                       F(w-n).(d-1), n' '
 570    0.1-0.5*10**(-d-1)<= m < 1-0.5*10**(-d)     F(w-n).d, n' '
 571    1-0.5*10**(-d)<= m < 10-0.5*10**(-d+1)      F(w-n).(d-1), n' '
 572    10-0.5*10**(-d+1)<= m < 100-0.5*10**(-d+2)  F(w-n).(d-2), n' '
 573    ................                           ..........
 574    10**(d-1)-0.5*10**(-1)<= m <10**d-0.5       F(w-n).0,n(' ')
 575    m >= 10**d-0.5                              Ew.d[Ee]
 576
 577    notes: for Gw.d ,  n' ' means 4 blanks
 578           for Gw.dEe, n' ' means e+2 blanks  */
 579
 580 #define OUTPUT_FLOAT_FMT_G(x) \
 581 static void \
 582 output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
 583                       GFC_REAL_ ## x m, char *buffer, size_t size, \
 584                       int sign_bit, bool zero_flag, int ndigits, int edigits) \
 585 { \
 586   int e = f->u.real.e;\
 587   int d = f->u.real.d;\
 588   int w = f->u.real.w;\
 589   fnode *newf;\
 590   GFC_REAL_ ## x exp_d;\
 591   int low, high, mid;\
 592   int ubound, lbound;\
 593   char *p;\
 594   int save_scale_factor, nb = 0;\
 595 \
 596   save_scale_factor = dtp->u.p.scale_factor;\
 597   newf = get_mem (sizeof (fnode));\
 598 \
 599   exp_d = calculate_exp_ ## x (d);\
 600   if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\
 601       ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\
 602     { \
 603       newf->format = FMT_E;\
 604       newf->u.real.w = w;\
 605       newf->u.real.d = d;\
 606       newf->u.real.e = e;\
 607       nb = 0;\
 608       goto finish;\
 609     }\
 610 \
 611   mid = 0;\
 612   low = 0;\
 613   high = d + 1;\
 614   lbound = 0;\
 615   ubound = d + 1;\
 616 \
 617   while (low <= high)\
 618     { \
 619       GFC_REAL_ ## x temp;\
 620       mid = (low + high) / 2;\
 621 \
 622       temp = 0.1 * calculate_exp_ ## x (mid) - 0.5\
 623              * calculate_exp_ ## x (mid - d - 1);\
 624 \
 625       if (m < temp)\
 626         { \
 627           ubound = mid;\
 628           if (ubound == lbound + 1)\
 629             break;\
 630           high = mid - 1;\
 631         }\
 632       else if (m > temp)\
 633         { \
 634           lbound = mid;\
 635           if (ubound == lbound + 1)\
 636             { \
 637               mid ++;\
 638               break;\
 639             }\
 640           low = mid + 1;\
 641         }\
 642       else\
 643         break;\
 644     }\
 645 \
 646   if (e < 0)\
 647     nb = 4;\
 648   else\
 649     nb = e + 2;\
 650 \
 651   newf->format = FMT_F;\
 652   newf->u.real.w = f->u.real.w - nb;\
 653 \
 654   if (m == 0.0)\
 655     newf->u.real.d = d - 1;\
 656   else\
 657     newf->u.real.d = - (mid - d - 1);\
 658 \
 659   dtp->u.p.scale_factor = 0;\
 660 \
 661  finish:\
 662   output_float (dtp, newf, buffer, size, sign_bit, zero_flag, ndigits, \
 663                 edigits);\
 664   dtp->u.p.scale_factor = save_scale_factor;\
 665 \
 666   free_mem(newf);\
 667 \
 668   if (nb > 0)\
 669     { \
 670       p = write_block (dtp, nb);\
 671       if (p == NULL)\
 672         return;\
 673       memset (p, ' ', nb);\
 674     }\
 675 }\
 676
 677 OUTPUT_FLOAT_FMT_G(4)
 678
 679 OUTPUT_FLOAT_FMT_G(8)
 680
 681 #ifdef HAVE_GFC_REAL_10
 682 OUTPUT_FLOAT_FMT_G(10)
 683 #endif
 684
 685 #ifdef HAVE_GFC_REAL_16
 686 OUTPUT_FLOAT_FMT_G(16)
 687 #endif
 688
 689 #undef OUTPUT_FLOAT_FMT_G
 690
 691 /* Define a macro to build code for write_float.  */
 692
 693 #ifdef HAVE_SNPRINTF
 694
 695 #define DTOA \
 696 snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 697           "e", ndigits - 1, tmp);
 698
 699 #define DTOAL \
 700 snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 701           "Le", ndigits - 1, tmp);
 702
 703 #else
 704
 705 #define DTOA \
 706 sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 707          "e", ndigits - 1, tmp);
 708
 709 #define DTOAL \
 710 sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 711          "Le", ndigits - 1, tmp);
 712
 713 #endif
 714
 715 #define WRITE_FLOAT(x,y)\
 716 {\
 717         GFC_REAL_ ## x tmp;\
 718         tmp = * (GFC_REAL_ ## x *)source;\
 719         sign_bit = signbit (tmp);\
 720         if (!isfinite (tmp))\
 721           { \
 722             write_infnan (dtp, f, isnan (tmp), sign_bit);\
 723             return;\
 724           }\
 725         tmp = sign_bit ? -tmp : tmp;\
 726         if (f->u.real.d == 0 && f->format == FMT_F)\
 727           {\
 728             if (tmp < 0.5)\
 729               tmp = 0.0;\
 730             else if (tmp < 1.0)\
 731               tmp = tmp + 0.5;\
 732           }\
 733         zero_flag = (tmp == 0.0);\
 734 \
 735         DTOA ## y\
 736 \
 737         if (f->format != FMT_G)\
 738           output_float (dtp, f, buffer, size, sign_bit, zero_flag, ndigits, \
 739                         edigits);\
 740         else \
 741           output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \
 742                                     zero_flag, ndigits, edigits);\
 743 }\
 744
 745 /* Output a real number according to its format.  */
 746
 747 static void
 748 write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
 749 {
 750
 751 #if defined(HAVE_GFC_REAL_16) && __LDBL_DIG__ > 18
 752 # define MIN_FIELD_WIDTH 46
 753 #else
 754 # define MIN_FIELD_WIDTH 31
 755 #endif
 756 #define STR(x) STR1(x)
 757 #define STR1(x) #x
 758
 759   /* This must be large enough to accurately hold any value.  */
 760   char buffer[MIN_FIELD_WIDTH+1];
 761   int sign_bit, ndigits, edigits;
 762   bool zero_flag;
 763   size_t size;
 764
 765   size = MIN_FIELD_WIDTH+1;
 766
 767   /* printf pads blanks for us on the exponent so we just need it big enough
 768      to handle the largest number of exponent digits expected.  */
 769   edigits=4;
 770
 771   if (f->format == FMT_F || f->format == FMT_EN || f->format == FMT_G
 772       || ((f->format == FMT_D || f->format == FMT_E)
 773       && dtp->u.p.scale_factor != 0))
 774     {
 775       /* Always convert at full precision to avoid double rounding.  */
 776       ndigits = MIN_FIELD_WIDTH - 4 - edigits;
 777     }
 778   else
 779     {
 780       /* The number of digits is known, so let printf do the rounding.  */
 781       if (f->format == FMT_ES)
 782         ndigits = f->u.real.d + 1;
 783       else
 784         ndigits = f->u.real.d;
 785       if (ndigits > MIN_FIELD_WIDTH - 4 - edigits)
 786         ndigits = MIN_FIELD_WIDTH - 4 - edigits;
 787     }
 788
 789   switch (len)
 790     {
 791     case 4:
 792       WRITE_FLOAT(4,)
 793       break;
 794
 795     case 8:
 796       WRITE_FLOAT(8,)
 797       break;
 798
 799 #ifdef HAVE_GFC_REAL_10
 800     case 10:
 801       WRITE_FLOAT(10,L)
 802       break;
 803 #endif
 804 #ifdef HAVE_GFC_REAL_16
 805     case 16:
 806       WRITE_FLOAT(16,L)
 807       break;
 808 #endif
 809     default:
 810       internal_error (NULL, "bad real kind");
 811     }
 812 }