2011-08-04 Yannick Moy <moy@adacore.com>

	* sem_prag.adb, sem.ads: Code cleanup.

2011-08-04  Tristan Gingold  <gingold@adacore.com>

	* s-tassta.adb (Task_Wrapper): Rewrite the dynamic stack usage part.
	* s-stausa.adb, s-stausa.ads: Major rewrite. Now provides accurate
	results if possible.
	* s-stusta.adb (Print): Adjust after changes in s-stausa.
	* gnat_ugn.texi: Update dynamic stack usage section.

2011-08-04  Steve Baird  <baird@adacore.com>

	* bindgen.adb (Gen_CodePeer_Wrapper): new procedure.
	Generate (if CodePeer_Mode is set) a "wrapper" subprogram which
	contains only a call to the user-defined main subprogram.
	(Gen_Main_Ada) - If CodePeer_Mode is set, then
	call the "wrapper" subprogram instead of directly
	calling the user-defined main subprogram.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb (Expand_N_Case_Statement): Check the statements of all
	alternatives of a case statement for controlled objects. Rename local
	variable A to Dead_Alt.
	(Expand_N_If_Statement): Check the then and else statements of an if
	statement for controlled objects. Check the then statements of all
	elsif parts of an if statement for controlled objects.
	(Expand_N_Loop_Statement): Check the statements of a loop for controlled
	objects.
	* exp_ch7.adb (Process_Transient_Objects): Rewrite the condition which
	detects a loop associated with the expansion of an array object.
	Augment the processing of the loop statements to account for a possible
	wrap done by Process_Statements_For_Controlled_Objects.
	* exp_ch9.adb (Expand_N_Asynchronous_Select): Check the triggering
	statements and abortable part of an asynchronous select for controlled
	objects.
	(Expand_N_Conditional_Entry_Call): Check the else statements of a
	conditional entry call for controlled objects.
	(Expand_N_Selective_Accept): Check the alternatives of a selective
	accept for controlled objects.
	(Expand_N_Timed_Entry_Call): Check the entry call and delay
	alternatives of a timed entry call for controlled objects.
	* exp_ch11.adb (Expand_Exception_Handlers): Check the statements of an
	exception handler for controlled objects.
	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
	Add formal parameter Nested_Constructs along with its associated
	comment.
	(Requires_Cleanup_Actions (Node_Id)): Update all calls to
	Requires_Cleanup_Actions.
	(Process_Statements_For_Controlled_Objects): New routine.
	* exp_util.ads (Process_Statements_For_Controlled_Objects): New
	routine. Inspect a node which contains a non-handled sequence of
	statements for controlled objects. If such an object is found, the
	statements are wrapped in a block.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177386 138bc75d-0d04-0410-961f-82ee72b054a4

15 files changed, 523 insertions, 384 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d2e9f0d85b3..ec696b94f1b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,60 @@
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb, sem.ads: Code cleanup.
+
+2011-08-04  Tristan Gingold  <gingold@adacore.com>
+
+	* s-tassta.adb (Task_Wrapper): Rewrite the dynamic stack usage part.
+	* s-stausa.adb, s-stausa.ads: Major rewrite. Now provides accurate
+	results if possible.
+	* s-stusta.adb (Print): Adjust after changes in s-stausa.
+	* gnat_ugn.texi: Update dynamic stack usage section.
+
+2011-08-04  Steve Baird  <baird@adacore.com>
+
+	* bindgen.adb (Gen_CodePeer_Wrapper): new procedure.
+	Generate (if CodePeer_Mode is set) a "wrapper" subprogram which
+	contains only a call to the user-defined main subprogram.
+	(Gen_Main_Ada) - If CodePeer_Mode is set, then
+	call the "wrapper" subprogram instead of directly
+	calling the user-defined main subprogram.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Case_Statement): Check the statements of all
+	alternatives of a case statement for controlled objects. Rename local
+	variable A to Dead_Alt.
+	(Expand_N_If_Statement): Check the then and else statements of an if
+	statement for controlled objects. Check the then statements of all
+	elsif parts of an if statement for controlled objects.
+	(Expand_N_Loop_Statement): Check the statements of a loop for controlled
+	objects.
+	* exp_ch7.adb (Process_Transient_Objects): Rewrite the condition which
+	detects a loop associated with the expansion of an array object.
+	Augment the processing of the loop statements to account for a possible
+	wrap done by Process_Statements_For_Controlled_Objects.
+	* exp_ch9.adb (Expand_N_Asynchronous_Select): Check the triggering
+	statements and abortable part of an asynchronous select for controlled
+	objects.
+	(Expand_N_Conditional_Entry_Call): Check the else statements of a
+	conditional entry call for controlled objects.
+	(Expand_N_Selective_Accept): Check the alternatives of a selective
+	accept for controlled objects.
+	(Expand_N_Timed_Entry_Call): Check the entry call and delay
+	alternatives of a timed entry call for controlled objects.
+	* exp_ch11.adb (Expand_Exception_Handlers): Check the statements of an
+	exception handler for controlled objects.
+	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
+	Add formal parameter Nested_Constructs along with its associated
+	comment.
+	(Requires_Cleanup_Actions (Node_Id)): Update all calls to
+	Requires_Cleanup_Actions.
+	(Process_Statements_For_Controlled_Objects): New routine.
+	* exp_util.ads (Process_Statements_For_Controlled_Objects): New
+	routine. Inspect a node which contains a non-handled sequence of
+	statements for controlled objects. If such an object is found, the
+	statements are wrapped in a block.
+
 2011-08-04  Bob Duff  <duff@adacore.com>
 
 	* sem_type.adb (Covers): If T2 is a subtype of a class-wide type, we
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 7ee75116879..f2714cdd895 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -1,4 +1,4 @@
-------------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
@@ -74,6 +74,10 @@ package body Bindgen is
    Lib_Final_Built : Boolean := False;
    --  Flag indicating whether the finalize_library rountine has been built
 
+   CodePeer_Wrapper_Name : constant String := "call_main_subprogram";
+   --  For CodePeer, introduce a wrapper subprogram which calls the
+   --  user-defined main subprogram.
+
    ----------------------------------
    -- Interface_State Pragma Table --
    ----------------------------------
@@ -275,6 +279,9 @@ package body Bindgen is
    procedure Gen_Finalize_Library_Defs_C;
    --  Generate a sequence of defininitions for package finalizers (C case)
 
+   procedure Gen_CodePeer_Wrapper;
+   --  For CodePeer, generate wrapper which calls user-defined main subprogram
+
    procedure Gen_Main_Ada;
    --  Generate procedure main (Ada code case)
 
@@ -2126,6 +2133,36 @@ package body Bindgen is
       WBI ("");
    end Gen_Finalize_Library_Defs_C;
 
