Commit a494036c by Quentin Ochem Committed by Arnaud Charlet

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

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
parent ce2798e8
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment