libgfortran/io/write_float.def

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