+   --------------------------
+   -- Gen_CodePeer_Wrapper --
+   --------------------------
+
+   procedure Gen_CodePeer_Wrapper is
+   begin
+      Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+
+      declare
+         --  Bypass Ada_Main_Program; its Import pragma confuses CodePeer
+
+         Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
+         --  Strip trailing "%b"
+      begin
+         if ALIs.Table (ALIs.First).Main_Program = Proc then
+            WBI ("   procedure " & CodePeer_Wrapper_Name & " is ");
+            WBI ("   begin");
+            WBI ("      " & Callee_Name & ";");
+         else
+            WBI
+              ("   function " & CodePeer_Wrapper_Name & " return Integer is");
+            WBI ("   begin");
+            WBI ("      return " & Callee_Name & ";");
+         end if;
+      end;
+
+      WBI ("   end " & CodePeer_Wrapper_Name & ";");
+      WBI ("");
+   end Gen_CodePeer_Wrapper;
+
    ------------------
    -- Gen_Main_Ada --
    ------------------
@@ -2318,22 +2355,11 @@ package body Bindgen is
       if not No_Main_Subprogram then
 
          if CodePeer_Mode then
-
-            --  Bypass Ada_Main_Program, its Import pragma confuses CodePeer
-
-            Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-
-            declare
-               Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
-               --  Strip trailing "%b"
-
-            begin
-               if ALIs.Table (ALIs.First).Main_Program = Proc then
-                  WBI ("      " & Callee_Name & ";");
-               else
-                  WBI ("      Result := " & Callee_Name & ";");
-               end if;
-            end;
+            if ALIs.Table (ALIs.First).Main_Program = Proc then
+               WBI ("      " & CodePeer_Wrapper_Name & ";");
+            else
+               WBI ("      Result := " & CodePeer_Wrapper_Name & ";");
+            end if;
 
          elsif ALIs.Table (ALIs.First).Main_Program = Proc then
             WBI ("      Ada_Main_Program;");
@@ -3232,6 +3258,13 @@ package body Bindgen is
       Gen_Adainit_Ada;
 
       if Bind_Main_Program and then VM_Target = No_VM then
+         --  For CodePeer, declare a wrapper for the
+         --  user-defined main program.
+
+         if CodePeer_Mode then
+            Gen_CodePeer_Wrapper;
+         end if;
+
          Gen_Main_Ada;
       end if;
 
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index d2eed096380..fc55d1567cb 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -968,6 +968,8 @@ package body Exp_Ch11 is
 
       Handler := First_Non_Pragma (Handlrs);
       Handler_Loop : while Present (Handler) loop
+         Process_Statements_For_Controlled_Objects (Handler);
+
          Next_Handler := Next_Non_Pragma (Handler);
 
          --  Remove source handler if gnat debug flag .x is set
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 6cbd62898ab..3c08b512d3b 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2279,6 +2279,8 @@ package body Exp_Ch5 is
       if Compile_Time_Known_Value (Expr) then
          Alt := Find_Static_Alternative (N);
 
+         Process_Statements_For_Controlled_Objects (Alt);
+
          --  Move statements from this alternative after the case statement.
          --  They are already analyzed, so will be skipped by the analyzer.
 
@@ -2290,21 +2292,21 @@ package body Exp_Ch5 is
          Kill_Dead_Code (Expression (N));
 
          declare
-            A : Node_Id;
+            Dead_Alt : Node_Id;
 
          begin
             --  Loop through case alternatives, skipping pragmas, and skipping
             --  the one alternative that we select (and therefore retain).
 
-            A := First (Alternatives (N));
-            while Present (A) loop
-               if A /= Alt
-                 and then Nkind (A) = N_Case_Statement_Alternative
+            Dead_Alt := First (Alternatives (N));
+            while Present (Dead_Alt) loop
+               if Dead_Alt /= Alt
+                 and then Nkind (Dead_Alt) = N_Case_Statement_Alternative
                then
-                  Kill_Dead_Code (Statements (A), Warn_On_Deleted_Code);
+                  Kill_Dead_Code (Statements (Dead_Alt), Warn_On_Deleted_Code);
                end if;
 
-               Next (A);
+               Next (Dead_Alt);
             end loop;
          end;
 
@@ -2351,12 +2353,16 @@ package body Exp_Ch5 is
          Len := List_Length (Alternatives (N));
 
          if Len = 1 then
-            --  We still need to evaluate the expression if it has any
-            --  side effects.
+
+            --  We still need to evaluate the expression if it has any side
+            --  effects.
 
             Remove_Side_Effects (Expression (N));
 
-            Insert_List_After (N, Statements (First (Alternatives (N))));
+            Alt := First (Alternatives (N));
+
+            Process_Statements_For_Controlled_Objects (Alt);
+            Insert_List_After (N, Statements (Alt));
 
             --  That leaves the case statement as a shell. The alternative that
             --  will be executed is reset to a null list. So now we can kill
@@ -2365,7 +2371,6 @@ package body Exp_Ch5 is
             Kill_Dead_Code (Expression (N));
             Rewrite (N, Make_Null_Statement (Loc));
             return;
-         end if;
 
          --  An optimization. If there are only two alternatives, and only
          --  a single choice, then rewrite the whole case statement as an
@@ -2374,7 +2379,7 @@ package body Exp_Ch5 is
          --  simple form, but also with generated code (discriminant check
          --  functions in particular)
 
-         if Len = 2 then
+         elsif Len = 2 then
             Chlist := Discrete_Choices (First (Alternatives (N)));
 
             if List_Length (Chlist) = 1 then
@@ -2451,6 +2456,15 @@ package body Exp_Ch5 is
               (Others_Node, Discrete_Choices (Last_Alt));
             Set_Discrete_Choices (Last_Alt, New_List (Others_Node));
          end if;
+
+         Alt := First (Alternatives (N));
+         while Present (Alt)
+           and then Nkind (Alt) = N_Case_Statement_Alternative
+         loop
+            Process_Statements_For_Controlled_Objects (Alt);
+
+            Next (Alt);
+         end loop;
       end;
    end Expand_N_Case_Statement;
 
@@ -2525,6 +2539,8 @@ package body Exp_Ch5 is
       --  these warnings for expander generated code.
 
    begin
+      Process_Statements_For_Controlled_Objects (N);
+
       Adjust_Condition (Condition (N));
 
       --  The following loop deals with constant conditions for the IF. We
@@ -2610,6 +2626,8 @@ package body Exp_Ch5 is
       if Present (Elsif_Parts (N)) then
          E := First (Elsif_Parts (N));
          while Present (E) loop
+            Process_Statements_For_Controlled_Objects (E);
+
             Adjust_Condition (Condition (E));
 
             --  If there are condition actions, then rewrite the if statement
@@ -3065,6 +3083,8 @@ package body Exp_Ch5 is
          return;
       end if;
 
+      Process_Statements_For_Controlled_Objects (N);
+
       --  Deal with condition for C/Fortran Boolean
 
       if Present (Isc) then
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index bb5a9efdce3..452b9e5b2e4 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4366,11 +4366,38 @@ package body Exp_Ch7 is
             --  sometimes generate a loop and create transient objects inside
             --  the loop.
 
