[multiple changes]

2016-04-21  Philippe Gil  <gil@adacore.com>

	* tracebak.c (__gnat_backtrace): handle bad RIP values (win64 only)

2016-04-21  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Component_Not_OK_For_Backend): Return true for string
	literals.

2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Has_Non_Null_Abstract_State): New routine.
	* einfo.ads New synthesized attribute
	Has_Non_Null_Abstract_State along with occurrences in entities.
	(Has_Non_Null_Abstract_State): New routine.
	* sem_ch7.adb (Unit_Requires_Body): Add local variable
	Requires_Body. A package declaring an abstract state requires
	a body only when the state is non-null and the package contains
	at least one other construct that requires completion in a body.
	* sem_util.adb (Mode_Is_Off): Removed.
	(Requires_State_Refinement): Remove an obsolete check. Code
	cleanup.

2016-04-21  Bob Duff  <duff@adacore.com>

	* sem_attr.adb (Analyze_Attribute): In processing
	the 'Old attribute, a warning is given for infinite recursion. Fix
	the code to not crash when the prefix of 'Old denotes a protected
	function.
	* sem_ch5.adb (Analyze_Iterator_Specification):
	Avoid calling Is_Dependent_Component_Of_Mutable_Object in cases
	where the parameter would not be an object.

2016-04-21  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_eval.adb (Compile_Time_Compare): Be prepared for an empty
	Etype or Underlying_Type of the operands.

2016-04-21  Eric Botcazou  <ebotcazou@adacore.com>

	* atree.adb (Print_Statistics): Protect against overflows and
	print the memory consumption in bytes.
	* table.adb (Reallocate): Do the intermediate calculation of the new
	size using the Memory.size_t type.

From-SVN: r235312

12 files changed, 196 insertions, 103 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d0cc96a..0203415 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,48 @@
+2016-04-21  Philippe Gil  <gil@adacore.com>
+
+	* tracebak.c (__gnat_backtrace): handle bad RIP values (win64 only)
+
+2016-04-21  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb (Component_Not_OK_For_Backend): Return true for string
+	literals.
+
+2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb (Has_Non_Null_Abstract_State): New routine.
+	* einfo.ads New synthesized attribute
+	Has_Non_Null_Abstract_State along with occurrences in entities.
+	(Has_Non_Null_Abstract_State): New routine.
+	* sem_ch7.adb (Unit_Requires_Body): Add local variable
+	Requires_Body. A package declaring an abstract state requires
+	a body only when the state is non-null and the package contains
+	at least one other construct that requires completion in a body.
+	* sem_util.adb (Mode_Is_Off): Removed.
+	(Requires_State_Refinement): Remove an obsolete check. Code
+	cleanup.
+
+2016-04-21  Bob Duff  <duff@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute): In processing
+	the 'Old attribute, a warning is given for infinite recursion. Fix
+	the code to not crash when the prefix of 'Old denotes a protected
+	function.
+	* sem_ch5.adb (Analyze_Iterator_Specification):
+	Avoid calling Is_Dependent_Component_Of_Mutable_Object in cases
+	where the parameter would not be an object.
+
+2016-04-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_eval.adb (Compile_Time_Compare): Be prepared for an empty
+	Etype or Underlying_Type of the operands.
+
+2016-04-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* atree.adb (Print_Statistics): Protect against overflows and
+	print the memory consumption in bytes.
+	* table.adb (Reallocate): Do the intermediate calculation of the new
+	size using the Memory.size_t type.
+
 2016-04-21  Gary Dismukes  <dismukes@adacore.com>
 
 	* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Suppress
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 67b55a9..a0849d2 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -1970,13 +1970,6 @@ package body Atree is
       E_Count : Natural := 0;
 
    begin
-      Write_Str ("Maximum number of nodes per entity: ");
-      Write_Int (Int (Num_Extension_Nodes + 1));
-      Write_Eol;
-      Write_Str ("Number of allocated nodes: ");
-      Write_Int (Int (N_Count));
-      Write_Eol;
-
       Write_Str ("Number of entities: ");
       Write_Eol;
 
