From c8869272f7f2129233c5f670a0064314dd312e64 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 9 Mar 2014 03:17:16 +0000 Subject: [PATCH] re PR libfortran/38199 (missed optimization: I/O performance) 2014-03-08 Jerry DeLisle PR libfortran/38199 * io/list_read.c (next_char): Delete unuseful error checks. (eat_spaces): For character array reading, skip ahead over spaces rather than call next_char multiple times. From-SVN: r208438 --- libgfortran/ChangeLog | 7 ++++++ libgfortran/io/list_read.c | 50 +++++++++++++++++++++++++++++++++++--- 2 files changed, 53 insertions(+), 4 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c82daa2564f..1a3539ddb71 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2014-03-08 Jerry DeLisle + + PR libfortran/38199 + * io/list_read.c (next_char): Delete unuseful error checks. + (eat_spaces): For character array reading, skip ahead over + spaces rather than call next_char multiple times. + 2014-03-08 Tobias Burnus * libgfortran.h (unlikely, likely): Add usage comment. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index d1d09b5fe7d..4a26db96a96 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -160,7 +160,7 @@ next_char (st_parameter_dt *dtp) dtp->u.p.line_buffer_pos = 0; dtp->u.p.line_buffer_enabled = 0; - } + } /* Handle the end-of-record and end-of-file conditions for internal array unit. */ @@ -208,16 +208,16 @@ next_char (st_parameter_dt *dtp) c = cc; } - if (length < 0) + if (unlikely (length < 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return '\0'; } - + if (is_array_io (dtp)) { /* Check whether we hit EOF. */ - if (length == 0) + if (unlikely (length == 0)) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return '\0'; @@ -264,6 +264,48 @@ eat_spaces (st_parameter_dt *dtp) { int c; + /* If internal character array IO, peak ahead and seek past spaces. + This is an optimazation to eliminate numerous calls to + next character unique to character arrays with large character + lengths (PR38199). */ + if (is_array_io (dtp)) + { + gfc_offset offset = stell (dtp->u.p.current_unit->s); + gfc_offset limit = dtp->u.p.current_unit->bytes_left; + + if (dtp->common.unit) /* kind=4 */ + { + gfc_char4_t cc; + limit *= (sizeof (gfc_char4_t)); + do + { + cc = dtp->internal_unit[offset]; + offset += (sizeof (gfc_char4_t)); + dtp->u.p.current_unit->bytes_left--; + } + while (offset < limit && (cc == (gfc_char4_t)' ' + || cc == (gfc_char4_t)'\t')); + /* Back up, seek ahead, and fall through to complete the + process so that END conditions are handled correctly. */ + dtp->u.p.current_unit->bytes_left++; + sseek (dtp->u.p.current_unit->s, + offset-(sizeof (gfc_char4_t)), SEEK_SET); + } + else + { + do + { + c = dtp->internal_unit[offset++]; + dtp->u.p.current_unit->bytes_left--; + } + while (offset < limit && (c == ' ' || c == '\t')); + /* Back up, seek ahead, and fall through to complete the + process so that END conditions are handled correctly. */ + dtp->u.p.current_unit->bytes_left++; + sseek (dtp->u.p.current_unit->s, offset-1, SEEK_SET); + } + } + /* Now skip spaces, EOF and EOL are handled in next_char. */ do c = next_char (dtp); while (c != EOF && (c == ' ' || c == '\t'));