-            elsif Nkind (Stmt) = N_Loop_Statement then
-               Process_Transient_Objects
-                 (First_Object => First (Statements (Stmt)),
-                  Last_Object  => Last (Statements (Stmt)),
-                  Related_Node => Related_Node);
+            elsif Nkind (Related_Node) = N_Object_Declaration
+              and then Is_Array_Type (Base_Type
+                         (Etype (Defining_Identifier (Related_Node))))
+              and then Nkind (Stmt) = N_Loop_Statement
+            then
+               declare
+                  Block_HSS : Node_Id := First (Statements (Stmt));
+
+               begin
+                  --  The loop statements may have been wrapped in a block by
+                  --  Process_Statements_For_Controlled_Objects, inspect the
+                  --  handled sequence of statements.
+
+                  if Nkind (Block_HSS) = N_Block_Statement
+                    and then No (Next (Block_HSS))
+                  then
+                     Block_HSS := Handled_Statement_Sequence (Block_HSS);
+
+                     Process_Transient_Objects
+                       (First_Object => First (Statements (Block_HSS)),
+                        Last_Object  => Last (Statements (Block_HSS)),
+                        Related_Node => Related_Node);
+
+                  --  Inspect the statements of the loop
+
+                  else
+                     Process_Transient_Objects
+                       (First_Object => First (Statements (Stmt)),
+                        Last_Object  => Last (Statements (Stmt)),
+                        Related_Node => Related_Node);
+                  end if;
+               end;
 
             --  Terminate the scan after the last object has been processed
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index eba59842af1..a55a7f51698 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -5872,6 +5872,9 @@ package body Exp_Ch9 is
       T   : Entity_Id;  --  Additional status flag
 
    begin
+      Process_Statements_For_Controlled_Objects (Trig);
+      Process_Statements_For_Controlled_Objects (Abrt);
+
       Blk_Ent := Make_Temporary (Loc, 'A');
       Ecall   := Triggering_Statement (Trig);
 
@@ -6824,6 +6827,8 @@ package body Exp_Ch9 is
       S : Entity_Id;  --  Primitive operation slot
 
    begin
+      Process_Statements_For_Controlled_Objects (N);
+
       if Ada_Version >= Ada_2005
         and then Nkind (Blk) = N_Procedure_Call_Statement
       then
@@ -9660,6 +9665,8 @@ package body Exp_Ch9 is
    --  Start of processing for Expand_N_Selective_Accept
 
    begin
+      Process_Statements_For_Controlled_Objects (N);
+
       --  First insert some declarations before the select. The first is:
 
       --    Ann : Address
@@ -9679,6 +9686,7 @@ package body Exp_Ch9 is
 
       Alt := First (Alts);
       while Present (Alt) loop
+         Process_Statements_For_Controlled_Objects (Alt);
 
          if Nkind (Alt) = N_Accept_Alternative then
             Add_Accept (Alt);
@@ -11035,6 +11043,9 @@ package body Exp_Ch9 is
          return;
       end if;
 
+      Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N));
+      Process_Statements_For_Controlled_Objects (Delay_Alternative (N));
+
       --  The arguments in the call may require dynamic allocation, and the
       --  call statement may have been transformed into a block. The block
       --  may contain additional declarations for internal entities, and the
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b993785f29d..c8d41cb0e7c 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -148,15 +148,17 @@ package body Exp_Util is
    --  Create an implicit subtype of CW_Typ attached to node N
 
    function Requires_Cleanup_Actions
-     (L           : List_Id;
-      For_Package : Boolean) return Boolean;
+     (L                 : List_Id;
+      For_Package       : Boolean;
+      Nested_Constructs : Boolean) return Boolean;
    --  Given a list L, determine whether it contains one of the following:
    --
    --    1) controlled objects
    --    2) library-level tagged types
    --
    --  Flag For_Package should be set when the list comes from a package spec
-   --  or body.
+   --  or body. Flag Nested_Constructs should be set when any nested packages
+   --  declared in L must be processed.
 
    ----------------------
    -- Adjust_Condition --
@@ -5446,6 +5448,107 @@ package body Exp_Util is
       end case;
    end Possible_Bit_Aligned_Component;
 
+   -----------------------------------------------
+   -- Process_Statements_For_Controlled_Objects --
+   -----------------------------------------------
+
+   procedure Process_Statements_For_Controlled_Objects (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      function Are_Wrapped (L : List_Id) return Boolean;
+      --  Determine whether list L contains only one statement which is a block
+
+      function Wrap_Statements_In_Block (L : List_Id) return Node_Id;
+      --  Given a list of statements L, wrap it in a block statement and return
+      --  the generated node.
+
+      -----------------
+      -- Are_Wrapped --
+      -----------------
+
+      function Are_Wrapped (L : List_Id) return Boolean is
+         Stmt : constant Node_Id := First (L);
+
+      begin
+         return
+           Present (Stmt)
+             and then No (Next (Stmt))
+             and then Nkind (Stmt) = N_Block_Statement;
+      end Are_Wrapped;
+
+      ------------------------------
+      -- Wrap_Statements_In_Block --
+      ------------------------------
+
+      function Wrap_Statements_In_Block (L : List_Id) return Node_Id is
+      begin
+         return
+           Make_Block_Statement (Loc,
+             Declarations => No_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => L));
+      end Wrap_Statements_In_Block;
+
+   --  Start of processing for Process_Statements_For_Controlled_Objects
+
+   begin
+      case Nkind (N) is
+         when N_Elsif_Part                 |
+              N_If_Statement               |
+              N_Conditional_Entry_Call     |
+              N_Selective_Accept           =>
+
+            --  Check the "then statements" for elsif parts and if statements
+
+            if Nkind_In (N, N_Elsif_Part,
+                            N_If_Statement)
+              and then not Is_Empty_List (Then_Statements (N))
+              and then not Are_Wrapped (Then_Statements (N))
+              and then Requires_Cleanup_Actions
+                         (Then_Statements (N), False, False)
+            then
+               Set_Then_Statements (N, New_List (
+                 Wrap_Statements_In_Block (Then_Statements (N))));
+            end if;
+
+            --  Check the "else statements" for conditional entry calls, if
+            --  statements and selective accepts.
+
+            if Nkind_In (N, N_Conditional_Entry_Call,
+                            N_If_Statement,
+                            N_Selective_Accept)
+              and then not Is_Empty_List (Else_Statements (N))
+              and then not Are_Wrapped (Else_Statements (N))
+              and then Requires_Cleanup_Actions
+                         (Else_Statements (N), False, False)
+            then
+               Set_Else_Statements (N, New_List (
+                 Wrap_Statements_In_Block (Else_Statements (N))));
+            end if;
+
+         when N_Abortable_Part             |
+              N_Accept_Alternative         |
+              N_Case_Statement_Alternative |
+              N_Delay_Alternative          |
+              N_Entry_Call_Alternative     |
+              N_Exception_Handler          |
+              N_Loop_Statement             |
+              N_Triggering_Alternative     =>
+
+            if not Is_Empty_List (Statements (N))
+              and then not Are_Wrapped (Statements (N))
+              and then Requires_Cleanup_Actions (Statements (N), False, False)
+            then
+               Set_Statements (N, New_List (
+                 Wrap_Statements_In_Block (Statements (N))));
+            end if;
+
+         when others                       =>
+            null;
+      end case;
+   end Process_Statements_For_Controlled_Objects;
+
    -------------------------
    -- Remove_Side_Effects --
    -------------------------
@@ -6148,18 +6251,20 @@ package body Exp_Util is
               N_Subprogram_Body       |
               N_Task_Body             =>
             return
