| Message ID | d47fd3f5-3cbd-772f-0be2-7ad2e696f34d@charter.net |
|---|---|
| State | New |
| Headers | show |
| Series | [libgfortran] Bug 78549 - [7/8 Regression] Very slow formatted internal file output | expand |
On Mon, Nov 20, 2017 at 12:56 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: > Hi all, > > After the usual considerable digging around I determined that for the test case > doing 1000000 writes to a string that we were allocating 1000000 newunit numbers > and the associated unit structures on the unit treap. Consequently, at the end > of the program, when all left open units are cleaned up and closed, a lot of > time was being burned. We did not benefit from the previously allocated unit > structures saved on the treap that could be reused. > > IO operations on strings complete with st_read_done or st_write_done of the > parent IO procedure. To fix the problem, I simply declared newunit_alloc > accessible to transfer.c and invoked it. > > Now unit numbers and their associated unit structures are reused as they should > be and internal unit I/O is just a little bit better than on gfortran version 6. > > My test results with the test case in the PR are as follows. (I commented out > the intermediate write to stdout for clarity) > > Patched trunk: > > $ gfc -static pr78549.f > $ time ./a.out > > real 0m22.476s > user 0m22.183s > sys 0m0.180s > > And gfortran 6: > > $ gfc6 -static pr78549.f > $ time ./a.out > > real 0m22.790s > user 0m22.633s > sys 0m0.011s > > Unpatched gfortran 7: > > $ gfc7 -static pr78549.f > $ time ./a.out > > real 0m29.915s > user 0m28.750s > sys 0m0.971s > > > Regression tested on x86-64-linux. > > I will commit to trunk in a day and back port to 7 in a few more days if no > objections. The patch is simple. > > Regards, > > Jerry > > 2017-11-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> > > PR libgfortran/78549 > * io/io.h (newunit_free): Add declaration. Clean some whitespace. > * io/transfer.c (st_read_done, st_write_done): Call newunit_free. > * io/unit.c (newunit_free): Change type from static void to void. In the patch: extern void finish_last_advance_record (gfc_unit *u); -internal_proto (finish_last_advance_record); +internal_proto(finish_last_advance_record); extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *); -internal_proto (unit_truncate); +internal_proto(unit_truncate); extern int newunit_alloc (void); internal_proto(newunit_alloc); +extern void newunit_free (int); +internal_proto (newunit_free); + Since you're fixing the whitespace for finish_last_advance_record and unit_truncate, you might as well do it right for newunit_free from the start.. :) Otherwise Ok, thanks for the patch!
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index d29b112b..dd98530e 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -764,14 +764,17 @@ extern void unlock_unit (gfc_unit *); internal_proto(unlock_unit); extern void finish_last_advance_record (gfc_unit *u); -internal_proto (finish_last_advance_record); +internal_proto(finish_last_advance_record); extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *); -internal_proto (unit_truncate); +internal_proto(unit_truncate); extern int newunit_alloc (void); internal_proto(newunit_alloc); +extern void newunit_free (int); +internal_proto (newunit_free); + /* open.c */ diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 52963706..d9378e3a 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -4084,16 +4084,19 @@ st_read_done (st_parameter_dt *dtp) if (dtp->u.p.current_unit != NULL && dtp->u.p.current_unit->child_dtio == 0) { - if (is_internal_unit (dtp) && - (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) - { - free (dtp->u.p.current_unit->filename); - dtp->u.p.current_unit->filename = NULL; - free (dtp->u.p.current_unit->s); - dtp->u.p.current_unit->s = NULL; - if (dtp->u.p.current_unit->ls) - free (dtp->u.p.current_unit->ls); - dtp->u.p.current_unit->ls = NULL; + if (is_internal_unit (dtp)) + { + if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) + { + free (dtp->u.p.current_unit->filename); + dtp->u.p.current_unit->filename = NULL; + free (dtp->u.p.current_unit->s); + dtp->u.p.current_unit->s = NULL; + if (dtp->u.p.current_unit->ls) + free (dtp->u.p.current_unit->ls); + dtp->u.p.current_unit->ls = NULL; + } + newunit_free (dtp->common.unit); } if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) { @@ -4152,16 +4155,19 @@ st_write_done (st_parameter_dt *dtp) /* If this is a parent WRITE statement we do not need to retain the internal unit structure for child use. */ - if (is_internal_unit (dtp) && - (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) + if (is_internal_unit (dtp)) { - free (dtp->u.p.current_unit->filename); - dtp->u.p.current_unit->filename = NULL; - free (dtp->u.p.current_unit->s); - dtp->u.p.current_unit->s = NULL; - if (dtp->u.p.current_unit->ls) - free (dtp->u.p.current_unit->ls); - dtp->u.p.current_unit->ls = NULL; + if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) + { + free (dtp->u.p.current_unit->filename); + dtp->u.p.current_unit->filename = NULL; + free (dtp->u.p.current_unit->s); + dtp->u.p.current_unit->s = NULL; + if (dtp->u.p.current_unit->ls) + free (dtp->u.p.current_unit->ls); + dtp->u.p.current_unit->ls = NULL; + } + newunit_free (dtp->common.unit); } if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) { diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index e06867aa..e62f9b83 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -89,7 +89,6 @@ static int newunit_size; /* Total number of elements in the newunits array. */ units are allocated, above and equal to the LWI there may be both allocated and free units. */ static int newunit_lwi; -static void newunit_free (int); /* Unit numbers assigned with NEWUNIT start from here. */ #define NEWUNIT_START -10 @@ -911,7 +910,7 @@ newunit_alloc (void) /* Free a previously allocated newunit= unit number. unit_lock must be held when calling. */ -static void +void newunit_free (int unit) { int ind = -unit + NEWUNIT_START;