From 49614a55fb4570dbbb1aea8d5ed3e853077c66f2 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Wed, 20 Sep 2017 01:32:59 +0000 Subject: [PATCH] backport: re PR fortran/78387 (OpenMP segfault/stack size exceeded writing to internal file) 2017-09-19 Jerry DeLisle Backport from trunk PR libgfortran/78387 * io/list_read.c (nml_read_obj): Remove use of stash. * io/transfer.c (st_read_done, st_write_done): Likewise. * io/unit.c (stash_internal_unit): Delete function. (get_unit): Remove use of stash. (init_units): Likewise. (close_units): Likewise. * io/write.c (nml_write_obj): Likewise: From-SVN: r252992 --- libgfortran/ChangeLog | 12 ++++++ libgfortran/io/list_read.c | 5 --- libgfortran/io/transfer.c | 8 +--- libgfortran/io/unit.c | 84 +++----------------------------------- libgfortran/io/write.c | 5 --- 5 files changed, 19 insertions(+), 95 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index ae277910839..8feed2f50da 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2017-09-19 Jerry DeLisle + + Backport from trunk + PR libgfortran/78387 + * io/list_read.c (nml_read_obj): Remove use of stash. + * io/transfer.c (st_read_done, st_write_done): Likewise. + * io/unit.c (stash_internal_unit): Delete function. + (get_unit): Remove use of stash. + (init_units): Likewise. + (close_units): Likewise. + * io/write.c (nml_write_obj): Likewise: + 2017-08-14 Release Manager * GCC 7.2.0 released. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 943afb51c6a..6a05cfe4f22 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -3019,11 +3019,6 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset, child_iomsg_len = IOMSG_LEN; } - /* If reading from an internal unit, stash it to allow - the child procedure to access it. */ - if (is_internal_unit (dtp)) - stash_internal_unit (dtp); - /* Call the user defined formatted READ procedure. */ dtp->u.p.current_unit->child_dtio++; dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist, diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 298b29e8d3e..529637061b1 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -4080,8 +4080,7 @@ st_read_done (st_parameter_dt *dtp) free_ionml (dtp); /* If this is a parent READ statement we do not need to retain the - internal unit structure for child use. Free it and stash the unit - number for reuse. */ + internal unit structure for child use. */ if (dtp->u.p.current_unit != NULL && dtp->u.p.current_unit->child_dtio == 0) { @@ -4095,7 +4094,6 @@ st_read_done (st_parameter_dt *dtp) if (dtp->u.p.current_unit->ls) free (dtp->u.p.current_unit->ls); dtp->u.p.current_unit->ls = NULL; - stash_internal_unit (dtp); } if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) { @@ -4153,8 +4151,7 @@ st_write_done (st_parameter_dt *dtp) free_ionml (dtp); /* If this is a parent WRITE statement we do not need to retain the - internal unit structure for child use. Free it and stash the - unit number for reuse. */ + internal unit structure for child use. */ if (is_internal_unit (dtp) && (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) { @@ -4165,7 +4162,6 @@ st_write_done (st_parameter_dt *dtp) if (dtp->u.p.current_unit->ls) free (dtp->u.p.current_unit->ls); dtp->u.p.current_unit->ls = NULL; - stash_internal_unit (dtp); } if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) { diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index ef94294526a..e06867aa0a1 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -94,16 +94,6 @@ static void newunit_free (int); /* Unit numbers assigned with NEWUNIT start from here. */ #define NEWUNIT_START -10 - -#define NEWUNIT_STACK_SIZE 16 - -/* A stack to save previously used newunit-assigned unit numbers to - allow them to be reused without reallocating the gfc_unit structure - which is still in the treap. */ -static gfc_saved_unit newunit_stack[NEWUNIT_STACK_SIZE]; -static int newunit_tos = 0; /* Index to Top of Stack. */ - - #define CACHE_SIZE 3 static gfc_unit *unit_cache[CACHE_SIZE]; gfc_offset max_offset; @@ -538,22 +528,6 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind) } -/* stash_internal_unit()-- Push the internal unit number onto the - avaialble stack. */ -void -stash_internal_unit (st_parameter_dt *dtp) -{ - __gthread_mutex_lock (&unit_lock); - newunit_tos++; - if (newunit_tos >= NEWUNIT_STACK_SIZE) - internal_error (&dtp->common, "stash_internal_unit(): Stack Size Exceeded"); - newunit_stack[newunit_tos].unit_number = dtp->common.unit; - newunit_stack[newunit_tos].unit = dtp->u.p.current_unit; - __gthread_mutex_unlock (&unit_lock); -} - - - /* get_unit()-- Returns the unit structure associated with the integer unit or the internal file. */ @@ -572,49 +546,13 @@ get_unit (st_parameter_dt *dtp, int do_create) else internal_error (&dtp->common, "get_unit(): Bad internal unit KIND"); - if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) != 0) - { - dtp->u.p.unit_is_internal = 1; - dtp->common.unit = newunit_alloc (); - unit = get_gfc_unit (dtp->common.unit, do_create); - set_internal_unit (dtp, unit, kind); - fbuf_init (unit, 128); - return unit; - } - else - { - __gthread_mutex_lock (&unit_lock); - if (newunit_tos) - { - dtp->common.unit = newunit_stack[newunit_tos].unit_number; - unit = newunit_stack[newunit_tos--].unit; - __gthread_mutex_unlock (&unit_lock); - unit->fbuf->act = unit->fbuf->pos = 0; - } - else - { - __gthread_mutex_unlock (&unit_lock); - dtp->common.unit = newunit_alloc (); - unit = xcalloc (1, sizeof (gfc_unit)); - fbuf_init (unit, 128); - } - set_internal_unit (dtp, unit, kind); - return unit; - } - } - - /* If an internal unit number is passed from the parent to the child - it should have been stashed on the newunit_stack ready to be used. - Check for it now and return the internal unit if found. */ - __gthread_mutex_lock (&unit_lock); - if (newunit_tos && (dtp->common.unit <= NEWUNIT_START) - && (dtp->common.unit == newunit_stack[newunit_tos].unit_number)) - { - unit = newunit_stack[newunit_tos--].unit; - __gthread_mutex_unlock (&unit_lock); + dtp->u.p.unit_is_internal = 1; + dtp->common.unit = newunit_alloc (); + unit = get_gfc_unit (dtp->common.unit, do_create); + set_internal_unit (dtp, unit, kind); + fbuf_init (unit, 128); return unit; } - __gthread_mutex_unlock (&unit_lock); /* Has to be an external unit. */ dtp->u.p.unit_is_internal = 0; @@ -752,10 +690,6 @@ init_units (void) max_offset = 0; for (i = 0; i < sizeof (max_offset) * 8 - 1; i++) max_offset = max_offset + ((gfc_offset) 1 << i); - - /* Initialize the newunit stack. */ - memset (newunit_stack, 0, NEWUNIT_STACK_SIZE * sizeof(gfc_saved_unit)); - newunit_tos = 0; } @@ -837,14 +771,6 @@ close_units (void) close_unit_1 (unit_root, 1); __gthread_mutex_unlock (&unit_lock); - while (newunit_tos != 0) - if (newunit_stack[newunit_tos].unit) - { - fbuf_destroy (newunit_stack[newunit_tos].unit); - free (newunit_stack[newunit_tos].unit->s); - free (newunit_stack[newunit_tos--].unit); - } - free (newunits); #ifdef HAVE_FREELOCALE diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 8dbbb0912e3..c9aad150090 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -2248,11 +2248,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset, child_iomsg_len = IOMSG_LEN; } - /* If writing to an internal unit, stash it to allow - the child procedure to access it. */ - if (is_internal_unit (dtp)) - stash_internal_unit (dtp); - /* Call the user defined formatted WRITE procedure. */ dtp->u.p.current_unit->child_dtio++; if (obj->type == BT_DERIVED)