-              Requires_Cleanup_Actions (Declarations (N), For_Pkg)
+              Requires_Cleanup_Actions (Declarations (N), For_Pkg, True)
                 or else
               (Present (Handled_Statement_Sequence (N))
                 and then
-              Requires_Cleanup_Actions
-                (Statements (Handled_Statement_Sequence (N)), For_Pkg));
+              Requires_Cleanup_Actions (Statements
+                (Handled_Statement_Sequence (N)), For_Pkg, True));
 
          when N_Package_Specification =>
             return
-              Requires_Cleanup_Actions (Visible_Declarations (N), For_Pkg)
-                or else
-              Requires_Cleanup_Actions (Private_Declarations (N), For_Pkg);
+              Requires_Cleanup_Actions
+                (Visible_Declarations (N), For_Pkg, True)
+                  or else
+              Requires_Cleanup_Actions
+                (Private_Declarations (N), For_Pkg, True);
 
          when others                  =>
             return False;
@@ -6171,8 +6276,9 @@ package body Exp_Util is
    ------------------------------
 
    function Requires_Cleanup_Actions
-     (L           : List_Id;
-      For_Package : Boolean) return Boolean
+     (L                 : List_Id;
+      For_Package       : Boolean;
+      Nested_Constructs : Boolean) return Boolean
    is
       Decl    : Node_Id;
       Expr    : Node_Id;
@@ -6345,7 +6451,9 @@ package body Exp_Util is
 
          --  Nested package declarations
 
-         elsif Nkind (Decl) = N_Package_Declaration then
+         elsif Nested_Constructs
+           and then Nkind (Decl) = N_Package_Declaration
+         then
             Pack_Id := Defining_Unit_Name (Specification (Decl));
 
             if Nkind (Pack_Id) = N_Defining_Program_Unit_Name then
@@ -6360,7 +6468,9 @@ package body Exp_Util is
 
          --  Nested package bodies
 
-         elsif Nkind (Decl) = N_Package_Body then
+         elsif Nested_Constructs
+           and then Nkind (Decl) = N_Package_Body
+         then
             Pack_Id := Corresponding_Spec (Decl);
 
             if Ekind (Pack_Id) /= E_Generic_Package
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index a60f40ffd32..c7b5b8f8e6c 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -706,6 +706,11 @@ package Exp_Util is
    --  causes trouble for the back end (see Component_May_Be_Bit_Aligned for
    --  further details).
 
+   procedure Process_Statements_For_Controlled_Objects (N : Node_Id);
+   --  N is a node which contains a non-handled statement list. Inspect the
+   --  statements looking for declarations of controlled objects. If at least
+   --  one such object is found, wrap the statement list in a block.
+
    procedure Remove_Side_Effects
      (Exp          : Node_Id;
       Name_Req     : Boolean := False;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 6f7843a0761..ee2c381314e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -17259,7 +17259,7 @@ output this info at program termination. Results are displayed in four
 columns:
 
 @noindent
-Index | Task Name | Stack Size | Stack Usage [Value +/- Variation]
+Index | Task Name | Stack Size | Stack Usage
 
 @noindent
 where:
@@ -17277,8 +17277,7 @@ is the maximum size for the stack.
 @item Stack Usage
 is the measure done by the stack analyzer. In order to prevent overflow, the stack
 is not entirely analyzed, and it's not possible to know exactly how
-much has actually been used. The report thus contains the theoretical stack usage
-(Value) and the possible variation (Variation) around this value.
+much has actually been used.
 
 @end table
 
diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb
index e85bc46bf97..76cac90454f 100644
--- a/gcc/ada/s-stausa.adb
+++ b/gcc/ada/s-stausa.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2004-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 2004-2011, 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- --
@@ -93,76 +93,6 @@ package body System.Stack_Usage is
    --  | entry frame | ... | leaf frame |                            |####|
    --  +------------------------------------------------------------------+
 
-   function Top_Slot_Index_In (Stack : Stack_Slots) return Integer;
-   --  Index of the stack Top slot in the Slots array, denoting the latest
-   --  possible slot available to call chain leaves.
-
-   function Bottom_Slot_Index_In (Stack : Stack_Slots) return Integer;
-   --  Index of the stack Bottom slot in the Slots array, denoting the first
-   --  possible slot available to call chain entry points.
-
-   function Push_Index_Step_For (Stack : Stack_Slots) return Integer;
-   --  By how much do we need to update a Slots index to Push a single slot on
-   --  the stack.
-
-   function Pop_Index_Step_For (Stack : Stack_Slots) return Integer;
-   --  By how much do we need to update a Slots index to Pop a single slot off
-   --  the stack.
-
-   pragma Inline_Always (Top_Slot_Index_In);
-   pragma Inline_Always (Bottom_Slot_Index_In);
-   pragma Inline_Always (Push_Index_Step_For);
-   pragma Inline_Always (Pop_Index_Step_For);
-
-   -----------------------
-   -- Top_Slot_Index_In --
-   -----------------------
-
-   function Top_Slot_Index_In (Stack : Stack_Slots) return Integer is
-   begin
-      if System.Parameters.Stack_Grows_Down then
-         return Stack'First;
-      else
-         return Stack'Last;
-      end if;
-   end Top_Slot_Index_In;
-
-   ----------------------------
-   --  Bottom_Slot_Index_In  --
-   ----------------------------
-
-   function Bottom_Slot_Index_In (Stack : Stack_Slots) return Integer is
-   begin
-      if System.Parameters.Stack_Grows_Down then
-         return Stack'Last;
-      else
-         return Stack'First;
-      end if;
-   end Bottom_Slot_Index_In;
-
-   -------------------------
-   -- Push_Index_Step_For --
-   -------------------------
-
-   function Push_Index_Step_For (Stack : Stack_Slots) return Integer is
-      pragma Unreferenced (Stack);
-   begin
-      if System.Parameters.Stack_Grows_Down then
-         return -1;
-      else
-         return +1;
-      end if;
-   end Push_Index_Step_For;
-
-   ------------------------
-   -- Pop_Index_Step_For --
-   ------------------------
-
-   function Pop_Index_Step_For (Stack : Stack_Slots) return Integer is
-   begin
-      return -Push_Index_Step_For (Stack);
-   end Pop_Index_Step_For;
-
    -------------------
    -- Unit Services --
    -------------------
@@ -175,9 +105,6 @@ package body System.Stack_Usage is
    Stack_Size_Str  : constant String  := "Stack Size";
    Actual_Size_Str : constant String  := "Stack usage";
 
-   function Get_Usage_Range (Result : Task_Result) return String;
-   --  Return string representing the range of possible result of stack usage
-
    procedure Output_Result
      (Result_Id          : Natural;
       Result             : Task_Result;
@@ -194,7 +121,6 @@ package body System.Stack_Usage is
    ----------------
 
    procedure Initialize (Buffer_Size : Natural) is
-      Bottom_Of_Stack  : aliased Integer;
       Stack_Size_Chars : System.Address;
 
    begin
@@ -204,9 +130,8 @@ package body System.Stack_Usage is
       Result_Array.all :=
         (others =>
            (Task_Name => (others => ASCII.NUL),
-            Variation => 0,
             Value     => 0,
-            Max_Size  => 0));
+            Stack_Size  => 0));
 
       --  Set the Is_Enabled flag to true, so that the task wrapper knows that
       --  it has to handle dynamic stack analysis
