From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 9117 invoked by alias); 4 Nov 2011 13:39:38 -0000 Received: (qmail 9107 invoked by uid 22791); 4 Nov 2011 13:39:36 -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:39:17 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 732B12BB538; Fri, 4 Nov 2011 09:39:16 -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 n6G+jAac2j8C; Fri, 4 Nov 2011 09:39:16 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 5454C2BB4DE; Fri, 4 Nov 2011 09:39:16 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 45FD03FEE8; Fri, 4 Nov 2011 09:39:16 -0400 (EDT) Date: Fri, 04 Nov 2011 13:44:00 -0000 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Extend atomic synchronization handling to selections Message-ID: <20111104133916.GA2605@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="BXVAT5kNtrzKuDFl" 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-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2011-11/txt/msg00551.txt.bz2 --BXVAT5kNtrzKuDFl Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 893 This patch extends atomic synchronization to selected components and explicit dereferences when the result is a type for which atomic sync is enabled. Also it handles the case of an indexed selection from an array with atomic components. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-04 Robert Dewar * exp_ch2.adb (Expand_Entity_Reference): Do not set Atomic_Sync_Required for the case of a prefix of an attribute. * exp_ch4.adb (Expand_N_Explicit_Dereference): May require atomic synchronization (Expand_N_Indexed_Component): Ditto. (Expand_B_Selected_Component): Ditto. * sem_prag.adb (Process_Suppress_Unsuppress): Disable/Enable_Atomic_Synchronization can now occur for array types with pragma Atomic_Components. * sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now occur on N_Explicit_Dereference nodes and on N_Indexed_Component nodes. --BXVAT5kNtrzKuDFl Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 8000 Index: sinfo.adb =================================================================== --- sinfo.adb (revision 180934) +++ sinfo.adb (working copy) @@ -254,7 +254,9 @@ begin pragma Assert (False or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier); + or else NT (N).Nkind = N_Explicit_Dereference + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Indexed_Component); return Flag14 (N); end Atomic_Sync_Required; @@ -3323,7 +3325,9 @@ begin pragma Assert (False or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier); + or else NT (N).Nkind = N_Explicit_Dereference + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Indexed_Component); Set_Flag14 (N, Val); end Set_Atomic_Sync_Required; Index: sinfo.ads =================================================================== --- sinfo.ads (revision 180934) +++ sinfo.ads (working copy) @@ -609,7 +609,13 @@ -- This flag is set in an identifier or expanded name node if the -- corresponding reference (or assignment when on the left side of -- an assignment) requires atomic synchronization, as a result of - -- Atomic_Synchronization being enabled for the corresponding entity. + -- Atomic_Synchronization being enabled for the corresponding entity + -- or its type. Also set for Selector_Name of an N_Selected Component + -- node if the type is atomic and requires atomic synchronization. + -- Also set on an N_Explicit Dereference node if the resulting type + -- is atomic and requires atomic synchronization. Finally it is set + -- on an N_Indexed_Component node if the resulting type is Atomic, or + -- if the array type or the array has pragma Atomic_Components set. -- At_End_Proc (Node1) -- This field is present in an N_Handled_Sequence_Of_Statements node. @@ -3175,6 +3181,7 @@ -- Sloc points to ALL -- Prefix (Node3) -- Actual_Designated_Subtype (Node4-Sem) + -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression ------------------------------- @@ -3197,6 +3204,7 @@ -- Sloc contains a copy of the Sloc value of the Prefix -- Prefix (Node3) -- Expressions (List1) + -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression -- Note: if any of the subscripts requires a range check, then the Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 180939) +++ sem_prag.adb (working copy) @@ -5462,7 +5462,7 @@ -- a non-atomic variable. if C = Atomic_Synchronization - and then not Is_Atomic (E) + and then not (Is_Atomic (E) or else Has_Atomic_Components (E)) then Error_Msg_N ("pragma & requires atomic type or variable", Index: exp_ch2.adb =================================================================== --- exp_ch2.adb (revision 180939) +++ exp_ch2.adb (working copy) @@ -404,6 +404,15 @@ if Nkind_In (N, N_Identifier, N_Expanded_Name) and then Ekind (E) = E_Variable and then (Is_Atomic (E) or else Is_Atomic (Etype (E))) + + -- Don't go setting the flag for the prefix of an attribute because + -- we don't want atomic sync for X'Size, X'Access etc. + + -- Is this right in all cases of attributes??? + -- Are there other exemptions required ??? + + and then (Nkind (Parent (N)) /= N_Attribute_Reference + or else Prefix (Parent (N)) /= N) then declare Set : Boolean; @@ -444,6 +453,7 @@ -- Set flag if required if Set then + Set_Atomic_Sync_Required (N); -- Generate info message if requested @@ -457,8 +467,6 @@ Error_Msg_N ("?info: atomic synchronization set for &", MLoc); end if; - - Set_Atomic_Sync_Required (N); end if; end; end if; Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 180934) +++ exp_ch4.adb (working copy) @@ -591,8 +591,7 @@ -- 1) Get access to the allocated object Rewrite (N, - Make_Explicit_Dereference (Loc, - Relocate_Node (N))); + Make_Explicit_Dereference (Loc, Relocate_Node (N))); Set_Etype (N, Etyp); Set_Analyzed (N); @@ -4472,6 +4471,21 @@ -- Insert explicit dereference call for the checked storage pool case Insert_Dereference_Action (Prefix (N)); + + -- If the type is an Atomic type for which Atomic_Sync is enabled, then + -- we set the atomic sync flag. + + if Is_Atomic (Etype (N)) + and then not Atomic_Synchronization_Disabled (Etype (N)) + then + Set_Atomic_Sync_Required (N); + + -- Generate info message if requested + + if Warn_On_Atomic_Synchronization then + Error_Msg_N ("?info: atomic synchronization set", N); + end if; + end if; end Expand_N_Explicit_Dereference; -------------------------------------- @@ -5245,6 +5259,7 @@ Typ : constant Entity_Id := Etype (N); P : constant Node_Id := Prefix (N); T : constant Entity_Id := Etype (P); + Atp : Entity_Id; begin -- A special optimization, if we have an indexed component that is @@ -5290,6 +5305,9 @@ if Is_Access_Type (T) then Insert_Explicit_Dereference (P); Analyze_And_Resolve (P, Designated_Type (T)); + Atp := Designated_Type (T); + else + Atp := T; end if; -- Generate index and validity checks @@ -5300,6 +5318,23 @@ Apply_Subscript_Validity_Checks (N); end if; + -- If selecting from an array with atomic components, and atomic sync + -- is not suppressed for this array type, set atomic sync flag. + + if (Has_Atomic_Components (Atp) + and then not Atomic_Synchronization_Disabled (Atp)) + or else (Is_Atomic (Typ) + and then not Atomic_Synchronization_Disabled (Typ)) + then + Set_Atomic_Sync_Required (N); + + -- Generate info message if requested + + if Warn_On_Atomic_Synchronization then + Error_Msg_N ("?info: atomic synchronization set", N); + end if; + end if; + -- All done for the non-packed case if not Is_Packed (Etype (Prefix (N))) then @@ -7869,9 +7904,6 @@ -- Expand_N_Selected_Component -- --------------------------------- - -- If the selector is a discriminant of a concurrent object, rewrite the - -- prefix to denote the corresponding record type. - procedure Expand_N_Selected_Component (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Par : constant Node_Id := Parent (N); @@ -8175,6 +8207,24 @@ Rewrite (N, New_N); 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. + + if Nkind (N) = N_Selected_Component + and then Is_Atomic (Etype (N)) + and then not Atomic_Synchronization_Disabled (Etype (N)) + then + Set_Atomic_Sync_Required (Selector_Name (N)); + + -- Generate info message if requested + + if Warn_On_Atomic_Synchronization then + Error_Msg_N + ("?info: atomic synchronization set for &", Selector_Name (N)); + end if; + end if; end Expand_N_Selected_Component; -------------------- --BXVAT5kNtrzKuDFl--