libgfortran/io/write_float.def

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