[multiple changes]

2015-10-20  Jerome Lambourg  <lambourg@adacore.com>

	* init.c (__gnat_vxsim_error_handler): Completely disable on
	VxWorks-7 as the VSBs used to build gcc do not support vxsim
	architecture.

2015-10-20  Claire Dross  <dross@adacore.com>

	* a-cfdlli.ads, a-cfinve.ads, a-cofove.ads (Generic_Sorting): Explicit
	SPARK_Mode.
	* a-cfhase.ads, a-cforse.ads (Generic_Keys): Explicit SPARK_Mode.

2015-10-20  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration):
	Check for No_Implicit_Protected_Object_Allocations.
	* fe.h (Check_No_Implicit_Task_Alloc,
	Check_No_Implicit_Protected_Alloc): Define and declare.
	* restrict.ads, restrict.adb (Check_No_Implicit_Task_Alloc,
	Check_No_Implicit_Protected_Alloc): New procedures to check the
	restrictions.
	* s-rident.ads (No_Implicit_Task_Allocations)
	(No_Implicit_Protected_Object_Allocations): Declare new
	restrictions.

2015-10-20  Yannick Moy  <moy@adacore.com>

	* sem_res.adb (Resolve_Selected_Component): Only set flag
	when component is defined in a variant part.
	* sem_util.adb,
	* sem_util.ads (Is_Declared_Within_Variant): Promote local query
	as publicy visible one for use in Resolve_Selected_Component.

2015-10-20  Philippe Gil  <gil@adacore.com>

	* g-debpoo.adb: allow instrumented System.Memory to use Debug_Pool
	from foreign threads.
	* g-debpoo.adb (Print_Traceback): NEW print traceback if available
	added to support Stack_Trace_Depth = 0.
	(Print_Address): NEW print System.Address without no secondary
	stack use (Address_Image uses secondary stack)

From-SVN: r229058

21 files changed, 256 insertions, 95 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fda8e8b..65e6c4c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2015-10-20  Jerome Lambourg  <lambourg@adacore.com>
+
+	* init.c (__gnat_vxsim_error_handler): Completely disable on
+	VxWorks-7 as the VSBs used to build gcc do not support vxsim
+	architecture.
+
+2015-10-20  Claire Dross  <dross@adacore.com>
+
+	* a-cfdlli.ads, a-cfinve.ads, a-cofove.ads (Generic_Sorting): Explicit
+	SPARK_Mode.
+	* a-cfhase.ads, a-cforse.ads (Generic_Keys): Explicit SPARK_Mode.
+
+2015-10-20  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch9.adb (Expand_N_Protected_Type_Declaration):
+	Check for No_Implicit_Protected_Object_Allocations.
+	* fe.h (Check_No_Implicit_Task_Alloc,
+	Check_No_Implicit_Protected_Alloc): Define and declare.
+	* restrict.ads, restrict.adb (Check_No_Implicit_Task_Alloc,
+	Check_No_Implicit_Protected_Alloc): New procedures to check the
+	restrictions.
+	* s-rident.ads (No_Implicit_Task_Allocations)
+	(No_Implicit_Protected_Object_Allocations): Declare new
+	restrictions.
+
+2015-10-20  Yannick Moy  <moy@adacore.com>
+
+	* sem_res.adb (Resolve_Selected_Component): Only set flag
+	when component is defined in a variant part.
+	* sem_util.adb,
+	* sem_util.ads (Is_Declared_Within_Variant): Promote local query
+	as publicy visible one for use in Resolve_Selected_Component.
+
+2015-10-20  Philippe Gil  <gil@adacore.com>
+
+	* g-debpoo.adb: allow instrumented System.Memory to use Debug_Pool
+	from foreign threads.
+	* g-debpoo.adb (Print_Traceback): NEW print traceback if available
+	added to support Stack_Trace_Depth = 0.
+	(Print_Address): NEW print System.Address without no secondary
+	stack use (Address_Image uses secondary stack)
+
 2015-10-20  Yannick Moy  <moy@adacore.com>
 
 	* exp_ch9.adb (Expand_Entry_Barrier): Default initialize local variable
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index 2e8676b..7b19dd6 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2015, 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- --
@@ -581,7 +581,7 @@ is
    -- Generic_Sorting --
    ---------------------
 
