Skip to content

R
riscv-gcc-1
Commit 4169b895 by Arnaud Charlet
Options

[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
parent d1ede5f4
Showing with 123 additions and 80 deletions
gcc/ada/ChangeLog
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
......
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);
......
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,
......
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,
......
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
......
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;
......
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
......
gcc/ada/sem_prag.adb
......@@ -8633,7 +8633,30 @@ package body Sem_Prag is
Name_Entity,
Name_External_Name,
Name_Link_Name));
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));
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 --
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment