aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-01-23 18:03:41 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2014-01-23 18:03:41 +0100
commit19992053df788e3280ae25dc272a43e8384b8db1 (patch)
treef698d9e3c90e8f644532770d9a43ebd40def33db /gcc
parent40f14e9f103d3bcd1216304919b568dd48e471bc (diff)
downloadgcc-19992053df788e3280ae25dc272a43e8384b8db1.zip
gcc-19992053df788e3280ae25dc272a43e8384b8db1.tar.gz
gcc-19992053df788e3280ae25dc272a43e8384b8db1.tar.bz2
[multiple changes]
2014-01-23 Ed Schonberg <schonberg@adacore.com> * exp_util.adb (Make_Invqriant_Call): If type of expression is a private extension, get invariant from base type. 2014-01-23 Robert Dewar <dewar@adacore.com> * sem_util.adb, sem_attr.adb: Minor reformatting. 2014-01-23 Robert Dewar <dewar@adacore.com> * opt.adb (Save_Opt_Config_Switches): Save SPARK_Mode_Pragma (Restore_Opt_Config_Switches): Restore SPARK_Mode_Pragma. * sem.adb (Semantics): Remove save/restore of SPARK_Mode[_Pragma]. Not needed since already done in Save/Restore_Opt_Config_Switches. 2014-01-23 Robert Dewar <dewar@adacore.com> * gnat_rm.texi, einfo.adb, einfo.ads, sem_prag.adb, gnat_ugn.texi, freeze.adb, repinfo.adb, aspects.adb, aspects.ads, sem_ch13.adb: Linker_Section enhancements. From-SVN: r206992
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog23
-rw-r--r--gcc/ada/aspects.adb1
-rw-r--r--gcc/ada/aspects.ads4
-rw-r--r--gcc/ada/einfo.adb22
-rw-r--r--gcc/ada/einfo.ads33
-rw-r--r--gcc/ada/exp_util.adb5
-rw-r--r--gcc/ada/freeze.adb14
-rw-r--r--gcc/ada/gnat_rm.texi34
-rw-r--r--gcc/ada/gnat_ugn.texi7
-rw-r--r--gcc/ada/opt.adb2
-rw-r--r--gcc/ada/repinfo.adb92
-rw-r--r--gcc/ada/sem.adb4
-rw-r--r--gcc/ada/sem_attr.adb5
-rw-r--r--gcc/ada/sem_ch13.adb10
-rw-r--r--gcc/ada/sem_prag.adb82
-rw-r--r--gcc/ada/sem_util.adb85
16 files changed, 318 insertions, 105 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 14be351..ae2480e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2014-01-23 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.adb (Make_Invqriant_Call): If type of expression is
+ a private extension, get invariant from base type.
+
+2014-01-23 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb, sem_attr.adb: Minor reformatting.
+
+2014-01-23 Robert Dewar <dewar@adacore.com>
+
+ * opt.adb (Save_Opt_Config_Switches): Save SPARK_Mode_Pragma
+ (Restore_Opt_Config_Switches): Restore SPARK_Mode_Pragma.
+ * sem.adb (Semantics): Remove save/restore of
+ SPARK_Mode[_Pragma]. Not needed since already done in
+ Save/Restore_Opt_Config_Switches.
+
+2014-01-23 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi, einfo.adb, einfo.ads, sem_prag.adb, gnat_ugn.texi,
+ freeze.adb, repinfo.adb, aspects.adb, aspects.ads, sem_ch13.adb:
+ Linker_Section enhancements.
+
2014-01-23 Tristan Gingold <gingold@adacore.com>
* gnat_rm.texi: Minor editing.
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 64a239a..e3ff78d 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -516,6 +516,7 @@ package body Aspects is
Aspect_Invariant => Aspect_Invariant,
Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_Link_Name => Aspect_Link_Name,
+ Aspect_Linker_Section => Aspect_Linker_Section,
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 c5d7632..5b76f6a 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -103,6 +103,7 @@ package Aspects is
Aspect_Invariant, -- GNAT
Aspect_Iterator_Element,
Aspect_Link_Name,
+ Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Output,
@@ -325,6 +326,7 @@ package Aspects is
Aspect_Invariant => Expression,
Aspect_Iterator_Element => Name,
Aspect_Link_Name => Expression,
+ Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Output => Name,
@@ -420,6 +422,7 @@ package Aspects is
Aspect_Invariant => Name_Invariant,
Aspect_Iterator_Element => Name_Iterator_Element,
Aspect_Link_Name => Name_Link_Name,
+ Aspect_Linker_Section => Name_Linker_Section,
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_No_Return => Name_No_Return,
@@ -624,6 +627,7 @@ package Aspects is
Aspect_Invariant => Always_Delay,
Aspect_Iterator_Element => Always_Delay,
Aspect_Link_Name => Always_Delay,
+ Aspect_Linker_Section => Always_Delay,
Aspect_Lock_Free => Always_Delay,
Aspect_No_Return => Always_Delay,
Aspect_Output => Always_Delay,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 88643b8..e070059 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -249,6 +249,7 @@ package body Einfo is
-- SPARK_Pragma Node32
+ -- Linker_Section_Pragma Node33
-- SPARK_Aux_Pragma Node33
-- Contract Node34
@@ -2387,6 +2388,13 @@ package body Einfo is
return Node23 (Id);
end Limited_View;
+ function Linker_Section_Pragma (Id : E) return N is
+ begin
+ pragma Assert
+ (Is_Type (Id) or else Is_Object (Id) or else Is_Subprogram (Id));
+ return Node33 (Id);
+ end Linker_Section_Pragma;
+
function Lit_Indexes (Id : E) return E is
begin
pragma Assert (Is_Enumeration_Type (Id));
@@ -5095,6 +5103,14 @@ package body Einfo is
Set_Node23 (Id, V);
end Set_Limited_View;
+ procedure Set_Linker_Section_Pragma (Id : E; V : N) is
+ begin
+ pragma Assert (Is_Type (Id)
+ or else Ekind_In (Id, E_Constant, E_Variable)
+ or else Is_Subprogram (Id));
+ Set_Node33 (Id, V);
+ end Set_Linker_Section_Pragma;
+
procedure Set_Lit_Indexes (Id : E; V : E) is
begin
pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
@@ -9453,6 +9469,12 @@ package body Einfo is
E_Package_Body =>
Write_Str ("SPARK_Aux_Pragma");
+ when E_Constant |
+ E_Variable |
+ Subprogram_Kind |
+ Type_Kind =>
+ Write_Str ("Linker_Section_Pragma");
+
when others =>
Write_Str ("Field33??");
end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7599574..e43107b 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1299,6 +1299,10 @@ package Einfo is
-- If any of these items are present, then the flag Has_Gigi_Rep_Item is
-- set, indicating that Gigi should search the chain.
--
+-- Note that in the case of Linker_Section, this is set only for objects,
+-- and only for transitional use until the new Linker_Section_Pragma
+-- field is properly processed by the back end.
+--
-- Other representation items are included in the chain so that error
-- messages can easily locate the relevant nodes for posting errors.
-- Note in particular that size clauses are defined only for this
@@ -1564,6 +1568,10 @@ package Einfo is
-- If this flag is set, then Gigi should scan the rep item chain to
-- process any of these items that appear. At least one such item will
-- be present.
+--
+-- Note that in the case of Linker_Section, this is set only for objects,
+-- and only for transitional use until the new Linker_Section_Pragma
+-- field is properly processed by the back end.
-- Has_Homonym (Flag56)
-- Defined in all entities. Set if an entity has a homonym in the same
@@ -3055,7 +3063,14 @@ package Einfo is
-- fide package with the limited-view list through the first_entity and
-- first_private attributes. The elements of this list are the shadow
-- entities created for the types and local packages that are declared
--- in a package appearing in a limited_with clause (Ada 2005: AI-50217)
+-- in a package appearing in a limited_with clause (Ada 2005: AI-50217).
+
+-- Linker_Section_Pragma (Node33)
+-- Present in constant, variable, type and subprogram entities. Points
+-- to a linker section pragma that applies to the entity, or is Empty if
+-- no such pragma applies. Note that for constants and variables, this
+-- field may be set as a result of a linker section pragma applied to the
+-- type of the object.
-- Lit_Indexes (Node15)
-- Defined in enumeration types and subtypes. Non-empty only for the
@@ -3906,9 +3921,9 @@ package Einfo is
-- or a copy of the low bound of the index base type if not.
-- Subprograms_For_Type (Node29)
--- Defined in all type entities, and in subprogram entities. This is used
--- to hold a list of subprogram entities for subprograms associated with
--- the type, linked through the Subprogram_List field of the subprogram
+-- Defined in all type and subprogram entities. This is used to hold
+-- a list of subprogram entities for subprograms associated with the
+-- type, linked through the Subprograms_For_Type field of the subprogram
-- entity. Basically this is a way of multiplexing the single field to
-- hold more than one entity (since we ran out of space in some type
-- entities). This is currently used for Invariant_Procedure and also
@@ -5067,6 +5082,7 @@ package Einfo is
-- Related_Expression (Node24)
-- Current_Use_Clause (Node27)
-- Subprograms_For_Type (Node29)
+ -- Linker_Section_Pragma (Node33)
-- Depends_On_Private (Flag14)
-- Discard_Names (Flag88)
@@ -5301,6 +5317,7 @@ package Einfo is
-- Interface_Name (Node21) (constants only)
-- Related_Type (Node27) (constants only)
-- Initialization_Statements (Node28)
+ -- Linker_Section_Pragma (Node33)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
@@ -5480,6 +5497,7 @@ package Einfo is
-- Corresponding_Equality (Node30) (implicit /= only)
-- Thunk_Entity (Node31) (thunk case only)
-- SPARK_Pragma (Node32)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Body_Needed_For_SAL (Flag40)
-- Elaboration_Entity_Required (Flag174)
@@ -5633,6 +5651,7 @@ package Einfo is
-- Last_Entity (Node20)
-- Overridden_Operation (Node26)
-- Subprograms_For_Type (Node29)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Invariants (Flag232)
-- Has_Postconditions (Flag240)
@@ -5767,6 +5786,7 @@ package Einfo is
-- Static_Initialization (Node30) (init_proc only)
-- Thunk_Entity (Node31) (thunk case only)
-- SPARK_Pragma (Node32)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Body_Needed_For_SAL (Flag40)
-- Delay_Cleanups (Flag114)
@@ -6001,6 +6021,7 @@ package Einfo is
-- Last_Assignment (Node26)
-- Related_Type (Node27)
-- Initialization_Statements (Node28)
+ -- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
@@ -6566,6 +6587,7 @@ package Einfo is
function Last_Assignment (Id : E) return N;
function Last_Entity (Id : E) return E;
function Limited_View (Id : E) return E;
+ function Linker_Section_Pragma (Id : E) return N;
function Lit_Indexes (Id : E) return E;
function Lit_Strings (Id : E) return E;
function Low_Bound_Tested (Id : E) return B;
@@ -7192,6 +7214,7 @@ package Einfo is
procedure Set_Last_Assignment (Id : E; V : N);
procedure Set_Last_Entity (Id : E; V : E);
procedure Set_Limited_View (Id : E; V : E);
+ procedure Set_Linker_Section_Pragma (Id : E; V : N);
procedure Set_Lit_Indexes (Id : E; V : E);
procedure Set_Lit_Strings (Id : E; V : E);
procedure Set_Low_Bound_Tested (Id : E; V : B := True);
@@ -7960,6 +7983,7 @@ package Einfo is
pragma Inline (Last_Assignment);
pragma Inline (Last_Entity);
pragma Inline (Limited_View);
+ pragma Inline (Linker_Section_Pragma);
pragma Inline (Lit_Indexes);
pragma Inline (Lit_Strings);
pragma Inline (Low_Bound_Tested);
@@ -8386,6 +8410,7 @@ package Einfo is
pragma Inline (Set_Last_Assignment);
pragma Inline (Set_Last_Entity);
pragma Inline (Set_Limited_View);
+ pragma Inline (Set_Linker_Section_Pragma);
pragma Inline (Set_Lit_Indexes);
pragma Inline (Set_Lit_Strings);
pragma Inline (Set_Low_Bound_Tested);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 1845a3b..f9a5818 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5566,11 +5566,12 @@ package body Exp_Util is
Typ := Etype (Expr);
-- Subtypes may be subject to invariants coming from their respective
- -- base types.
+ -- base types. The subtype may be fully or partially private.
if Ekind_In (Typ, E_Array_Subtype,
E_Private_Subtype,
- E_Record_Subtype)
+ E_Record_Subtype,
+ E_Record_Subtype_With_Private)
then
Typ := Base_Type (Typ);
end if;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 310511f..952ea3f 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2283,7 +2283,6 @@ package body Freeze is
-- Start of processing for Alias_Atomic_Check
begin
-
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
@@ -4046,6 +4045,19 @@ package body Freeze is
Set_Is_Public (E);
end if;
+ -- For source objects that are not Imported and are library
+ -- level, if no linker section pragma was given inherit the
+ -- appropriate linker section from the corresponding type.
+
+ if Comes_From_Source (E)
+ and then not Is_Imported (E)
+ and then Is_Library_Level_Entity (E)
+ and then No (Linker_Section_Pragma (E))
+ then
+ Set_Linker_Section_Pragma
+ (E, Linker_Section_Pragma (Etype (E)));
+ end if;
+
-- For convention C objects of an enumeration type, warn if
-- the size is not integer size and no explicit size given.
-- Skip warning for Boolean, and Character, assume programmer
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 8ad73c5..210ed23 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -294,6 +294,7 @@ Implementation Defined Aspects
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
+* Aspect Linker_Section::
* Aspect Object_Size::
* Aspect Persistent_BSS::
* Aspect Predicate::
@@ -4249,12 +4250,30 @@ pragma Linker_Section (
@end smallexample
@noindent
-@var{LOCAL_NAME} must refer to an object that is
+@var{LOCAL_NAME} must refer to an object, type, or subprogram that is
declared at the library level. This pragma specifies the name of the
linker section for the given entity. It is equivalent to
@code{__attribute__((section))} in GNU C and causes @var{LOCAL_NAME} to
be placed in the @var{static_string_EXPRESSION} section of the
executable (assuming the linker doesn't rename the section).
+GNAT also provides an implementation defined aspect of the same name.
+
+In the case of specifying this aspect for a type, the effect is to
+specify the corresponding for all library level objects of the type which
+do not have an explicit linker section set. Note that this only applies to
+whole objects, not to components of composite objects.
+
+In the case of a subprogram, the linker section applies to all previously
+declared matching overloaded subprograms in the current declarative part
+which do not already have a linker section assigned. The linker section
+aspect is useful in this case for specifying different linker sections
+for different elements of such an overloaded set.
+
+Note that an empty string specifies that no linker section is specified.
+This is not quite the same as omitting the pragma or aspect, since it
+can be used to specify that one element of an overloaded set of subprograms
+has the default linker section, or that one object of a type for which a
+linker section is specified should has the default linker section.
The compiler normally places library-level entities in standard sections
depending on the class: procedures and functions generally go in the
@@ -4283,6 +4302,12 @@ package IO_Card is
Port_B : Integer;
pragma Volatile (Port_B);
pragma Linker_Section (Port_B, ".bss.port_b");
+
+ type Port_Type is new Integer with Linker_Section => ".bss";
+ PA : Port_Type with Linker_Section => ".bss.PA";
+ PB : Port_Type; -- ends up in linker section ".bss"
+
+ procedure Q with Linker_Section => "Qsection";
end IO_Card;
@end smallexample
@@ -7631,6 +7656,7 @@ clause.
* Aspect Initializes::
* Aspect Inline_Always::
* Aspect Invariant::
+* Aspect Linker_Section::
* Aspect Lock_Free::
* Aspect Object_Size::
* Aspect Persistent_BSS::
@@ -7824,6 +7850,12 @@ This aspect is equivalent to pragma @code{Invariant}. It is a
synonym for the language defined aspect @code{Type_Invariant} except
that it is separately controllable using pragma @code{Assertion_Policy}.
+@node Aspect Linker_Section
+@unnumberedsec Aspect Linker_Section
+@findex Linker_Section
+@noindent
+This aspect is equivalent to an @code{Linker_Section} pragma.
+
@node Aspect Lock_Free
@unnumberedsec Aspect Lock_Free
@findex Lock_Free
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index ca9209c..11286ef 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -7430,7 +7430,12 @@ the @option{-gnatR} switch). For @option{-gnatR1} (which is the default,
so @option{-gnatR} with no parameter has the same effect), size and alignment
information is listed for declared array and record types. For
@option{-gnatR2}, size and alignment information is listed for all
-declared types and objects. Finally @option{-gnatR3} includes symbolic
+declared types and objects. The @code{Linker_Section} is also listed for any
+entity for which the @code{Linker_Section} is set explicitly or implicitly (the
+latter case occurs for objects of a type for which a @code{Linker_Section}
+is set).
+
+Finally @option{-gnatR3} includes symbolic
expressions for values that are computed at run time for
variant records. These symbolic expressions have a mostly obvious
format with #n being used to represent the value of the n'th
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index 636829c..20ecb4f5 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -100,6 +100,7 @@ package body Opt is
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
SPARK_Mode := Save.SPARK_Mode;
+ SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
Use_VADS_Size := Save.Use_VADS_Size;
-- Update consistently the value of Init_Or_Norm_Scalars. The value of
@@ -137,6 +138,7 @@ package body Opt is
Save.Polling_Required := Polling_Required;
Save.Short_Descriptors := Short_Descriptors;
Save.SPARK_Mode := SPARK_Mode;
+ Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
Save.Use_VADS_Size := Use_VADS_Size;
end Save_Opt_Config_Switches;
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index a907c7b..11b92e6 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -36,6 +36,7 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Lib; use Lib;
with Namet; use Namet;
+with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
with Sem_Aux; use Sem_Aux;
@@ -43,6 +44,7 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
+with Stringt; use Stringt;
with Table; use Table;
with Uname; use Uname;
with Urealp; use Urealp;
@@ -147,6 +149,10 @@ package body Repinfo is
procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
-- List representation info for array type Ent
+ procedure List_Linker_Section (Ent : Entity_Id);
+ -- List linker section for Ent (caller has checked that Ent is an entity
+ -- for which the Linker_Section_Pragma field is defined).
+
procedure List_Mechanisms (Ent : Entity_Id);
-- List mechanism information for parameters of Ent, which is subprogram,
-- subprogram type, or an entry or entry family.
@@ -352,8 +358,8 @@ package body Repinfo is
if List_Representation_Info_Mechanisms
and then (Is_Subprogram (Ent)
- or else Ekind (Ent) = E_Entry
- or else Ekind (Ent) = E_Entry_Family)
+ or else Ekind (Ent) = E_Entry
+ or else Ekind (Ent) = E_Entry_Family)
then
Need_Blank_Line := True;
List_Mechanisms (Ent);
@@ -374,13 +380,16 @@ package body Repinfo is
and then Present (Full_View (E))))
or else Debug_Flag_AA
then
- if Is_Subprogram (E)
- or else
- Ekind (E) = E_Entry
- or else
- Ekind (E) = E_Entry_Family
- or else
- Ekind (E) = E_Subprogram_Type
+ if Is_Subprogram (E) then
+ List_Linker_Section (E);
+
+ if List_Representation_Info_Mechanisms then
+ List_Mechanisms (E);
+ end if;
+
+ elsif Ekind_In (E, E_Entry,
+ E_Entry_Family,
+ E_Subprogram_Type)
then
if List_Representation_Info_Mechanisms then
List_Mechanisms (E);
@@ -391,24 +400,28 @@ package body Repinfo is
List_Record_Info (E, Bytes_Big_Endian);
end if;
+ List_Linker_Section (E);
+
elsif Is_Array_Type (E) then
if List_Representation_Info >= 1 then
List_Array_Info (E, Bytes_Big_Endian);
end if;
+ List_Linker_Section (E);
+
elsif Is_Type (E) then
if List_Representation_Info >= 2 then
List_Type_Info (E);
+ List_Linker_Section (E);
end if;
- elsif Ekind (E) = E_Variable
- or else
- Ekind (E) = E_Constant
- or else
- Ekind (E) = E_Loop_Parameter
- or else
- Is_Formal (E)
- then
+ elsif Ekind_In (E, E_Variable, E_Constant) then
+ if List_Representation_Info >= 2 then
+ List_Object_Info (E);
+ List_Linker_Section (E);
+ end if;
+
+ elsif Ekind (E) = E_Loop_Parameter or else Is_Formal (E) then
if List_Representation_Info >= 2 then
List_Object_Info (E);
end if;
@@ -425,17 +438,12 @@ package body Repinfo is
-- Recurse into bodies
- elsif Ekind (E) = E_Protected_Type
- or else
- Ekind (E) = E_Task_Type
- or else
- Ekind (E) = E_Subprogram_Body
- or else
- Ekind (E) = E_Package_Body
- or else
- Ekind (E) = E_Task_Body
- or else
- Ekind (E) = E_Protected_Body
+ elsif Ekind_In (E, E_Protected_Type,
+ E_Task_Type,
+ E_Subprogram_Body,
+ E_Package_Body,
+ E_Task_Body,
+ E_Protected_Body)
then
List_Entities (E, Bytes_Big_Endian);
@@ -633,6 +641,34 @@ package body Repinfo is
end if;
end List_GCC_Expression;
+ -------------------------
+ -- List_Linker_Section --
+ -------------------------
+
+ procedure List_Linker_Section (Ent : Entity_Id) is
+ Arg : Node_Id;
+
+ begin
+ if Present (Linker_Section_Pragma (Ent)) then
+ Write_Str ("pragma Linker_Section (");
+ List_Name (Ent);
+ Write_Str (", """);
+
+ Arg :=
+ Last (Pragma_Argument_Associations (Linker_Section_Pragma (Ent)));
+
+ if Nkind (Arg) = N_Pragma_Argument_Association then
+ Arg := Expression (Arg);
+ end if;
+
+ pragma Assert (Nkind (Arg) = N_String_Literal);
+ String_To_Name_Buffer (Strval (Arg));
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Str (""");");
+ Write_Eol;
+ end if;
+ end List_Linker_Section;
+
---------------------
-- List_Mechanisms --
---------------------
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index db462a4..b6eb3fe 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1311,8 +1311,6 @@ package body Sem is
S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
S_Style_Check : constant Boolean := Style_Check;
- S_SPARK_Mode : constant SPARK_Mode_Type := SPARK_Mode;
- S_SPARK_Mode_Pragma : constant Node_Id := SPARK_Mode_Pragma;
Generic_Main : constant Boolean :=
Nkind (Unit (Cunit (Main_Unit)))
@@ -1512,8 +1510,6 @@ package body Sem is
Inside_A_Generic := S_Inside_A_Generic;
Outer_Generic_Scope := S_Outer_Gen_Scope;
Style_Check := S_Style_Check;
- SPARK_Mode := S_SPARK_Mode;
- SPARK_Mode_Pragma := S_SPARK_Mode_Pragma;
Restore_Opt_Config_Switches (Save_Config_Switches);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 413be90..1ce0d83 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4525,8 +4525,9 @@ package body Sem_Attr is
and then Is_Potentially_Unevaluated (N)
and then not Is_Entity_Name (P)
then
- Error_Msg_N ("prefix that is potentially unevaluated must "
- & "denote an entity", N);
+ Error_Msg_N
+ ("prefix that is potentially unevaluated must denote an entity",
+ N);
end if;
-- The attribute appears within a pre/postcondition, but refers to
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index dbfc215..9c1c698 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1633,10 +1633,11 @@ package body Sem_Ch13 is
-- referring to the entity, and the second argument is the
-- aspect definition expression.
- -- Suppress/Unsuppress
+ -- Linker_Section/Suppress/Unsuppress
- when Aspect_Suppress |
- Aspect_Unsuppress =>
+ when Aspect_Linker_Section |
+ Aspect_Suppress |
+ Aspect_Unsuppress =>
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
@@ -7941,6 +7942,9 @@ package body Sem_Ch13 is
Aspect_Value_Size =>
T := Any_Integer;
+ when Aspect_Linker_Section =>
+ T := Standard_String;
+
when Aspect_Synchronization =>
return;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1a847fd..cffae57 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15545,7 +15545,11 @@ package body Sem_Prag is
-- [Entity =>] LOCAL_NAME
-- [Section =>] static_string_EXPRESSION);
- when Pragma_Linker_Section =>
+ when Pragma_Linker_Section => Linker_Section : declare
+ Arg : Node_Id;
+ Ent : Entity_Id;
+
+ begin
GNAT_Pragma;
Check_Arg_Order ((Name_Entity, Name_Section));
Check_Arg_Count (2);
@@ -15554,25 +15558,69 @@ package body Sem_Prag is
Check_Arg_Is_Library_Level_Local_Name (Arg1);
Check_Arg_Is_Static_Expression (Arg2, Standard_String);
- -- This pragma applies to objects and types
+ -- Check kind of entity
- if not Is_Object (Entity (Get_Pragma_Arg (Arg1)))
- and then not Is_Type (Entity (Get_Pragma_Arg (Arg1)))
- then
- Error_Pragma_Arg
- ("pragma% applies only to objects and types", Arg1);
- end if;
+ Arg := Get_Pragma_Arg (Arg1);
+ Ent := Entity (Arg);
- -- The only processing required is to link this item on to the
- -- list of rep items for the given entity. This is accomplished
- -- by the call to Rep_Item_Too_Late (when no error is detected
- -- and False is returned).
+ case Ekind (Ent) is
- if Rep_Item_Too_Late (Entity (Get_Pragma_Arg (Arg1)), N) then
- return;
- else
- Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
- end if;
+ -- Objects (constants and variables)
+
+ when E_Constant | E_Variable =>
+ Set_Linker_Section_Pragma (Ent, N);
+
+ -- For now, for objects, we also link onto the rep item
+ -- chain and set the gigi rep item flag. This is here for
+ -- transition purposes only. When the processing for the
+ -- Linker_Section_Pragma field is completed, this can be
+ -- removed, since it will no longer be used.
+
+ -- This is accomplished by the call to Rep_Item_Too_Late
+ -- (when no error is detected and False is returned).
+
+ if not Rep_Item_Too_Late (Ent, N) then
+ Set_Has_Gigi_Rep_Item (Ent);
+ end if;
+
+ -- Types
+
+ when Type_Kind =>
+ Set_Linker_Section_Pragma (Ent, N);
+
+ -- Subprograms
+
+ when Subprogram_Kind =>
+
+ -- Aspect case, entity already set
+
+ if From_Aspect_Specification (N) then
+ Set_Linker_Section_Pragma
+ (Entity (Corresponding_Aspect (N)), N);
+
+ -- Pragma case, we must climb the homonym chain, but skip
+ -- any for which the linker section is already set.
+
+ else
+ loop
+ if No (Linker_Section_Pragma (Ent)) then
+ Set_Linker_Section_Pragma (Ent, N);
+ end if;
+
+ Ent := Homonym (Ent);
+ exit when No (Ent)
+ or else Scope (Ent) /= Current_Scope;
+ end loop;
+ end if;
+
+ -- All other cases are illegal
+
+ when others =>
+ Error_Pragma_Arg
+ ("pragma% applies only to objects, subprograms, and types",
+ Arg1);
+ end case;
+ end Linker_Section;
----------
-- List --
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a315e5d..be59c9b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10249,48 +10249,6 @@ package body Sem_Util is
end if;
end Is_Partially_Initialized_Type;
- --------------------------------
- -- Is_Potentially_Unevaluated --
- --------------------------------
-
- function Is_Potentially_Unevaluated (N : Node_Id) return Boolean is
- Par : Node_Id;
- Expr : Node_Id;
-
- begin
- Expr := N;
- Par := Parent (N);
- while not Nkind_In (Par, N_If_Expression,
- N_Case_Expression,
- N_And_Then,
- N_Or_Else,
- N_In,
- N_Not_In)
- loop
- Expr := Par;
- Par := Parent (Par);
- if Nkind (Par) not in N_Subexpr then
- return False;
- end if;
- end loop;
-
- if Nkind (Par) = N_If_Expression then
- return Is_Elsif (Par) or else Expr /= First (Expressions (Par));
-
- elsif Nkind (Par) = N_Case_Expression then
- return Expr /= Expression (Par);
-
- elsif Nkind_In (Par, N_And_Then, N_Or_Else) then
- return Expr = Right_Opnd (Par);
-
- elsif Nkind_In (Par, N_In, N_Not_In) then
- return Expr /= Left_Opnd (Par);
-
- else
- return False;
- end if;
- end Is_Potentially_Unevaluated;
-
------------------------------------
-- Is_Potentially_Persistent_Type --
------------------------------------
@@ -10355,6 +10313,49 @@ package body Sem_Util is
end if;
end Is_Potentially_Persistent_Type;
+ --------------------------------
+ -- Is_Potentially_Unevaluated --
+ --------------------------------
+
+ function Is_Potentially_Unevaluated (N : Node_Id) return Boolean is
+ Par : Node_Id;
+ Expr : Node_Id;
+
+ begin
+ Expr := N;
+ Par := Parent (N);
+ while not Nkind_In (Par, N_If_Expression,
+ N_Case_Expression,
+ N_And_Then,
+ N_Or_Else,
+ N_In,
+ N_Not_In)
+ loop
+ Expr := Par;
+ Par := Parent (Par);
+
+ if Nkind (Par) not in N_Subexpr then
+ return False;
+ end if;
+ end loop;
+
+ if Nkind (Par) = N_If_Expression then
+ return Is_Elsif (Par) or else Expr /= First (Expressions (Par));
+
+ elsif Nkind (Par) = N_Case_Expression then
+ return Expr /= Expression (Par);
+
+ elsif Nkind_In (Par, N_And_Then, N_Or_Else) then
+ return Expr = Right_Opnd (Par);
+
+ elsif Nkind_In (Par, N_In, N_Not_In) then
+ return Expr /= Left_Opnd (Par);
+
+ else
+ return False;
+ end if;
+ end Is_Potentially_Unevaluated;
+
---------------------------------
-- Is_Protected_Self_Reference --
---------------------------------