-   package body Generic_Sorting is
+   package body Generic_Sorting with SPARK_Mode => Off is
 
       ---------------
       -- Is_Sorted --
diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads
index f4a2586..e0b96a3 100644
--- a/gcc/ada/a-cfdlli.ads
+++ b/gcc/ada/a-cfdlli.ads
@@ -299,7 +299,7 @@ is
 
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
+   package Generic_Sorting with SPARK_Mode is
 
       function Is_Sorted (Container : List) return Boolean with
         Global => null;
diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index 8d73a2c..ac2ea61 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2015, 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- --
@@ -1387,7 +1387,7 @@ is
       end;
    end Vet;
 
-   package body Generic_Keys is
+   package body Generic_Keys with SPARK_Mode => Off is
 
       -----------------------
       -- Local Subprograms --
diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads
index e0d210e..0c43cf2 100644
--- a/gcc/ada/a-cfhase.ads
+++ b/gcc/ada/a-cfhase.ads
@@ -279,7 +279,7 @@ is
 
       with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
-   package Generic_Keys is
+   package Generic_Keys with SPARK_Mode is
 
       function Key (Container : Set; Position : Cursor) return Key_Type with
         Global => null;
diff --git a/gcc/ada/a-cfinve.adb b/gcc/ada/a-cfinve.adb
index f088b9e..da23a44 100644
--- a/gcc/ada/a-cfinve.adb
+++ b/gcc/ada/a-cfinve.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2014, Free Software Foundation, Inc.           --
+--          Copyright (C) 2014-2015, 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- --
@@ -174,7 +174,7 @@ is
    -- Generic_Sorting --
    ---------------------
 
-   package body Generic_Sorting is
+   package body Generic_Sorting with SPARK_Mode => Off is
 
       function "<" (X, Y : Holder) return Boolean is (E (X) < E (Y));
       package Def_Sorting is new Def.Generic_Sorting ("<");
diff --git a/gcc/ada/a-cfinve.ads b/gcc/ada/a-cfinve.ads
index 7559df6..2fef4af 100644
--- a/gcc/ada/a-cfinve.ads
+++ b/gcc/ada/a-cfinve.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2014, Free Software Foundation, Inc.           --
+--          Copyright (C) 2014-2015, 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 --
@@ -198,7 +198,7 @@ is
 
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
+   package Generic_Sorting with SPARK_Mode is
 
       function Is_Sorted (Container : Vector) return Boolean with
         Global => null;
diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb
index e120321..2b09018 100644
--- a/gcc/ada/a-cforse.adb
+++ b/gcc/ada/a-cforse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2015, 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- --
@@ -674,7 +674,7 @@ is
    -- Generic_Keys --
    ------------------
 
-   package body Generic_Keys is
+   package body Generic_Keys with SPARK_Mode => Off is
 
       -----------------------
       -- Local Subprograms --
diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads
index a69aa4f..a3cbae1 100644
--- a/gcc/ada/a-cforse.ads
+++ b/gcc/ada/a-cforse.ads
@@ -288,7 +288,7 @@ is
 
       with function "<" (Left, Right : Key_Type) return Boolean is <>;
 
-   package Generic_Keys is
+   package Generic_Keys with SPARK_Mode is
 
       function Equivalent_Keys (Left, Right : Key_Type) return Boolean with
         Global => null;
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index ef37cc0..c713bbc 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2015, 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- --
@@ -355,7 +355,7 @@ is
    -- Generic_Sorting --
    ---------------------
 
-   package body Generic_Sorting is
+   package body Generic_Sorting with SPARK_Mode => Off is
 
       ---------------
       -- Is_Sorted --
diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads
index 284f034..622454e 100644
--- a/gcc/ada/a-cofove.ads
+++ b/gcc/ada/a-cofove.ads
@@ -203,7 +203,7 @@ is
 
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
+   package Generic_Sorting with SPARK_Mode is
 
       function Is_Sorted (Container : Vector) return Boolean with
         Global => null;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 3e13126..b0bf000 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -9140,6 +9140,8 @@ package body Exp_Ch9 is
                      --  is OK to miss this check in -gnatc mode.
 
                      Check_Restriction (No_Implicit_Heap_Allocations, Priv);
+                     Check_Restriction
+                       (No_Implicit_Protected_Object_Allocations, Priv);
 
                   elsif Restriction_Active (No_Implicit_Heap_Allocations) then
                      if not Discriminated_Size (Defining_Identifier (Priv))
@@ -9162,6 +9164,34 @@ package body Exp_Ch9 is
                            & " restriction No_Implicit_Heap_Allocations??",
                            Priv, Prot_Typ);
                      end if;
+
+                  --  Likewise for No_Implicit_Protected_Object_Allocations
+
+                  elsif Restriction_Active
+                    (No_Implicit_Protected_Object_Allocations)
+                  then
+                     if not Discriminated_Size (Defining_Identifier (Priv))
+                     then
+
+                        --  Any object of the type will be  non-static.
+
+                        Error_Msg_N ("component has non-static size??", Priv);
+                        Error_Msg_NE
+                          ("\creation of protected object of type& will"
+                           & " violate restriction "
+                           & "No_Implicit_Protected_Object_Allocations??",
+                           Priv, Prot_Typ);
+                     else
+
+                        --  Object will be non-static if discriminants are.
+
+                        Error_Msg_NE
+                          ("creation of protected object of type& with "
+                           &  "non-static discriminants  will violate "
+                           & " restriction"
+                           & " No_Implicit_Protected_Object_Allocations??",
+                           Priv, Prot_Typ);
+                     end if;
                   end if;
                end if;
 
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 1df23b5..36befa6 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -194,11 +194,15 @@ extern Boolean No_Strict_Aliasing_CP;
 
 #define No_Exception_Handlers_Set      restrict__no_exception_handlers_set
 #define Check_No_Implicit_Heap_Alloc   restrict__check_no_implicit_heap_alloc
+#define Check_No_Implicit_Task_Alloc   restrict__check_no_implicit_task_alloc
+#define Check_No_Implicit_Protected_Alloc restrict__check_no_implicit_protected_alloc
 #define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed
 #define Check_Implicit_Dynamic_Code_Allowed restrict__check_implicit_dynamic_code_allowed
 
 extern Boolean No_Exception_Handlers_Set   (void);
 extern void Check_No_Implicit_Heap_Alloc   (Node_Id);
+extern void Check_No_Implicit_Task_Alloc   (Node_Id);
+extern void Check_No_Implicit_Protected_Alloc (Node_Id);
 extern void Check_Elaboration_Code_Allowed (Node_Id);
 extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
 
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index 8768e3e..5857094 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -302,6 +302,20 @@ package body GNAT.Debug_Pools is
    --  Wrapper for Put_Line that ensures we always write to stdout instead of
    --  the current output file defined in GNAT.IO.
 
+   procedure Print_Traceback
+     (Output_File : File_Type;
+      Prefix      : String;
+      Traceback   : Traceback_Htable_Elem_Ptr);
+   --  Output Prefix & Traceback & EOL.
+   --  Print nothing if Traceback is null.
+
+   procedure Print_Address (File : File_Type; Addr : Address);
+   --  Output System.Address without using secondary stack.
+   --  When System.Memory uses Debug_Pool, secondary stack cannot be used
+   --  during Allocate calls, as some Allocate calls are done to
+   --  register/initialize a secondary stack for a foreign thread.
+   --  During these calls, the secondary stack is not available yet.
+
    package Validity is
       function Is_Handled (Storage : System.Address) return Boolean;
       pragma Inline (Is_Handled);
