From 11700d5713d3d7f654882af03d39e73f491b309d Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 4 Nov 2011 13:55:34 +0000 Subject: [PATCH] 2011-11-04 Gary Dismukes * bindgen.adb (Gen_Elab_Calls): In the case of the AAMP target, set elaboration entities to 1 rather than incrementing. 2011-11-04 Ed Schonberg * sem_ch10.adb (Install_Limited_With_Unit): To establish the proper entities on the ancestors of a child unit that appear in a limited_with clause, follow the unit links because the units are not analyzed and scope information is incomplete. 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. 2011-11-04 Bob Duff * g-excact.adb: Minor: use named notation. 2011-11-04 Ed Schonberg * sem_ch5.adb: Improve error messages for illegal iterators. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180952 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 29 ++++++++++++++++++++++++++++ gcc/ada/bindgen.adb | 54 ++++++++++++++++++++++++++++++++++++++-------------- gcc/ada/exp_ch4.adb | 45 +++++++++++++++++++++++++++++++++++-------- gcc/ada/exp_util.adb | 30 ++++++++++++++++++++++------- gcc/ada/g-excact.adb | 4 ++-- gcc/ada/sem_ch10.adb | 8 ++++++-- gcc/ada/sem_ch5.adb | 27 ++++++++++++++++++++------ 7 files changed, 158 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 392c0b19f8c..41bd2b67269 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2011-11-04 Gary Dismukes + + * bindgen.adb (Gen_Elab_Calls): In the case + of the AAMP target, set elaboration entities to 1 rather than + incrementing. + +2011-11-04 Ed Schonberg + + * sem_ch10.adb (Install_Limited_With_Unit): To establish the + proper entities on the ancestors of a child unit that appear + in a limited_with clause, follow the unit links because the + units are not analyzed and scope information is incomplete. + +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. + +2011-11-04 Bob Duff + + * g-excact.adb: Minor: use named notation. + +2011-11-04 Ed Schonberg + + * sem_ch5.adb: Improve error messages for illegal iterators. + 2011-11-04 Hristian Kirtchev * exp_alfa.adb: Add with and use clauses for Exp_Ch8 and diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index e99d8753a9e..a4b7d394deb 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -1060,18 +1060,31 @@ package body Bindgen is then Set_String (" E"); Set_Unit_Number (Unum_Spec); - Set_String (" := E"); - Set_Unit_Number (Unum_Spec); - Set_String (" + 1;"); + + -- The AAMP target has no notion of shared libraries, and + -- there's no possibility of reelaboration, so we treat the + -- the elaboration var as a flag instead of a counter and + -- simply set it. + + if AAMP_On_Target then + Set_String (" := 1;"); + + -- Otherwise (normal case), increment elaboration counter + + else + Set_String (" := E"); + Set_Unit_Number (Unum_Spec); + Set_String (" + 1;"); + end if; + Write_Statement_Buffer; -- In the special case where the target is AAMP and the unit is -- a spec with a body, the elaboration entity is initialized -- here. This is done because it's the only way to accomplish - -- initialization of such entities, because there's not any - -- mechanism provided to initialize global variables at load - -- time on AAMP. (Also note that there is no notion of shared - -- libraries for AAMP, so no possibility of reelaboration.) + -- initialization of such entities, as there is no mechanism + -- provided for initializing global variables at load time on + -- AAMP. elsif AAMP_On_Target and then U.Utype = Is_Spec @@ -1106,10 +1119,9 @@ package body Bindgen is -- In the special case where the target is AAMP and the unit is -- a spec with a body, the elaboration entity is initialized -- here. This is done because it's the only way to accomplish - -- initialization of such entities, because there's not any - -- mechanism provided to initialize global variables at load - -- time on AAMP. (Also note that there is no notion of shared - -- libraries for AAMP, so no possibility of reelaboration.) + -- initialization of such entities, as there is no mechanism + -- provided for initializing global variables at load time on + -- AAMP. if AAMP_On_Target and then U.Utype = Is_Spec @@ -1185,9 +1197,23 @@ package body Bindgen is then Set_String (" E"); Set_Unit_Number (Unum_Spec); - Set_String (" := E"); - Set_Unit_Number (Unum_Spec); - Set_String (" + 1;"); + + -- The AAMP target has no notion of shared libraries, and + -- there's no possibility of reelaboration, so we treat the + -- the elaboration var as a flag instead of a counter and + -- simply set it. + + if AAMP_On_Target then + Set_String (" := 1;"); + + -- Otherwise (normal case), increment elaboration counter + + else + Set_String (" := E"); + Set_Unit_Number (Unum_Spec); + Set_String (" + 1;"); + end if; + Write_Statement_Buffer; end if; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b056d114d17..8f2b86543db 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -8196,15 +8196,44 @@ package body Exp_Ch4 is 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 8281ded0c30..aa33066d9da 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -168,14 +168,30 @@ package body Exp_Util is 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 diff --git a/gcc/ada/g-excact.adb b/gcc/ada/g-excact.adb index 1ba4cf8d64e..ed454cefcde 100644 --- a/gcc/ada/g-excact.adb +++ b/gcc/ada/g-excact.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -97,7 +97,7 @@ package body GNAT.Exception_Actions is function Name_To_Id (Name : String) return Exception_Id is begin - return To_Id (Internal_Exception (Name, False)); + return To_Id (Internal_Exception (Name, Create_If_Not_Exist => False)); end Name_To_Id; --------------------------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 98a57e2556e..34346e39925 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5013,12 +5013,16 @@ package body Sem_Ch10 is -- Set entity of parent identifiers if the unit is a child -- unit. This ensures that the tree is properly formed from - -- semantic point of view (e.g. for ASIS queries). + -- semantic point of view (e.g. for ASIS queries). The unit + -- entities are not fully analyzed, so we need to follow unit + -- links in the tree. Set_Entity (Nam, Ent); Nam := Prefix (Nam); - Ent := Scope (Ent); + Ent := + Defining_Entity + (Unit (Parent_Spec (Unit_Declaration_Node (Ent)))); -- Set entity of last ancestor diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 1b0f919d3ff..2ddf1af53bb 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2429,8 +2429,17 @@ package body Sem_Ch5 is -- The type of the loop variable is the Iterator_Element aspect of -- the container type. - Set_Etype (Def_Id, - Entity (Find_Aspect (Typ, Aspect_Iterator_Element))); + declare + Element : constant Entity_Id := + Find_Aspect (Typ, Aspect_Iterator_Element); + begin + if No (Element) then + Error_Msg_NE ("cannot iterate over&", N, Typ); + return; + else + Set_Etype (Def_Id, Entity (Element)); + end if; + end; else -- For an iteration of the form IN, the name must denote an @@ -2440,12 +2449,18 @@ package body Sem_Ch5 is if Is_Entity_Name (Original_Node (Name (N))) and then not Is_Iterator (Typ) then - Error_Msg_N - ("name must be an iterator, not a container", Name (N)); + if No (Find_Aspect (Typ, Aspect_Iterator_Element)) then + Error_Msg_NE + ("cannot iterate over&", Name (N), Typ); + else + + Error_Msg_N + ("name must be an iterator, not a container", Name (N)); + end if; Error_Msg_NE - ("\to iterate directly over a container, write `of &`", - Name (N), Original_Node (Name (N))); + ("\to iterate directly over the elements of a container, " & + "write `of &`", Name (N), Original_Node (Name (N))); end if; -- The result type of Iterate function is the classwide type of -- 2.11.0