[multiple changes]

2017-09-07  Nicolas Roche  <roche@adacore.com>

	* s-traces-default.adb, s-trafor-default.adb, s-trafor-default.ads,
	s-traces.adb, s-traces.ads, s-tratas-default.adb, s-tfsetr-default.adb,
	s-tfsetr-vxworks.adb, s-tratas.adb, s-tratas.ads, s-tasuti.adb,
	s-parame-hpux.ads, s-tassta.adb, s-taasde.adb, s-tasren.adb,
	s-taprob.adb, a-caldel.adb, s-parame.ads, Makefile.rtl, s-tpobop.adb,
	s-taenca.adb, s-parame-vxworks.ads: Remove support for System.Traces.

2017-09-07  Yannick Moy  <moy@adacore.com>

	* a-ngelfu.ads Add preconditions to all functions
	listed in Ada RM A.5.1(19-33) as having constraints on inputs.

2017-09-07  Arnaud Charlet  <charlet@adacore.com>

	* lib-xref.adb (Generate_Reference): ignore
	references to entities which are Part_Of single concurrent
	objects.

2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch7.adb (Hide_Public_Entities): Add paragraph to main
	comment.

2017-09-07  Arnaud Charlet  <charlet@adacore.com>

	* a-taside.adb (Activation_Is_Complete): Raise Program_Error if
	Null_Task_Id is passed.

2017-09-07  Javier Miranda  <miranda@adacore.com>

	* einfo.ads, einfo.adb (Access_Disp_Table_Elab_Flag): New
	attribute. Defined for record types and subtypes.
	* exp_ch3.ads (Init_Secondary_Tags): Adding new formal
	(Init_Tags_List) to facilitate generating separate code in the
	IP routine to initialize the object components and for completing
	the elaboration of dispatch tables.
	* exp_ch3.adb (Build_Init_Procedure): Improve the code
	generated in the IP routines by means of keeping separate
	the initialization of the object components from the
	initialization of its dispatch tables.	(Init_Secondary_Tags):
	Adding new formal (Init_Tags_List) and adjusting calls to
	Ada.Tags.Set_Dynamic_Offset_To_Top since it has a new formal;
	adjusting also calls to Ada.Tags.Register_Interface_Offset
	because the type of one of its formals has been changed.
	* a-tags.ads, a-tags.adb (Register_Interface_Offset): Profile
	modified. Instead of receiving a pointer to an object this
	routine receives now a primary tag.
	(Set_Dyanic_Offset_To_Top): Profile modified. This routine receives an
	additional formal: the tag of the primary dispatch table.
	* exp_disp.ads (Elab_Flag_Needed): New subprogram.
	* exp_disp.adb (Elab_Flag_Needed): New subprogram.
	(Make_Tags): Adding the declaration of the elaboration flag (if needed).
	* exp_aggr.adb (Build_Record_Aggr_Code): Adding actual of new
	formal in calls to Init_Secondary_Tags.

2017-09-07  Javier Miranda  <miranda@adacore.com>

	* ghost.adb (Mark_And_Set_Ghost_Instantiation.Check_Ghost_Actuals): New
	subprogram.
	* sem_prag.adb (Pragma_Ghost): Add missing support for ghost
	applied to generic subprograms.

From-SVN: r251838

28 files changed, 346 insertions, 294 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dabb90f..a127676 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,67 @@
+2017-09-07  Nicolas Roche  <roche@adacore.com>
+
+	* s-traces-default.adb, s-trafor-default.adb, s-trafor-default.ads,
+	s-traces.adb, s-traces.ads, s-tratas-default.adb, s-tfsetr-default.adb,
+	s-tfsetr-vxworks.adb, s-tratas.adb, s-tratas.ads, s-tasuti.adb,
+	s-parame-hpux.ads, s-tassta.adb, s-taasde.adb, s-tasren.adb,
+	s-taprob.adb, a-caldel.adb, s-parame.ads, Makefile.rtl, s-tpobop.adb,
+	s-taenca.adb, s-parame-vxworks.ads: Remove support for System.Traces.
+
+2017-09-07  Yannick Moy  <moy@adacore.com>
+
+	* a-ngelfu.ads Add preconditions to all functions
+	listed in Ada RM A.5.1(19-33) as having constraints on inputs.
+
+2017-09-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* lib-xref.adb (Generate_Reference): ignore
+	references to entities which are Part_Of single concurrent
+	objects.
+
+2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch7.adb (Hide_Public_Entities): Add paragraph to main
+	comment.
+
+2017-09-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* a-taside.adb (Activation_Is_Complete): Raise Program_Error if
+	Null_Task_Id is passed.
+
+2017-09-07  Javier Miranda  <miranda@adacore.com>
+
+	* einfo.ads, einfo.adb (Access_Disp_Table_Elab_Flag): New
+	attribute. Defined for record types and subtypes.
+	* exp_ch3.ads (Init_Secondary_Tags): Adding new formal
+	(Init_Tags_List) to facilitate generating separate code in the
+	IP routine to initialize the object components and for completing
+	the elaboration of dispatch tables.
+	* exp_ch3.adb (Build_Init_Procedure): Improve the code
+	generated in the IP routines by means of keeping separate
+	the initialization of the object components from the
+	initialization of its dispatch tables.	(Init_Secondary_Tags):
+	Adding new formal (Init_Tags_List) and adjusting calls to
+	Ada.Tags.Set_Dynamic_Offset_To_Top since it has a new formal;
+	adjusting also calls to Ada.Tags.Register_Interface_Offset
+	because the type of one of its formals has been changed.
+	* a-tags.ads, a-tags.adb (Register_Interface_Offset): Profile
+	modified. Instead of receiving a pointer to an object this
+	routine receives now a primary tag.
+	(Set_Dyanic_Offset_To_Top): Profile modified. This routine receives an
+	additional formal: the tag of the primary dispatch table.
+	* exp_disp.ads (Elab_Flag_Needed): New subprogram.
+	* exp_disp.adb (Elab_Flag_Needed): New subprogram.
+	(Make_Tags): Adding the declaration of the elaboration flag (if needed).
+	* exp_aggr.adb (Build_Record_Aggr_Code): Adding actual of new
+	formal in calls to Init_Secondary_Tags.
+
+2017-09-07  Javier Miranda  <miranda@adacore.com>
+
+	* ghost.adb (Mark_And_Set_Ghost_Instantiation.Check_Ghost_Actuals): New
+	subprogram.
+	* sem_prag.adb (Pragma_Ghost): Add missing support for ghost
+	applied to generic subprograms.
+
 2017-09-07  Arnaud Charlet  <charlet@adacore.com>
 
 	* sem_util.adb (Check_Part_Of_Reference): rename Conc_Typ to Conc_Obj
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 4eb60b5..021da82 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -73,7 +73,6 @@ GNATRTL_TASKING_OBJS= \
   s-tpoben$(objext) \
   s-tpobop$(objext) \
   s-tposen$(objext) \
-  s-tratas$(objext) \
   thread$(objext) \
   $(EXTRA_GNATRTL_TASKING_OBJS)
 
@@ -673,7 +672,6 @@ GNATRTL_NONTASKING_OBJS= \
   s-ststop$(objext) \
   s-tasloc$(objext) \
   s-traceb$(objext) \
-  s-traces$(objext) \
   s-traent$(objext) \
   s-unstyp$(objext) \
   s-utf_32$(objext) \