@@ -460,6 +474,18 @@ package body GNAT.Debug_Pools is
       end if;
    end Output_File;
 
+   -------------------
+   -- Print_Address --
+   -------------------
+
+   procedure Print_Address (File : File_Type; Addr : Address) is
+      type My_Address is mod Memory_Size;
+      function To_My_Address is new Ada.Unchecked_Conversion
+        (System.Address, My_Address);
+   begin
+      Put (File, My_Address'Image (To_My_Address (Addr)));
+   end Print_Address;
+
    --------------
    -- Put_Line --
    --------------
@@ -481,7 +507,8 @@ package body GNAT.Debug_Pools is
       procedure Print (Tr : Tracebacks_Array) is
       begin
          for J in Tr'Range loop
-            Put (File, "0x" & Address_Image (PC_For (Tr (J))) & ' ');
+            Print_Address (File, PC_For (Tr (J)));
+            Put (File, ' ');
          end loop;
          Put (File, ASCII.LF);
       end Print;
@@ -964,12 +991,16 @@ package body GNAT.Debug_Pools is
       if Pool.Low_Level_Traces then
          Put (Output_File (Pool),
               "info: Allocated"
-                & Storage_Count'Image (Size_In_Storage_Elements)
-                & " bytes at 0x" & Address_Image (Storage_Address)
-                & " (physically:"
-                & Storage_Count'Image (Local_Storage_Array'Length)
-                & " bytes at 0x" & Address_Image (P.all'Address)
-                & "), at ");
+              & Storage_Count'Image (Size_In_Storage_Elements)
+              & " bytes at ");
+         Print_Address (Output_File (Pool), Storage_Address);
+         Put (Output_File (Pool),
+              " (physically:"
+              & Storage_Count'Image (Local_Storage_Array'Length)
+              & " bytes at ");
+         Print_Address (Output_File (Pool), P.all'Address);
+         Put (Output_File (Pool),
+              "), at ");
          Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
                    Allocate_Label'Address,
                    Code_Address_For_Deallocate_End);
@@ -1151,13 +1182,15 @@ package body GNAT.Debug_Pools is
                Next := Header.Next;
 
                if Pool.Low_Level_Traces then
-                  Put_Line
+                  Put
                     (Output_File (Pool),
                      "info: Freeing physical memory "
-                       & Storage_Count'Image
+                     & Storage_Count'Image
                        ((abs Header.Block_Size) + Extra_Allocation)
-                       & " bytes at 0x"
-                       & Address_Image (Header.Allocation_Address));
+                     & " bytes at ");
+                  Print_Address (Output_File (Pool),
+                                 Header.Allocation_Address);
+                  Put_Line (Output_File (Pool), "");
                end if;
 
                if System_Memory_Debug_Pool_Enabled then
@@ -1343,6 +1376,21 @@ package body GNAT.Debug_Pools is
 
    end Get_Size;
 
+   ---------------------
+   -- Print_Traceback --
+   ---------------------
+
+   procedure Print_Traceback
+     (Output_File : File_Type;
+      Prefix      : String;
+      Traceback   : Traceback_Htable_Elem_Ptr) is
+   begin
+      if Traceback /= null then
+         Put (Output_File, Prefix);
+         Put_Line (Output_File, 0, Traceback.Traceback);
+      end if;
+   end Print_Traceback;
+
    ----------------
    -- Deallocate --
    ----------------
@@ -1411,12 +1459,11 @@ package body GNAT.Debug_Pools is
             Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
                       Deallocate_Label'Address,
                       Code_Address_For_Deallocate_End);
-            Put (Output_File (Pool), "   Memory already deallocated at ");
-            Put_Line
-               (Output_File (Pool), 0,
-                To_Traceback (Header.Dealloc_Traceback).Traceback);
-            Put (Output_File (Pool), "   Memory was allocated at ");
-            Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
+            Print_Traceback (Output_File (Pool),
+                             "   Memory already deallocated at ",
+                            To_Traceback (Header.Dealloc_Traceback));
+            Print_Traceback (Output_File (Pool), "   Memory was allocated at ",
+                             Header.Alloc_Traceback);
          end if;
 
       else
