From 3b63b663d72d1ba843d3d1c2f729c9496c236fd5 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Thu, 13 Mar 2014 05:06:57 +0000 Subject: [PATCH] re PR libfortran/38199 (missed optimization: I/O performance) 2014-03-12 Jerry DeLisle PR libfortran/38199 * io/read.c (read_decimal): Quickly skip spaces to avoid calls to next_char. * io/unit.c (is_trim_ok): New helper function to check various conditions to see if its OK to trim the internal unit string. (get_internal_unit): Use LEN_TRIM to shorten selected internal unit strings for optimizing READ. Enable this optimization for formatted READ. * io/list_read.c (finish_list_read): Don't call eat_line for internal units. From-SVN: r208528 --- libgfortran/ChangeLog | 13 +++++++ libgfortran/io/list_read.c | 11 +++--- libgfortran/io/read.c | 8 ++++- libgfortran/io/unit.c | 69 ++++++++++++++++++++++++++------------ 4 files changed, 75 insertions(+), 26 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 83749aa6b1f..f32b34cd8a4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2014-03-12 Jerry DeLisle + + PR libfortran/38199 + * io/read.c (read_decimal): Quickly skip spaces to avoid calls + to next_char. + * io/unit.c (is_trim_ok): New helper function to check various + conditions to see if its OK to trim the internal unit string. + (get_internal_unit): Use LEN_TRIM to shorten selected internal + unit strings for optimizing READ. Enable this optimization for + formatted READ. + * io/list_read.c (finish_list_read): Don't call eat_line for + internal units. + 2014-03-08 Jerry DeLisle PR libfortran/38199 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 4a26db96a96..2467569d639 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2104,11 +2104,14 @@ finish_list_read (st_parameter_dt *dtp) return; } - err = eat_line (dtp); - if (err == LIBERROR_END) + if (!is_internal_unit (dtp)) { - free_line (dtp); - hit_eof (dtp); + err = eat_line (dtp); + if (err == LIBERROR_END) + { + free_line (dtp); + hit_eof (dtp); + } } } diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index 331edc23d39..64f2ddf49a1 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -677,7 +677,13 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) if (c == ' ') { - if (dtp->u.p.blank_status == BLANK_NULL) continue; + if (dtp->u.p.blank_status == BLANK_NULL) + { + /* Skip spaces. */ + for ( ; w > 0; p++, w--) + if (*p != ' ') break; + continue; + } if (dtp->u.p.blank_status == BLANK_ZERO) c = '0'; } diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 901d66fa0c1..e522195e5dd 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -375,6 +375,38 @@ find_or_create_unit (int n) } +/* Helper function to check rank, stride, format string, and namelist. + This is used for optimization. You can't trim out blanks or shorten + the string if trailing spaces are significant. */ +static bool +is_trim_ok (st_parameter_dt *dtp) +{ + /* Check rank and stride. */ + if (dtp->internal_unit_desc + && (GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc) > 1 + || GFC_DESCRIPTOR_STRIDE(dtp->internal_unit_desc, 0) != 1)) + return false; + /* Format strings can not have 'BZ' or '/'. */ + if (dtp->common.flags & IOPARM_DT_HAS_FORMAT) + { + char *p = dtp->format; + off_t i; + if (dtp->common.flags & IOPARM_DT_HAS_BLANK) + return false; + for (i = 0; i < dtp->format_len; i++) + { + if (p[i] == '/') return false; + if (p[i] == 'b' || p[i] == 'B') + if (p[i+1] == 'z' || p[i+1] == 'Z') + return false; + } + } + if (dtp->u.p.ionml) /* A namelist. */ + return false; + return true; +} + + gfc_unit * get_internal_unit (st_parameter_dt *dtp) { @@ -402,6 +434,22 @@ get_internal_unit (st_parameter_dt *dtp) some other file I/O unit. */ iunit->unit_number = -1; + /* As an optimization, adjust the unit record length to not + include trailing blanks. This will not work under certain conditions + where trailing blanks have significance. */ + if (dtp->u.p.mode == READING && is_trim_ok (dtp)) + { + int len; + if (dtp->common.unit == 0) + len = string_len_trim (dtp->internal_unit_len, + dtp->internal_unit); + else + len = string_len_trim_char4 (dtp->internal_unit_len, + (const gfc_char4_t*) dtp->internal_unit); + dtp->internal_unit_len = len; + iunit->recl = dtp->internal_unit_len; + } + /* Set up the looping specification from the array descriptor, if any. */ if (is_array_io (dtp)) @@ -414,27 +462,6 @@ get_internal_unit (st_parameter_dt *dtp) start_record *= iunit->recl; } - else - { - /* If we are not processing an array, adjust the unit record length not - to include trailing blanks for list-formatted reads. */ - if (dtp->u.p.mode == READING && !(dtp->common.flags & IOPARM_DT_HAS_FORMAT)) - { - if (dtp->common.unit == 0) - { - dtp->internal_unit_len = - string_len_trim (dtp->internal_unit_len, dtp->internal_unit); - iunit->recl = dtp->internal_unit_len; - } - else - { - dtp->internal_unit_len = - string_len_trim_char4 (dtp->internal_unit_len, - (const gfc_char4_t*) dtp->internal_unit); - iunit->recl = dtp->internal_unit_len; - } - } - } /* Set initial values for unit parameters. */ if (dtp->common.unit)