https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78549
--- Comment #16 from Thomas Koenig <tkoenig at gcc dot gnu.org> --- Jerry, what do you think of this approach? This creates a local copy of the gfc_unit, without putting it into the tree. Index: transfer.c =================================================================== --- transfer.c (Revision 253377) +++ transfer.c (Arbeitskopie) @@ -4170,6 +4170,9 @@ st_write_done (st_parameter_dt *dtp) } unlock_unit (dtp->u.p.current_unit); } + if (is_internal_unit (dtp)) + free (dtp->u.p.current_unit); + library_end (); } Index: unit.c =================================================================== --- unit.c (Revision 253377) +++ unit.c (Arbeitskopie) @@ -225,7 +225,7 @@ insert (gfc_unit *new, gfc_unit *t) /* insert_unit()-- Create a new node, insert it into the treap. */ static gfc_unit * -insert_unit (int n) +insert_unit (int n, int internal) { gfc_unit *u = xcalloc (1, sizeof (gfc_unit)); u->unit_number = n; @@ -238,8 +238,11 @@ static gfc_unit * __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock); #endif __gthread_mutex_lock (&u->lock); - u->priority = pseudo_random (); - unit_root = insert (u, unit_root); + if (!internal) + { + u->priority = pseudo_random (); + unit_root = insert (u, unit_root); + } return u; } @@ -316,14 +319,21 @@ delete_unit (gfc_unit *old) /* get_gfc_unit()-- Given an integer, return a pointer to the unit structure. Returns NULL if the unit does not exist, - otherwise returns a locked unit. */ + otherwise returns a locked unit. If internal, do not put it + in the unit cache. */ static gfc_unit * -get_gfc_unit (int n, int do_create) +get_gfc_unit (int n, int do_create, int internal) { gfc_unit *p; int c, created = 0; + if (internal) + { + p = insert_unit (n, 1); + return p; + } + __gthread_mutex_lock (&unit_lock); retry: for (c = 0; c < CACHE_SIZE; c++) @@ -347,7 +357,7 @@ retry: if (p == NULL && do_create) { - p = insert_unit (n); + p = insert_unit (n, 0); created = 1; } @@ -405,7 +415,7 @@ found: gfc_unit * find_unit (int n) { - return get_gfc_unit (n, 0); + return get_gfc_unit (n, 0, 0); } @@ -412,7 +422,7 @@ find_unit (int n) gfc_unit * find_or_create_unit (int n) { - return get_gfc_unit (n, 1); + return get_gfc_unit (n, 1, 0); } @@ -548,7 +558,7 @@ get_unit (st_parameter_dt *dtp, int do_create) dtp->u.p.unit_is_internal = 1; dtp->common.unit = newunit_alloc (); - unit = get_gfc_unit (dtp->common.unit, do_create); + unit = get_gfc_unit (dtp->common.unit, do_create, 1); set_internal_unit (dtp, unit, kind); fbuf_init (unit, 128); return unit; @@ -563,9 +573,9 @@ get_unit (st_parameter_dt *dtp, int do_create) is not allowed, such units must be created with OPEN(NEWUNIT=...). */ if (dtp->common.unit < 0) - return get_gfc_unit (dtp->common.unit, 0); + return get_gfc_unit (dtp->common.unit, 0, 0); - return get_gfc_unit (dtp->common.unit, do_create); + return get_gfc_unit (dtp->common.unit, do_create, 0); } @@ -592,7 +602,7 @@ init_units (void) if (options.stdin_unit >= 0) { /* STDIN */ - u = insert_unit (options.stdin_unit); + u = insert_unit (options.stdin_unit, 0); u->s = input_stream (); u->flags.action = ACTION_READ; @@ -624,7 +634,7 @@ init_units (void) if (options.stdout_unit >= 0) { /* STDOUT */ - u = insert_unit (options.stdout_unit); + u = insert_unit (options.stdout_unit, 0); u->s = output_stream (); u->flags.action = ACTION_WRITE; @@ -655,7 +665,7 @@ init_units (void) if (options.stderr_unit >= 0) { /* STDERR */ - u = insert_unit (options.stderr_unit); + u = insert_unit (options.stderr_unit, 0); u->s = error_stream (); u->flags.action = ACTION_WRITE;