diff --git a/gcc/ada/a-caldel.adb b/gcc/ada/a-caldel.adb
index cb55324..efa4478 100644
--- a/gcc/ada/a-caldel.adb
+++ b/gcc/ada/a-caldel.adb
@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---                     Copyright (C) 1995-2010, AdaCore                     --
+--                     Copyright (C) 1995-2017, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -32,8 +32,6 @@
 
 with System.OS_Primitives;
 with System.Soft_Links;
-with System.Traces;
-with System.Parameters;
 
 package body Ada.Calendar.Delays is
 
@@ -42,8 +40,6 @@ package body Ada.Calendar.Delays is
 
    use type SSL.Timed_Delay_Call;
 
-   use System.Traces;
-
    --  Earlier, System.Time_Operations was used to implement the following
    --  operations. The idea was to avoid sucking in the tasking packages. This
    --  did not work. Logically, we can't have it both ways. There is no way to
@@ -64,16 +60,8 @@ package body Ada.Calendar.Delays is
 
    procedure Delay_For (D : Duration) is
    begin
-      if System.Parameters.Runtime_Traces then
-         Send_Trace_Info (W_Delay, D);
-      end if;
-
       SSL.Timed_Delay.all (Duration'Min (D, OSP.Max_Sensible_Delay),
                            OSP.Relative);
-
-      if System.Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Delay, D);
-      end if;
    end Delay_For;
 
    -----------------
@@ -84,15 +72,7 @@ package body Ada.Calendar.Delays is
       D : constant Duration := To_Duration (T);
 
    begin
-      if System.Parameters.Runtime_Traces then
-         Send_Trace_Info (WU_Delay, D);
-      end if;
-
       SSL.Timed_Delay.all (D, OSP.Absolute_Calendar);
-
-      if System.Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Delay, D);
-      end if;
    end Delay_Until;
 
    --------------------
diff --git a/gcc/ada/a-ngelfu.ads b/gcc/ada/a-ngelfu.ads
index 767708d..52a00d2 100644
--- a/gcc/ada/a-ngelfu.ads
+++ b/gcc/ada/a-ngelfu.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2012-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2012-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -41,7 +41,16 @@ package Ada.Numerics.Generic_Elementary_Functions with
 is
    pragma Pure;
 
