This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, libgfortran] PR33985 access="stream",form="unformatted" doesn't buffer
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 02 Dec 2007 15:15:48 -0800
- Subject: [patch, libgfortran] PR33985 access="stream",form="unformatted" doesn't buffer
I plan to commit the attached patch approved by Thomas in the PR report.
The patch adds simple tests for "stream" I/O to avoid unnecessary seeks and
flushes. Gives substantial performance improvement.
Regression tested on x86-64-linux-gnu.
No new test cases.
Thanks to Thomas for testing, reviewing, and some of the concept here.
Jerry
2007-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/33985
* io/transfer.c (read_block, read_block_direct, write_block, write_buf):
Don't seek if file position is already there for STREAM I/O.
(finalize_transfer): For STREAM I/O don't flush unless the file position
has moved past the start position before the transfer.
Index: transfer.c
===================================================================
--- transfer.c (revision 130547)
+++ transfer.c (working copy)
@@ -272,8 +272,10 @@ read_block (st_parameter_dt *dtp, int *l
if (is_stream_io (dtp))
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ if (dtp->u.p.current_unit->strm_pos - 1
+ != file_position (dtp->u.p.current_unit->s)
+ && sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return NULL;
@@ -357,8 +359,10 @@ read_block_direct (st_parameter_dt *dtp,
if (is_stream_io (dtp))
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ if (dtp->u.p.current_unit->strm_pos - 1
+ != file_position (dtp->u.p.current_unit->s)
+ && sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
@@ -533,8 +537,10 @@ write_block (st_parameter_dt *dtp, int l
if (is_stream_io (dtp))
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ if (dtp->u.p.current_unit->strm_pos - 1
+ != file_position (dtp->u.p.current_unit->s)
+ && sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return NULL;
@@ -595,8 +601,10 @@ write_buf (st_parameter_dt *dtp, void *b
if (is_stream_io (dtp))
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ if (dtp->u.p.current_unit->strm_pos - 1
+ != file_position (dtp->u.p.current_unit->s)
+ && sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
@@ -2640,8 +2648,13 @@ finalize_transfer (st_parameter_dt *dtp)
{
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
next_record (dtp, 1);
- flush (dtp->u.p.current_unit->s);
- sfree (dtp->u.p.current_unit->s);
+
+ if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
+ && file_position (dtp->u.p.current_unit->s) >= dtp->rec)
+ {
+ flush (dtp->u.p.current_unit->s);
+ sfree (dtp->u.p.current_unit->s);
+ }
return;
}