backport: re PR fortran/78387 (OpenMP segfault/stack size exceeded writing to internal file)
2017-09-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> 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
This commit is contained in:
Jerry DeLisle
parent
93a3014866
commit
49614a55fb
|
|
@ -1,3 +1,15 @@
|
|||
2017-09-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue