[multiple changes]

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.

From-SVN: r177386

1 files changed, 112 insertions, 235 deletions

diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb
index e85bc46..76cac90 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;