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 <[email protected]>
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.
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;
