This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[fortran-dev, patch] Floating-point parser speed-up, once again
- From: Daniel Kraft <d at domob dot eu>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 22 Mar 2009 21:44:17 +0100
- Subject: [fortran-dev, patch] Floating-point parser speed-up, once again
Hi all,
in light of the new fortran-dev branch and Janne's commit there, I
updated my floating-point parser speed-up patch and merged Janne's patch in.
I've yet to do a new regression-testing run, but ok for fortran-dev and
4.5 if successful?
BTW, there's one XXX comment in where I'd like to hear other opinions.
If neither blank-zero nor blank-null is selected (that is,
blank-unspecified) and there's a blank following the mantissa, at the
moment we simply regard the parse as done. However, if a blank appears
during parsing the exponent, we keep going and check that really only
blanks follow (otherwise, an error is issued). This was how the code
behaved before (if I understood it correct at least) and how my patch
still behaves. I'm no expert on I/O, but this seems a little
inconsistent to me; so what to do?
Yours,
Daniel
--
Done: Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri
2009-03-22 Daniel Kraft <d@domob.eu>
PR fortran/38654
* io/read.c (read_f): Reworked to speed up floating point parsing.
(convert_real): Use pointer-casting instead of memcpy and temporaries.
Index: libgfortran/io/read.c
===================================================================
*** libgfortran/io/read.c (revision 144995)
--- libgfortran/io/read.c (working copy)
***************
*** 33,38 ****
--- 33,39 ----
#include <errno.h>
#include <ctype.h>
#include <stdlib.h>
+ #include <assert.h>
typedef unsigned char uchar;
***************
*** 141,178 ****
switch (length)
{
case 4:
! {
! GFC_REAL_4 tmp =
#if defined(HAVE_STRTOF)
! strtof (buffer, NULL);
#else
! (GFC_REAL_4) strtod (buffer, NULL);
#endif
- memcpy (dest, (void *) &tmp, length);
- }
break;
case 8:
! {
! GFC_REAL_8 tmp = strtod (buffer, NULL);
! memcpy (dest, (void *) &tmp, length);
! }
break;
#if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD)
case 10:
! {
! GFC_REAL_10 tmp = strtold (buffer, NULL);
! memcpy (dest, (void *) &tmp, length);
! }
break;
#endif
#if defined(HAVE_GFC_REAL_16) && defined (HAVE_STRTOLD)
case 16:
! {
! GFC_REAL_16 tmp = strtold (buffer, NULL);
! memcpy (dest, (void *) &tmp, length);
! }
break;
#endif
default:
internal_error (&dtp->common, "Unsupported real kind during IO");
}
--- 142,171 ----
switch (length)
{
case 4:
! *((GFC_REAL_4*) dest) =
#if defined(HAVE_STRTOF)
! strtof (buffer, NULL);
#else
! (GFC_REAL_4) strtod (buffer, NULL);
#endif
break;
+
case 8:
! *((GFC_REAL_8*) dest) = strtod (buffer, NULL);
break;
+
#if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD)
case 10:
! *((GFC_REAL_10*) dest) = strtold (buffer, NULL);
break;
#endif
+
#if defined(HAVE_GFC_REAL_16) && defined (HAVE_STRTOLD)
case 16:
! *((GFC_REAL_16*) dest) = strtold (buffer, NULL);
break;
#endif
+
default:
internal_error (&dtp->common, "Unsupported real kind during IO");
}
***************
*** 769,839 ****
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
int w, seen_dp, exponent;
! int exponent_sign, val_sign;
! int ndigits;
! int edigits;
! int i;
! char *p, *buffer;
! char *digits;
! char scratch[SCRATCH_SIZE];
- val_sign = 1;
seen_dp = 0;
w = f->u.w;
p = read_block_form (dtp, &w);
-
if (p == NULL)
return;
-
p = eat_leading_spaces (&w, p);
if (w == 0)
goto zero;
! /* Optional sign */
if (*p == '-' || *p == '+')
{
if (*p == '-')
! val_sign = -1;
! p++;
! w--;
}
- exponent_sign = 1;
p = eat_leading_spaces (&w, p);
if (w == 0)
goto zero;
! /* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D')
! is required at this point */
!
! if (!isdigit (*p) && *p != '.' && *p != ',' && *p != 'd' && *p != 'D'
! && *p != 'e' && *p != 'E')
! goto bad_float;
!
! /* Remember the position of the first digit. */
! digits = p;
! ndigits = 0;
!
! /* Scan through the string to find the exponent. */
while (w > 0)
{
switch (*p)
{
case ',':
! if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA
! && *p == ',')
! *p = '.';
! else
goto bad_float;
! /* Fall through */
case '.':
if (seen_dp)
goto bad_float;
seen_dp = 1;
! /* Fall through */
case '0':
case '1':
case '2':
--- 762,840 ----
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
int w, seen_dp, exponent;
! int exponent_sign;
! char* p;
! char* buffer;
! char* out;
! int seen_int_digit; /* Seen a digit before the decimal point? */
! int seen_dec_digit; /* Seen a digit after the decimal point? */
seen_dp = 0;
+ seen_int_digit = 0;
+ seen_dec_digit = 0;
+ exponent_sign = 1;
+ exponent = 0;
w = f->u.w;
+ /* Read in the next block. */
p = read_block_form (dtp, &w);
if (p == NULL)
return;
p = eat_leading_spaces (&w, p);
if (w == 0)
goto zero;
! /* In this buffer we're going to re-format the number cleanly to be parsed
! by convert_real in the end; this assures we're using strtod from the
! C library for parsing and thus probably get the best accuracy possible.
! This process may add a '+0.0' in front of the number as well as change the
! exponent because of an implicit decimal point or the like. Thus allocating
! strlen ("+0.0e-1000") == 10 characters plus one for NUL more than the
! original buffer had should be enough. */
! buffer = gfc_alloca (w + 11);
! out = buffer;
+ /* Optional sign */
if (*p == '-' || *p == '+')
{
if (*p == '-')
! *(out++) = '-';
! ++p;
! --w;
}
p = eat_leading_spaces (&w, p);
if (w == 0)
goto zero;
! /* Process the mantissa string. */
while (w > 0)
{
switch (*p)
{
case ',':
! if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA)
goto bad_float;
! /* Fall through. */
case '.':
if (seen_dp)
goto bad_float;
+ if (!seen_int_digit)
+ *(out++) = '0';
+ *(out++) = '.';
seen_dp = 1;
! break;
+ case ' ':
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ *p = '0';
+ else if (dtp->u.p.blank_status == BLANK_NULL)
+ break;
+ else
+ /* XXX: Should we check instead that there are only trailing
+ blanks here, as is done below for exponents? */
+ goto done;
+ /* Fall through. */
case '0':
case '1':
case '2':
***************
*** 844,1059 ****
case '7':
case '8':
case '9':
! case ' ':
! ndigits++;
! p++;
! w--;
break;
case '-':
- exponent_sign = -1;
- /* Fall through */
-
case '+':
! p++;
! w--;
! goto exp2;
- case 'd':
case 'e':
- case 'D':
case 'E':
! p++;
! w--;
! goto exp1;
default:
goto bad_float;
}
- }
-
- /* No exponent has been seen, so we use the current scale factor */
- exponent = -dtp->u.p.scale_factor;
- goto done;
-
- bad_float:
- generate_error (&dtp->common, LIBERROR_READ_VALUE,
- "Bad value during floating point read");
- next_record (dtp, 1);
- return;
-
- /* The value read is zero */
- zero:
- switch (length)
- {
- case 4:
- *((GFC_REAL_4 *) dest) = 0;
- break;
-
- case 8:
- *((GFC_REAL_8 *) dest) = 0;
- break;
-
- #ifdef HAVE_GFC_REAL_10
- case 10:
- *((GFC_REAL_10 *) dest) = 0;
- break;
- #endif
-
- #ifdef HAVE_GFC_REAL_16
- case 16:
- *((GFC_REAL_16 *) dest) = 0;
- break;
- #endif
! default:
! internal_error (&dtp->common, "Unsupported real kind during IO");
}
! return;
! /* At this point the start of an exponent has been found */
! exp1:
! while (w > 0 && *p == ' ')
{
! w--;
! p++;
}
! switch (*p)
! {
! case '-':
! exponent_sign = -1;
! /* Fall through */
!
! case '+':
! p++;
! w--;
! break;
! }
if (w == 0)
goto bad_float;
- /* At this point a digit string is required. We calculate the value
- of the exponent in order to take account of the scale factor and
- the d parameter before explict conversion takes place. */
- exp2:
- /* Normal processing of exponent */
- exponent = 0;
if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
{
while (w > 0 && isdigit (*p))
! {
! exponent = 10 * exponent + *p - '0';
! p++;
! w--;
! }
!
! /* Only allow trailing blanks */
!
while (w > 0)
! {
! if (*p != ' ')
goto bad_float;
! p++;
! w--;
! }
}
! else /* BZ or BN status is enabled */
{
while (w > 0)
! {
! if (*p == ' ')
! {
! if (dtp->u.p.blank_status == BLANK_ZERO)
! {
! exponent = 10 * exponent;
! p++;
! w--;
! continue;
! }
! if (dtp->u.p.blank_status == BLANK_NULL)
! {
! p++;
! w--;
! continue;
! }
! }
! else if (!isdigit (*p))
! goto bad_float;
!
! exponent = 10 * exponent + *p - '0';
! p++;
! w--;
! }
}
! exponent = exponent * exponent_sign;
! done:
/* Use the precision specified in the format if no decimal point has been
seen. */
if (!seen_dp)
exponent -= f->u.real.d;
! if (exponent > 0)
{
! edigits = 2;
! i = exponent;
! }
! else
! {
! edigits = 3;
! i = -exponent;
! }
! while (i >= 10)
! {
! i /= 10;
! edigits++;
}
! i = ndigits + edigits + 1;
! if (val_sign < 0)
! i++;
! if (i < SCRATCH_SIZE)
! buffer = scratch;
! else
! buffer = get_mem (i);
! /* Reformat the string into a temporary buffer. As we're using atof it's
! easiest to just leave the decimal point in place. */
! p = buffer;
! if (val_sign < 0)
! *(p++) = '-';
! for (; ndigits > 0; ndigits--)
{
! if (*digits == ' ')
! {
! if (dtp->u.p.blank_status == BLANK_ZERO) *p = '0';
! else if (dtp->u.p.blank_status == BLANK_NULL)
! {
! digits++;
! continue;
! }
! else
! *p = ' ';
! }
! else
! *p = *digits;
! p++;
! digits++;
! }
! *(p++) = 'e';
! sprintf (p, "%d", exponent);
! /* Do the actual conversion. */
! convert_real (dtp, dest, buffer, length);
! if (buffer != scratch)
! free_mem (buffer);
}
--- 845,1018 ----
case '7':
case '8':
case '9':
! *(out++) = *p;
! if (!seen_dp)
! seen_int_digit = 1;
! else
! seen_dec_digit = 1;
break;
case '-':
case '+':
! goto exponent;
case 'e':
case 'E':
! case 'd':
! case 'D':
! ++p;
! --w;
! goto exponent;
default:
goto bad_float;
}
! ++p;
! --w;
}
!
! /* No exponent has been seen, so we use the current scale factor. */
! exponent = - dtp->u.p.scale_factor;
! goto done;
! /* At this point the start of an exponent has been found. */
! exponent:
! p = eat_leading_spaces (&w, p);
! if (*p == '-' || *p == '+')
{
! if (*p == '-')
! exponent_sign = -1;
! ++p;
! --w;
}
! /* At this point a digit string is required. We calculate the value
! of the exponent in order to take account of the scale factor and
! the d parameter before explict conversion takes place. */
if (w == 0)
goto bad_float;
if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
{
while (w > 0 && isdigit (*p))
! {
! exponent *= 10;
! exponent += *p - '0';
! ++p;
! --w;
! }
!
! /* Only allow trailing blanks. */
while (w > 0)
! {
! if (*p != ' ')
goto bad_float;
! ++p;
! --w;
! }
}
! else /* BZ or BN status is enabled. */
{
while (w > 0)
! {
! if (*p == ' ')
! {
! if (dtp->u.p.blank_status == BLANK_ZERO)
! *p = '0';
! else
! {
! assert (dtp->u.p.blank_status == BLANK_NULL);
! ++p;
! --w;
! continue;
! }
! }
! else if (!isdigit (*p))
! goto bad_float;
!
! exponent *= 10;
! exponent += *p - '0';
! ++p;
! --w;
! }
}
! exponent *= exponent_sign;
! done:
/* Use the precision specified in the format if no decimal point has been
seen. */
if (!seen_dp)
exponent -= f->u.real.d;
! /* Output a trailing '0' after decimal point if not yet found. */
! if (seen_dp && !seen_dec_digit)
! *(out++) = '0';
!
! /* Print out the exponent to finish the reformatted number. Maximum 4
! digits for the exponent. */
! if (exponent != 0)
{
! int dig;
! *(out++) = 'e';
! if (exponent < 0)
! {
! *(out++) = '-';
! exponent = - exponent;
! }
!
! assert (exponent < 10000);
! for (dig = 3; dig >= 0; --dig)
! {
! out[dig] = (char) ('0' + exponent % 10);
! exponent /= 10;
! }
! out += 4;
}
+ *(out++) = '\0';
! /* Do the actual conversion. */
! convert_real (dtp, dest, buffer, length);
! return;
! /* The value read is zero. */
! zero:
! switch (length)
{
! case 4:
! *((GFC_REAL_4 *) dest) = 0.0;
! break;
! case 8:
! *((GFC_REAL_8 *) dest) = 0.0;
! break;
!
! #ifdef HAVE_GFC_REAL_10
! case 10:
! *((GFC_REAL_10 *) dest) = 0.0;
! break;
! #endif
! #ifdef HAVE_GFC_REAL_16
! case 16:
! *((GFC_REAL_16 *) dest) = 0.0;
! break;
! #endif
+ default:
+ internal_error (&dtp->common, "Unsupported real kind during IO");
+ }
+ return;
+
+ bad_float:
+ generate_error (&dtp->common, LIBERROR_READ_VALUE,
+ "Bad value during floating point read");
+ next_record (dtp, 1);
+ return;
}
Index: gcc/testsuite/gfortran.dg/read_float_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/read_float_3.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/read_float_3.f90 (revision 0)
***************
*** 0 ****
--- 1,21 ----
+ ! { dg-do run }
+ ! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+
+ character(100) :: str1 = &
+ "123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+03 0.4E+03"
+ character(100), parameter :: should_be = &
+ "123.00456.88 0.123E+01 0.987E+01-0.2345E+02-0.6879E+02 0.7E+03 0.4E+03"
+ character(100) :: output
+ complex :: c1, c2, c3, c4
+
+ 100 format ( 2F6.2, 2E10.3, 2E11.4, 2E8.1)
+ read (str1,100) c1, c2, c3, c4
+ write (output, 100) c1, c2, c3, c4
+
+ print *, output
+ if (output /= should_be) then
+ print *, should_be
+ call abort ()
+ end if
+
+ end
Index: gcc/testsuite/gfortran.dg/read_float_2.f03
===================================================================
*** gcc/testsuite/gfortran.dg/read_float_2.f03 (revision 0)
--- gcc/testsuite/gfortran.dg/read_float_2.f03 (revision 0)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do run }
+ ! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+
+ character(15) :: str="+ .339 567+2"
+ real, parameter :: should_be = .339567e2
+ real, parameter :: eps = 10 * epsilon (should_be)
+ real :: x, y
+
+ read(str,'(BN,F15.6)') x
+ print *, x
+ read(str,'(G15.7)') y
+ print *, y
+
+ if (abs (x - should_be) > eps .or. abs (y - should_be) > eps) then
+ call abort ()
+ end if
+
+ end