+   --  Preconditions in this unit are meant for analysis only, not for run-time
+   --  checking, so that the expected exceptions are raised when calling
+   --  Assert. This is enforced by setting the corresponding assertion policy
+   --  to Ignore. This is done in the generic spec so that it applies to all
+   --  instances.
+
+   pragma Assertion_Policy (Pre => Ignore);
+
    function Sqrt (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => X >= 0.0,
      Post => Sqrt'Result >= 0.0
        and then (if X = 0.0 then Sqrt'Result = 0.0)
        and then (if X = 1.0 then Sqrt'Result = 1.0)
@@ -64,15 +73,18 @@ is
        and then (if X >= Float_Type'Succ (0.0) then Sqrt'Result > 0.0);
 
    function Log (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => X > 0.0,
      Post => (if X = 1.0 then Log'Result = 0.0);
 
    function Log (X, Base : Float_Type'Base) return Float_Type'Base with
+     Pre  => X > 0.0 and Base > 0.0 and Base /= 1.0,
      Post => (if X = 1.0 then Log'Result = 0.0);
 
    function Exp (X : Float_Type'Base) return Float_Type'Base with
      Post => (if X = 0.0 then Exp'Result = 1.0);
 
    function "**" (Left, Right : Float_Type'Base) return Float_Type'Base with
+     Pre  => (if Left = 0.0 then Right > 0.0) and Left >= 0.0,
      Post => "**"'Result >= 0.0
        and then (if Right = 0.0 then "**"'Result = 1.0)
        and then (if Right = 1.0 then "**"'Result = Left)
@@ -84,6 +96,7 @@ is
        and then (if X = 0.0 then Sin'Result = 0.0);
 
    function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre  => Cycle > 0.0,
      Post => Sin'Result in -1.0 .. 1.0
        and then (if X = 0.0 then Sin'Result = 0.0);
 
@@ -92,6 +105,7 @@ is
        and then (if X = 0.0 then Cos'Result = 1.0);
 
    function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre  => Cycle > 0.0,
      Post => Cos'Result in -1.0 .. 1.0
        and then (if X = 0.0 then Cos'Result = 1.0);
 
@@ -99,28 +113,40 @@ is
      Post => (if X = 0.0 then Tan'Result = 0.0);
 
    function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre  => Cycle > 0.0
+       and then abs Float_Type'Base'Remainder (X, Cycle) /= 0.25 * Cycle,
      Post => (if X = 0.0 then Tan'Result = 0.0);
 
-   function Cot (X : Float_Type'Base) return Float_Type'Base;
+   function Cot (X : Float_Type'Base) return Float_Type'Base with
+     Pre => X /= 0.0;
 
-   function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
+   function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre => Cycle > 0.0
+       and then X /= 0.0
+       and then Float_Type'Base'Remainder (X, Cycle) /= 0.0
+       and then abs Float_Type'Base'Remainder (X, Cycle) = 0.5 * Cycle;
 
    function Arcsin (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => abs X <= 1.0,
      Post => (if X = 0.0 then Arcsin'Result = 0.0);
 
    function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre  => Cycle > 0.0 and abs X <= 1.0,
      Post => (if X = 0.0 then Arcsin'Result = 0.0);
 
    function Arccos (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => abs X <= 1.0,
      Post => (if X = 1.0 then Arccos'Result = 0.0);
 
    function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base with
+     Pre  => Cycle > 0.0 and abs X <= 1.0,
      Post => (if X = 1.0 then Arccos'Result = 0.0);
 
    function Arctan
      (Y : Float_Type'Base;
       X : Float_Type'Base := 1.0) return Float_Type'Base
    with
+     Pre  => X /= 0.0 or Y /= 0.0,
      Post => (if X > 0.0 and then Y = 0.0 then Arctan'Result = 0.0);
 
    function Arctan
@@ -128,12 +154,14 @@ is
       X     : Float_Type'Base := 1.0;
       Cycle : Float_Type'Base) return Float_Type'Base
    with
+     Pre  => Cycle > 0.0 and (X /= 0.0 or Y /= 0.0),
      Post => (if X > 0.0 and then Y = 0.0 then Arctan'Result = 0.0);
 
    function Arccot
      (X   : Float_Type'Base;
       Y   : Float_Type'Base := 1.0) return Float_Type'Base
    with
+     Pre  => X /= 0.0 or Y /= 0.0,
      Post => (if X > 0.0 and then Y = 0.0 then Arccot'Result = 0.0);
 
    function Arccot
@@ -141,6 +169,7 @@ is
       Y     : Float_Type'Base := 1.0;
       Cycle : Float_Type'Base) return Float_Type'Base
    with
+     Pre  => Cycle > 0.0 and (X /= 0.0 or Y /= 0.0),
      Post => (if X > 0.0 and then Y = 0.0 then Arccot'Result = 0.0);
 
    function Sinh (X : Float_Type'Base) return Float_Type'Base with
@@ -155,18 +184,22 @@ is
        and then (if X = 0.0 then Tanh'Result = 0.0);
 
    function Coth (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => X /= 0.0,
      Post => abs Coth'Result >= 1.0;
 
    function Arcsinh (X : Float_Type'Base) return Float_Type'Base with
      Post => (if X = 0.0 then Arcsinh'Result = 0.0);
 
    function Arccosh (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => X >= 1.0,
      Post => Arccosh'Result >= 0.0
        and then (if X = 1.0 then Arccosh'Result = 0.0);
 
    function Arctanh (X : Float_Type'Base) return Float_Type'Base with
+     Pre  => abs X /= 1.0,
      Post => (if X = 0.0 then Arctanh'Result = 0.0);
 
-   function Arccoth (X : Float_Type'Base) return Float_Type'Base;
+   function Arccoth (X : Float_Type'Base) return Float_Type'Base with
+     Pre => X <= 1.0 and abs X /= 1.0;
 
 end Ada.Numerics.Generic_Elementary_Functions;
diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 95bc208..fd99782 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -906,22 +906,16 @@ package body Ada.Tags is
    -------------------------------
 
    procedure Register_Interface_Offset
-     (This         : System.Address;
+     (Prim_T       : Tag;
       Interface_T  : Tag;
       Is_Static    : Boolean;
       Offset_Value : SSE.Storage_Offset;
       Offset_Func  : Offset_To_Top_Function_Ptr)
    is
-      Prim_DT     : Dispatch_Table_Ptr;
-      Iface_Table : Interface_Data_Ptr;
-
+      Prim_DT     : constant Dispatch_Table_Ptr := DT (Prim_T);
+      Iface_Table : constant Interface_Data_Ptr :=
+                      To_Type_Specific_Data_Ptr (Prim_DT.TSD).Interfaces_Table;
    begin
-      --  "This" points to the primary DT and we must save Offset_Value in
-      --  the Offset_To_Top field of the corresponding dispatch table.
-
-      Prim_DT     := DT (To_Tag_Ptr (This).all);
-      Iface_Table := To_Type_Specific_Data_Ptr (Prim_DT.TSD).Interfaces_Table;
-
       --  Save Offset_Value in the table of interfaces of the primary DT.
       --  This data will be used by the subprogram "Displace" to give support
       --  to backward abstract interface type conversions.
@@ -1008,6 +1002,7 @@ package body Ada.Tags is
 
    procedure Set_Dynamic_Offset_To_Top
      (This         : System.Address;
+      Prim_T       : Tag;
       Interface_T  : Tag;
       Offset_Value : SSE.Storage_Offset;
       Offset_Func  : Offset_To_Top_Function_Ptr)
@@ -1025,7 +1020,7 @@ package body Ada.Tags is
       end if;
 
       Register_Interface_Offset
-        (This, Interface_T, False, Offset_Value, Offset_Func);
+        (Prim_T, Interface_T, False, Offset_Value, Offset_Func);
    end Set_Dynamic_Offset_To_Top;
 
    ----------------------
diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads
index 7397de5..df578eb 100644
--- a/gcc/ada/a-tags.ads
+++ b/gcc/ada/a-tags.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -527,18 +527,18 @@ private
    --  assumes that _size is always in slot one of the dispatch table.
 
    procedure Register_Interface_Offset
-     (This         : System.Address;
+     (Prim_T       : Tag;
       Interface_T  : Tag;
       Is_Static    : Boolean;
       Offset_Value : SSE.Storage_Offset;
       Offset_Func  : Offset_To_Top_Function_Ptr);
    --  Register in the table of interfaces of the tagged type associated with
-   --  "This" object the offset of the record component associated with the
-   --  progenitor Interface_T (that is, the distance from "This" to the object
-   --  component containing the tag of the secondary dispatch table). In case
-   --  of constant offset, Is_Static is true and Offset_Value has such value.
-   --  In case of variable offset, Is_Static is false and Offset_Func is an
-   --  access to function that must be called to evaluate the offset.
+   --  Prim_T the offset of the record component associated with the progenitor
+   --  Interface_T (that is, the distance from "This" to the object component
+   --  containing the tag of the secondary dispatch table). In case of constant
+   --  offset, Is_Static is true and Offset_Value has such value. In case of
+   --  variable offset, Is_Static is false and Offset_Func is an access to
+   --  function that must be called to evaluate the offset.
 
    procedure Register_Tag (T : Tag);
    --  Insert the Tag and its associated external_tag in a table for the sake
@@ -546,20 +546,24 @@ private
 
    procedure Set_Dynamic_Offset_To_Top
      (This         : System.Address;
+      Prim_T       : Tag;
       Interface_T  : Tag;
       Offset_Value : SSE.Storage_Offset;
       Offset_Func  : Offset_To_Top_Function_Ptr);
    --  Ada 2005 (AI-251): The compiler generates calls to this routine only
-   --  when initializing the Offset_To_Top field of dispatch tables associated
-   --  with tagged type whose parent has variable size components. "This" is
-   --  the object whose dispatch table is being initialized. Interface_T is the
-   --  interface for which the secondary dispatch table is being initialized,
-   --  and Offset_Value is the distance from "This" to the object component
-   --  containing the tag of the secondary dispatch table (a zero value means
-   --  that this interface shares the primary dispatch table). Offset_Func
-   --  references a function that must be called to evaluate the offset at
-   --  runtime. This routine also takes care of registering these values in
-   --  the table of interfaces of the type.
+   --  when initializing the Offset_To_Top field of dispatch tables of tagged
+   --  types that cover interface types whose parent type has variable size
+   --  components.
+   --
+   --  "This" is the object whose dispatch table is being initialized. Prim_T
+   --  is the primary tag of such object. Interface_T is the interface tag for
+   --  which the secondary dispatch table is being initialized, Offset_Value
+   --  is the distance from "This" to the object component containing the tag
+   --  of the secondary dispatch table (a zero value means that this interface
+   --  shares the primary dispatch table). Offset_Func references a function
+   --  that must be called to evaluate the offset at runtime. This routine also
+   --  takes care of registering these values in the table of interfaces of the
+   --  type.
 
    procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
    --  Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
diff --git a/gcc/ada/a-taside.adb b/gcc/ada/a-taside.adb
index b916c76..9433669 100644
--- a/gcc/ada/a-taside.adb
+++ b/gcc/ada/a-taside.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -92,7 +92,11 @@ is
    function Activation_Is_Complete (T : Task_Id) return Boolean is
       use type System.Tasking.Task_Id;
    begin
-      return Convert_Ids (T).Common.Activator = null;
+      if T = Null_Task_Id then
+         raise Program_Error;
+      else
+         return Convert_Ids (T).Common.Activator = null;
+      end if;
    end Activation_Is_Complete;
 
    -----------------
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 4ad9466..3ecf322 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -249,6 +249,7 @@ package body Einfo is
    --    BIP_Initialization_Call         Node29
    --    Subprograms_For_Type            Elist29
 
+   --    Access_Disp_Table_Elab_Flag     Node30
    --    Anonymous_Object                Node30
    --    Corresponding_Equality          Node30
    --    Last_Aggregate_Assignment       Node30
@@ -724,6 +725,14 @@ package body Einfo is
       return Elist16 (Implementation_Base_Type (Id));
    end Access_Disp_Table;
 
+   function Access_Disp_Table_Elab_Flag (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Record_Type,
+                                   E_Record_Type_With_Private,
+                                   E_Record_Subtype));
+      return Node30 (Implementation_Base_Type (Id));
+   end Access_Disp_Table_Elab_Flag;
+
    function Activation_Record_Component (Id : E) return E is
    begin
       pragma Assert (Ekind_In (Id, E_Constant,
@@ -3817,6 +3826,14 @@ package body Einfo is
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
+   procedure Set_Access_Disp_Table_Elab_Flag (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind (Id) = E_Record_Type
+        and then Id = Implementation_Base_Type (Id));
+      pragma Assert (Is_Tagged_Type (Id));
+      Set_Node30 (Id, V);
+   end Set_Access_Disp_Table_Elab_Flag;
+
    procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
@@ -10855,6 +10872,11 @@ package body Einfo is
    procedure Write_Field30_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Record_Type
+            | E_Record_Type_With_Private
+         =>
+            Write_Str ("Access_Disp_Table_Elab_Flag");
+
          when E_Protected_Type
             | E_Task_Type
          =>
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 2fcdac7..928ea3c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -355,6 +355,14 @@ package Einfo is
 --       used to expand dispatching calls through the primary dispatch table.
 --       For an untagged record, contains No_Elist.
 
+--    Access_Disp_Table_Elab_Flag (Node30) [implementation base type only]
+--       Defined in E_Record_Type and E_Record_Subtype entities. Set in tagged
+--       types whose dispatch table elaboration must be completed at runtime by
+--       the IP routine to point to its pending elaboration flag entity. This
+--       flag is needed when the elaboration of the dispatch table relies on
+--       attribute 'Position applied to an object of the type; it is used by
+--       the IP routine to avoid performing this elaboration twice.
+
 --    Activation_Record_Component (Node31)
 --       Defined in E_Variable, E_Constant, E_Loop_Parameter, E_In_Parameter,
 --       E_Out_Parameter, E_In_Out_Parameter nodes. Used only if we are in
@@ -6466,6 +6474,7 @@ package Einfo is
    --  E_Record_Subtype
    --    Direct_Primitive_Operations         (Elist10)
    --    Access_Disp_Table                   (Elist16)  (base type only)
+   --    Access_Disp_Table_Elab_Flag         (Node30)   (base type only)
    --    Cloned_Subtype                      (Node16)   (subtype case only)
    --    First_Entity                        (Node17)
    --    Corresponding_Concurrent_Type       (Node18)
@@ -6911,6 +6920,7 @@ package Einfo is
    function Abstract_States                     (Id : E) return L;
    function Accept_Address                      (Id : E) return L;
    function Access_Disp_Table                   (Id : E) return L;
+   function Access_Disp_Table_Elab_Flag         (Id : E) return E;
    function Activation_Record_Component         (Id : E) return E;
    function Actual_Subtype                      (Id : E) return E;
    function Address_Taken                       (Id : E) return B;
@@ -7602,6 +7612,7 @@ package Einfo is
    procedure Set_Abstract_States                 (Id : E; V : L);
    procedure Set_Accept_Address                  (Id : E; V : L);
    procedure Set_Access_Disp_Table               (Id : E; V : L);
+   procedure Set_Access_Disp_Table_Elab_Flag     (Id : E; V : E);
    procedure Set_Activation_Record_Component     (Id : E; V : E);
    procedure Set_Actual_Subtype                  (Id : E; V : E);
    procedure Set_Address_Taken                   (Id : E; V : B := True);
@@ -8415,6 +8426,7 @@ package Einfo is
    pragma Inline (Abstract_States);
    pragma Inline (Accept_Address);
    pragma Inline (Access_Disp_Table);
+   pragma Inline (Access_Disp_Table_Elab_Flag);
    pragma Inline (Activation_Record_Component);
    pragma Inline (Actual_Subtype);
    pragma Inline (Address_Taken);
@@ -8941,6 +8953,7 @@ package Einfo is
    pragma Inline (Set_Abstract_States);
    pragma Inline (Set_Accept_Address);
    pragma Inline (Set_Access_Disp_Table);
+   pragma Inline (Set_Access_Disp_Table_Elab_Flag);
    pragma Inline (Set_Activation_Record_Component);
    pragma Inline (Set_Actual_Subtype);
    pragma Inline (Set_Address_Taken);
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 9ab9573..71f2840 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3324,7 +3324,8 @@ package body Exp_Aggr is
                      Init_Secondary_Tags
                        (Typ        => Base_Type (Typ),
                         Target     => Target,
-                        Stmts_List => Assign);
+                        Stmts_List => Assign,
+                        Init_Tags_List => Assign);
                   end if;
                end if;
 
@@ -3859,7 +3860,8 @@ package body Exp_Aggr is
             Init_Secondary_Tags
               (Typ        => Base_Type (Typ),
                Target     => Target,
-               Stmts_List => L);
+               Stmts_List => L,
+               Init_Tags_List => L);
          end if;
       end if;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d76aa71..69db5dd 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2475,18 +2475,44 @@ package body Exp_Ch3 is
                  and then not Is_Interface (Rec_Type)
                  and then Has_Interfaces (Rec_Type)
                then
-                  Init_Secondary_Tags
-                    (Typ            => Rec_Type,
-                     Target         => Make_Identifier (Loc, Name_uInit),
-                     Stmts_List     => Init_Tags_List,
-                     Fixed_Comps    => True,
-                     Variable_Comps => False);
-               end if;
+                  declare
+                     Elab_Sec_DT_Stmts_List : constant List_Id := New_List;
 
-               Prepend_To (Body_Stmts,
-                 Make_If_Statement (Loc,
-                   Condition => New_Occurrence_Of (Set_Tag, Loc),
-                   Then_Statements => Init_Tags_List));
+                  begin
+                     Init_Secondary_Tags
+                       (Typ            => Rec_Type,
+                        Target         => Make_Identifier (Loc, Name_uInit),
+                        Init_Tags_List => Init_Tags_List,
+                        Stmts_List     => Elab_Sec_DT_Stmts_List,
+                        Fixed_Comps    => True,
+                        Variable_Comps => False);
+
+                     Append_To (Elab_Sec_DT_Stmts_List,
+                       Make_Assignment_Statement (Loc,
+                         Name =>
+                           New_Occurrence_Of
+                             (Access_Disp_Table_Elab_Flag (Rec_Type), Loc),
+                         Expression =>
+                           New_Occurrence_Of (Standard_False, Loc)));
+
+                     Prepend_List_To (Body_Stmts,
+                       New_List (
+                         Make_If_Statement (Loc,
+                           Condition => New_Occurrence_Of (Set_Tag, Loc),
+                           Then_Statements => Init_Tags_List),
+
+                       Make_If_Statement (Loc,
+                         Condition =>
+                           New_Occurrence_Of
+                             (Access_Disp_Table_Elab_Flag (Rec_Type), Loc),
+                         Then_Statements => Elab_Sec_DT_Stmts_List)));
+                  end;
+               else
+                  Prepend_To (Body_Stmts,
+                    Make_If_Statement (Loc,
+                      Condition => New_Occurrence_Of (Set_Tag, Loc),
+                      Then_Statements => Init_Tags_List));
+               end if;
 
             --  Case 2: CPP type. The imported C++ constructor takes care of
             --  tags initialization. No action needed here because the IP
@@ -2533,6 +2559,7 @@ package body Exp_Ch3 is
                   Init_Secondary_Tags
                     (Typ            => Rec_Type,
                      Target         => Make_Identifier (Loc, Name_uInit),
+                     Init_Tags_List => Init_Tags_List,
                      Stmts_List     => Init_Tags_List,
                      Fixed_Comps    => True,
                      Variable_Comps => False);
@@ -2606,6 +2633,7 @@ package body Exp_Ch3 is
                Init_Secondary_Tags
                  (Typ            => Rec_Type,
                   Target         => Make_Identifier (Loc, Name_uInit),
+                  Init_Tags_List => Init_Tags_List,
                   Stmts_List     => Init_Tags_List,
                   Fixed_Comps    => False,
                   Variable_Comps => True);
@@ -8119,6 +8147,7 @@ package body Exp_Ch3 is
    procedure Init_Secondary_Tags
      (Typ            : Entity_Id;
       Target         : Node_Id;
+      Init_Tags_List : List_Id;
       Stmts_List     : List_Id;
       Fixed_Comps    : Boolean := True;
       Variable_Comps : Boolean := True)
@@ -8156,7 +8185,7 @@ package body Exp_Ch3 is
          --  Initialize pointer to secondary DT associated with the interface
 
          if not Is_Ancestor (Iface, Typ, Use_Full_View => True) then
-            Append_To (Stmts_List,
+            Append_To (Init_Tags_List,
               Make_Assignment_Statement (Loc,
                 Name       =>
                   Make_Selected_Component (Loc,
@@ -8190,6 +8219,7 @@ package body Exp_Ch3 is
             --  Generate:
             --    Set_Dynamic_Offset_To_Top
             --      (This         => Init,
+            --       Prim_T       => Typ'Tag,
             --       Interface_T  => Iface'Tag,
             --       Offset_Value => n,
             --       Offset_Func  => Fn'Address)
@@ -8205,6 +8235,10 @@ package body Exp_Ch3 is
 
                   Unchecked_Convert_To (RTE (RE_Tag),
                     New_Occurrence_Of
+                      (Node (First_Elmt (Access_Disp_Table (Typ))), Loc)),
+
+                  Unchecked_Convert_To (RTE (RE_Tag),
+                    New_Occurrence_Of
                       (Node (First_Elmt (Access_Disp_Table (Iface))),
                        Loc)),
 
@@ -8230,7 +8264,7 @@ package body Exp_Ch3 is
             Offset_To_Top_Comp := Next_Entity (Tag_Comp);
             pragma Assert (Present (Offset_To_Top_Comp));
 
-            Append_To (Stmts_List,
+            Append_To (Init_Tags_List,
               Make_Assignment_Statement (Loc,
                 Name       =>
                   Make_Selected_Component (Loc,
@@ -8269,7 +8303,7 @@ package body Exp_Ch3 is
 
             --  Generate:
             --    Register_Interface_Offset
-            --      (This         => Init,
+            --      (Prim_T       => Typ'Tag,
             --       Interface_T  => Iface'Tag,
             --       Is_Constant  => True,
             --       Offset_Value => n,
@@ -8282,9 +8316,9 @@ package body Exp_Ch3 is
                      New_Occurrence_Of
                        (RTE (RE_Register_Interface_Offset), Loc),
                    Parameter_Associations => New_List (
-                     Make_Attribute_Reference (Loc,
-                       Prefix         => New_Copy_Tree (Target),
-                       Attribute_Name => Name_Address),
+                     Unchecked_Convert_To (RTE (RE_Tag),
+                       New_Occurrence_Of
+                         (Node (First_Elmt (Access_Disp_Table (Typ))), Loc)),
 
                      Unchecked_Convert_To (RTE (RE_Tag),
                        New_Occurrence_Of
@@ -8403,7 +8437,7 @@ package body Exp_Ch3 is
             --  Initialize secondary tags
 
             else
-               Append_To (Stmts_List,
+               Append_To (Init_Tags_List,
                  Make_Assignment_Statement (Loc,
                    Name =>
                      Make_Selected_Component (Loc,
diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads
index e42fc82..c1e6798 100644
--- a/gcc/ada/exp_ch3.ads
+++ b/gcc/ada/exp_ch3.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -94,15 +94,17 @@ package Exp_Ch3 is
    procedure Init_Secondary_Tags
      (Typ            : Entity_Id;
       Target         : Node_Id;
+      Init_Tags_List : List_Id;
       Stmts_List     : List_Id;
       Fixed_Comps    : Boolean := True;
       Variable_Comps : Boolean := True);
    --  Ada 2005 (AI-251): Initialize the tags of the secondary dispatch tables
    --  of Typ. The generated code referencing tag fields of Target is appended
-   --  to Stmts_List. If Fixed_Comps is True then the tag components located at
-   --  fixed positions of Target are initialized; if Variable_Comps is True
-   --  then tags components located at variable positions of Target are
-   --  initialized.
+   --  to Init_Tags_List and the code required to complete the elaboration of
+   --  the dispatch tables of Typ is appended to Stmts_List. If Fixed_Comps is
+   --  True then the tag components located at fixed positions of Target are
+   --  initialized; if Variable_Comps is True then tags components located at
+   --  variable positions of Target are initialized.
 
    function Make_Tag_Assignment (N : Node_Id) return Node_Id;
    --  An object declaration that has an initialization for a tagged object
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 2b63377..7783354 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -625,6 +625,17 @@ package body Exp_Disp is
       raise Program_Error;
    end Default_Prim_Op_Position;
 
+   ----------------------
+   -- Elab_Flag_Needed --
+   ----------------------
+
+   function Elab_Flag_Needed (Typ : Entity_Id) return Boolean is
+   begin
+      return Ada_Version >= Ada_2005
+        and then not Is_Interface (Typ)
+        and then Has_Interfaces (Typ);
+   end Elab_Flag_Needed;
+
    -----------------------------
    -- Expand_Dispatching_Call --
    -----------------------------
@@ -6670,6 +6681,24 @@ package body Exp_Disp is
       pragma Assert (No (Access_Disp_Table (Typ)));
       Set_Access_Disp_Table (Typ, New_Elmt_List);
 
+      --  If the elaboration of this tagged type needs a boolean flag then
+      --  define now its entity. It is initialized to True to indicate that
+      --  elaboration is still pending; set to False by the IP routine.
+
+      --      TypFxx : boolean := True;
+
+      if Elab_Flag_Needed (Typ) then
+         Set_Access_Disp_Table_Elab_Flag (Typ,
+           Make_Defining_Identifier (Loc,
+             New_External_Name (Tname, 'F', Suffix_Index => -1)));
+
+         Append_To (Result,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Access_Disp_Table_Elab_Flag (Typ),
+             Object_Definition   => New_Occurrence_Of (Standard_Boolean, Loc),
+             Expression          => New_Occurrence_Of (Standard_True, Loc)));
+      end if;
+
       --  1) Generate the primary tag entities
 
       --  Primary dispatch table containing user-defined primitives
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 61f13e8..7cb56d8 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -214,6 +214,12 @@ package Exp_Disp is
    --  Return the number of primitives of the C++ part of the dispatch table.
    --  For types that are not derivations of CPP types return 0.
 
+   function Elab_Flag_Needed (Typ : Entity_Id) return Boolean;
+   --  Return True if the elaboration of the tagged type Typ is completed at
+   --  runtime by the execution of code located in the IP routine and the
+   --  expander must generate an extra elaboration flag to avoid performing
+   --  such elaboration twice.
+
    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
    --  Expand the call to the operation through the dispatch table and perform
    --  the required tag checks when appropriate. For CPP types tag checks are
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 78ba5f3..6640d6a 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -1303,6 +1303,43 @@ package body Ghost is
      (N      : Node_Id;
       Gen_Id : Entity_Id)
    is
+      procedure Check_Ghost_Actuals;
+      --  Check the context of ghost actuals
+
+      -------------------------
+      -- Check_Ghost_Actuals --
+      -------------------------
+
+      procedure Check_Ghost_Actuals is
+         Assoc : Node_Id := First (Generic_Associations (N));
+         Act   : Node_Id;
+
+      begin
+         while Present (Assoc) loop
+            if Nkind (Assoc) /= N_Others_Choice then
+               Act := Explicit_Generic_Actual_Parameter (Assoc);
+
+               --  Within a nested instantiation, a defaulted actual is an
+               --  empty association, so nothing to check.
+
+               if No (Act) then
+                  null;
+
+               elsif Comes_From_Source (Act)
+                  and then Nkind (Act) in N_Has_Etype
+                  and then Present (Etype (Act))
+                  and then Is_Ghost_Entity (Etype (Act))
+               then
+                  Check_Ghost_Context (Etype (Act), Act);
+               end if;
+            end if;
+
+            Next (Assoc);
+         end loop;
+      end Check_Ghost_Actuals;
+
+      --  Local variables
+
       Policy : Name_Id := No_Name;
 
    begin
@@ -1336,6 +1373,13 @@ package body Ghost is
       --  Install the appropriate Ghost mode
 
       Install_Ghost_Mode (Policy);
+
+      --  Check ghost actuals. Given that this routine is unconditionally
+      --  invoked with subprogram and package instantiations, this check
+      --  verifies the context of all the ghost entities passed in generic
+      --  instantiations.
+
+      Check_Ghost_Actuals;
    end Mark_And_Set_Ghost_Instantiation;
 
    ---------------------------------------
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index edc955b..9cc54eb 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1126,6 +1126,19 @@ package body Lib.Xref is
          --  Comment needed here for special SPARK code ???
 
          if GNATprove_Mode then
+            --  Ignore reference to an entity that is a Part_Of single
+            --  concurrent object. Ideally we would prefer to add it as a
+            --  reference to the corresponding concurrent type, but it is quite
+            --  difficult (as such references are not currently added even for)
+            --  reads/writes of private protected components) and not worth the
+            --  effort.
+            if Ekind_In (Ent, E_Abstract_State, E_Constant, E_Variable)
+              and then Present (Encapsulating_State (Ent))
+              and then Is_Single_Concurrent_Object (Encapsulating_State (Ent))
+            then
+               return;
+            end if;
+
             Ref := Sloc (Nod);
             Def := Sloc (Ent);
 
diff --git a/gcc/ada/s-parame-hpux.ads b/gcc/ada/s-parame-hpux.ads
index 3191956..f20cfbe 100644
--- a/gcc/ada/s-parame-hpux.ads
+++ b/gcc/ada/s-parame-hpux.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -181,15 +181,6 @@ package System.Parameters is
    Max_Attribute_Count : constant := 32;
    --  Number of task attributes stored in the task control block
 
-   --------------------
-   -- Runtime Traces --
-   --------------------
-
-   Runtime_Traces : constant Boolean := False;
-   --  This constant indicates whether the runtime outputs traces to a
-   --  predefined output or not (True means that traces are output).
-   --  See System.Traces for more details.
-
    -----------------------
    -- Task Image Length --
    -----------------------
diff --git a/gcc/ada/s-parame-vxworks.ads b/gcc/ada/s-parame-vxworks.ads
index 10769cd..919361a 100644
--- a/gcc/ada/s-parame-vxworks.ads
+++ b/gcc/ada/s-parame-vxworks.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -183,15 +183,6 @@ package System.Parameters is
    Max_Attribute_Count : constant := 16;
    --  Number of task attributes stored in the task control block
 
-   --------------------
-   -- Runtime Traces --
-   --------------------
-
-   Runtime_Traces : constant Boolean := False;
-   --  This constant indicates whether the runtime outputs traces to a
-   --  predefined output or not (True means that traces are output).
-   --  See System.Traces for more details.
-
    -----------------------
    -- Task Image Length --
    -----------------------
diff --git a/gcc/ada/s-parame.ads b/gcc/ada/s-parame.ads
index 2c2a2fa..f48c7e0 100644
--- a/gcc/ada/s-parame.ads
+++ b/gcc/ada/s-parame.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -183,15 +183,6 @@ package System.Parameters is
    Max_Attribute_Count : constant := 32;
    --  Number of task attributes stored in the task control block
 
-   --------------------
-   -- Runtime Traces --
-   --------------------
-
-   Runtime_Traces : constant Boolean := False;
-   --  This constant indicates whether the runtime outputs traces to a
-   --  predefined output or not (True means that traces are output).
-   --  See System.Traces for more details.
-
    -----------------------
    -- Task Image Length --
    -----------------------
diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb
index d7be384..cab0be7 100644
--- a/gcc/ada/s-taasde.adb
+++ b/gcc/ada/s-taasde.adb
@@ -42,8 +42,6 @@ with System.Tasking.Initialization;
 with System.Tasking.Debug;
 with System.OS_Primitives;
 with System.Interrupt_Management.Operations;
-with System.Parameters;
-with System.Traces.Tasking;
 
 package body System.Tasking.Async_Delays is
 
@@ -54,8 +52,6 @@ package body System.Tasking.Async_Delays is
    package OSP renames System.OS_Primitives;
 
    use Parameters;
-   use System.Traces;
-   use System.Traces.Tasking;
 
    function To_System is new Ada.Unchecked_Conversion
      (Ada.Task_Identification.Task_Id, Task_Id);
@@ -369,10 +365,6 @@ package body System.Tasking.Async_Delays is
             --  the timer queue, but that is OK because we always restart the
             --  next iteration at the head of the queue.
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (E_Kill, Dequeued.Self_Id);
-            end if;
-
             STPO.Unlock (Timer_Server_ID);
             STPO.Write_Lock (Dequeued.Self_Id);
             Dequeued_Task := Dequeued.Self_Id;
diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb
index 9fa1384..1236194 100644
--- a/gcc/ada/s-taenca.adb
+++ b/gcc/ada/s-taenca.adb
@@ -36,7 +36,6 @@ with System.Tasking.Protected_Objects.Operations;
 with System.Tasking.Queuing;
 with System.Tasking.Utilities;
 with System.Parameters;
-with System.Traces;
 
 package body System.Tasking.Entry_Calls is
 
@@ -46,7 +45,6 @@ package body System.Tasking.Entry_Calls is
    use Task_Primitives;
    use Protected_Objects.Entries;
    use Protected_Objects.Operations;
-   use System.Traces;
 
    --  DO NOT use Protected_Objects.Lock or Protected_Objects.Unlock
    --  internally. Those operations will raise Program_Error, which
@@ -478,10 +476,6 @@ package body System.Tasking.Entry_Calls is
       --  If this is a conditional call, it should be cancelled when it
       --  becomes abortable. This is checked in the loop below.
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (W_Completion);
-      end if;
-
       Self_Id.Common.State := Entry_Caller_Sleep;
 
       --  Try to remove calls to Sleep in the loop below by letting the caller
@@ -515,9 +509,6 @@ package body System.Tasking.Entry_Calls is
       Self_Id.Common.State := Runnable;
       Utilities.Exit_One_ATC_Level (Self_Id);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Call_Complete);
-      end if;
    end Wait_For_Completion;
 
    --------------------------------------
@@ -567,10 +558,6 @@ package body System.Tasking.Entry_Calls is
       --  is allowed to wake up at any time, not just when the condition is
       --  signaled. See same loop in the ordinary Wait_For_Completion, above.
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (WT_Completion, Wakeup_Time);
-      end if;
-
       loop
          Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
          exit when Entry_Call.State >= Done;
@@ -579,10 +566,6 @@ package body System.Tasking.Entry_Calls is
            Entry_Caller_Sleep, Timedout, Yielded);
 
          if Timedout then
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (E_Timeout);
-            end if;
-
             --  Try to cancel the call (see Try_To_Cancel_Entry_Call for
             --  corresponding code in the ATC case).
 
@@ -620,10 +603,6 @@ package body System.Tasking.Entry_Calls is
       --  This last part is the same as ordinary Wait_For_Completion,
       --  and is only executed if the call completed without timing out.
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Call_Complete);
-      end if;
-
       Self_Id.Common.State := Runnable;
       Utilities.Exit_One_ATC_Level (Self_Id);
    end Wait_For_Completion_With_Timeout;
@@ -640,10 +619,6 @@ package body System.Tasking.Entry_Calls is
       pragma Assert (Self_ID.ATC_Nesting_Level > 0);
       pragma Assert (Call.Mode = Asynchronous_Call);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (W_Completion);
-      end if;
-
       STPO.Write_Lock (Self_ID);
       Self_ID.Common.State := Entry_Caller_Sleep;
 
@@ -656,9 +631,6 @@ package body System.Tasking.Entry_Calls is
       Self_ID.Common.State := Runnable;
       STPO.Unlock (Self_ID);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Call_Complete);
-      end if;
    end Wait_Until_Abortable;
 
 end System.Tasking.Entry_Calls;
diff --git a/gcc/ada/s-taprob.adb b/gcc/ada/s-taprob.adb
index 755b772..8ba5198cc 100644
--- a/gcc/ada/s-taprob.adb
+++ b/gcc/ada/s-taprob.adb
@@ -6,8 +6,8 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---            Copyright (C) 1991-1994, Florida State University             --
---                     Copyright (C) 1995-2014, AdaCore                     --
+--            Copyright (C) 1991-1997, Florida State University             --
+--                     Copyright (C) 1995-2017, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -35,8 +35,6 @@ pragma Polling (Off);
 --  operations. It causes infinite loops and other problems.
 
 with System.Task_Primitives.Operations;
-with System.Parameters;
-with System.Traces;
 with System.Soft_Links.Tasking;
 
 with System.Secondary_Stack;
@@ -48,7 +46,6 @@ pragma Unreferenced (System.Secondary_Stack);
 package body System.Tasking.Protected_Objects is
 
    use System.Task_Primitives.Operations;
-   use System.Traces;
 
    ----------------
    -- Local Data --
@@ -128,10 +125,6 @@ package body System.Tasking.Protected_Objects is
 
       Write_Lock (Object.L'Access, Ceiling_Violation);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (PO_Lock);
-      end if;
-
       if Ceiling_Violation then
          raise Program_Error;
       end if;
@@ -185,10 +178,6 @@ package body System.Tasking.Protected_Objects is
 
       Read_Lock (Object.L'Access, Ceiling_Violation);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (PO_Lock);
-      end if;
-
       if Ceiling_Violation then
          raise Program_Error;
       end if;
@@ -271,9 +260,6 @@ package body System.Tasking.Protected_Objects is
 
       Unlock (Object.L'Access);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (PO_Unlock);
-      end if;
    end Unlock;
 
 begin
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index b5e85e1..c1b35482 100644
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -38,7 +38,6 @@ with System.Tasking.Protected_Objects.Operations;
 with System.Tasking.Debug;
 with System.Restrictions;
 with System.Parameters;
-with System.Traces.Tasking;
 
 package body System.Tasking.Rendezvous is
 
@@ -48,8 +47,6 @@ package body System.Tasking.Rendezvous is
 
    use Parameters;
    use Task_Primitives.Operations;
-   use System.Traces;
-   use System.Traces.Tasking;
 
    type Select_Treatment is (
      Accept_Alternative_Selected,   --  alternative with non-null body
@@ -200,10 +197,6 @@ package body System.Tasking.Rendezvous is
 
          --  Wait for normal call
 
-         if Parameters.Runtime_Traces then
-            Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
-         end if;
-
          pragma Debug
            (Debug.Trace (Self_Id, "Accept_Call: wait", 'R'));
          Wait_For_Call (Self_Id);
@@ -232,9 +225,6 @@ package body System.Tasking.Rendezvous is
 
       Initialization.Undefer_Abort (Self_Id);
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Accept_Complete, Caller, Entry_Index (E));
-      end if;
    end Accept_Call;
 
    --------------------
@@ -285,10 +275,6 @@ package body System.Tasking.Rendezvous is
          Open_Accepts (1).S := E;
          Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
 
-         if Parameters.Runtime_Traces then
-            Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
-         end if;
-
          pragma Debug
           (Debug.Trace (Self_Id, "Accept_Trivial: wait", 'R'));
 
@@ -314,15 +300,6 @@ package body System.Tasking.Rendezvous is
          STPO.Unlock (Caller);
       end if;
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (M_Accept_Complete);
-
-         --  Fake one, since there is (???) no way to know that the rendezvous
-         --  is over.
-
-         Send_Trace_Info (M_RDV_Complete);
-      end if;
-
       if Single_Lock then
          Unlock_RTS;
       end if;
@@ -404,10 +381,6 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Mode := Mode;
       Entry_Call.Cancellation_Attempted := False;
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
-      end if;
-
       --  If this is a call made inside of an abort deferred region,
       --  the call should be never abortable.
 
@@ -438,10 +411,6 @@ package body System.Tasking.Rendezvous is
             Unlock_RTS;
          end if;
 
-         if Parameters.Runtime_Traces then
-            Send_Trace_Info (E_Missed, Acceptor);
-         end if;
-
          Local_Undefer_Abort (Self_Id);
          raise Tasking_Error;
       end if;
@@ -560,10 +529,6 @@ package body System.Tasking.Rendezvous is
          --  The call came from normal end-of-rendezvous, so abort is not yet
          --  deferred.
 
-         if Parameters.Runtime_Traces then
-            Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
-         end if;
-
          Initialization.Defer_Abort (Self_Id);
 
       elsif ZCX_By_Default then
@@ -848,10 +813,6 @@ package body System.Tasking.Rendezvous is
 
             --  Accept body is null, so rendezvous is over immediately
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
-            end if;
-
             STPO.Unlock (Self_Id);
             Caller := Entry_Call.Self;
 
@@ -867,11 +828,6 @@ package body System.Tasking.Rendezvous is
             pragma Debug
               (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R'));
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (W_Select, Self_Id,
-                                Integer (Open_Accepts'Length));
-            end if;
-
             Wait_For_Call (Self_Id);
 
             pragma Assert (Self_Id.Open_Accepts = null);
@@ -908,10 +864,6 @@ package body System.Tasking.Rendezvous is
          when Else_Selected =>
             pragma Assert (Self_Id.Open_Accepts = null);
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (M_Select_Else);
-            end if;
-
             STPO.Unlock (Self_Id);
 
          when Terminate_Selected =>
@@ -1320,10 +1272,6 @@ package body System.Tasking.Rendezvous is
            "potentially blocking operation";
       end if;
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
-      end if;
-
       if Mode = Simple_Call or else Mode = Conditional_Call then
          Call_Synchronous
            (Acceptor, E, Uninterpreted_Data, Mode, Rendezvous_Successful);
@@ -1369,10 +1317,6 @@ package body System.Tasking.Rendezvous is
 
             Initialization.Undefer_Abort (Self_Id);
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (E_Missed, Acceptor);
-            end if;
-
             raise Tasking_Error;
          end if;
 
@@ -1514,10 +1458,6 @@ package body System.Tasking.Rendezvous is
 
             --  Rendezvous is over
 
-            if Parameters.Runtime_Traces then
-               Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
-            end if;
-
             STPO.Unlock (Self_Id);
             Caller := Entry_Call.Self;
 
@@ -1568,23 +1508,12 @@ package body System.Tasking.Rendezvous is
                if Timedout then
                   Sleep (Self_Id, Acceptor_Delay_Sleep);
                else
-                  if Parameters.Runtime_Traces then
-                     Send_Trace_Info (WT_Select,
-                                      Self_Id,
-                                      Integer (Open_Accepts'Length),
-                                      Timeout);
-                  end if;
-
                   STPO.Timed_Sleep (Self_Id, Timeout, Mode,
                     Acceptor_Delay_Sleep, Timedout, Yielded);
                end if;
 
                if Timedout then
                   Self_Id.Open_Accepts := null;
-
-                  if Parameters.Runtime_Traces then
-                     Send_Trace_Info (E_Timeout);
-                  end if;
                end if;
             end loop;
 
@@ -1700,11 +1629,6 @@ package body System.Tasking.Rendezvous is
         (Debug.Trace (Self_Id, "TTEC: entered ATC level: " &
          ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
 
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (WT_Call, Acceptor,
-                          Entry_Index (E), Timeout);
-      end if;
-
       Level := Self_Id.ATC_Nesting_Level;
       Entry_Call := Self_Id.Entry_Calls (Level)'Access;
       Entry_Call.Next := null;
@@ -1744,9 +1668,6 @@ package body System.Tasking.Rendezvous is
 
          Initialization.Undefer_Abort (Self_Id);
 
-         if Parameters.Runtime_Traces then
-            Send_Trace_Info (E_Missed, Acceptor);
-         end if;
          raise Tasking_Error;
       end if;
 
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 7e0bdcb..346e5bf 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2016, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2017, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -52,7 +52,6 @@ with System.OS_Primitives;
 with System.Secondary_Stack;
 with System.Restrictions;
 with System.Standard_Library;
-with System.Traces.Tasking;
 with System.Stack_Usage;
 with System.Storage_Elements;
 
@@ -81,9 +80,6 @@ package body System.Tasking.Stages is
    use Task_Primitives.Operations;
    use Task_Info;
 
-   use System.Traces;
-   use System.Traces.Tasking;
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -426,9 +422,6 @@ package body System.Tasking.Stages is
 
       --  ??? Why do we need to allow for nested deferral here?
 
-      if Runtime_Traces then
-         Send_Trace_Info (T_Activate);
-      end if;
    end Complete_Activation;
 
    ---------------------
@@ -709,10 +702,6 @@ package body System.Tasking.Stages is
       Created_Task := T;
       Initialization.Undefer_Abort_Nestable (Self_ID);
 
-      if Runtime_Traces then
-         Send_Trace_Info (T_Create, T);
-      end if;
-
       pragma Debug
         (Debug.Trace
            (Self_ID, "Created task in " & T.Master_of_Task'Img, 'C', T));
@@ -1453,10 +1442,6 @@ package body System.Tasking.Stages is
    begin
       Debug.Task_Termination_Hook;
 
-      if Runtime_Traces then
-         Send_Trace_Info (T_Terminate);
-      end if;
-
       --  Since GCC cannot allocate stack chunks efficiently without reordering
       --  some of the allocations, we have to handle this unexpected situation
       --  here. Normally we never have to call Vulnerable_Complete_Task here.
diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb
index 1a64448..1a7e8cf 100644
--- a/gcc/ada/s-tasuti.adb
+++ b/gcc/ada/s-tasuti.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2014, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2017, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -42,7 +42,6 @@ with System.Task_Primitives.Operations;
 with System.Tasking.Initialization;
 with System.Tasking.Queuing;
 with System.Parameters;
-with System.Traces.Tasking;
 
 package body System.Tasking.Utilities is
 
@@ -53,9 +52,6 @@ package body System.Tasking.Utilities is
    use Task_Primitives;
    use Task_Primitives.Operations;
 
-   use System.Traces;
-   use System.Traces.Tasking;
-
    --------------------
    -- Abort_One_Task --
    --------------------
@@ -67,10 +63,6 @@ package body System.Tasking.Utilities is
 
    procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id) is
    begin
-      if Parameters.Runtime_Traces then
-         Send_Trace_Info (T_Abort, Self_ID, T);
-      end if;
-
       Write_Lock (T);
 
       if T.Common.State = Unactivated then
diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb
index 379ec41..242fe45 100644
--- a/gcc/ada/s-tpobop.adb
+++ b/gcc/ada/s-tpobop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1998-2016, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2017, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -49,7 +49,6 @@ with System.Tasking.Rendezvous;
 with System.Tasking.Utilities;
 with System.Tasking.Debug;
 with System.Parameters;
-with System.Traces.Tasking;
 with System.Restrictions;
 
 with System.Tasking.Initialization;
@@ -67,8 +66,6 @@ package body System.Tasking.Protected_Objects.Operations is
 
    use System.Restrictions;
    use System.Restrictions.Rident;
-   use System.Traces;
-   use System.Traces.Tasking;
 
    -----------------------
    -- Local Subprograms --
@@ -272,13 +269,6 @@ package body System.Tasking.Protected_Objects.Operations is
          --  PO_Service_Entries on return.
 
       end if;
-
-      if Runtime_Traces then
-
-         --  ??? Entry_Call can be null
-
-         Send_Trace_Info (PO_Done, Entry_Call.Self);
-      end if;
    end Exceptional_Complete_Entry_Body;
 
    --------------------
@@ -439,11 +429,6 @@ package body System.Tasking.Protected_Objects.Operations is
          Object.Call_In_Progress := Entry_Call;
 
          begin
-            if Runtime_Traces then
-               Send_Trace_Info (PO_Run, Self_ID,
-                                Entry_Call.Self, Entry_Index (E));
-            end if;
-
             pragma Debug
               (Debug.Trace (Self_ID, "POSE: start entry body", 'P'));
 
@@ -562,10 +547,6 @@ package body System.Tasking.Protected_Objects.Operations is
       pragma Debug
         (Debug.Trace (Self_ID, "Protected_Entry_Call", 'P'));
 
-      if Runtime_Traces then
-         Send_Trace_Info (PO_Call, Entry_Index (E));
-      end if;
-
       if Self_ID.ATC_Nesting_Level = ATC_Level'Last then
          raise Storage_Error with "not enough ATC nesting levels";
       end if;
@@ -981,10 +962,6 @@ package body System.Tasking.Protected_Objects.Operations is
          raise Program_Error with "potentially blocking operation";
       end if;
 
-      if Runtime_Traces then
-         Send_Trace_Info (POT_Call, Entry_Index (E), Timeout);
-      end if;
-
       Initialization.Defer_Abort_Nestable (Self_Id);
       Lock_Entries_With_Status (Object, Ceiling_Violation);
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 16f4f34..241e6fe 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -575,6 +575,12 @@ package body Sem_Ch7 is
          --  i.e. not just syntactic, and the gain would very likely be worth
          --  neither the hassle nor the slowdown of the compiler.
 
+         --  Finally, an important thing to be aware of is that, at this point,
+         --  instantiations are not done yet so we cannot directly see inlined
+         --  bodies coming from them. That's not catastrophic because only the
+         --  actual parameters of the instantiations matter here, and they are
+         --  present in the declarations list of the instantiated packages.
+
          Subprogram_Table.Reset;
          Discard := Has_Referencer (Decls, Top_Level => True);
       end Hide_Public_Entities;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 6d838b3..0354db7 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15825,6 +15825,11 @@ package body Sem_Prag is
 
                elsif Nkind (Context) = N_Subprogram_Declaration then
                   Id := Defining_Entity (Context);
+
+               --  Pragma Ghost applies to a generic subprogram
+
+               elsif Nkind (Context) = N_Generic_Subprogram_Declaration then
+                  Id := Defining_Entity (Specification (Context));
                end if;
             end if;