s-stausa.adb (Initialize): Updated result initialization, and initialization of envir...

2008-05-27  Quentin Ochem  <ochem@adacore.com>

	* s-stausa.adb (Initialize): Updated result initialization, and
	initialization of environment stack.
	(Fill_Stack): Improved computation of the pattern zone, taking into
	account already filled at the calling point.
	(Get_Usage_Range): Now uses Min_Measure and Max_Measure instead of
	Measure and Overflow_Guard.
	(Report_Result): Fixed computation of the result using new fields of
	Stack_Analyzer.

	* s-stausa.ads (Initialize_Analyzer): Replaced Size / Overflow_Guard
	params by more explicit Stack_Size / Max_Pattern_Size params.
	(Stack_Analyzer): Added distinct Stack_Size & Pattern_Size fields.
	Added Stack_Used_When_Filling field.
	(Task_Result): Replaced Measure / Overflow_Guard by more explicit
	Min_Measure and Max_Measure fields.

	* s-tassta.adb (Task_Wrapper): Updated call to Initialize_Analyzer.

From-SVN: r135999

diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb
index 6eb8a0ca6effde7aaa32213fa3dcd462f628eb39..71474dd319c4dfc5e12cc26d73565c780777f391 100644 (file)
--- a/gcc/ada/s-stausa.adb
+++ b/gcc/ada/s-stausa.adb
@@ -205,10 +205,10 @@ package body System.Stack_Usage is
       Result_Array := new Result_Array_Type (1 .. Buffer_Size);
       Result_Array.all :=
         (others =>
-           (Task_Name      => (others => ASCII.NUL),
-            Measure        => 0,
-            Max_Size       => 0,
-            Overflow_Guard => 0));
+           (Task_Name   => (others => ASCII.NUL),
+            Min_Measure => 0,
+            Max_Measure => 0,
+            Max_Size    => 0));
 
       --  Set the Is_Enabled flag to true, so that the task wrapper knows that
       --  it has to handle dynamic stack analysis
