From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 14456 invoked by alias); 1 Oct 2017 13:41:54 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 14435 invoked by uid 89); 1 Oct 2017 13:41:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.0 required=5.0 tests=AWL,BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_LOW,RP_MATCHES_RCVD,SPF_PASS autolearn=ham version=3.3.2 spammy=7456, Hx-languages-length:7421, tkoenig@gcc.gnu.org, tkoeniggccgnuorg X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout3.netcologne.de Received: from cc-smtpout3.netcologne.de (HELO cc-smtpout3.netcologne.de) (89.1.8.213) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 01 Oct 2017 13:41:51 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 161E5123D9; Sun, 1 Oct 2017 15:41:49 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id 0640D11DFA; Sun, 1 Oct 2017 15:41:49 +0200 (CEST) Received: from [78.35.161.68] (helo=cc-smtpin3.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 59d0f09c-02b7-7f0000012729-7f0000019176-1 for ; Sun, 01 Oct 2017 15:41:48 +0200 Received: from [192.168.178.20] (xdsl-78-35-161-68.netcologne.de [78.35.161.68]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA; Sun, 1 Oct 2017 15:41:44 +0200 (CEST) Subject: Re: [patch, libfortran] Fix thead sanitizer issue with libgfortran To: Bernd Edlinger , Janne Blomqvist Cc: "fortran@gcc.gnu.org" , "gcc-patches@gcc.gnu.org" References: <304c58c9-3c15-380a-a748-2fe4b792d2d1@hotmail.de> From: Thomas Koenig Message-ID: <17746f9b-3dea-d99e-514f-56dfe0cbc814@netcologne.de> Date: Sun, 01 Oct 2017 13:41:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.3.0 MIME-Version: 1.0 In-Reply-To: <304c58c9-3c15-380a-a748-2fe4b792d2d1@hotmail.de> Content-Type: multipart/mixed; boundary="------------4B715F673D9E64ADE2A0FED9" X-SW-Source: 2017-10/txt/msg00006.txt.bz2 This is a multi-part message in MIME format. --------------4B715F673D9E64ADE2A0FED9 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-length: 1727 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 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 PR fortran/66756 PR fortran/82378 * gfortran.dg/openmp-close.f90: New test. --------------4B715F673D9E64ADE2A0FED9 Content-Type: text/x-patch; name="p6.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="p6.diff" Content-length: 6115 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; --------------4B715F673D9E64ADE2A0FED9 Content-Type: text/x-fortran; name="openmp-close.f90" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="openmp-close.f90" Content-length: 247 ! { 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 --------------4B715F673D9E64ADE2A0FED9--