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