@@ -1439,16 +1486,20 @@ package body GNAT.Debug_Pools is
             Put (Output_File (Pool),
                  "info: Deallocated"
                  & Storage_Count'Image (Header.Block_Size)
-                 & " bytes at 0x" & Address_Image (Storage_Address)
-                 & " (physically"
+                 & " bytes at ");
+            Print_Address (Output_File (Pool), Storage_Address);
+            Put (Output_File (Pool),
+                 " (physically"
                  & Storage_Count'Image (Header.Block_Size + Extra_Allocation)
-                 & " bytes at 0x" & Address_Image (Header.Allocation_Address)
-                 & "), at ");
+                 & " bytes at ");
+            Print_Address (Output_File (Pool), Header.Allocation_Address);
+            Put (Output_File (Pool), "), at ");
+
             Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
                       Deallocate_Label'Address,
                       Code_Address_For_Deallocate_End);
-            Put (Output_File (Pool), "   Memory was allocated at ");
-            Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
+            Print_Traceback (Output_File (Pool), "   Memory was allocated at ",
+                             Header.Alloc_Traceback);
          end if;
 
          --  Remove this block from the list of used blocks
@@ -1594,14 +1645,10 @@ package body GNAT.Debug_Pools is
                  (Output_File (Pool), Pool.Stack_Trace_Depth, null,
                   Dereference_Label'Address,
                   Code_Address_For_Dereference_End);
-               Put (Output_File (Pool), "  First deallocation at ");
-               Put_Line
-                 (Output_File (Pool),
-                  0, To_Traceback (Header.Dealloc_Traceback).Traceback);
-               Put (Output_File (Pool), "  Initial allocation at ");
-               Put_Line
-                 (Output_File (Pool),
-                  0, Header.Alloc_Traceback.Traceback);
+               Print_Traceback (Output_File (Pool), "  First deallocation at ",
+                                To_Traceback (Header.Dealloc_Traceback));
+               Print_Traceback (Output_File (Pool), "  Initial allocation at ",
+                                Header.Alloc_Traceback);
             end if;
          end if;
       end if;