@@ -233,7 +233,7 @@ package body System.Stack_Usage is
               (Environment_Task_Analyzer,
                "ENVIRONMENT TASK",
                Stack_Size,
-               0,
+               Stack_Size,
                System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
 
             Fill_Stack (Environment_Task_Analyzer);
@@ -253,32 +253,46 @@ package body System.Stack_Usage is
    ----------------
 
    procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
-
       --  Change the local variables and parameters of this function with
       --  super-extra care. The more the stack frame size of this function is
       --  big, the more an "instrumentation threshold at writing" error is
       --  likely to happen.
 
-      Stack : aliased Stack_Slots (1 .. Analyzer.Size / Bytes_Per_Pattern);
-
+      Current_Stack_Level : aliased Integer;
    begin
-      Stack := (others => Analyzer.Pattern);
+      --  Reajust the pattern size. When we arrive in this function, there is
+      --  already a given amount of stack used, that we won't analyze.
 
-      Analyzer.Stack_Overlay_Address := Stack'Address;
+      Analyzer.Stack_Used_When_Filling := Stack_Size
+        (Analyzer.Bottom_Of_Stack,
+         To_Stack_Address (Current_Stack_Level'Address))
+        + Natural (Current_Stack_Level'Size);
 
-      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);
+      Analyzer.Pattern_Size := Analyzer.Pattern_Size
+        - Analyzer.Stack_Used_When_Filling;
+
+      declare
+         Stack : aliased Stack_Slots
+           (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
+      begin
+         Stack := (others => Analyzer.Pattern);
 
-      --  If Arr has been packed, the following assertion must be true (we add
-      --  the size of the element whose address is:
-      --    Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
+         Analyzer.Stack_Overlay_Address := Stack'Address;
 
-      pragma Assert
-        (Analyzer.Size =
-           Stack_Size
-             (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
+         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);
+
+         --  If Arr has been packed, the following assertion must be true (we
+         --  add the size of the element whose address is:
+         --    Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
+
+         pragma Assert
+           (Analyzer.Pattern_Size =
+              Stack_Size
+                (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
+      end;
    end Fill_Stack;
 
    -------------------------
@@ -286,18 +300,19 @@ package body System.Stack_Usage is
    -------------------------
 
    procedure Initialize_Analyzer
-     (Analyzer       : in out Stack_Analyzer;
-      Task_Name      : String;
-      Size           : Natural;
-      Overflow_Guard : Natural;
-      Bottom         : Stack_Address;
-      Pattern        : Unsigned_32 := 16#DEAD_BEEF#)
+     (Analyzer         : in out Stack_Analyzer;
+      Task_Name        : String;
+      Stack_Size       : Natural;
+      Max_Pattern_Size : Natural;
+      Bottom           : Stack_Address;
+      Pattern          : Unsigned_32 := 16#DEAD_BEEF#)
    is
    begin
       --  Initialize the analyzer fields
 
       Analyzer.Bottom_Of_Stack := Bottom;
-      Analyzer.Size := Size;
+      Analyzer.Stack_Size := Stack_Size;
+      Analyzer.Pattern_Size := Max_Pattern_Size;
       Analyzer.Pattern := Pattern;
       Analyzer.Result_Id := Next_Id;
 
@@ -314,8 +329,6 @@ package body System.Stack_Usage is
                         Task_Name'First + Task_Name_Length - 1);
       end if;
 
-      Analyzer.Overflow_Guard := Overflow_Guard;
-
       Next_Id := Next_Id + 1;
    end Initialize_Analyzer;
 
@@ -346,7 +359,7 @@ package body System.Stack_Usage is
       --  is, the more an "instrumentation threshold at reading" error is
       --  likely to happen.
 
-      Stack : Stack_Slots (1 .. Analyzer.Size / Bytes_Per_Pattern);
+      Stack : Stack_Slots (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
       for Stack'Address use Analyzer.Stack_Overlay_Address;
 
    begin
@@ -382,10 +395,8 @@ package body System.Stack_Usage is
    ---------------------
 
    function Get_Usage_Range (Result : Task_Result) return String is
-      Min_Used_Str : constant String :=
-                       Natural'Image (Result.Measure);
-      Max_Used_Str : constant String :=
-                       Natural'Image (Result.Measure + Result.Overflow_Guard);
+      Min_Used_Str : constant String := Natural'Image (Result.Min_Measure);
+      Max_Used_Str : constant String := Natural'Image (Result.Max_Measure);
    begin
       return "[" & Min_Used_Str (2 .. Min_Used_Str'Last) & " -"
              & Max_Used_Str & "]";
@@ -458,8 +469,8 @@ package body System.Stack_Usage is
          for J in Result_Array'Range loop
             exit when J >= Next_Id;
 
-            if Result_Array (J).Measure
-              > Result_Array (Max_Actual_Use_Result_Id).Measure
+            if Result_Array (J).Max_Measure
+              > Result_Array (Max_Actual_Use_Result_Id).Max_Measure
             then
                Max_Actual_Use_Result_Id := J;
             end if;
@@ -526,16 +537,17 @@ package body System.Stack_Usage is
    -------------------
 
    procedure Report_Result (Analyzer : Stack_Analyzer) is
+      Measure : constant Natural :=
+        Stack_Size
+          (Analyzer.Topmost_Touched_Mark,
+           Analyzer.Bottom_Of_Stack)
+        + Analyzer.Stack_Used_When_Filling;
       Result : constant Task_Result :=
-                 (Task_Name      => Analyzer.Task_Name,
-                  Max_Size       => Analyzer.Size + Analyzer.Overflow_Guard,
-                  Measure        => Stack_Size
-                                      (Analyzer.Topmost_Touched_Mark,
-                                       Analyzer.Bottom_Of_Stack),
-                  Overflow_Guard => Analyzer.Overflow_Guard -
-                                      Natural (Analyzer.Bottom_Of_Stack -
-                                        Analyzer.Bottom_Pattern_Mark));
-
+        (Task_Name      => Analyzer.Task_Name,
+         Max_Size       => Analyzer.Stack_Size,
+         Min_Measure    => Measure,
+         Max_Measure    => Measure + Analyzer.Stack_Size
+         - Analyzer.Pattern_Size);
    begin
       if Analyzer.Result_Id in Result_Array'Range then
 
@@ -550,7 +562,7 @@ package body System.Stack_Usage is
             Result_Str_Len : constant Natural :=
                                Get_Usage_Range (Result)'Length;
             Size_Str_Len   : constant Natural :=
-                               Natural'Image (Analyzer.Size)'Length;
+                               Natural'Image (Analyzer.Stack_Size)'Length;
 
             Max_Stack_Size_Len : Natural;
             Max_Actual_Use_Len : Natural;

diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads
index b309c3735e8009ebc5e18834bc5f7edeed648880..dd27efe4141f8df6004a4fac261dbb68c0acf190 100644 (file)
--- a/gcc/ada/s-stausa.ads
+++ b/gcc/ada/s-stausa.ads
@@ -211,15 +211,18 @@ package System.Stack_Usage is
    --                                            Analyzer.Top_Pattern_Mark
 
    procedure Initialize_Analyzer
-     (Analyzer       : in out Stack_Analyzer;
-      Task_Name      : String;
-      Size           : Natural;
-      Overflow_Guard : Natural;
-      Bottom         : Stack_Address;
-      Pattern        : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
+     (Analyzer         : in out Stack_Analyzer;
+      Task_Name        : String;
+      Stack_Size       : Natural;
+      Max_Pattern_Size : Natural;
+      Bottom           : Stack_Address;
+      Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
    --  Should be called before any use of a Stack_Analyzer, to initialize it.
-   --  Size is the size of the pattern zone. Bottom should be a close
-   --  approximation of the caller base frame address.
+   --  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 gard against overflow. The actual size taken will be
+   --  reajusted, 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
@@ -274,7 +277,10 @@ private
       Task_Name : String (1 .. Task_Name_Length);
       --  Name of the task
 
-      Size : Natural;
+      Stack_Size : Natural;
+      --  Entire size of the analyzed stack
+
+      Pattern_Size : Natural;
       --  Size of the pattern zone
 
       Pattern : Pattern_Type;
@@ -304,9 +310,9 @@ private
       --  Id of the result. If less than value given to gnatbind -u corresponds
       --  to the location in the result array of result for the current task.
 
-      Overflow_Guard : Natural;
-      --  The amount of bytes that won't be analyzed in order to prevent
-      --  writing out of the stack
+      Stack_Used_When_Filling : Natural := 0;
+      --  Amount of stack that was already used when actually filling the
+      --  memory, and therefore not analyzed.
    end record;
 
    Environment_Task_Analyzer : Stack_Analyzer;
@@ -315,9 +321,14 @@ private
 
    type Task_Result is record
       Task_Name      : String (1 .. Task_Name_Length);
-      Measure        : Natural;
+      Min_Measure    : Natural;
+      --  Minimal value for the measure.
+
+      Max_Measure    : Natural;
+      --  Maximal value for the measure, taking into account the actual size
+      --  of the pattern filled.
+
       Max_Size       : Natural;
-      Overflow_Guard : Natural;
    end record;
 
    type Result_Array_Type is array (Positive range <>) of Task_Result;

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 09d9070cd4e85d675de019a64d1df0cfd83e7453..d28cb7e42d23bfa3c464fc856fedd6b520ac0853 100644 (file)
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1065,8 +1065,6 @@ package body System.Tasking.Stages is
          Overflow_Guard := Big_Overflow_Guard;
       end if;
 
-      Size := Size - Overflow_Guard;
-
       if not Parameters.Sec_Stack_Dynamic then
          Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
            Secondary_Stack'Address;
@@ -1078,14 +1076,18 @@ package body System.Tasking.Stages is
          Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address;
       end if;
 
+      Size := Size - Overflow_Guard;
+
       if System.Stack_Usage.Is_Enabled then
          STPO.Lock_RTS;
-         Initialize_Analyzer (Self_ID.Common.Analyzer,
-                              Self_ID.Common.Task_Image
-                                (1 .. Self_ID.Common.Task_Image_Len),
-                              Size,
-                              Overflow_Guard,
-                              SSE.To_Integer (Bottom_Of_Stack'Address));
+         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,
+            SSE.To_Integer (Bottom_Of_Stack'Address));
          STPO.Unlock_RTS;
          Fill_Stack (Self_ID.Common.Analyzer);
       end if;