diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-05-15 12:52:24 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-05-15 12:52:24 +0200 |
commit | 4169b895e85cd78da39ec821149672567ed6f609 (patch) | |
tree | 04c1eb149f086e71e621f985ba45cbbf1470156a /gcc | |
parent | d1ede5f4d099faee41e60f7709a027ab2b7ac306 (diff) | |
download | gcc-4169b895e85cd78da39ec821149672567ed6f609.zip gcc-4169b895e85cd78da39ec821149672567ed6f609.tar.gz gcc-4169b895e85cd78da39ec821149672567ed6f609.tar.bz2 |
[multiple changes]
2012-05-15 Tristan Gingold <gingold@adacore.com>
* a-exextr.adb: Add comment.
2012-05-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Minor reformatting (remove long dead code).
2012-05-15 Ed Schonberg <schonberg@adacore.com>
* aspects.adb, aspects.ads: Add aspects for Convention, Export,
External_Name, Import, and Link_Name.
* exp_prag.adb (Expand_Pragma_Import_Or_Interface): if the
pragma comes from an aspect specification, the entity is the
first argument.
* sem_prag.adb (Analyze_Pragma, cases Pragma_Export and
Pragma_Import): if the pragma comes from an aspect specification,
the entity is the first argument, and the second has the value
True by default.
* sem_ch13.adb (Analyze_Aspect_Specifications): generate pragam
for aspect Convention. Add placeholders for Link_Name and
External_Name.
From-SVN: r187523
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
-rw-r--r-- | gcc/ada/a-exextr.adb | 8 | ||||
-rw-r--r-- | gcc/ada/aspects.adb | 5 | ||||
-rw-r--r-- | gcc/ada/aspects.ads | 13 | ||||
-rw-r--r-- | gcc/ada/exp_prag.adb | 12 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 24 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 74 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 52 |
8 files changed, 127 insertions, 84 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ec714b0..7ad79d3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2012-05-15 Tristan Gingold <gingold@adacore.com> + + * a-exextr.adb: Add comment. + +2012-05-15 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb: Minor reformatting (remove long dead code). + +2012-05-15 Ed Schonberg <schonberg@adacore.com> + + * aspects.adb, aspects.ads: Add aspects for Convention, Export, + External_Name, Import, and Link_Name. + * exp_prag.adb (Expand_Pragma_Import_Or_Interface): if the + pragma comes from an aspect specification, the entity is the + first argument. + * sem_prag.adb (Analyze_Pragma, cases Pragma_Export and + Pragma_Import): if the pragma comes from an aspect specification, + the entity is the first argument, and the second has the value + True by default. + * sem_ch13.adb (Analyze_Aspect_Specifications): generate pragam + for aspect Convention. Add placeholders for Link_Name and + External_Name. + 2012-05-15 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch9.adb (Expand_N_Asynchronous_Select): Extract the statements diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb index b6ba237..d8f4072 100644 --- a/gcc/ada/a-exextr.adb +++ b/gcc/ada/a-exextr.adb @@ -162,14 +162,14 @@ package body Exception_Traces is ----------------------------------- procedure Unhandled_Exception_Terminate is - - -- Comments needed on why we do things this way ??? (see RH) - Excep : Exception_Occurrence; -- This occurrence will be used to display a message after finalization. -- It is necessary to save a copy here, or else the designated value -- could be overwritten if an exception is raised during finalization - -- (even if that exception is caught). + -- (even if that exception is caught). The occurrence is saved on the + -- stack to avoid dynamic allocation (if this exception is due to lack + -- of space in the heap, we therefore avoid a second failure). We assume + -- that there is enough room on the stack however. begin Save_Occurrence (Excep, Get_Current_Excep.all.all); diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 86e7091..6605b71 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -252,6 +252,7 @@ package body Aspects is Aspect_Component_Size => Aspect_Component_Size, Aspect_Constant_Indexing => Aspect_Constant_Indexing, Aspect_Contract_Case => Aspect_Contract_Case, + Aspect_Convention => Aspect_Convention, Aspect_CPU => Aspect_CPU, Aspect_Default_Component_Value => Aspect_Default_Component_Value, Aspect_Default_Iterator => Aspect_Default_Iterator, @@ -262,9 +263,12 @@ package body Aspects is Aspect_Dispatching_Domain => Aspect_Dispatching_Domain, Aspect_Dynamic_Predicate => Aspect_Predicate, Aspect_Elaborate_Body => Aspect_Elaborate_Body, + Aspect_Export => Aspect_Export, + Aspect_External_Name => Aspect_External_Name, Aspect_External_Tag => Aspect_External_Tag, Aspect_Favor_Top_Level => Aspect_Favor_Top_Level, Aspect_Implicit_Dereference => Aspect_Implicit_Dereference, + Aspect_Import => Aspect_Import, Aspect_Independent => Aspect_Independent, Aspect_Independent_Components => Aspect_Independent_Components, Aspect_Inline => Aspect_Inline, @@ -274,6 +278,7 @@ package body Aspects is Aspect_Interrupt_Priority => Aspect_Interrupt_Priority, Aspect_Invariant => Aspect_Invariant, Aspect_Iterator_Element => Aspect_Iterator_Element, + Aspect_Link_Name => Aspect_Link_Name, Aspect_Lock_Free => Aspect_Lock_Free, Aspect_Machine_Radix => Aspect_Machine_Radix, Aspect_No_Return => Aspect_No_Return, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 523412b..330f72a 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -51,6 +51,7 @@ package Aspects is Aspect_Component_Size, Aspect_Constant_Indexing, Aspect_Contract_Case, -- GNAT + Aspect_Convention, Aspect_CPU, Aspect_Default_Component_Value, Aspect_Default_Iterator, @@ -59,12 +60,14 @@ package Aspects is Aspect_Dimension_System, -- GNAT Aspect_Dispatching_Domain, Aspect_Dynamic_Predicate, + Aspect_External_Name, Aspect_External_Tag, Aspect_Implicit_Dereference, Aspect_Input, Aspect_Interrupt_Priority, Aspect_Invariant, Aspect_Iterator_Element, + Aspect_Link_Name, Aspect_Machine_Radix, Aspect_Object_Size, -- GNAT Aspect_Output, @@ -121,9 +124,11 @@ package Aspects is Aspect_Atomic, Aspect_Atomic_Components, Aspect_Discard_Names, + Aspect_Export, Aspect_Favor_Top_Level, -- GNAT Aspect_Independent, Aspect_Independent_Components, + Aspect_Import, Aspect_Inline, Aspect_Inline_Always, -- GNAT Aspect_Interrupt_Handler, @@ -269,6 +274,7 @@ package Aspects is Aspect_Component_Size => Expression, Aspect_Constant_Indexing => Name, Aspect_Contract_Case => Expression, + Aspect_Convention => Name, Aspect_CPU => Expression, Aspect_Default_Component_Value => Expression, Aspect_Default_Iterator => Name, @@ -277,12 +283,14 @@ package Aspects is Aspect_Dimension_System => Expression, Aspect_Dispatching_Domain => Expression, Aspect_Dynamic_Predicate => Expression, + Aspect_External_Name => Expression, Aspect_External_Tag => Expression, Aspect_Implicit_Dereference => Name, Aspect_Input => Name, Aspect_Interrupt_Priority => Expression, Aspect_Invariant => Expression, Aspect_Iterator_Element => Name, + Aspect_Link_Name => Expression, Aspect_Machine_Radix => Expression, Aspect_Object_Size => Expression, Aspect_Output => Name, @@ -336,6 +344,7 @@ package Aspects is Aspect_Component_Size => Name_Component_Size, Aspect_Constant_Indexing => Name_Constant_Indexing, Aspect_Contract_Case => Name_Contract_Case, + Aspect_Convention => Name_Convention, Aspect_CPU => Name_CPU, Aspect_Default_Iterator => Name_Default_Iterator, Aspect_Default_Value => Name_Default_Value, @@ -346,9 +355,12 @@ package Aspects is Aspect_Dispatching_Domain => Name_Dispatching_Domain, Aspect_Dynamic_Predicate => Name_Dynamic_Predicate, Aspect_Elaborate_Body => Name_Elaborate_Body, + Aspect_External_Name => Name_External_Name, Aspect_External_Tag => Name_External_Tag, + Aspect_Export => Name_Export, Aspect_Favor_Top_Level => Name_Favor_Top_Level, Aspect_Implicit_Dereference => Name_Implicit_Dereference, + Aspect_Import => Name_Import, Aspect_Independent => Name_Independent, Aspect_Independent_Components => Name_Independent_Components, Aspect_Inline => Name_Inline, @@ -358,6 +370,7 @@ package Aspects is Aspect_Interrupt_Priority => Name_Interrupt_Priority, Aspect_Invariant => Name_Invariant, Aspect_Iterator_Element => Name_Iterator_Element, + Aspect_Link_Name => Name_Link_Name, Aspect_Lock_Free => Name_Lock_Free, Aspect_Machine_Radix => Name_Machine_Radix, Aspect_No_Return => Name_No_Return, diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 8cb084d..d283a6e 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -527,10 +527,18 @@ package body Exp_Prag is -- seen (i.e. this elaboration cannot be deferred to the freeze point). procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is - Def_Id : constant Entity_Id := Entity (Arg2 (N)); + Def_Id : Entity_Id; Init_Call : Node_Id; begin + -- If the pragma comes from an aspect, the entity is its first argument. + + if Present (Corresponding_Aspect (N)) then + Def_Id := Entity (Arg1 (N)); + else + Def_Id := Entity (Arg2 (N)); + end if; + if Ekind (Def_Id) = E_Variable then -- Find generated initialization call for object, if any diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6b46b2d..fbbde85 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1168,6 +1168,14 @@ package body Sem_Ch13 is -- the second argument is a local name referring to the entity, -- and the first argument is the aspect definition expression. + when Aspect_Convention => + Aitem := + Make_Pragma (Loc, + Pragma_Argument_Associations => + New_List (Relocate_Node (Expr), Ent), + Pragma_Identifier => + Make_Identifier (Sloc (Id), Chars (Id))); + when Aspect_Warnings => -- Construct the pragma @@ -1562,6 +1570,13 @@ package body Sem_Ch13 is Analyze_Aspect_Dimension_System (N, Id, Expr); goto Continue; + -- Placeholders for new aspects without corresponding pragmas + + when Aspect_External_Name => + null; + + when Aspect_Link_Name => + null; end case; -- If a delay is required, we delay the freeze (not much point in @@ -6199,6 +6214,9 @@ package body Sem_Ch13 is when Aspect_Attach_Handler => T := RTE (RE_Interrupt_ID); + when Aspect_Convention => + null; + -- Default_Value is resolved with the type entity in question when Aspect_Default_Value => @@ -6226,6 +6244,12 @@ package body Sem_Ch13 is when Aspect_External_Tag => T := Standard_String; + when Aspect_External_Name => + T := Standard_String; + + when Aspect_Link_Name => + T := Standard_String; + when Aspect_Priority | Aspect_Interrupt_Priority => T := Standard_Integer; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 233d5ff..e6f3c4c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3592,80 +3592,6 @@ package body Sem_Ch3 is else Validate_Controlled_Object (Id); end if; - - -- Generate a warning when an initialization causes an obvious ABE - -- violation. If the init expression is a simple aggregate there - -- shouldn't be any initialize/adjust call generated. This will be - -- true as soon as aggregates are built in place when possible. - - -- ??? at the moment we do not generate warnings for temporaries - -- created for those aggregates although Program_Error might be - -- generated if compiled with -gnato. - - if Is_Controlled (Etype (Id)) - and then Comes_From_Source (Id) - then - declare - BT : constant Entity_Id := Base_Type (Etype (Id)); - - Implicit_Call : Entity_Id; - pragma Warnings (Off, Implicit_Call); - -- ??? what is this for (never referenced!) - - function Is_Aggr (N : Node_Id) return Boolean; - -- Check that N is an aggregate - - ------------- - -- Is_Aggr -- - ------------- - - function Is_Aggr (N : Node_Id) return Boolean is - begin - case Nkind (Original_Node (N)) is - when N_Aggregate | N_Extension_Aggregate => - return True; - - when N_Qualified_Expression | - N_Type_Conversion | - N_Unchecked_Type_Conversion => - return Is_Aggr (Expression (Original_Node (N))); - - when others => - return False; - end case; - end Is_Aggr; - - begin - -- If no underlying type, we already are in an error situation. - -- Do not try to add a warning since we do not have access to - -- prim-op list. - - if No (Underlying_Type (BT)) then - Implicit_Call := Empty; - - -- A generic type does not have usable primitive operators. - -- Initialization calls are built for instances. - - elsif Is_Generic_Type (BT) then - Implicit_Call := Empty; - - -- If the init expression is not an aggregate, an adjust call - -- will be generated - - elsif Present (E) and then not Is_Aggr (E) then - Implicit_Call := Find_Prim_Op (BT, Name_Adjust); - - -- If no init expression and we are not in the deferred - -- constant case, an Initialize call will be generated - - elsif No (E) and then not Constant_Present (N) then - Implicit_Call := Find_Prim_Op (BT, Name_Initialize); - - else - Implicit_Call := Empty; - end if; - end; - end if; end if; if Has_Task (Etype (Id)) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 1cd3590..28bb574 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8633,7 +8633,30 @@ package body Sem_Prag is Name_Entity, Name_External_Name, Name_Link_Name)); - Check_At_Least_N_Arguments (2); + + if Present (Corresponding_Aspect (N)) then + + -- If the pragma comes from an Aspect, there is a single entity + -- parameter and an optional booean value with default true. + -- The convention must be provided by a separate aspect. + + Check_At_Least_N_Arguments (1); + Check_At_Most_N_Arguments (2); + Def_Id := Entity (Arg1); + + if No (Arg2) then + + -- If the aspect has a default True value, set corresponding + -- flag on the entity. + + Set_Is_Exported (Def_Id); + end if; + return; + + else + Check_At_Least_N_Arguments (2); + end if; + Check_At_Most_N_Arguments (4); Process_Convention (C, Def_Id); @@ -9566,9 +9589,30 @@ package body Sem_Prag is Name_Entity, Name_External_Name, Name_Link_Name)); - Check_At_Least_N_Arguments (2); - Check_At_Most_N_Arguments (4); - Process_Import_Or_Interface; + + if Present (Corresponding_Aspect (N)) then + + -- If the pragma comes from an Aspect, there is a single entity + -- parameter and an optional booean value with default true. + -- The convention must be provided by a separate aspect. + + Check_At_Least_N_Arguments (1); + Check_At_Most_N_Arguments (2); + + if No (Arg2) then + + -- If the aspect has a default True value, set corresponding + -- flag on the entity. + + Set_Is_Imported (Entity (Arg1)); + end if; + return; + + else + Check_At_Least_N_Arguments (2); + Check_At_Most_N_Arguments (4); + Process_Import_Or_Interface; + end if; ---------------------- -- Import_Exception -- |