[multiple changes]

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* get_scos.adb: Ignore chaining indicators not currently supported
	by Ada.

2011-08-29  Arnaud Charlet  <charlet@adacore.com>

	* system.ads: Minor editing.

2011-08-29  Arnaud Charlet  <charlet@adacore.com>

	* bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in
	CodePeer mode.
	* sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of
	Attribute_Elab_Subp_Body.
	* snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New.
	* sem_util.adb: Update comments.

From-SVN: r178165

10 files changed, 81 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 971cb8f1..e888dab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,23 @@
 2011-08-29  Thomas Quinot  <quinot@adacore.com>
 
+	* get_scos.adb: Ignore chaining indicators not currently supported
+	by Ada.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* system.ads: Minor editing.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in
+	CodePeer mode.
+	* sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of
+	Attribute_Elab_Subp_Body.
+	* snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New.
+	* sem_util.adb: Update comments.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
 	* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
 	pragma name for each SCO statement corresponding to a pragma.
 
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 78c077c..6e0d5bd 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -984,7 +984,12 @@ package body Bindgen is
 
             --  Case of no elaboration code
 
-            elsif U.No_Elab then
+            elsif U.No_Elab
+              and then (not CodePeer_Mode
+                        or else U.Utype = Is_Spec
+                        or else U.Utype = Is_Spec_Only
+                        or else U.Unit_Kind /= 's')
+            then
 
                --  The only case in which we have to do something is if this
                --  is a body, with a separate spec, where the separate spec
@@ -1019,10 +1024,7 @@ package body Bindgen is
             --  The uname_E increment is skipped if this is a separate spec,
             --  since it will be done when we process the body.
 
-            --  Ignore subprograms in CodePeer mode, since no useful
-            --  elaboration subprogram is needed by CodePeer.
-
-            elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then
+            else
                Check_Elab_Flag :=
                  not CodePeer_Mode
                    and then (Force_Checking_Of_Elaboration_Flags
@@ -1055,12 +1057,18 @@ package body Bindgen is
                   if Name_Buffer (Name_Len) = 's' then
                      Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
                        "'elab_spec";
+                     Name_Len := Name_Len + 8;
+
+                  elsif U.Unit_Kind = 's' and CodePeer_Mode then
+                     Name_Buffer (Name_Len - 1 .. Name_Len + 13) :=
+                       "'elab_subp_body";
+                     Name_Len := Name_Len + 13;
+
                   else
                      Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
                        "'elab_body";
+                     Name_Len := Name_Len + 8;
                   end if;
-
-                  Name_Len := Name_Len + 8;
                end if;
 
                Set_Casing (U.Icasing);
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index c6d396d..21703d8 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1813,13 +1813,14 @@ package body Exp_Attr is
       --  and then the Elab_Body/Spec attribute is replaced by a reference
       --  to this defining identifier.
 
-      when Attribute_Elab_Body |
-           Attribute_Elab_Spec =>
+      when Attribute_Elab_Body      |
+           Attribute_Elab_Subp_Body |
+           Attribute_Elab_Spec      =>
 
          --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
          --  back-end knows how to handle this attribute directly.
 
-         if CodePeer_Mode then
+         if CodePeer_Mode or else Id = Attribute_Elab_Subp_Body then
             return;
          end if;
 
diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb
index 1cc0706..43c27b5 100644
--- a/gcc/ada/get_scos.adb
+++ b/gcc/ada/get_scos.adb
@@ -387,6 +387,18 @@ begin
                elsif C = ' ' then
                   Skip_Spaces;
 
+               elsif C = 'T' or else C = 'F' then
+
+                  --  Chaining indicator: skip for now???
+
+                  declare
+                     Loc1, Loc2 : Source_Location;
+                     pragma Unreferenced (Loc1, Loc2);
+                  begin
+                     Skipc;
+                     Get_Source_Location_Range (Loc1, Loc2);
+                  end;
+
                else
                   raise Data_Error;
                end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 5195e4f..12fce95 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1945,6 +1945,8 @@ package body Sem_Attr is
            and then
          Aname /= Name_Elab_Spec
            and then
+         Aname /= Name_Elab_Subp_Body
+           and then
          Aname /= Name_UET_Address
            and then
          Aname /= Name_Enabled
@@ -3014,7 +3016,10 @@ package body Sem_Attr is
 
       --  Also handles processing for Elab_Spec
 
-      when Attribute_Elab_Body | Attribute_Elab_Spec =>
+      when Attribute_Elab_Body      |
+           Attribute_Elab_Spec      |
+           Attribute_Elab_Subp_Body =>
+
          Check_E0;
          Check_Unit_Name (P);
          Set_Etype (N, Standard_Void_Type);
@@ -7712,6 +7717,7 @@ package body Sem_Attr is
            Attribute_Elaborated               |
            Attribute_Elab_Body                |
            Attribute_Elab_Spec                |
+           Attribute_Elab_Subp_Body           |
            Attribute_Enabled                  |
            Attribute_External_Tag             |
            Attribute_Fast_Math                |
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 6db8949..0e8561a 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -172,6 +172,17 @@ package Sem_Attr is
       --  Ada code, e.g. if it is necessary to do selective reelaboration to
       --  fix some error.
 
+      --------------------
+      -- Elab_Subp_Body --
+      --------------------
+
+      Attribute_Elab_Subp_Body => True,
+      --  This attribute can only be applied to a library level subprogram
+      --  name and is only relevant in CodePeer mode. It returns the entity
+      --  for the corresponding elaboration procedure for elaborating the body
+      --  of the referenced subprogram unit. This is used in the main generated
+      --  elaboration procedure by the binder in CodePeer mode only.
+
       ---------------
       -- Elab_Spec --
       ---------------
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 55566fb..f493454 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1156,11 +1156,12 @@ package body Sem_Ch6 is
          end loop;
       end if;
 
-      --  Special processing for Elab_Spec and Elab_Body calls
+      --  Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls
 
       if Nkind (P) = N_Attribute_Reference
         and then (Attribute_Name (P) = Name_Elab_Spec
-                   or else Attribute_Name (P) = Name_Elab_Body)
+                   or else Attribute_Name (P) = Name_Elab_Body
+                   or else Attribute_Name (P) = Name_Elab_Subp_Body)
       then
          if Present (Actuals) then
             Error_Msg_N
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5a07a4f..9c8d9c5 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7584,9 +7584,9 @@ package body Sem_Util is
 
    begin
       --  Verify that prefix is analyzed and has the proper form. Note that
