Am 01.10.2017 um 10:59 schrieb Bernd Edlinger:
maybe there is a way how you could explicitly join
all running threads?
Yes, that seems to do the trick. Thanks!
Here is a patch which appears to work. It does hit a snag with static
linking, though, because it calls __gthread_self (), and that causes
a segfault with -static :-(.
The test case in question is static_linking_1.f.
This appears to be a general problem, and has been discussed
before, for example in
https://gcc.gnu.org/ml/gcc-help/2010-05/msg00029.html .
What would be the best way to proceed? Modify the behavior of -static
with gfortran?
Regards
Thomas
2017-10-01 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66756
PR fortran/82378
* io/io.h: Add field th to gfc_unit. Add prototypes for
lock_unit and trylock_unit.
* io/unit.c (insert_unit): Do not create lock and lock, move to
(gfc_get_unit): here; lock after insert_unit has succeded.
Use lock_unit and trylock_unit instead of __gthread_mutex_lock
and __gthread_mutex_trylock.
(init_units): Do not unlock unit locks for stdin, stdout and
stderr.
(lock_unit): New function.
(trylock_unit): New function.
(close_units): If a unit still has a lock, wait for the
completion of the corresponding thread.
* io/unix.c (find_file): Use lock_unit and trylock_unit instead
of __gthread_mutex_lock and __gthread_mutex_trylock.
(flush_all_units): Likewise.
2017-10-01 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66756
PR fortran/82378
* gfortran.dg/openmp-close.f90: New test.
Index: io/io.h
===================================================================
--- io/io.h (Revision 253162)
+++ io/io.h (Arbeitskopie)
@@ -661,6 +661,8 @@ typedef struct gfc_unit
int continued;
__gthread_mutex_t lock;
+ /* ID of the thread currently holding the lock. */
+ __gthread_t th;
/* Number of threads waiting to acquire this unit's lock.
When non-zero, close_unit doesn't only removes the unit
from the UNIT_ROOT tree, but doesn't free it and the
@@ -764,6 +766,12 @@ internal_proto(get_unit);
extern void unlock_unit (gfc_unit *);
internal_proto(unlock_unit);
+extern void lock_unit (gfc_unit *);
+internal_proto(lock_unit);
+
+extern int trylock_unit (gfc_unit *);
+internal_proto (trylock_unit);
+
extern void finish_last_advance_record (gfc_unit *u);
internal_proto (finish_last_advance_record);
Index: io/unit.c
===================================================================
--- io/unit.c (Revision 253162)
+++ io/unit.c (Arbeitskopie)
@@ -221,9 +221,9 @@ insert (gfc_unit *new, gfc_unit *t)
return t;
}
+/* insert_unit()-- Create a new node, insert it into the treap. It is assumed
+ that the caller holds unit_lock. */
-/* insert_unit()-- Create a new node, insert it into the treap. */
-
static gfc_unit *
insert_unit (int n)
{
@@ -237,7 +237,6 @@ insert_unit (int n)
#else
__GTHREAD_MUTEX_INIT_FUNCTION (&u->lock);
#endif
- __gthread_mutex_lock (&u->lock);
u->priority = pseudo_random ();
unit_root = insert (u, unit_root);
return u;
@@ -361,9 +360,12 @@ retry:
if (created)
{
- /* Newly created units have their lock held already
- from insert_unit. Just unlock UNIT_LOCK and return. */
__gthread_mutex_unlock (&unit_lock);
+
+ /* Nobody outside this address has seen this unit yet. We could safely
+ keep it unlocked until now. */
+
+ lock_unit (p);
return p;
}
@@ -371,7 +373,7 @@ found:
if (p != NULL && (p->child_dtio == 0))
{
/* Fast path. */
- if (! __gthread_mutex_trylock (&p->lock))
+ if (! trylock_unit (p))
{
/* assert (p->closed == 0); */
__gthread_mutex_unlock (&unit_lock);
@@ -386,7 +388,7 @@ found:
if (p != NULL && (p->child_dtio == 0))
{
- __gthread_mutex_lock (&p->lock);
+ lock_unit (p);
if (p->closed)
{
__gthread_mutex_lock (&unit_lock);
@@ -616,10 +618,9 @@ init_units (void)
u->endfile = NO_ENDFILE;
u->filename = strdup (stdin_name);
+ u->th = __gthread_self ();
fbuf_init (u, 0);
-
- __gthread_mutex_unlock (&u->lock);
}
if (options.stdout_unit >= 0)
@@ -647,10 +648,9 @@ init_units (void)
u->endfile = AT_ENDFILE;
u->filename = strdup (stdout_name);
+ u->th = __gthread_self ();
fbuf_init (u, 0);
-
- __gthread_mutex_unlock (&u->lock);
}
if (options.stderr_unit >= 0)
@@ -677,11 +677,10 @@ init_units (void)
u->endfile = AT_ENDFILE;
u->filename = strdup (stderr_name);
+ u->th = __gthread_self ();
fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing
any kind of exotic formatting to stderr. */
-
- __gthread_mutex_unlock (&u->lock);
}
/* Calculate the maximum file offset in a portable manner.
@@ -745,6 +744,28 @@ unlock_unit (gfc_unit *u)
__gthread_mutex_unlock (&u->lock);
}
+
+/* Lock a unit and record the thread id. */
+
+void
+lock_unit (gfc_unit *u)
+{
+ __gthread_mutex_lock (&u->lock);
+ u->th = __gthread_self ();
+}
+
+/* Try to lock a unit lock and record the thread id on success. */
+
+int
+trylock_unit (gfc_unit *u)
+{
+ int ret = __gthread_mutex_trylock (&u->lock);
+ if (ret)
+ u->th = __gthread_self();
+
+ return ret;
+}
+
/* close_unit()-- Close a unit. The stream is closed, and any memory
associated with the stream is freed. Returns nonzero on I/O error.
Should be called with the u->lock locked. */
@@ -756,12 +777,9 @@ close_unit (gfc_unit *u)
}
-/* close_units()-- Delete units on completion. We just keep deleting
- the root of the treap until there is nothing left.
- Not sure what to do with locking here. Some other thread might be
- holding some unit's lock and perhaps hold it indefinitely
- (e.g. waiting for input from some pipe) and close_units shouldn't
- delay the program too much. */
+/* close_units()-- Delete units on completion. We just keep deleting the root
+ of the treap until there is nothing left. If a thread is still locked, we
+ wait for its completion and unlock, then call close_unit_1. */
void
close_units (void)
@@ -768,7 +786,14 @@ close_units (void)
{
__gthread_mutex_lock (&unit_lock);
while (unit_root != NULL)
- close_unit_1 (unit_root, 1);
+ {
+ if (!trylock_unit (unit_root) &&
+ !__gthread_equal (unit_root->th, __gthread_self ()))
+ __gthread_join (unit_root->th, NULL);
+
+ unlock_unit (unit_root);
+ close_unit_1 (unit_root, 1);
+ }
__gthread_mutex_unlock (&unit_lock);
free (newunits);
Index: io/unix.c
===================================================================
--- io/unix.c (Revision 253162)
+++ io/unix.c (Arbeitskopie)
@@ -1714,7 +1714,7 @@ retry:
if (u != NULL)
{
/* Fast path. */
- if (! __gthread_mutex_trylock (&u->lock))
+ if (! trylock_unit (u))
{
/* assert (u->closed == 0); */
__gthread_mutex_unlock (&unit_lock);
@@ -1726,7 +1726,7 @@ retry:
__gthread_mutex_unlock (&unit_lock);
if (u != NULL)
{
- __gthread_mutex_lock (&u->lock);
+ lock_unit (u);
if (u->closed)
{
__gthread_mutex_lock (&unit_lock);
@@ -1756,7 +1756,7 @@ flush_all_units_1 (gfc_unit *u, int min_unit)
}
if (u->unit_number >= min_unit)
{
- if (__gthread_mutex_trylock (&u->lock))
+ if (trylock_unit (u))
return u;
if (u->s)
sflush (u->s);
@@ -1783,7 +1783,7 @@ flush_all_units (void)
if (u == NULL)
return;
- __gthread_mutex_lock (&u->lock);
+ lock_unit (u);
min_unit = u->unit_number + 1;
! { dg-do run }
! { dg-require-effective-target fopenmp }
! { dg-additional-options "-fopenmp" }
program main
use omp_lib
!$OMP PARALLEL NUM_THREADS(100)
write (10,*) 'asdf'
!$OMP END PARALLEL
close(10,status="delete")
end program main
