From patchwork Fri Nov 4 13:55:48 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 123641 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 155B0B6F8C for ; Sat, 5 Nov 2011 00:56:15 +1100 (EST) Received: (qmail 20793 invoked by alias); 4 Nov 2011 13:56:14 -0000 Received: (qmail 20782 invoked by uid 22791); 4 Nov 2011 13:56:12 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 04 Nov 2011 13:55:49 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 95FE92BABB3; Fri, 4 Nov 2011 09:55:48 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id MDusg7FAJS+8; Fri, 4 Nov 2011 09:55:48 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 764A02BABA6; Fri, 4 Nov 2011 09:55:48 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 74FE83FEE8; Fri, 4 Nov 2011 09:55:48 -0400 (EDT) Date: Fri, 4 Nov 2011 09:55:48 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Further work on atomic synchronization Message-ID: <20111104135548.GA15218@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This makes the compiler detect one more case needing atomic synchronization, namely a pragma Atomic on a component with a predefined type. And this also excludes a few more cases not needing it. The compiler should issue the warning with -gnatw.n -gnatld7 -gnatj60 on: procedure Synccomp is type R is record I : Integer; pragma Atomic (I); end record; Rec : R; begin Rec.I := 1; end; for Rec.I in the assignment. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-04 Eric Botcazou * exp_ch4.adb (Expand_N_Selected_Component): Refine code setting the Atomic_Sync_Required flag to detect one more case. * exp_util.adb (Activate_Atomic_Synchronization): Refine code setting the Atomic_Sync_Required flag to exclude more cases, depending on the parent of the node to be examined. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 180951) +++ exp_util.adb (working copy) @@ -168,15 +168,31 @@ Msg_Node : Node_Id; begin - -- Nothing to do if we are the prefix of an attribute, since we do not - -- want an atomic sync operation for things like A'Adress or A'Size). - if Nkind (Parent (N)) = N_Attribute_Reference - and then Prefix (Parent (N)) = N - then - return; - end if; + case Nkind (Parent (N)) is + when N_Attribute_Reference | + -- Nothing to do if we are the prefix of an attribute, since we + -- do not want an atomic sync operation for things like 'Size. + + N_Reference | + + -- Likewise for a mere reference + + N_Indexed_Component | + N_Selected_Component | + N_Slice => + + -- The C.6(15) clause says that only reads and updates of the + -- object as a whole require atomic synchronization. + + if Prefix (Parent (N)) = N then + return; + end if; + + when others => null; + end case; + -- Go ahead and set the flag Set_Atomic_Sync_Required (N); Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 180950) +++ exp_ch4.adb (working copy) @@ -8196,15 +8196,44 @@ Analyze (N); end if; - -- If we still have a selected component, and the type is an Atomic - -- type for which Atomic_Sync is enabled, then we set the atomic sync - -- flag on the selector. + -- Set Atomic_Sync_Required if necessary for atomic component - if Nkind (N) = N_Selected_Component - and then Is_Atomic (Etype (N)) - and then not Atomic_Synchronization_Disabled (Etype (N)) - then - Activate_Atomic_Synchronization (N); + if Nkind (N) = N_Selected_Component then + declare + E : constant Entity_Id := Entity (Selector_Name (N)); + Set : Boolean; + + begin + -- If component is atomic, but type is not, setting depends on + -- disable/enable state for the component. + + if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then + Set := not Atomic_Synchronization_Disabled (E); + + -- If component is not atomic, but its type is atomic, setting + -- depends on disable/enable state for the type. + + elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then + Set := not Atomic_Synchronization_Disabled (Etype (E)); + + -- If both component and type are atomic, we disable if either + -- component or its type have sync disabled. + + elsif Is_Atomic (E) and then Is_Atomic (Etype (E)) then + Set := (not Atomic_Synchronization_Disabled (E)) + and then + (not Atomic_Synchronization_Disabled (Etype (E))); + + else + Set := False; + end if; + + -- Set flag if required + + if Set then + Activate_Atomic_Synchronization (N); + end if; + end; end if; end Expand_N_Selected_Component;