From a494036c8e2c67c7938f7c4cf34651c3aa1737e2 Mon Sep 17 00:00:00 2001 From: Quentin Ochem Date: Tue, 27 May 2008 12:13:53 +0200 Subject: [PATCH] s-stausa.adb (Initialize): Updated result initialization, and initialization of environment stack. 2008-05-27 Quentin Ochem * 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 --- gcc/ada/s-stausa.adb | 106 ++++++++++++++++++++++++------------------- gcc/ada/s-stausa.ads | 39 ++++++++++------ gcc/ada/s-tassta.adb | 18 ++++---- 3 files changed, 94 insertions(+), 69 deletions(-) diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index 6eb8a0ca6ef..71474dd319c 100644 --- 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 b309c3735e8..dd27efe4141 100644 --- 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 09d9070cd4e..d28cb7e42d2 100644 --- 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; -- 2.30.2