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 (d <= 0 && i == 0)
 171         {
 172           generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
 173                           "greater than zero in format specifier 'E' or 'D'");
 174           return;
 175         }
 176       if (i <= -d || i >= d + 2)
 177         {
 178           generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
 179                           "out of range in format specifier 'E' or 'D'");
 180           return;
 181         }
 182
 183       if (!zero_flag)
 184         e -= i;
 185       if (i < 0)
 186         {
 187           nbefore = 0;
 188           nzero = -i;
 189           nafter = d + i;
 190         }
 191       else if (i > 0)
 192         {
 193           nbefore = i;
 194           nzero = 0;
 195           nafter = (d - i) + 1;
 196         }
 197       else /* i == 0 */
 198         {
 199           nbefore = 0;
 200           nzero = 0;
 201           nafter = d;
 202         }
 203
 204       if (ft == FMT_E)
 205         expchar = 'E';
 206       else
 207         expchar = 'D';
 208       break;
 209
 210     case FMT_EN:
 211       /* The exponent must be a multiple of three, with 1-3 digits before
 212          the decimal point.  */
 213       if (!zero_flag)
 214         e--;
 215       if (e >= 0)
 216         nbefore = e % 3;
 217       else
 218         {
 219           nbefore = (-e) % 3;
 220           if (nbefore != 0)
 221             nbefore = 3 - nbefore;
 222         }
 223       e -= nbefore;
 224       nbefore++;
 225       nzero = 0;
 226       nafter = d;
 227       expchar = 'E';
 228       break;
 229
 230     case FMT_ES:
 231       if (!zero_flag)
 232         e--;
 233       nbefore = 1;
 234       nzero = 0;
 235       nafter = d;
 236       expchar = 'E';
 237       break;
 238
 239     default:
 240       /* Should never happen.  */
 241       internal_error (&dtp->common, "Unexpected format token");
 242     }
 243
 244   /* Round the value.  */
 245   if (nbefore + nafter == 0)
 246     {
 247       ndigits = 0;
 248       if (nzero_real == d && digits[0] >= '5')
 249         {
 250           /* We rounded to zero but shouldn't have */
 251           nzero--;
 252           nafter = 1;
 253           digits[0] = '1';
 254           ndigits = 1;
 255         }
 256     }
 257   else if (nbefore + nafter < ndigits)
 258     {
 259       ndigits = nbefore + nafter;
 260       i = ndigits;
 261       if (digits[i] >= '5')
 262         {
 263           /* Propagate the carry.  */
 264           for (i--; i >= 0; i--)
 265             {
 266               if (digits[i] != '9')
 267                 {
 268                   digits[i]++;
 269                   break;
 270                 }
 271               digits[i] = '0';
 272             }
 273
 274           if (i < 0)
 275             {
 276               /* The carry overflowed.  Fortunately we have some spare space
 277                  at the start of the buffer.  We may discard some digits, but
 278                  this is ok because we already know they are zero.  */
 279               digits--;
 280               digits[0] = '1';
 281               if (ft == FMT_F)
 282                 {
 283                   if (nzero > 0)
 284                     {
 285                       nzero--;
 286                       nafter++;
 287                     }
 288                   else
 289                     nbefore++;
 290                 }
 291               else if (ft == FMT_EN)
 292                 {
 293                   nbefore++;
 294                   if (nbefore == 4)
 295                     {
 296                       nbefore = 1;
 297                       e += 3;
 298                     }
 299                 }
 300               else
 301                 e++;
 302             }
 303         }
 304     }
 305
 306   /* Calculate the format of the exponent field.  */
 307   if (expchar)
 308     {
 309       edigits = 1;
 310       for (i = abs (e); i >= 10; i /= 10)
 311         edigits++;
 312
 313       if (f->u.real.e < 0)
 314         {
 315           /* Width not specified.  Must be no more than 3 digits.  */
 316           if (e > 999 || e < -999)
 317             edigits = -1;
 318           else
 319             {
 320               edigits = 4;
 321               if (e > 99 || e < -99)
 322                 expchar = ' ';
 323             }
 324         }
 325       else
 326         {
 327           /* Exponent width specified, check it is wide enough.  */
 328           if (edigits > f->u.real.e)
 329             edigits = -1;
 330           else
 331             edigits = f->u.real.e + 2;
 332         }
 333     }
 334   else
 335     edigits = 0;
 336
 337   /* Pick a field size if none was specified.  */
 338   if (w <= 0)
 339     w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
 340
 341   /* Create the ouput buffer.  */
 342   out = write_block (dtp, w);
 343   if (out == NULL)
 344     return;
 345
 346   /* Zero values always output as positive, even if the value was negative
 347      before rounding.  */
 348   for (i = 0; i < ndigits; i++)
 349     {
 350       if (digits[i] != '0')
 351         break;
 352     }
 353   if (i == ndigits)
 354     {
 355       /* The output is zero, so set the sign according to the sign bit unless
 356          -fno-sign-zero was specified.  */
 357       if (compile_options.sign_zero == 1)
 358         sign = calculate_sign (dtp, sign_bit);
 359       else
 360         sign = calculate_sign (dtp, 0);
 361     }
 362
 363   /* Work out how much padding is needed.  */
 364   nblanks = w - (nbefore + nzero + nafter + edigits + 1);
 365   if (sign != SIGN_NONE)
 366     nblanks--;
 367
 368   /* Check the value fits in the specified field width.  */
 369   if (nblanks < 0 || edigits == -1)
 370     {
 371       star_fill (out, w);
 372       return;
 373     }
 374
 375   /* See if we have space for a zero before the decimal point.  */
 376   if (nbefore == 0 && nblanks > 0)
 377     {
 378       leadzero = 1;
 379       nblanks--;
 380     }
 381   else
 382     leadzero = 0;
 383
 384   /* Pad to full field width.  */
 385
 386   if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
 387     {
 388       memset (out, ' ', nblanks);
 389       out += nblanks;
 390     }
 391
 392   /* Output the initial sign (if any).  */
 393   if (sign == SIGN_PLUS)
 394     *(out++) = '+';
 395   else if (sign == SIGN_MINUS)
 396     *(out++) = '-';
 397
 398   /* Output an optional leading zero.  */
 399   if (leadzero)
 400     *(out++) = '0';
 401
 402   /* Output the part before the decimal point, padding with zeros.  */
 403   if (nbefore > 0)
 404     {
 405       if (nbefore > ndigits)
 406         {
 407           i = ndigits;
 408           memcpy (out, digits, i);
 409           ndigits = 0;
 410           while (i < nbefore)
 411             out[i++] = '0';
 412         }
 413       else
 414         {
 415           i = nbefore;
 416           memcpy (out, digits, i);
 417           ndigits -= i;
 418         }
 419
 420       digits += i;
 421       out += nbefore;
 422     }
 423   /* Output the decimal point.  */
 424   *(out++) = '.';
 425
 426   /* Output leading zeros after the decimal point.  */
 427   if (nzero > 0)
 428     {
 429       for (i = 0; i < nzero; i++)
 430         *(out++) = '0';
 431     }
 432
 433   /* Output digits after the decimal point, padding with zeros.  */
 434   if (nafter > 0)
 435     {
 436       if (nafter > ndigits)
 437         i = ndigits;
 438       else
 439         i = nafter;
 440
 441       memcpy (out, digits, i);
 442       while (i < nafter)
 443         out[i++] = '0';
 444
 445       digits += i;
 446       ndigits -= i;
 447       out += nafter;
 448     }
 449
 450   /* Output the exponent.  */
 451   if (expchar)
 452     {
 453       if (expchar != ' ')
 454         {
 455           *(out++) = expchar;
 456           edigits--;
 457         }
 458 #if HAVE_SNPRINTF
 459       snprintf (buffer, size, "%+0*d", edigits, e);
 460 #else
 461       sprintf (buffer, "%+0*d", edigits, e);
 462 #endif
 463       memcpy (out, buffer, edigits);
 464     }
 465   if (dtp->u.p.no_leading_blank)
 466     {
 467       out += edigits;
 468       memset( out , ' ' , nblanks );
 469       dtp->u.p.no_leading_blank = 0;
 470     }
 471 #undef STR
 472 #undef STR1
 473 #undef MIN_FIELD_WIDTH
 474 }
 475
 476
 477 /* Write "Infinite" or "Nan" as appropriate for the given format.  */
 478
 479 static void
 480 write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit)
 481 {
 482   char * p, fin;
 483   int nb = 0;
 484
 485   if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
 486     {
 487           nb =  f->u.real.w;
 488
 489           /* If the field width is zero, the processor must select a width
 490              not zero.  4 is chosen to allow output of '-Inf' or '+Inf' */
 491
 492           if (nb == 0) nb = 4;
 493           p = write_block (dtp, nb);
 494           if (p == NULL)
 495             return;
 496           if (nb < 3)
 497             {
 498               memset (p, '*',nb);
 499               return;
 500             }
 501
 502           memset(p, ' ', nb);
 503           if (!isnan_flag)
 504             {
 505               if (sign_bit)
 506                 {
 507
 508                   /* If the sign is negative and the width is 3, there is
 509                      insufficient room to output '-Inf', so output asterisks */
 510
 511                   if (nb == 3)
 512                     {
 513                       memset (p, '*',nb);
 514                       return;
 515                     }
 516
 517                   /* The negative sign is mandatory */
 518
 519                   fin = '-';
 520                 }
 521               else
 522
 523                   /* The positive sign is optional, but we output it for
 524                      consistency */
 525                   fin = '+';
 526
 527               if (nb > 8)
 528
 529                 /* We have room, so output 'Infinity' */
 530                 memcpy(p + nb - 8, "Infinity", 8);
 531               else
 532
 533                 /* For the case of width equals 8, there is not enough room
 534                    for the sign and 'Infinity' so we go with 'Inf' */
 535                 memcpy(p + nb - 3, "Inf", 3);
 536
 537               if (nb < 9 && nb > 3)
 538                 p[nb - 4] = fin;  /* Put the sign in front of Inf */
 539               else if (nb > 8)
 540                 p[nb - 9] = fin;  /* Put the sign in front of Infinity */
 541             }
 542           else
 543             memcpy(p + nb - 3, "NaN", 3);
 544           return;
 545         }
 546     }
 547
 548
 549 /* Returns the value of 10**d.  */
 550
 551 #define CALCULATE_EXP(x) \
 552 inline static GFC_REAL_ ## x \
 553 calculate_exp_ ## x  (int d)\
 554 {\
 555   int i;\
 556   GFC_REAL_ ## x r = 1.0;\
 557   for (i = 0; i< (d >= 0 ? d : -d); i++)\
 558     r *= 10;\
 559   r = (d >= 0) ? r : 1.0 / r;\
 560   return r;\
 561 }
 562
 563 CALCULATE_EXP(4)
 564
 565 CALCULATE_EXP(8)
 566
 567 #ifdef HAVE_GFC_REAL_10
 568 CALCULATE_EXP(10)
 569 #endif
 570
 571 #ifdef HAVE_GFC_REAL_16
 572 CALCULATE_EXP(16)
 573 #endif
 574 #undef CALCULATE_EXP
 575
 576 /* Generate corresponding I/O format for FMT_G and output.
 577    The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
 578    LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
 579
 580    Data Magnitude                              Equivalent Conversion
 581    0< m < 0.1-0.5*10**(-d-1)                   Ew.d[Ee]
 582    m = 0                                       F(w-n).(d-1), n' '
 583    0.1-0.5*10**(-d-1)<= m < 1-0.5*10**(-d)     F(w-n).d, n' '
 584    1-0.5*10**(-d)<= m < 10-0.5*10**(-d+1)      F(w-n).(d-1), n' '
 585    10-0.5*10**(-d+1)<= m < 100-0.5*10**(-d+2)  F(w-n).(d-2), n' '
 586    ................                           ..........
 587    10**(d-1)-0.5*10**(-1)<= m <10**d-0.5       F(w-n).0,n(' ')
 588    m >= 10**d-0.5                              Ew.d[Ee]
 589
 590    notes: for Gw.d ,  n' ' means 4 blanks
 591           for Gw.dEe, n' ' means e+2 blanks  */
 592
 593 #define OUTPUT_FLOAT_FMT_G(x) \
 594 static void \
 595 output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
 596                       GFC_REAL_ ## x m, char *buffer, size_t size, \
 597                       int sign_bit, bool zero_flag, int ndigits, int edigits) \
 598 { \
 599   int e = f->u.real.e;\
 600   int d = f->u.real.d;\
 601   int w = f->u.real.w;\
 602   fnode *newf;\
 603   GFC_REAL_ ## x exp_d;\
 604   int low, high, mid;\
 605   int ubound, lbound;\
 606   char *p;\
 607   int save_scale_factor, nb = 0;\
 608 \
 609   save_scale_factor = dtp->u.p.scale_factor;\
 610   newf = get_mem (sizeof (fnode));\
 611 \
 612   exp_d = calculate_exp_ ## x (d);\
 613   if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\
 614       ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\
 615     { \
 616       newf->format = FMT_E;\
 617       newf->u.real.w = w;\
 618       newf->u.real.d = d;\
 619       newf->u.real.e = e;\
 620       nb = 0;\
 621       goto finish;\
 622     }\
 623 \
 624   mid = 0;\
 625   low = 0;\
 626   high = d + 1;\
 627   lbound = 0;\
 628   ubound = d + 1;\
 629 \
 630   while (low <= high)\
 631     { \
 632       GFC_REAL_ ## x temp;\
 633       mid = (low + high) / 2;\
 634 \
 635       temp = 0.1 * calculate_exp_ ## x (mid) - 0.5\
 636              * calculate_exp_ ## x (mid - d - 1);\
 637 \
 638       if (m < temp)\
 639         { \
 640           ubound = mid;\
 641           if (ubound == lbound + 1)\
 642             break;\
 643           high = mid - 1;\
 644         }\
 645       else if (m > temp)\
 646         { \
 647           lbound = mid;\
 648           if (ubound == lbound + 1)\
 649             { \
 650               mid ++;\
 651               break;\
 652             }\
 653           low = mid + 1;\
 654         }\
 655       else\
 656         break;\
 657     }\
 658 \
 659   if (e < 0)\
 660     nb = 4;\
 661   else\
 662     nb = e + 2;\
 663 \
 664   newf->format = FMT_F;\
 665   newf->u.real.w = f->u.real.w - nb;\
 666 \
 667   if (m == 0.0)\
 668     newf->u.real.d = d - 1;\
 669   else\
 670     newf->u.real.d = - (mid - d - 1);\
 671 \
 672   dtp->u.p.scale_factor = 0;\
 673 \
 674  finish:\
 675   output_float (dtp, newf, buffer, size, sign_bit, zero_flag, ndigits, \
 676                 edigits);\
 677   dtp->u.p.scale_factor = save_scale_factor;\
 678 \
 679   free_mem(newf);\
 680 \
 681   if (nb > 0)\
 682     { \
 683       p = write_block (dtp, nb);\
 684       if (p == NULL)\
 685         return;\
 686       memset (p, ' ', nb);\
 687     }\
 688 }\
 689
 690 OUTPUT_FLOAT_FMT_G(4)
 691
 692 OUTPUT_FLOAT_FMT_G(8)
 693
 694 #ifdef HAVE_GFC_REAL_10
 695 OUTPUT_FLOAT_FMT_G(10)
 696 #endif
 697
 698 #ifdef HAVE_GFC_REAL_16
 699 OUTPUT_FLOAT_FMT_G(16)
 700 #endif
 701
 702 #undef OUTPUT_FLOAT_FMT_G
 703
 704 /* Define a macro to build code for write_float.  */
 705
 706 #ifdef HAVE_SNPRINTF
 707
 708 #define DTOA \
 709 snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 710           "e", ndigits - 1, tmp);
 711
 712 #define DTOAL \
 713 snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 714           "Le", ndigits - 1, tmp);
 715
 716 #else
 717
 718 #define DTOA \
 719 sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 720          "e", ndigits - 1, tmp);
 721
 722 #define DTOAL \
 723 sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 724          "Le", ndigits - 1, tmp);
 725
 726 #endif
 727
 728 #define WRITE_FLOAT(x,y)\
 729 {\
 730         GFC_REAL_ ## x tmp;\
 731         tmp = * (GFC_REAL_ ## x *)source;\
 732         sign_bit = signbit (tmp);\
 733         if (!isfinite (tmp))\
 734           { \
 735             write_infnan (dtp, f, isnan (tmp), sign_bit);\
 736             return;\
 737           }\
 738         tmp = sign_bit ? -tmp : tmp;\
 739         if (f->u.real.d == 0 && f->format == FMT_F)\
 740           {\
 741             if (tmp < 0.5)\
 742               tmp = 0.0;\
 743             else if (tmp < 1.0)\
 744               tmp = tmp + 0.5;\
 745           }\
 746         zero_flag = (tmp == 0.0);\
 747 \
 748         DTOA ## y\
 749 \
 750         if (f->format != FMT_G)\
 751           output_float (dtp, f, buffer, size, sign_bit, zero_flag, ndigits, \
 752                         edigits);\
 753         else \
 754           output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \
 755                                     zero_flag, ndigits, edigits);\
 756 }\
 757
 758 /* Output a real number according to its format.  */
 759
 760 static void
 761 write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
 762 {
 763
 764 #if defined(HAVE_GFC_REAL_16) && __LDBL_DIG__ > 18
 765 # define MIN_FIELD_WIDTH 46
 766 #else
 767 # define MIN_FIELD_WIDTH 31
 768 #endif
 769 #define STR(x) STR1(x)
 770 #define STR1(x) #x
 771
 772   /* This must be large enough to accurately hold any value.  */
 773   char buffer[MIN_FIELD_WIDTH+1];
 774   int sign_bit, ndigits, edigits;
 775   bool zero_flag;
 776   size_t size;
 777
 778   size = MIN_FIELD_WIDTH+1;
 779
 780   /* printf pads blanks for us on the exponent so we just need it big enough
 781      to handle the largest number of exponent digits expected.  */
 782   edigits=4;
 783
 784   if (f->format == FMT_F || f->format == FMT_EN || f->format == FMT_G
 785       || ((f->format == FMT_D || f->format == FMT_E)
 786       && dtp->u.p.scale_factor != 0))
 787     {
 788       /* Always convert at full precision to avoid double rounding.  */
 789       ndigits = MIN_FIELD_WIDTH - 4 - edigits;
 790     }
 791   else
 792     {
 793       /* The number of digits is known, so let printf do the rounding.  */
 794       if (f->format == FMT_ES)
 795         ndigits = f->u.real.d + 1;
 796       else
 797         ndigits = f->u.real.d;
 798       if (ndigits > MIN_FIELD_WIDTH - 4 - edigits)
 799         ndigits = MIN_FIELD_WIDTH - 4 - edigits;
 800     }
 801
 802   switch (len)
 803     {
 804     case 4:
 805       WRITE_FLOAT(4,)
 806       break;
 807
 808     case 8:
 809       WRITE_FLOAT(8,)
 810       break;
 811
 812 #ifdef HAVE_GFC_REAL_10
 813     case 10:
 814       WRITE_FLOAT(10,L)
 815       break;
 816 #endif
 817 #ifdef HAVE_GFC_REAL_16
 818     case 16:
 819       WRITE_FLOAT(16,L)
 820       break;
 821 #endif
 822     default:
 823       internal_error (NULL, "bad real kind");
 824     }
 825 }