re PR libfortran/38199 (missed optimization: I/O performance)
2014-03-08 Jerry DeLisle <jvdelisle@gcc.gnu> 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
This commit is contained in:
parent
a5165cff4d
commit
c8869272f7
@ -1,3 +1,10 @@
|
||||
2014-03-08 Jerry DeLisle <jvdelisle@gcc.gnu>
|
||||
|
||||
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 <burnus@net-b.de>
|
||||
|
||||
* libgfortran.h (unlikely, likely): Add usage comment.
|
||||
|
@ -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'));
|
||||
|
Loading…
Reference in New Issue
Block a user