@@ -231,9 +156,8 @@ package body System.Stack_Usage is
               (Environment_Task_Analyzer,
                "ENVIRONMENT TASK",
                My_Stack_Size,
-               My_Stack_Size,
-               System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address),
-               0);
+               0,
+               My_Stack_Size);
 
             Fill_Stack (Environment_Task_Analyzer);
 
@@ -257,99 +181,78 @@ package body System.Stack_Usage is
       --  big, the more an "instrumentation threshold at writing" error is
       --  likely to happen.
 
-      Stack_Used_When_Filling : Integer;
-      Current_Stack_Level     : aliased Integer;
+      Current_Stack_Level : aliased Integer;
 
-      Guard : constant Integer := 256;
+      Guard : constant := 256;
       --  Guard space between the Current_Stack_Level'Address and the last
       --  allocated byte on the stack.
-
    begin
-      --  Easiest and most accurate method: the top of the stack is known.
-
-      if Analyzer.Top_Pattern_Mark /= 0 then
-         Analyzer.Pattern_Size :=
-           Stack_Size (Analyzer.Top_Pattern_Mark,
-                       To_Stack_Address (Current_Stack_Level'Address))
-           - Guard;
-
-         if System.Parameters.Stack_Grows_Down then
-            Analyzer.Stack_Overlay_Address :=
-              To_Address (Analyzer.Top_Pattern_Mark);
-         else
-            Analyzer.Stack_Overlay_Address :=
-              To_Address (Analyzer.Top_Pattern_Mark
-                            - Stack_Address (Analyzer.Pattern_Size));
+      if Parameters.Stack_Grows_Down then
+         if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size)
+           > To_Stack_Address (Current_Stack_Level'Address) - Guard
+         then
+            --  No room for a pattern
+            Analyzer.Pattern_Size := 0;
+            return;
          end if;
 
-         declare
-            Pattern : aliased Stack_Slots
-                        (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
-            for Pattern'Address use Analyzer.Stack_Overlay_Address;
-
-         begin
-            if System.Parameters.Stack_Grows_Down then
-               for J in reverse Pattern'Range loop
-                  Pattern (J) := Analyzer.Pattern;
-               end loop;
+         Analyzer.Pattern_Limit := Analyzer.Stack_Base
+           - Stack_Address (Analyzer.Pattern_Size);
 
-               Analyzer.Bottom_Pattern_Mark :=
-                 To_Stack_Address (Pattern (Pattern'Last)'Address);
-
-            else
-               for J in Pattern'Range loop
-                  Pattern (J) := Analyzer.Pattern;
-               end loop;
-
-               Analyzer.Bottom_Pattern_Mark :=
-                 To_Stack_Address (Pattern (Pattern'First)'Address);
-            end if;
-         end;
+         if Analyzer.Stack_Base >
+           To_Stack_Address (Current_Stack_Level'Address) - Guard
+         then
+            --  Reduce pattern size to prevent local frame overwrite
+            Analyzer.Pattern_Size :=
+              Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard
+                         - Analyzer.Pattern_Limit);
+         end if;
 
+         Analyzer.Pattern_Overlay_Address :=
+           To_Address (Analyzer.Pattern_Limit);
       else
-         --  Readjust the pattern size. When we arrive in this function, there
-         --  is already a given amount of stack used, that we won't analyze.
+         if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size)
+           < To_Stack_Address (Current_Stack_Level'Address) + Guard
+         then
+            --  No room for a pattern
+            Analyzer.Pattern_Size := 0;
+            return;
+         end if;
 
-         Stack_Used_When_Filling :=
-           Stack_Size (Analyzer.Bottom_Of_Stack,
-                       To_Stack_Address (Current_Stack_Level'Address));
+         Analyzer.Pattern_Limit := Analyzer.Stack_Base
+           + Stack_Address (Analyzer.Pattern_Size);
 
-         if Stack_Used_When_Filling > Analyzer.Pattern_Size then
+         if Analyzer.Stack_Base <
+           To_Stack_Address (Current_Stack_Level'Address) + Guard
+         then
+            --  Reduce pattern size to prevent local frame overwrite
+            Analyzer.Pattern_Size := Integer
+              (Analyzer.Pattern_Limit
+                 - (To_Stack_Address (Current_Stack_Level'Address) + Guard));
+         end if;
 
-            --  In this case, the known size of the stack is too small, we've
-            --  already taken more than expected, so there's no possible
-            --  computation
+         Analyzer.Pattern_Overlay_Address :=
+           To_Address (Analyzer.Pattern_Limit
+                         - Stack_Address (Analyzer.Pattern_Size));
+      end if;
 
-            Analyzer.Pattern_Size := 0;
+      --  Declare and fill the pattern buffer
+      declare
+         Pattern : aliased Stack_Slots
+           (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
+         for Pattern'Address use Analyzer.Pattern_Overlay_Address;
+
+      begin
+         if System.Parameters.Stack_Grows_Down then
+            for J in reverse Pattern'Range loop
+               Pattern (J) := Analyzer.Pattern;
+            end loop;
          else
-            Analyzer.Pattern_Size :=
-              Analyzer.Pattern_Size - Stack_Used_When_Filling;
+            for J in Pattern'Range loop
+               Pattern (J) := Analyzer.Pattern;
+            end loop;
          end if;
-
-         declare
-            Stack : aliased Stack_Slots
-              (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
-
-         begin
-            Stack := (others => Analyzer.Pattern);
-
-            Analyzer.Stack_Overlay_Address := Stack'Address;
-
-            if Analyzer.Pattern_Size /= 0 then
-               Analyzer.Bottom_Pattern_Mark :=
-                 To_Stack_Address
-                   (Stack (Bottom_Slot_Index_In (Stack))'Address);
-               Analyzer.Top_Pattern_Mark :=
-                 To_Stack_Address
-                   (Stack (Top_Slot_Index_In (Stack))'Address);
-            else
-               Analyzer.Bottom_Pattern_Mark :=
-                 To_Stack_Address (Stack'Address);
-               Analyzer.Top_Pattern_Mark :=
-                 To_Stack_Address (Stack'Address);
-            end if;
-         end;
-      end if;
+      end;
    end Fill_Stack;
 
    -------------------------
@@ -359,22 +262,20 @@ package body System.Stack_Usage is
    procedure Initialize_Analyzer
      (Analyzer         : in out Stack_Analyzer;
       Task_Name        : String;
-      My_Stack_Size    : Natural;
-      Max_Pattern_Size : Natural;
-      Bottom           : Stack_Address;
-      Top              : Stack_Address;
-      Pattern          : Unsigned_32 := 16#DEAD_BEEF#)
+      Stack_Size       : Natural;
+      Stack_Base       : Stack_Address;
+      Pattern_Size     : Natural;
+      Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#)
    is
    begin
       --  Initialize the analyzer fields
 
-      Analyzer.Bottom_Of_Stack  := Bottom;
-      Analyzer.Stack_Size       := My_Stack_Size;
-      Analyzer.Pattern_Size     := Max_Pattern_Size;
-      Analyzer.Pattern          := Pattern;
-      Analyzer.Result_Id        := Next_Id;
-      Analyzer.Task_Name        := (others => ' ');
-      Analyzer.Top_Pattern_Mark := Top;
+      Analyzer.Stack_Base    := Stack_Base;
+      Analyzer.Stack_Size    := Stack_Size;
+      Analyzer.Pattern_Size  := Pattern_Size;
+      Analyzer.Pattern       := Pattern;
+      Analyzer.Result_Id     := Next_Id;
+      Analyzer.Task_Name     := (others => ' ');
 
       --  Compute the task name, and truncate if bigger than Task_Name_Length
 
@@ -399,9 +300,9 @@ package body System.Stack_Usage is
    is
    begin
       if SP_Low > SP_High then
-         return Natural (SP_Low - SP_High + 4);
+         return Natural (SP_Low - SP_High);
       else
-         return Natural (SP_High - SP_Low + 4);
+         return Natural (SP_High - SP_Low);
       end if;
    end Stack_Size;
 
@@ -417,10 +318,17 @@ package body System.Stack_Usage is
       --  likely to happen.
 
       Stack : Stack_Slots (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
-      for Stack'Address use Analyzer.Stack_Overlay_Address;
+      for Stack'Address use Analyzer.Pattern_Overlay_Address;
 
    begin
-      Analyzer.Topmost_Touched_Mark := Analyzer.Bottom_Pattern_Mark;
+      --  Value if the pattern was not modified
+      if Parameters.Stack_Grows_Down then
+         Analyzer.Topmost_Touched_Mark :=
+           Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size);
+      else
+         Analyzer.Topmost_Touched_Mark :=
+           Analyzer.Pattern_Limit - Stack_Address (Analyzer.Pattern_Size);
+      end if;
 
       if Analyzer.Pattern_Size = 0 then
          return;
@@ -430,39 +338,26 @@ package body System.Stack_Usage is
       --  the bottom of it. The first index not equals to the patterns marks
       --  the beginning of the used stack.
 
-      declare
-         Top_Index    : constant Integer := Top_Slot_Index_In (Stack);
-         Bottom_Index : constant Integer := Bottom_Slot_Index_In (Stack);
-         Step         : constant Integer := Pop_Index_Step_For (Stack);
-         J            : Integer;
-
-      begin
-         J := Top_Index;
-         loop
+      if System.Parameters.Stack_Grows_Down then
+         for J in Stack'Range loop
             if Stack (J) /= Analyzer.Pattern then
                Analyzer.Topmost_Touched_Mark
                  := To_Stack_Address (Stack (J)'Address);
                exit;
             end if;
-
-            exit when J = Bottom_Index;
-            J := J + Step;
          end loop;
-      end;
-   end Compute_Result;
 
-   ---------------------
-   -- Get_Usage_Range --
-   ---------------------
+      else
+         for J in reverse Stack'Range loop
+            if Stack (J) /= Analyzer.Pattern then
+               Analyzer.Topmost_Touched_Mark
+                 := To_Stack_Address (Stack (J)'Address);
+               exit;
+            end if;
+         end loop;
 
-   function Get_Usage_Range (Result : Task_Result) return String is
-      Variation_Used_Str : constant String :=
-                             Natural'Image (Result.Variation);
-      Value_Used_Str     : constant String :=
-                             Natural'Image (Result.Value);
-   begin
-      return Value_Used_Str & " +/- " & Variation_Used_Str;
-   end Get_Usage_Range;
+      end if;
+   end Compute_Result;
 
    ---------------------
    --  Output_Result --
@@ -474,16 +369,16 @@ package body System.Stack_Usage is
       Max_Stack_Size_Len : Natural;
       Max_Actual_Use_Len : Natural)
    is
-      Result_Id_Str     : constant String := Natural'Image (Result_Id);
-      My_Stack_Size_Str : constant String := Natural'Image (Result.Max_Size);
-      Actual_Use_Str    : constant String := Get_Usage_Range (Result);
+      Result_Id_Str  : constant String := Natural'Image (Result_Id);
+      Stack_Size_Str : constant String := Natural'Image (Result.Stack_Size);
+      Actual_Use_Str : constant String := Natural'Image (Result.Value);
 
       Result_Id_Blanks  : constant
         String (1 .. Index_Str'Length - Result_Id_Str'Length)    :=
           (others => ' ');
 
       Stack_Size_Blanks : constant
-        String (1 .. Max_Stack_Size_Len - My_Stack_Size_Str'Length) :=
+        String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
           (others => ' ');
 
       Actual_Use_Blanks : constant
@@ -496,7 +391,7 @@ package body System.Stack_Usage is
       Put (" | ");
       Put (Result.Task_Name);
       Put (" | ");
-      Put (Stack_Size_Blanks & My_Stack_Size_Str);
+      Put (Stack_Size_Blanks & Stack_Size_Str);
       Put (" | ");
       Put (Actual_Use_Blanks & Actual_Use_Str);
       New_Line;
@@ -508,7 +403,7 @@ package body System.Stack_Usage is
 
    procedure Output_Results is
       Max_Stack_Size                         : Natural := 0;
-      Max_Actual_Use_Result_Id               : Natural := Result_Array'First;
+      Max_Stack_Usage                        : Natural := 0;
       Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0;
 
       Task_Name_Blanks : constant
@@ -531,21 +426,18 @@ package body System.Stack_Usage is
          for J in Result_Array'Range loop
             exit when J >= Next_Id;
 
-            if Result_Array (J).Value >
-               Result_Array (Max_Actual_Use_Result_Id).Value
-            then
-               Max_Actual_Use_Result_Id := J;
+            if Result_Array (J).Value > Max_Stack_Usage then
+               Max_Stack_Usage := Result_Array (J).Value;
             end if;
 
-            if Result_Array (J).Max_Size > Max_Stack_Size then
-               Max_Stack_Size := Result_Array (J).Max_Size;
+            if Result_Array (J).Stack_Size > Max_Stack_Size then
+               Max_Stack_Size := Result_Array (J).Stack_Size;
             end if;
          end loop;
 
          Max_Stack_Size_Len := Natural'Image (Max_Stack_Size)'Length;
 
-         Max_Actual_Use_Len :=
-           Get_Usage_Range (Result_Array (Max_Actual_Use_Result_Id))'Length;
+         Max_Actual_Use_Len := Natural'Image (Max_Stack_Usage)'Length;
 
          --  Display the output header. Blanks will be added in front of the
          --  labels if needed.
@@ -599,37 +491,22 @@ package body System.Stack_Usage is
    -------------------
 
    procedure Report_Result (Analyzer : Stack_Analyzer) is
-      Result  : Task_Result :=
-                  (Task_Name      => Analyzer.Task_Name,
-                   Max_Size       => Analyzer.Stack_Size,
-                   Variation    => 0,
-                   Value    => 0);
-
-      Overflow_Guard : constant Integer :=
-        Analyzer.Stack_Size
-          - Stack_Size (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Of_Stack);
-      Max, Min : Positive;
-
+      Result  : Task_Result := (Task_Name  => Analyzer.Task_Name,
+                                Stack_Size => Analyzer.Stack_Size,
+                                Value      => 0);
    begin
       if Analyzer.Pattern_Size = 0 then
-
          --  If we have that result, it means that we didn't do any computation
          --  at all. In other words, we used at least everything (and possibly
          --  more).
 
-         Min := Analyzer.Stack_Size - Overflow_Guard;
-         Max := Analyzer.Stack_Size;
+         Result.Value := Analyzer.Stack_Size;
 
       else
-         Min :=
-           Stack_Size
-             (Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack);
-         Max := Min + Overflow_Guard;
+         Result.Value := Stack_Size (Analyzer.Topmost_Touched_Mark,
+                                     Analyzer.Stack_Base);
       end if;
 
-      Result.Value := (Max + Min) / 2;
-      Result.Variation := (Max - Min) / 2;
-
       if Analyzer.Result_Id in Result_Array'Range then
 
          --  If the result can be stored, then store it in Result_Array
@@ -641,7 +518,7 @@ package body System.Stack_Usage is
 
          declare
             Result_Str_Len : constant Natural :=
-                               Get_Usage_Range (Result)'Length;
+                               Natural'Image (Result.Value)'Length;
             Size_Str_Len   : constant Natural :=
                                Natural'Image (Analyzer.Stack_Size)'Length;
 
diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads
index 1cd78ea0465..c0449e8fbc8 100644
--- a/gcc/ada/s-stausa.ads
+++ b/gcc/ada/s-stausa.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---         Copyright (C) 2004-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 2004-2011, 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- --
@@ -57,11 +57,8 @@ package System.Stack_Usage is
       --  Amount of stack used. The value is calculated on the basis of the
       --  mechanism used by GNAT to allocate it, and it is NOT a precise value.
 
-      Variation : Natural;
-      --  Possible variation in the amount of used stack. The real stack usage
-      --  may vary in the range Value +/- Variation
-
-      Max_Size : Natural;
+      Stack_Size : Natural;
+      --  Size of the stack
    end record;
 
    type Result_Array_Type is array (Positive range <>) of Task_Result;
@@ -91,8 +88,9 @@ package System.Stack_Usage is
    --  begin
    --     Initialize_Analyzer (A,
    --                          "Task t",
+   --                          A_Storage_Size,
+   --                          0,
    --                          A_Storage_Size - A_Guard,
-   --                          A_Guard
    --                          To_Stack_Address (Bottom_Of_Stack'Address));
    --     Fill_Stack (A);
    --     Some_User_Code;
@@ -115,7 +113,9 @@ package System.Stack_Usage is
    --       before the call to the instrumentation procedure.
 
    --     Strategy: The user of this package should measure the bottom of stack
-   --       before the call to Fill_Stack and pass it in parameter.
+   --       before the call to Fill_Stack and pass it in parameter. The impact
+   --       is very minor unless the stack used is very small, but in this case
+   --       you aren't very interested by the figure.
 
    --  Instrumentation threshold at writing:
 
@@ -212,32 +212,29 @@ package System.Stack_Usage is
    --  the memory will look like that:
    --
    --                                                             Stack growing
-   --  ----------------------------------------------------------------------->
-   --  |<---------------------->|<----------------------------------->|
-   --  |  Stack frame           | Memory filled with Analyzer.Pattern |
-   --  |  of Fill_Stack         |                                     |
-   --  |  (deallocated at       |                                     |
-   --  |  the end of the call)  |                                     |
-   --  ^                        |                                     ^
-   --  Analyzer.Bottom_Of_Stack |                  Analyzer.Top_Pattern_Mark
-   --                           ^
-   --                    Analyzer.Bottom_Pattern_Mark
+   --  ---------------------------------------------------------------------->
+   --  |<--------------------->|<----------------------------------->|
+   --  |  Stack frames to      | Memory filled with Analyzer.Pattern |
+   --  |  Fill_Stack           |                                     |
+   --  ^                       |                                     ^
+   --  Analyzer.Stack_Base     |                      Analyzer.Pattern_Limit
+   --                          ^
+   --                    Analyzer.Pattern_Limit +/- Analyzer.Pattern_Size
    --
 
    procedure Initialize_Analyzer
      (Analyzer         : in out Stack_Analyzer;
       Task_Name        : String;
-      My_Stack_Size    : Natural;
-      Max_Pattern_Size : Natural;
-      Bottom           : Stack_Address;
-      Top              : Stack_Address;
+      Stack_Size       : Natural;
+      Stack_Base       : Stack_Address;
+      Pattern_Size     : Natural;
       Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
    --  Should be called before any use of a Stack_Analyzer, to initialize it.
    --  Max_Pattern_Size is the size of the pattern zone, might be smaller than
-   --  the full stack size in order to take into account e.g. the secondary
-   --  stack and a guard against overflow. The actual size taken will be
-   --  readjusted with data already used at the time the stack is actually
-   --  filled.
+   --  the full stack size Stack_Size in order to take into account e.g. the
+   --  secondary stack and a guard against overflow. The actual size taken
+   --  will be readjusted with data already used at the time the stack is
+   --  actually filled.
 
    Is_Enabled : Boolean := False;
    --  When this flag is true, then stack analysis is enabled
@@ -253,16 +250,14 @@ package System.Stack_Usage is
    --                                                             Stack growing
    --  ----------------------------------------------------------------------->
    --  |<---------------------->|<-------------->|<--------->|<--------->|
-   --  |  Stack frame           | Array of       | used      |  Memory   |
-   --  |  of Compute_Result     | Analyzer.Probe | during    |   filled  |
-   --  |  (deallocated at       | elements       |  the      |    with   |
-   --  |  the end of the call)  |                | execution |  pattern  |
-   --  |                        ^                |           |           |
-   --  |                   Bottom_Pattern_Mark   |           |           |
+   --  |  Stack frames          | Array of       | used      |  Memory   |
+   --  |  to Compute_Result     | Analyzer.Probe | during    |   filled  |
+   --  |                        | elements       |  the      |    with   |
+   --  |                        |                | execution |  pattern  |
    --  |                                                     |           |
    --  |<---------------------------------------------------->           |
    --                  Stack used                                        ^
-   --                                                     Top_Pattern_Mark
+   --                                                           Pattern_Limit
 
    procedure Report_Result (Analyzer : Stack_Analyzer);
    --  Store the results of the computation in memory, at the address
@@ -288,6 +283,10 @@ private
       Task_Name : String (1 .. Task_Name_Length);
       --  Name of the task
 
+      Stack_Base : Stack_Address;
+      --  Address of the base of the stack, as given by the caller of
+      --  Initialize_Analyzer.
+
       Stack_Size : Natural;
       --  Entire size of the analyzed stack
 
@@ -297,11 +296,8 @@ private
       Pattern : Pattern_Type;
       --  Pattern used to recognize untouched memory
 
-      Bottom_Pattern_Mark : Stack_Address;
-      --  Bound of the pattern area on the stack closest to the bottom
-
-      Top_Pattern_Mark : Stack_Address;
-      --  Topmost bound of the pattern area on the stack
+      Pattern_Limit : Stack_Address;
+      --  Bound of the pattern area farthest to the base
 
       Topmost_Touched_Mark : Stack_Address;
       --  Topmost address of the pattern area whose value it is pointing
@@ -309,11 +305,7 @@ private
       --  compensated, it is the topmost value of the stack pointer during
       --  the execution.
 
-      Bottom_Of_Stack : Stack_Address;
-      --  Address of the bottom of the stack, as given by the caller of
-      --  Initialize_Analyzer.
-
-      Stack_Overlay_Address : System.Address;
+      Pattern_Overlay_Address : System.Address;
       --  Address of the stack abstraction object we overlay over a
       --  task's real stack, typically a pattern-initialized array.
 
diff --git a/gcc/ada/s-stusta.adb b/gcc/ada/s-stusta.adb
index da925a788d3..8961759ce10 100644
--- a/gcc/ada/s-stusta.adb
+++ b/gcc/ada/s-stusta.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---           Copyright (C) 2009-2010, Free Software Foundation, Inc.        --
+--           Copyright (C) 2009-2011, Free Software Foundation, Inc.        --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -250,9 +250,8 @@ package body System.Stack_Usage.Tasking is
                     Obj.Task_Name (Obj.Task_Name'First .. Pos);
       begin
          Put_Line
-           ("| " & T_Name & " | " & Natural'Image (Obj.Max_Size) &
-            Natural'Image (Obj.Value) & " +/- " &
-            Natural'Image (Obj.Variation));
+           ("| " & T_Name & " | " & Natural'Image (Obj.Stack_Size) &
+            Natural'Image (Obj.Value));
       end;
    end Print;
 
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index d1a5815a835..9a5b67d5284 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1027,32 +1027,11 @@ package body System.Tasking.Stages is
 
       Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
 
-      pragma Warnings (Off);
-      --  Why are warnings being turned off here???
-
       Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
       --  Address of secondary stack. In the fixed secondary stack case, this
       --  value is not modified, causing a warning, hence the bracketing with
       --  Warnings (Off/On). But why is so much *more* bracketed???
 
-      Small_Overflow_Guard : constant := 12 * 1024;
-      --  Note: this used to be 4K, but was changed to 12K, since smaller
-      --  values resulted in segmentation faults from dynamic stack analysis.
-
-      Big_Overflow_Guard   : constant := 16 * 1024;
-      Small_Stack_Limit    : constant := 64 * 1024;
-      --  ??? These three values are experimental, and seems to work on most
-      --  platforms. They still need to be analyzed further. They also need
-      --  documentation, what are they???
-
-      Size : Natural :=
-               Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
-
-      Overflow_Guard : Natural;
-      --  Size of the overflow guard, used by dynamic stack usage analysis
-
-      pragma Warnings (On);
-
       SEH_Table : aliased SSE.Storage_Array (1 .. 8);
       --  Structured Exception Registration table (2 words)
 
@@ -1116,7 +1095,6 @@ package body System.Tasking.Stages is
          Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
            Secondary_Stack'Address;
          SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last));
-         Size := Size - Natural (Secondary_Stack_Size);
       end if;
 
       if Use_Alternate_Stack then
@@ -1136,24 +1114,64 @@ package body System.Tasking.Stages is
       --  Initialize dynamic stack usage
 
       if System.Stack_Usage.Is_Enabled then
-         Overflow_Guard :=
-           (if Size < Small_Stack_Limit
-              then Small_Overflow_Guard
-              else Big_Overflow_Guard);
-
-         STPO.Lock_RTS;
-         Initialize_Analyzer
-           (Self_ID.Common.Analyzer,
-            Self_ID.Common.Task_Image
-              (1 .. Self_ID.Common.Task_Image_Len),
-            Natural
-              (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size),
-            Size - Overflow_Guard,
-            SSE.To_Integer (Bottom_Of_Stack'Address),
-            SSE.To_Integer
-              (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Limit));
-         STPO.Unlock_RTS;
-         Fill_Stack (Self_ID.Common.Analyzer);
+         declare
+            Guard_Page_Size      : constant := 12 * 1024;
+            --  Part of the stack used as a guard page. This is an OS dependent
+            --  value, so we need to use the maximum. This value is only used
+            --  when the stack address is known, that is currently Windows.
+
+            Small_Overflow_Guard : constant := 12 * 1024;
+            --  Note: this used to be 4K, but was changed to 12K, since
+            --  smaller values resulted in segmentation faults from dynamic
+            --  stack analysis.
+
+            Big_Overflow_Guard   : constant := 16 * 1024;
+            Small_Stack_Limit    : constant := 64 * 1024;
+            --  ??? These three values are experimental, and seems to work on
+            --  most platforms. They still need to be analyzed further. They
+            --  also need documentation, what are they???
+
+            Pattern_Size : Natural :=
+              Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
+            --  Size of the pattern
+
+            Stack_Base : Address;
+            --  Address of the base of the stack
+         begin
+            Stack_Base := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base;
+            if Stack_Base = Null_Address then
+               --  On many platforms, we don't know the real stack base
+               --  address. Estimate it using an address in the frame.
+               Stack_Base := Bottom_Of_Stack'Address;
+
+               --  Also reduce the size of the stack to take into account the
+               --  secondary stack array declared in this frame. This is for
+               --  sure very conservative.
+               if not Parameters.Sec_Stack_Dynamic then
+                  Pattern_Size :=
+                    Pattern_Size - Natural (Secondary_Stack_Size);
+               end if;
+
+               --  Adjustments for inner frames
+               Pattern_Size := Pattern_Size -
+                 (if Pattern_Size < Small_Stack_Limit
+                    then Small_Overflow_Guard
+                    else Big_Overflow_Guard);
+            else
+               --  Reduce by the size of the final guard page
+               Pattern_Size := Pattern_Size - Guard_Page_Size;
+            end if;
+
+            STPO.Lock_RTS;
+            Initialize_Analyzer
+              (Self_ID.Common.Analyzer,
+               Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len),
+               Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size),
+               SSE.To_Integer (Stack_Base),
+               Pattern_Size);
+            STPO.Unlock_RTS;
+            Fill_Stack (Self_ID.Common.Analyzer);
+         end;
       end if;
 
       --  We setup the SEH (Structured Exception Handling) handler if supported
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 79c5a71d2c3..9528841e1c8 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -240,14 +240,6 @@ package Sem is
    --  then Full_Analysis above must be False. You should really regard this as
    --  a read only flag.
 
-   In_Pre_Post_Expression : Boolean := False;
-   --  Switch to indicate that we are in a precondition or postcondition. The
-   --  analysis is not expected to process a precondition or a postcondition as
-   --  a sub-analysis for another precondition or postcondition, so this switch
-   --  needs not be saved for recursive calls. When this switch is True then
-   --  In_Spec_Expression above must be True also. You should really regard
-   --  this as a read only flag.
-
    In_Deleted_Code : Boolean := False;
    --  If the condition in an if-statement is statically known, the branch
    --  that is not taken is analyzed with expansion disabled, and the tree
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3eb0bdb70f0..d04a7efc413 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -258,11 +258,8 @@ package body Sem_Prag is
       --  Preanalyze the boolean expression, we treat this as a spec expression
       --  (i.e. similar to a default expression).
 
-      pragma Assert (In_Pre_Post_Expression = False);
-      In_Pre_Post_Expression := True;
       Preanalyze_Spec_Expression
         (Get_Pragma_Arg (Arg1), Standard_Boolean);
-      In_Pre_Post_Expression := False;
 
       --  Remove the subprogram from the scope stack now that the pre-analysis
       --  of the precondition/postcondition is done.