@@ -1787,10 +1834,12 @@ package body GNAT.Debug_Pools is
 
             Put ("Size: " & Storage_Count'Image (Header.Block_Size) & " at: ");
 
-            for T in Header.Alloc_Traceback.Traceback'Range loop
-               Put ("0x" & Address_Image
-                      (PC_For (Header.Alloc_Traceback.Traceback (T))) & ' ');
-            end loop;
+            if Header.Alloc_Traceback /= null then
+               for T in Header.Alloc_Traceback.Traceback'Range loop
+                  Put ("0x" & Address_Image
+                       (PC_For (Header.Alloc_Traceback.Traceback (T))) & ' ');
+               end loop;
+            end if;
 
             Put_Line ("");
             Current := Header.Next;
@@ -2090,16 +2139,16 @@ package body GNAT.Debug_Pools is
 
       else
          Header := Header_Of (Storage);
-         Put_Line (Standard_Output, "0x" & Address_Image (A)
-                     & " allocated at:");
-         Put_Line (Standard_Output, 0, Header.Alloc_Traceback.Traceback);
+         Print_Address (Standard_Output, A);
+         Put_Line (Standard_Output, " allocated at:");
+         Print_Traceback (Standard_Output, "", Header.Alloc_Traceback);
 
          if To_Traceback (Header.Dealloc_Traceback) /= null then
-            Put_Line (Standard_Output, "0x" & Address_Image (A)
-                      & " logically freed memory, deallocated at:");
-            Put_Line
-               (Standard_Output, 0,
-                To_Traceback (Header.Dealloc_Traceback).Traceback);
+            Print_Address (Standard_Output, A);
+            Put_Line (Standard_Output,
+                      " logically freed memory, deallocated at:");
+            Print_Traceback (Standard_Output, "",
+                             To_Traceback (Header.Dealloc_Traceback));
          end if;
       end if;
    end Print_Pool;
@@ -2180,30 +2229,34 @@ package body GNAT.Debug_Pools is
 
          Actual_Size := size_t (Header.Block_Size);
          Tracebk := Header.Alloc_Traceback.Traceback;
-         Num_Calls := Tracebk'Length;
 
-         --  (Code taken from memtrack.adb in GNAT's sources)
+         if Header.Alloc_Traceback /= null then
+            Num_Calls := Tracebk'Length;
 
-         --  Logs allocation call using the format:
+            --  (Code taken from memtrack.adb in GNAT's sources)
 
-         --   'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
+            --  Logs allocation call using the format:
 
-         fputc (Character'Pos ('A'), File);
-         fwrite (Current'Address, Address_Size, 1, File);
-         fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
-                 File);
-         fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements, 1,
-                 File);
-         fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
-                 File);
+            --  'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
 
-         for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
-            declare
-               Ptr : System.Address := PC_For (Tracebk (J));
-            begin
-               fwrite (Ptr'Address, Address_Size, 1, File);
-            end;
-         end loop;
+            fputc (Character'Pos ('A'), File);
+            fwrite (Current'Address, Address_Size, 1, File);
+            fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements,
+                    1, File);
+            fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements,
+                    1, File);
+            fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
+                    File);
+
+            for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
+               declare
+                  Ptr : System.Address := PC_For (Tracebk (J));
+               begin
+                  fwrite (Ptr'Address, Address_Size, 1, File);
+               end;
+            end loop;
+
+         end if;
 
          Current := Header.Next;
       end loop;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 1db3009..e905a0b 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1902,7 +1902,8 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
   Raise_From_Signal_Handler (exception, msg);
 }
 
-#if defined (__i386__) && !defined (VTHREADS)
+#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR < 7
+
 extern void
 __gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
 
@@ -1939,7 +1940,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
   sigdelset (&mask, sig);
   sigprocmask (SIG_SETMASK, &mask, NULL);
 
-#if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__)
+#if defined (__ARMEL__) || defined (__PPC__) || (defined (__i386__) && _WRS_VXWORKS_MAJOR < 7)
   /* On certain targets, kernel mode, we process signals through a Call Frame
      Info trampoline, voiding the need for myriads of fallback_frame_state
      variants in the ZCX runtime.  We have no simple way to distinguish ZCX
@@ -2039,7 +2040,7 @@ __gnat_install_handler (void)
   trap_0_entry->inst_fourth = 0xa1480000;
 #endif
 
-#if defined (__i386__) && !defined (VTHREADS)
+#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR != 7
   /*  By experiment, found that sysModel () returns the following string
       prefix for vxsim when running on Linux and Windows.  */
   model = sysModel ();
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 8c0f902..1dbd3d5 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -285,6 +285,24 @@ package body Restrict is
       Check_Restriction (No_Implicit_Heap_Allocations, N);
    end Check_No_Implicit_Heap_Alloc;
 
+   ----------------------------------
+   -- Check_No_Implicit_Task_Alloc --
+   ----------------------------------
+
+   procedure Check_No_Implicit_Task_Alloc (N : Node_Id) is
+   begin
+      Check_Restriction (No_Implicit_Task_Allocations, N);
+   end Check_No_Implicit_Task_Alloc;
+
+   ---------------------------------------
+   -- Check_No_Implicit_Protected_Alloc --
+   ---------------------------------------
+
+   procedure Check_No_Implicit_Protected_Alloc (N : Node_Id) is
+   begin
+      Check_Restriction (No_Implicit_Protected_Object_Allocations, N);
+   end Check_No_Implicit_Protected_Alloc;
+
    -----------------------------------
    -- Check_Obsolescent_2005_Entity --
    -----------------------------------
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index ac0a09e..48a531d 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -337,6 +337,15 @@ package Restrict is
    --  Equivalent to Check_Restriction (No_Implicit_Heap_Allocations, N).
    --  Provided for easy use by back end, which has to check this restriction.
 
+   procedure Check_No_Implicit_Task_Alloc (N : Node_Id);
+   --  Equivalent to Check_Restriction (No_Implicit_Task_Allocations, N).
+   --  Provided for easy use by back end, which has to check this restriction.
+
+   procedure Check_No_Implicit_Protected_Alloc (N : Node_Id);
+   --  Equivalent to:
+   --    Check_Restriction (No_Implicit_Protected_Object_Allocations, N)
+   --  Provided for easy use by back end, which has to check this restriction.
+
    procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id);
    --  This routine checks if the entity E is one of the obsolescent entries
    --  in Ada.Characters.Handling in Ada 2005 and No_Obsolescent_Features
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index 7537387..4fdb6ac 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -119,6 +119,8 @@ package System.Rident is
       No_Implicit_Conditionals,                  -- GNAT
       No_Implicit_Dynamic_Code,                  -- GNAT
       No_Implicit_Heap_Allocations,              -- (RM D.8(8), H.4(3))
+      No_Implicit_Task_Allocations,              -- GNAT
+      No_Implicit_Protected_Object_Allocations,  -- GNAT
       No_Implicit_Loops,                         -- GNAT
       No_Initialize_Scalars,                     -- GNAT
       No_Local_Allocators,                       -- (RM H.4(8))
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 2f5b8ca95..7ff465a 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9883,6 +9883,8 @@ package body Sem_Res is
         and then Ekind_In (Entity (S), E_Component, E_Discriminant)
         and then Present (Original_Record_Component (Entity (S)))
         and then Ekind (Original_Record_Component (Entity (S))) = E_Component
+        and then
+          Is_Declared_Within_Variant (Original_Record_Component (Entity (S)))
         and then not Discriminant_Checks_Suppressed (T)
         and then not Init_Component
       then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cc17f01..b2f1f10 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11125,6 +11125,17 @@ package body Sem_Util is
       end case;
    end Is_Declaration;
 
+   --------------------------------
+   -- Is_Declared_Within_Variant --
+   --------------------------------
+
+   function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean is
+      Comp_Decl : constant Node_Id := Parent (Comp);
+      Comp_List : constant Node_Id := Parent (Comp_Decl);
+   begin
+      return Nkind (Parent (Comp_List)) = N_Variant;
+   end Is_Declared_Within_Variant;
+
    ----------------------------------------------
    -- Is_Dependent_Component_Of_Mutable_Object --
    ----------------------------------------------
@@ -11132,20 +11143,6 @@ package body Sem_Util is
    function Is_Dependent_Component_Of_Mutable_Object
      (Object : Node_Id) return Boolean
    is
-      function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
-      --  Returns True if and only if Comp is declared within a variant part
-
-      --------------------------------
-      -- Is_Declared_Within_Variant --
-      --------------------------------
-
-      function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean is
-         Comp_Decl : constant Node_Id   := Parent (Comp);
-         Comp_List : constant Node_Id   := Parent (Comp_Decl);
-      begin
-         return Nkind (Parent (Comp_List)) = N_Variant;
-      end Is_Declared_Within_Variant;
-
       P           : Node_Id;
       Prefix_Type : Entity_Id;
       P_Aliased   : Boolean := False;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e882f16..872bded 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1262,6 +1262,9 @@ package Sem_Util is
    function Is_Declaration (N : Node_Id) return Boolean;
    --  Determine whether arbitrary node N denotes a declaration
 
+   function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
+   --  Returns True iff component Comp is declared within a variant part
+
    function Is_Dependent_Component_Of_Mutable_Object
      (Object : Node_Id) return Boolean;
    --  Returns True if Object is the name of a subcomponent that depends on