@@ -2051,10 +2044,29 @@ package body Atree is
       Write_Str ("Total number of entities: ");
       Write_Int (Int (E_Count));
       Write_Eol;
+
+      Write_Str ("Maximum number of nodes per entity: ");
+      Write_Int (Int (Num_Extension_Nodes + 1));
+      Write_Eol;
+
+      Write_Str ("Number of allocated nodes: ");
+      Write_Int (Int (N_Count));
+      Write_Eol;
+
       Write_Str ("Ratio allocated nodes/entities: ");
-      Write_Int (Int (N_Count * 100 / E_Count));
+      Write_Int (Int (Long_Long_Integer (N_Count) * 100 /
+                                                 Long_Long_Integer (E_Count)));
       Write_Str ("/100");
       Write_Eol;
+
+      Write_Str ("Size of a node in bytes: ");
+      Write_Int (Int (Node_Record'Size) / Storage_Unit);
+      Write_Eol;
+
+      Write_Str ("Memory consumption in bytes: ");
+      Write_Int (Int (Long_Long_Integer (N_Count) *
+                                           (Node_Record'Size / Storage_Unit)));
+      Write_Eol;
    end Print_Statistics;
 
    -------------------
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 9f1f3a9..f52702f 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -7332,6 +7332,20 @@ package body Einfo is
         and then Present (Non_Limited_View (Id));
    end Has_Non_Limited_View;
 
+   ---------------------------------
+   -- Has_Non_Null_Abstract_State --
+   ---------------------------------
+
+   function Has_Non_Null_Abstract_State (Id : E) return B is
+   begin
+      pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
+
+      return
+        Present (Abstract_States (Id))
+          and then
+            not Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
+   end Has_Non_Null_Abstract_State;
+
    -------------------------------------
    -- Has_Non_Null_Visible_Refinement --
    -------------------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 535fa39..d403f77 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -1761,6 +1761,10 @@ package Einfo is
 --       E_Abstract_State entities. True if their Non_Limited_View attribute
 --       is present.
 
+--    Has_Non_Null_Abstract_State (synth)
+--       Defined in package entities. True if the package is subject to a non-
+--       null Abstract_State aspect/pragma.
+
 --    Has_Non_Null_Visible_Refinement (synth)
 --       Defined in E_Abstract_State entities. True if the state has a visible
 --       refinement of at least one variable or state constituent as expressed
@@ -6133,6 +6137,7 @@ package Einfo is
    --    SPARK_Aux_Pragma_Inherited          (Flag266)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Static_Elaboration_Desired          (Flag77)   (non-generic case only)
+   --    Has_Non_Null_Abstract_State         (synth)
    --    Has_Null_Abstract_State             (synth)
    --    Is_Wrapper_Package                  (synth)    (non-generic case only)
    --    Scope_Depth                         (synth)
@@ -7270,6 +7275,7 @@ package Einfo is
    function Has_Entries                         (Id : E) return B;
    function Has_Foreign_Convention              (Id : E) return B;
    function Has_Non_Limited_View                (Id : E) return B;
+   function Has_Non_Null_Abstract_State         (Id : E) return B;
    function Has_Non_Null_Visible_Refinement     (Id : E) return B;
    function Has_Null_Abstract_State             (Id : E) return B;
    function Has_Null_Visible_Refinement         (Id : E) return B;
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c7a9a97..a99b6ce 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -6014,6 +6014,12 @@ package body Exp_Aggr is
             elsif Possible_Bit_Aligned_Component (Expr_Q) then
                Static_Components := False;
                return True;
+
+            elsif Modify_Tree_For_C
+              and then Ekind (Etype (Expr_Q)) = E_String_Literal_Subtype
+            then
+               Static_Components := False;
+               return True;
             end if;
 
             if Is_Elementary_Type (Etype (Expr_Q)) then
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index db02aa5..3a0fcbe 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4940,7 +4940,13 @@ package body Sem_Attr is
             --    function Func (...) return ...
             --      with Post => Func'Old ...;
 
-            elsif Nkind (P) = N_Function_Call then
+            --  The function may be specified in qualified form X.Y where X is
+            --  a protected object and Y is a protected function. In that case
+            --  ensure that the qualified form has an entity.
+
+            elsif Nkind (P) = N_Function_Call
+              and then Nkind (Name (P)) in N_Has_Entity
+            then
                Pref_Id := Entity (Name (P));
 
                if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 71ab4d0..138da4d 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -2139,11 +2139,15 @@ package body Sem_Ch5 is
 
             else
                declare
-                  Element     : constant Entity_Id :=
-                    Find_Value_Of_Aspect (Typ, Aspect_Iterator_Element);
-                  Iterator    : constant Entity_Id :=
-                    Find_Value_Of_Aspect (Typ, Aspect_Default_Iterator);
-                  Cursor_Type : Entity_Id;
+                  Element        : constant Entity_Id :=
+                                     Find_Value_Of_Aspect
+                                       (Typ, Aspect_Iterator_Element);
+                  Iterator       : constant Entity_Id :=
+                                     Find_Value_Of_Aspect
+                                       (Typ, Aspect_Default_Iterator);
+                  Orig_Iter_Name : constant Node_Id :=
+                                     Original_Node (Iter_Name);
+                  Cursor_Type    : Entity_Id;
 
                begin
                   if No (Element) then
@@ -2181,8 +2185,9 @@ package body Sem_Ch5 is
                      if not Is_Variable (Iter_Name)
                        and then not Has_Aspect (Typ, Aspect_Constant_Indexing)
                      then
-                        Error_Msg_N ("iteration over constant container "
-                          & "require constant_indexing aspect", N);
+                        Error_Msg_N
+                          ("iteration over constant container require "
+                           & "constant_indexing aspect", N);
 
                      --  The Iterate function may have an in_out parameter,
                      --  and a constant container is thus illegal.
@@ -2193,15 +2198,20 @@ package body Sem_Ch5 is
                                   E_In_Parameter
                        and then not Is_Variable (Iter_Name)
                      then
-                        Error_Msg_N
-                          ("variable container expected", N);
+                        Error_Msg_N ("variable container expected", N);
                      end if;
 
-                     if Nkind (Original_Node (Iter_Name))
-                        = N_Selected_Component
-                       and then
-                         Is_Dependent_Component_Of_Mutable_Object
-                           (Original_Node (Iter_Name))
+                     --  It could be a function, which
+                     --  Is_Dependent_Component_Of_Mutable_Object doesn't like,
+                     --  so check that it's a component.
+
+                     if Nkind (Orig_Iter_Name) = N_Selected_Component
+                       and then Ekind_In
+                                  (Entity (Selector_Name (Orig_Iter_Name)),
+                                   E_Component,
+                                   E_Discriminant)
+                       and then Is_Dependent_Component_Of_Mutable_Object
+                                  (Orig_Iter_Name)
                      then
                         Error_Msg_N
                           ("container cannot be a discriminant-dependent "
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index e24de93..04ad209 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -2454,7 +2454,7 @@ package body Sem_Ch7 is
 
       elsif Ekind (Id) = E_Package
         and then Nkind (Original_Node (Unit_Declaration_Node (Id))) =
-                                                   N_Formal_Package_Declaration
+                   N_Formal_Package_Declaration
       then
          return False;
 
@@ -2464,8 +2464,7 @@ package body Sem_Ch7 is
       --  implicit completion at some point.
 
       elsif (Is_Overloadable (Id)
-              and then Ekind (Id) /= E_Enumeration_Literal
-              and then Ekind (Id) /= E_Operator
+              and then not Ekind_In (Id, E_Enumeration_Literal, E_Operator)
               and then not Is_Abstract_Subprogram (Id)
               and then not Has_Completion (Id)
               and then Comes_From_Source (Parent (Id)))
@@ -2494,7 +2493,6 @@ package body Sem_Ch7 is
         or else
           (Is_Generic_Subprogram (Id)
             and then not Has_Completion (Id))
-
       then
          return True;
 
@@ -2962,6 +2960,10 @@ package body Sem_Ch7 is
    is
       E : Entity_Id;
 
+      Requires_Body : Boolean := False;
+      --  Flag set when the unit has at least one construct that requries
+      --  completion in a body.
+
    begin
       --  Imported entity never requires body. Right now, only subprograms can
       --  be imported, but perhaps in the future we will allow import of
@@ -2996,35 +2998,42 @@ package body Sem_Ch7 is
                return True;
             end if;
          end;
-
-      --  A [generic] package that introduces at least one non-null abstract
-      --  state requires completion. However, there is a separate rule that
-      --  requires that such a package have a reason other than this for a
-      --  body being required (if necessary a pragma Elaborate_Body must be
-      --  provided). If Ignore_Abstract_State is True, we don't do this check
-      --  (so we can use Unit_Requires_Body to check for some other reason).
-
-      elsif Ekind_In (Pack_Id, E_Generic_Package, E_Package)
-        and then not Ignore_Abstract_State
-        and then Present (Abstract_States (Pack_Id))
-        and then not Is_Null_State
-                       (Node (First_Elmt (Abstract_States (Pack_Id))))
-      then
-         return True;
       end if;
 
-      --  Otherwise search entity chain for entity requiring completion
+      --  Traverse the entity chain of the package and look for constructs that
+      --  require a completion in a body.
 
       E := First_Entity (Pack_Id);
       while Present (E) loop
-         if Requires_Completion_In_Body (E, Pack_Id) then
-            return True;
+
+         --  Skip abstract states because their completion depends on several
+         --  criteria (see below).
+
+         if Ekind (E) = E_Abstract_State then
+            null;
+
+         elsif Requires_Completion_In_Body (E, Pack_Id) then
+            Requires_Body := True;
+            exit;
          end if;
 
          Next_Entity (E);
       end loop;
 
-      return False;
+      --  A [generic] package that defines at least one non-null abstract state
+      --  requires a completion only when at least one other construct requires
+      --  a completion in a body (SPARK RM 7.1.4(4) and (6)). This check is not
+      --  performed if the caller requests this behavior.
+
+      if not Ignore_Abstract_State
+        and then Ekind_In (Pack_Id, E_Generic_Package, E_Package)
+        and then Has_Non_Null_Abstract_State (Pack_Id)
+        and then Requires_Body
+      then
+         return True;
+      end if;
+
+      return Requires_Body;
    end Unit_Requires_Body;
 
    -----------------------------
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 620c166..5589394 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -772,12 +772,8 @@ package body Sem_Eval is
       Assume_Valid : Boolean;
       Rec          : Boolean := False) return Compare_Result
    is
-      Ltyp : Entity_Id := Underlying_Type (Etype (L));
-      Rtyp : Entity_Id := Underlying_Type (Etype (R));
-      --  These get reset to the base type for the case of entities where
-      --  Is_Known_Valid is not set. This takes care of handling possible
-      --  invalid representations using the value of the base type, in
-      --  accordance with RM 13.9.1(10).
+      Ltyp : Entity_Id := Etype (L);
+      Rtyp : Entity_Id := Etype (R);
 
       Discard : aliased Uint;
 
@@ -1100,19 +1096,35 @@ package body Sem_Eval is
 
       if L = R then
          return EQ;
+      end if;
 
       --  If expressions have no types, then do not attempt to determine if
       --  they are the same, since something funny is going on. One case in
       --  which this happens is during generic template analysis, when bounds
       --  are not fully analyzed.
 
-      elsif No (Ltyp) or else No (Rtyp) then
+      if No (Ltyp) or else No (Rtyp) then
+         return Unknown;
+      end if;
+
+      --  These get reset to the base type for the case of entities where
+      --  Is_Known_Valid is not set. This takes care of handling possible
+      --  invalid representations using the value of the base type, in
+      --  accordance with RM 13.9.1(10).
+
+      Ltyp := Underlying_Type (Ltyp);
+      Rtyp := Underlying_Type (Rtyp);
+
+      --  Same rationale as above, but for Underlying_Type instead of Etype
+
+      if No (Ltyp) or else No (Rtyp) then
          return Unknown;
+      end if;
 
-      --  We do not attempt comparisons for packed arrays represented as
+      --  We do not attempt comparisons for packed arrays arrays represented as
       --  modular types, where the semantics of comparison is quite different.
 
-      elsif Is_Packed_Array_Impl_Type (Ltyp)
+      if Is_Packed_Array_Impl_Type (Ltyp)
         and then Is_Modular_Integer_Type (Ltyp)
       then
          return Unknown;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a106711..a470026 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18267,35 +18267,7 @@ package body Sem_Util is
      (Spec_Id : Entity_Id;
       Body_Id : Entity_Id) return Boolean
    is
-      function Mode_Is_Off (Prag : Node_Id) return Boolean;
-      --  Given pragma SPARK_Mode, determine whether the mode is Off
-
-      -----------------
-      -- Mode_Is_Off --
-      -----------------
-
-      function Mode_Is_Off (Prag : Node_Id) return Boolean is
-         Mode : Node_Id;
-
-      begin
-         --  The default SPARK mode is On
-
-         if No (Prag) then
-            return False;
-         end if;
-
-         Mode := Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag)));
-
-         --  Then the pragma lacks an argument, the default mode is On
-
-         if No (Mode) then
-            return False;
-         else
-            return Chars (Mode) = Name_Off;
-         end if;
-      end Mode_Is_Off;
-
-   --  Start of processing for Requires_State_Refinement
+      Prag : constant Node_Id := SPARK_Pragma (Body_Id);
 
    begin
       --  A package that does not define at least one abstract state cannot
@@ -18314,15 +18286,8 @@ package body Sem_Util is
       --  it is and the mode is Off, the package body is considered to be in
       --  regular Ada and does not require refinement.
 
-      elsif Mode_Is_Off (SPARK_Pragma (Body_Id)) then
-         return False;
-
-      --  The body's SPARK_Mode may be inherited from a similar pragma that
-      --  appears in the private declarations of the spec. The pragma we are
-      --  interested appears as the second entry in SPARK_Pragma.
-
-      elsif Present (SPARK_Pragma (Spec_Id))
-        and then Mode_Is_Off (Next_Pragma (SPARK_Pragma (Spec_Id)))
+      elsif Present (Prag)
+        and then Get_SPARK_Mode_From_Annotation (Prag) = Off
       then
          return False;
 
diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb
index 4c74539..34fe728 100644
--- a/gcc/ada/table.adb
+++ b/gcc/ada/table.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -207,9 +207,11 @@ package body Table is
             end if;
          end if;
 
+         --  Do the intermediate calculation in size_t to avoid signed overflow
+
          New_Size :=
-           Memory.size_t ((Max - Min + 1) *
-                          (Table_Type'Component_Size / Storage_Unit));
+           Memory.size_t (Max - Min + 1) *
+                                    (Table_Type'Component_Size / Storage_Unit);
 
          if Table = null then
             Table := To_Pointer (Alloc (New_Size));
diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c
index ff85ca5..dceac0d 100644
--- a/gcc/ada/tracebak.c
+++ b/gcc/ada/tracebak.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *            Copyright (C) 2000-2015, Free Software Foundation, Inc.       *
+ *            Copyright (C) 2000-2016, 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- *
@@ -99,6 +99,8 @@ extern void (*Unlock_Task) (void);
 
 #include <windows.h>
 
+#define IS_BAD_PTR(ptr) (IsBadCodePtr((FARPROC)ptr))
+
 int
 __gnat_backtrace (void **array,
                   int size,
@@ -137,6 +139,10 @@ __gnat_backtrace (void **array,
 	}
       else
 	{
+	  /* If the last unwinding step failed somehow, stop here.  */
+	  if (IS_BAD_PTR(context.Rip))
+	    break;
+
 	  /* Unwind.  */
 	  memset (&NvContext, 0, sizeof (KNONVOLATILE_CONTEXT_POINTERS));
 	  RtlVirtualUnwind (0, ImageBase, context.Rip, RuntimeFunction,