-      --  the attributes Elab_Spec, Elab_Body, and UET_Address, which also
-      --  produce the address of an entity, do not analyze their prefix
-      --  because they denote entities that are not necessarily visible.
+      --  the attributes Elab_Spec, Elab_Body, Elab_Subp_Body and UET_Address,
+      --  which also produce the address of an entity, do not analyze their
+      --  prefix because they denote entities that are not necessarily visible.
       --  Neither of them can apply to a protected type.
 
       return Ada_Version >= Ada_2005
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 69e53db..6df2077 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -882,6 +882,7 @@ package Snames is
    First_Entity_Attribute_Name         : constant Name_Id := N + $;
    Name_Elab_Body                      : constant Name_Id := N + $; -- GNAT
    Name_Elab_Spec                      : constant Name_Id := N + $; -- GNAT
+   Name_Elab_Subp_Body                 : constant Name_Id := N + $; -- GNAT
    Name_Storage_Pool                   : constant Name_Id := N + $;
 
    --  These attributes are the ones that return types
@@ -1414,6 +1415,7 @@ package Snames is
 
       Attribute_Elab_Body,
       Attribute_Elab_Spec,
+      Attribute_Elab_Subp_Body,
       Attribute_Storage_Pool,
 
       --  Type attributes
diff --git a/gcc/ada/system.ads b/gcc/ada/system.ads
index 10d4ccf..437afbc 100644
--- a/gcc/ada/system.ads
+++ b/gcc/ada/system.ads
@@ -123,11 +123,11 @@ private
    -- System Implementation Parameters --
    --------------------------------------
 
-   --  These parameters provide information about the target that is used
-   --  by the compiler. They are in the private part of System, where they
-   --  can be accessed using the special circuitry in the Targparm unit
-   --  whose source should be consulted for more detailed descriptions
-   --  of the individual switch values.
+   --  These parameters provide information about the target that is used by
+   --  the compiler. They are in the private part of System, where they can be
+   --  accessed using the special circuitry in the Targparm unit whose source
+   --  should be consulted for more detailed descriptions of the individual
+   --  switch values.
 
    --  This version of system.ads is used only for building the compiler.
    --  We really ought to use the proper target system (i.e. the one that