s-stausa.ads, [...] (Initialize_Analyzer): Added parameter "Overflow_Guard".
2007-04-20 Quentin Ochem <ochem@adacore.com> * s-stausa.ads, s-stausa.adb (Initialize_Analyzer): Added parameter "Overflow_Guard". (Stack_Analyzer): Added field "Overflow_Guard" (Task_Result): Added field "Overflow_Guard". (Index_Str): New constant. (Task_Name_Str): New constant. (Actual_Size_Str): New constant. (Pattern_Array_Element_Size): New constant. (Get_Usage_Range): New subprogram. (Output_Result): Added parameter Max_Size_Len and Max_Actual_Use_Len. Now align the output. Added comments. (Initialize): Added value for Overflow_Guard. (Fill_Stack): Use constant Pattern_Array_Elem_Size when relevant. Update the value of the overflow guard according to the actual beginning of the pattern array. (Initialize_Analyzer): Added parameter Overflow_Guard. Take this parameter into accound when computing the max size. (Compute_Result): Use constant Pattern_Array_Elem_Size when relevant. (Report_Result): Removed extra useless procedure. Updated call to Output_Result. Moved full computation of the Task_Result here. From-SVN: r125465
This commit is contained in:
parent
1513f9bf9b
commit
37000abae4
2 changed files with 305 additions and 138 deletions
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2007, 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- --
|
||||
|
@ -39,24 +39,42 @@ package body System.Stack_Usage is
|
|||
use System.Storage_Elements;
|
||||
use System;
|
||||
use System.IO;
|
||||
use Interfaces;
|
||||
|
||||
procedure Output_Result (Result_Id : Natural; Result : Task_Result);
|
||||
Index_Str : constant String := "Index";
|
||||
Task_Name_Str : constant String := "Task Name";
|
||||
Stack_Size_Str : constant String := "Stack Size";
|
||||
Actual_Size_Str : constant String := "Stack usage [min - max]";
|
||||
Pattern_Array_Elem_Size : constant Natural :=
|
||||
(Unsigned_32_Size / Byte_Size);
|
||||
|
||||
function Report_Result (Analyzer : Stack_Analyzer) return Natural;
|
||||
function Get_Usage_Range (Result : Task_Result) return String;
|
||||
-- Return string representing the range of possible result of stack usage
|
||||
|
||||
function Inner_Than
|
||||
procedure Output_Result
|
||||
(Result_Id : Natural;
|
||||
Result : Task_Result;
|
||||
Max_Stack_Size_Len : Natural;
|
||||
Max_Actual_Use_Len : Natural);
|
||||
-- Prints the result on the standard output. Result Id is the number of
|
||||
-- the result in the array, and Result the contents of the actual result.
|
||||
-- Max_Stack_Size_Len and Max_Actual_Use_Len are used for displaying the
|
||||
-- proper layout. They hold the maximum length of the string representing
|
||||
-- the Stack_Size and Actual_Use values.
|
||||
|
||||
function Closer_To_Bottom
|
||||
(A1 : Stack_Address;
|
||||
A2 : Stack_Address) return Boolean;
|
||||
pragma Inline (Inner_Than);
|
||||
pragma Inline (Closer_To_Bottom);
|
||||
-- Return True if, according to the direction of the stack growth, A1 is
|
||||
-- inner than A2. Inlined to reduce the size of the stack used by the
|
||||
-- instrumentation code.
|
||||
-- closer to the bottom than A2. Inlined to reduce the size of the stack
|
||||
-- used by the instrumentation code.
|
||||
|
||||
----------------
|
||||
-- Inner_Than --
|
||||
----------------
|
||||
----------------------
|
||||
-- Closer_To_Bottom --
|
||||
----------------------
|
||||
|
||||
function Inner_Than
|
||||
function Closer_To_Bottom
|
||||
(A1 : Stack_Address;
|
||||
A2 : Stack_Address) return Boolean
|
||||
is
|
||||
|
@ -66,27 +84,29 @@ package body System.Stack_Usage is
|
|||
else
|
||||
return A2 > A1;
|
||||
end if;
|
||||
end Inner_Than;
|
||||
end Closer_To_Bottom;
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
-- Add comments to this procedure ???
|
||||
-- Other subprograms also need more comment in code???
|
||||
|
||||
procedure Initialize (Buffer_Size : Natural) is
|
||||
Bottom_Of_Stack : aliased Integer;
|
||||
|
||||
Bottom_Of_Stack : aliased Integer;
|
||||
Stack_Size_Chars : System.Address;
|
||||
|
||||
begin
|
||||
-- Initialize the buffered result array
|
||||
|
||||
Result_Array := new Result_Array_Type (1 .. Buffer_Size);
|
||||
Result_Array.all :=
|
||||
(others =>
|
||||
(Task_Name =>
|
||||
(others => ASCII.NUL),
|
||||
Measure => 0,
|
||||
Max_Size => 0));
|
||||
(Task_Name => (others => ASCII.NUL),
|
||||
Measure => 0,
|
||||
Max_Size => 0,
|
||||
Overflow_Guard => 0));
|
||||
|
||||
-- Set the Is_Enabled flag to true, so that the task wrapper knows that
|
||||
-- it has to handle dynamic stack analysis
|
||||
|
||||
Is_Enabled := True;
|
||||
|
||||
|
@ -104,11 +124,12 @@ package body System.Stack_Usage is
|
|||
begin
|
||||
Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
|
||||
|
||||
Initialize_Analyzer (Environment_Task_Analyzer,
|
||||
"ENVIRONMENT TASK",
|
||||
Stack_Size,
|
||||
System.Storage_Elements.To_Integer
|
||||
(Bottom_Of_Stack'Address));
|
||||
Initialize_Analyzer
|
||||
(Environment_Task_Analyzer,
|
||||
"ENVIRONMENT TASK",
|
||||
Stack_Size,
|
||||
0,
|
||||
System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
|
||||
|
||||
Fill_Stack (Environment_Task_Analyzer);
|
||||
|
||||
|
@ -133,43 +154,48 @@ package body System.Stack_Usage is
|
|||
-- big, the more an "instrumentation threshold at writing" error is
|
||||
-- likely to happen.
|
||||
|
||||
type Word_32_Arr is
|
||||
array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32;
|
||||
pragma Pack (Word_32_Arr);
|
||||
type Unsigned_32_Arr is
|
||||
array (1 .. Analyzer.Size / Pattern_Array_Elem_Size) of Unsigned_32;
|
||||
for Unsigned_32_Arr'Component_Size use 32;
|
||||
|
||||
package Arr_Addr is
|
||||
new System.Address_To_Access_Conversions (Word_32_Arr);
|
||||
new System.Address_To_Access_Conversions (Unsigned_32_Arr);
|
||||
|
||||
Arr : aliased Word_32_Arr;
|
||||
Arr : aliased Unsigned_32_Arr;
|
||||
|
||||
begin
|
||||
for J in Word_32_Arr'Range loop
|
||||
-- Fill the stack with the pattern
|
||||
|
||||
for J in Unsigned_32_Arr'Range loop
|
||||
Arr (J) := Analyzer.Pattern;
|
||||
end loop;
|
||||
Analyzer.Array_Address := Arr_Addr.To_Address (Arr'Access);
|
||||
Analyzer.Inner_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
|
||||
Analyzer.Outer_Pattern_Mark :=
|
||||
To_Stack_Address (Arr (Word_32_Arr'Last)'Address);
|
||||
|
||||
if Inner_Than (Analyzer.Outer_Pattern_Mark,
|
||||
Analyzer.Inner_Pattern_Mark) then
|
||||
Analyzer.Inner_Pattern_Mark := Analyzer.Outer_Pattern_Mark;
|
||||
Analyzer.Outer_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
|
||||
Analyzer.First_Is_Outermost := True;
|
||||
-- Initialize the analyzer value
|
||||
|
||||
Analyzer.Array_Address := Arr_Addr.To_Address (Arr'Access);
|
||||
Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
|
||||
Analyzer.Top_Pattern_Mark :=
|
||||
To_Stack_Address (Arr (Unsigned_32_Arr'Last)'Address);
|
||||
|
||||
if
|
||||
Closer_To_Bottom
|
||||
(Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark)
|
||||
then
|
||||
Analyzer.Bottom_Pattern_Mark := Analyzer.Top_Pattern_Mark;
|
||||
Analyzer.Top_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
|
||||
Analyzer.First_Is_Topmost := True;
|
||||
else
|
||||
Analyzer.First_Is_Outermost := False;
|
||||
Analyzer.First_Is_Topmost := False;
|
||||
end if;
|
||||
|
||||
-- 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.Size =
|
||||
Stack_Size
|
||||
(Analyzer.Outer_Pattern_Mark, Analyzer.Inner_Pattern_Mark) +
|
||||
Word_32_Size / Byte_Size);
|
||||
(Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
|
||||
end Fill_Stack;
|
||||
|
||||
-------------------------
|
||||
|
@ -177,13 +203,16 @@ package body System.Stack_Usage is
|
|||
-------------------------
|
||||
|
||||
procedure Initialize_Analyzer
|
||||
(Analyzer : in out Stack_Analyzer;
|
||||
Task_Name : String;
|
||||
Size : Natural;
|
||||
Bottom : Stack_Address;
|
||||
Pattern : Word_32 := 16#DEAD_BEEF#)
|
||||
(Analyzer : in out Stack_Analyzer;
|
||||
Task_Name : String;
|
||||
Size : Natural;
|
||||
Overflow_Guard : 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.Pattern := Pattern;
|
||||
|
@ -191,6 +220,9 @@ package body System.Stack_Usage is
|
|||
|
||||
Analyzer.Task_Name := (others => ' ');
|
||||
|
||||
-- Compute the task name, and truncate it if it's bigger than
|
||||
-- Task_Name_Length
|
||||
|
||||
if Task_Name'Length <= Task_Name_Length then
|
||||
Analyzer.Task_Name (1 .. Task_Name'Length) := Task_Name;
|
||||
else
|
||||
|
@ -199,11 +231,8 @@ package body System.Stack_Usage is
|
|||
Task_Name'First + Task_Name_Length - 1);
|
||||
end if;
|
||||
|
||||
if Next_Id in Result_Array'Range then
|
||||
Result_Array (Analyzer.Result_Id).Task_Name := Analyzer.Task_Name;
|
||||
end if;
|
||||
Analyzer.Overflow_Guard := Overflow_Guard;
|
||||
|
||||
Result_Array (Analyzer.Result_Id).Max_Size := Size;
|
||||
Next_Id := Next_Id + 1;
|
||||
end Initialize_Analyzer;
|
||||
|
||||
|
@ -234,45 +263,81 @@ package body System.Stack_Usage is
|
|||
-- is, the more an "instrumentation threshold at reading" error is
|
||||
-- likely to happen.
|
||||
|
||||
type Word_32_Arr is
|
||||
array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32;
|
||||
pragma Pack (Word_32_Arr);
|
||||
type Unsigned_32_Arr is
|
||||
array (1 .. Analyzer.Size / Pattern_Array_Elem_Size) of Unsigned_32;
|
||||
for Unsigned_32_Arr'Component_Size use 32;
|
||||
|
||||
package Arr_Addr is
|
||||
new System.Address_To_Access_Conversions (Word_32_Arr);
|
||||
new System.Address_To_Access_Conversions (Unsigned_32_Arr);
|
||||
|
||||
Arr_Access : Arr_Addr.Object_Pointer;
|
||||
|
||||
begin
|
||||
Arr_Access := Arr_Addr.To_Pointer (Analyzer.Array_Address);
|
||||
Analyzer.Outermost_Touched_Mark := Analyzer.Inner_Pattern_Mark;
|
||||
Analyzer.Topmost_Touched_Mark := Analyzer.Bottom_Pattern_Mark;
|
||||
|
||||
for J in Word_32_Arr'Range loop
|
||||
-- Look backward from the end of the stack to the beginning. The first
|
||||
-- index not equals to the patterns marks the beginning of the used
|
||||
-- stack.
|
||||
|
||||
for J in Unsigned_32_Arr'Range loop
|
||||
if Arr_Access (J) /= Analyzer.Pattern then
|
||||
Analyzer.Outermost_Touched_Mark :=
|
||||
Analyzer.Topmost_Touched_Mark :=
|
||||
To_Stack_Address (Arr_Access (J)'Address);
|
||||
|
||||
if Analyzer.First_Is_Outermost then
|
||||
if Analyzer.First_Is_Topmost then
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
end Compute_Result;
|
||||
|
||||
---------------------
|
||||
-- Get_Usage_Range --
|
||||
---------------------
|
||||
|
||||
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);
|
||||
begin
|
||||
return "[" & Min_Used_Str (2 .. Min_Used_Str'Last) & " -"
|
||||
& Max_Used_Str & "]";
|
||||
end Get_Usage_Range;
|
||||
|
||||
---------------------
|
||||
-- Output_Result --
|
||||
---------------------
|
||||
|
||||
procedure Output_Result (Result_Id : Natural; Result : Task_Result) is
|
||||
procedure Output_Result
|
||||
(Result_Id : Natural;
|
||||
Result : Task_Result;
|
||||
Max_Stack_Size_Len : Natural;
|
||||
Max_Actual_Use_Len : Natural)
|
||||
is
|
||||
Result_Id_Str : constant String := Natural'Image (Result_Id);
|
||||
Stack_Size_Str : constant String := Natural'Image (Result.Max_Size);
|
||||
Actual_Use_Str : constant String := Get_Usage_Range (Result);
|
||||
|
||||
Result_Id_Blanks : constant
|
||||
String (1 .. Index_Str'Length - Result_Id_Str'Length) :=
|
||||
(others => ' ');
|
||||
Stack_Size_Blanks : constant
|
||||
String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
|
||||
(others => ' ');
|
||||
Actual_Use_Blanks : constant
|
||||
String (1 .. Max_Actual_Use_Len - Actual_Use_Str'Length) :=
|
||||
(others => ' ');
|
||||
begin
|
||||
Set_Output (Standard_Error);
|
||||
Put (Natural'Image (Result_Id));
|
||||
Put (Result_Id_Blanks & Natural'Image (Result_Id));
|
||||
Put (" | ");
|
||||
Put (Result.Task_Name);
|
||||
Put (" | ");
|
||||
Put (Natural'Image (Result.Max_Size));
|
||||
Put (Stack_Size_Blanks & Stack_Size_Str);
|
||||
Put (" | ");
|
||||
Put (Natural'Image (Result.Measure));
|
||||
Put (Actual_Use_Blanks & Actual_Use_Str);
|
||||
New_Line;
|
||||
end Output_Result;
|
||||
|
||||
|
@ -281,21 +346,87 @@ 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_Size_Len, Max_Actual_Use_Len : Natural := 0;
|
||||
|
||||
Task_Name_Blanks :
|
||||
constant String (1 .. Task_Name_Length - Task_Name_Str'Length) :=
|
||||
(others => ' ');
|
||||
begin
|
||||
Set_Output (Standard_Error);
|
||||
|
||||
if Compute_Environment_Task then
|
||||
Compute_Result (Environment_Task_Analyzer);
|
||||
Report_Result (Environment_Task_Analyzer);
|
||||
end if;
|
||||
|
||||
Set_Output (Standard_Error);
|
||||
Put ("Index | Task Name | Stack Size | Actual Use");
|
||||
New_Line;
|
||||
if Result_Array'Length > 0 then
|
||||
-- Computes the size of the largest strings that will get displayed,
|
||||
-- in order to do correct column alignment.
|
||||
|
||||
for J in Result_Array'Range loop
|
||||
exit when J >= Next_Id;
|
||||
for J in Result_Array'Range loop
|
||||
exit when J >= Next_Id;
|
||||
|
||||
Output_Result (J, Result_Array (J));
|
||||
end loop;
|
||||
if Result_Array (J).Measure
|
||||
> Result_Array (Max_Actual_Use_Result_Id).Measure
|
||||
then
|
||||
Max_Actual_Use_Result_Id := J;
|
||||
end if;
|
||||
|
||||
if Result_Array (J).Max_Size > Max_Stack_Size then
|
||||
Max_Stack_Size := Result_Array (J).Max_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;
|
||||
|
||||
-- Display the output header. Blanks will be added in front of the
|
||||
-- labels if needed.
|
||||
|
||||
declare
|
||||
Stack_Size_Blanks : constant
|
||||
String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
|
||||
(others => ' ');
|
||||
Stack_Usage_Blanks : constant
|
||||
String (1 .. Max_Actual_Use_Len - Actual_Size_Str'Length) :=
|
||||
(others => ' ');
|
||||
|
||||
begin
|
||||
if Stack_Size_Str'Length > Max_Stack_Size_Len then
|
||||
Max_Stack_Size_Len := Stack_Size_Str'Length;
|
||||
end if;
|
||||
|
||||
if Actual_Size_Str'Length > Max_Actual_Use_Len then
|
||||
Max_Actual_Use_Len := Actual_Size_Str'Length;
|
||||
end if;
|
||||
|
||||
Put
|
||||
(Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
|
||||
& Stack_Size_Str & Stack_Size_Blanks & " | "
|
||||
& Stack_Usage_Blanks & Actual_Size_Str);
|
||||
end;
|
||||
|
||||
New_Line;
|
||||
|
||||
-- Now display the individual results
|
||||
|
||||
for J in Result_Array'Range loop
|
||||
exit when J >= Next_Id;
|
||||
Output_Result
|
||||
(J, Result_Array (J), Max_Stack_Size_Len, Max_Actual_Use_Len);
|
||||
end loop;
|
||||
else
|
||||
-- If there are no result stored, we'll still display the labels
|
||||
|
||||
Put
|
||||
(Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
|
||||
& Stack_Size_Str & " | " & Actual_Size_Str);
|
||||
New_Line;
|
||||
end if;
|
||||
end Output_Results;
|
||||
|
||||
-------------------
|
||||
|
@ -303,27 +434,60 @@ package body System.Stack_Usage is
|
|||
-------------------
|
||||
|
||||
procedure Report_Result (Analyzer : Stack_Analyzer) is
|
||||
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));
|
||||
begin
|
||||
if Analyzer.Result_Id in Result_Array'Range then
|
||||
Result_Array (Analyzer.Result_Id).Measure := Report_Result (Analyzer);
|
||||
else
|
||||
Output_Result
|
||||
(Analyzer.Result_Id,
|
||||
(Task_Name => Analyzer.Task_Name,
|
||||
Max_Size => Analyzer.Size,
|
||||
Measure => Report_Result (Analyzer)));
|
||||
end if;
|
||||
end Report_Result;
|
||||
|
||||
function Report_Result (Analyzer : Stack_Analyzer) return Natural is
|
||||
begin
|
||||
if Analyzer.Outermost_Touched_Mark = Analyzer.Inner_Pattern_Mark then
|
||||
return Stack_Size (Analyzer.Inner_Pattern_Mark,
|
||||
Analyzer.Bottom_Of_Stack);
|
||||
-- If the result can be stored, then store it in Result_Array
|
||||
|
||||
Result_Array (Analyzer.Result_Id) := Result;
|
||||
|
||||
else
|
||||
return Stack_Size (Analyzer.Outermost_Touched_Mark,
|
||||
Analyzer.Bottom_Of_Stack);
|
||||
|
||||
-- If the result cannot be stored, then we display it right away
|
||||
|
||||
declare
|
||||
Result_Str_Len : constant Natural :=
|
||||
Get_Usage_Range (Result)'Length;
|
||||
Size_Str_Len : constant Natural :=
|
||||
Natural'Image (Analyzer.Size)'Length;
|
||||
|
||||
Max_Stack_Size_Len : Natural;
|
||||
Max_Actual_Use_Len : Natural;
|
||||
|
||||
begin
|
||||
-- Take either the label size or the number image size for the
|
||||
-- size of the column "Stack Size".
|
||||
|
||||
if Size_Str_Len > Stack_Size_Str'Length then
|
||||
Max_Stack_Size_Len := Size_Str_Len;
|
||||
else
|
||||
Max_Stack_Size_Len := Stack_Size_Str'Length;
|
||||
end if;
|
||||
|
||||
-- Take either the label size or the number image size for the
|
||||
-- size of the column "Stack Usage"
|
||||
|
||||
if Result_Str_Len > Actual_Size_Str'Length then
|
||||
Max_Actual_Use_Len := Result_Str_Len;
|
||||
else
|
||||
Max_Actual_Use_Len := Actual_Size_Str'Length;
|
||||
end if;
|
||||
|
||||
Output_Result
|
||||
(Analyzer.Result_Id,
|
||||
Result,
|
||||
Max_Stack_Size_Len,
|
||||
Max_Actual_Use_Len);
|
||||
end;
|
||||
end if;
|
||||
end Report_Result;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2007, 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- --
|
||||
|
@ -34,6 +34,7 @@
|
|||
with System;
|
||||
with System.Storage_Elements;
|
||||
with System.Address_To_Access_Conversions;
|
||||
with Interfaces;
|
||||
|
||||
package System.Stack_Usage is
|
||||
pragma Preelaborate;
|
||||
|
@ -41,25 +42,18 @@ package System.Stack_Usage is
|
|||
package SSE renames System.Storage_Elements;
|
||||
|
||||
Byte_Size : constant := 8;
|
||||
Word_32_Size : constant := 4 * Byte_Size;
|
||||
Unsigned_32_Size : constant := 4 * Byte_Size;
|
||||
|
||||
type Word_32 is mod 2 ** Word_32_Size;
|
||||
for Word_32'Alignment use 4;
|
||||
-- The alignment clause seems dubious, what about architectures where
|
||||
-- the maximum alignment is less than 4???
|
||||
-- Anyway, why not use Interfaces.Unsigned_32???
|
||||
|
||||
subtype Stack_Address is SSE.Integer_Address;
|
||||
-- Address on the stack
|
||||
--
|
||||
-- Note: in this package, when comparing two addresses on the stack, the
|
||||
-- comments use the terms "outer", "inner", "outermost" and "innermost"
|
||||
-- instead of the ambigous "higher", "lower", "highest" and "lowest".
|
||||
-- "inner" means "closer to the bottom of stack" and is the contrary of
|
||||
-- "outer". "innermost" means "closest address to the bottom of stack". The
|
||||
-- stack is growing from the inner to the outer.
|
||||
|
||||
-- Top/Bottom would be much better than inner and outer ???
|
||||
|
||||
function To_Stack_Address (Value : System.Address) return Stack_Address
|
||||
renames System.Storage_Elements.To_Integer;
|
||||
function To_Stack_Address
|
||||
(Value : System.Address) return Stack_Address
|
||||
renames System.Storage_Elements.To_Integer;
|
||||
|
||||
type Stack_Analyzer is private;
|
||||
-- Type of the stack analyzer tool. It is used to fill a portion of
|
||||
|
@ -88,6 +82,7 @@ package System.Stack_Usage is
|
|||
-- Initialize_Analyzer (A,
|
||||
-- "Task t",
|
||||
-- A_Storage_Size - A_Guard,
|
||||
-- A_Guard
|
||||
-- To_Stack_Address (Bottom_Of_Stack'Address));
|
||||
-- Fill_Stack (A);
|
||||
-- Some_User_Code;
|
||||
|
@ -139,14 +134,14 @@ package System.Stack_Usage is
|
|||
|
||||
-- Pattern zone overflow:
|
||||
|
||||
-- Description: The stack grows outer than the outermost bound of the
|
||||
-- pattern zone. In that case, the outermost region modified in the
|
||||
-- Description: The stack grows outer than the topmost bound of the
|
||||
-- pattern zone. In that case, the topmost region modified in the
|
||||
-- pattern is not the maximum value of the stack pointer during the
|
||||
-- execution.
|
||||
|
||||
-- Strategy: At the end of the execution, the difference between the
|
||||
-- outermost memory region modified in the pattern zone and the
|
||||
-- outermost bound of the pattern zone can be understood as the
|
||||
-- topmost memory region modified in the pattern zone and the
|
||||
-- topmost bound of the pattern zone can be understood as the
|
||||
-- biggest allocation that the method could have detect, provided
|
||||
-- that there is no "Untouched allocated zone" error and no "Pattern
|
||||
-- usage in user code" error. If no object in the user code is likely
|
||||
|
@ -165,7 +160,7 @@ package System.Stack_Usage is
|
|||
-- changes the measure. Note that this error *very* rarely influence
|
||||
-- the measure of the total stack usage: to have some influence, the
|
||||
-- pattern has to be used in the object that has been allocated on the
|
||||
-- outermost address of the used stack.
|
||||
-- topmost address of the used stack.
|
||||
|
||||
-- Stack overflow:
|
||||
|
||||
|
@ -192,7 +187,7 @@ package System.Stack_Usage is
|
|||
-- error is really rare, and it is most probably a bug in the user
|
||||
-- code, e.g. some uninitialized variable. It is (most of the time)
|
||||
-- harmless: it influences the measure only if the untouched allocated
|
||||
-- zone happens to be located at the outermost value of the stack
|
||||
-- zone happens to be located at the topmost value of the stack
|
||||
-- pointer for the whole execution.
|
||||
|
||||
procedure Initialize (Buffer_Size : Natural);
|
||||
|
@ -215,15 +210,16 @@ package System.Stack_Usage is
|
|||
-- | the end of the call) | |
|
||||
-- ^ | |
|
||||
-- Analyzer.Bottom_Of_Stack ^ |
|
||||
-- Analyzer.Inner_Pattern_Mark ^
|
||||
-- Analyzer.Outer_Pattern_Mark
|
||||
-- Analyzer.Bottom_Pattern_Mark ^
|
||||
-- Analyzer.Top_Pattern_Mark
|
||||
|
||||
procedure Initialize_Analyzer
|
||||
(Analyzer : in out Stack_Analyzer;
|
||||
Task_Name : String;
|
||||
Size : Natural;
|
||||
Bottom : Stack_Address;
|
||||
Pattern : Word_32 := 16#DEAD_BEEF#);
|
||||
(Analyzer : in out Stack_Analyzer;
|
||||
Task_Name : String;
|
||||
Size : Natural;
|
||||
Overflow_Guard : 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.
|
||||
|
@ -234,7 +230,7 @@ package System.Stack_Usage is
|
|||
procedure Compute_Result (Analyzer : in out Stack_Analyzer);
|
||||
-- Read the patern zone and deduce the stack usage. It should be called
|
||||
-- from the same frame as Fill_Stack. If Analyzer.Probe is not null, an
|
||||
-- array of Word_32 with Analyzer.Probe elements is allocated on
|
||||
-- array of Unsigned_32 with Analyzer.Probe elements is allocated on
|
||||
-- Compute_Result's stack frame. Probe can be used to detect the error:
|
||||
-- "instrumentation threshold at reading". See above. After the call
|
||||
-- to this procedure, the memory will look like:
|
||||
|
@ -247,11 +243,11 @@ package System.Stack_Usage is
|
|||
-- | (deallocated at | elements | the | with |
|
||||
-- | the end of the call) | | execution | pattern |
|
||||
-- | ^ | | |
|
||||
-- | Inner_Pattern_Mark | | |
|
||||
-- | Bottom_Pattern_Mark | | |
|
||||
-- | | |
|
||||
-- |<----------------------------------------------------> |
|
||||
-- Stack used ^
|
||||
-- Outer_Pattern_Mark
|
||||
-- Top_Pattern_Mark
|
||||
|
||||
procedure Report_Result (Analyzer : Stack_Analyzer);
|
||||
-- Store the results of the computation in memory, at the address
|
||||
|
@ -268,9 +264,11 @@ package System.Stack_Usage is
|
|||
private
|
||||
|
||||
Task_Name_Length : constant := 32;
|
||||
-- The maximum length of task name displayed.
|
||||
-- ??? Consider merging this variable with Max_Task_Image_Length.
|
||||
|
||||
package Word_32_Addr is
|
||||
new System.Address_To_Access_Conversions (Word_32);
|
||||
package Unsigned_32_Addr is
|
||||
new System.Address_To_Access_Conversions (Interfaces.Unsigned_32);
|
||||
|
||||
type Stack_Analyzer is record
|
||||
Task_Name : String (1 .. Task_Name_Length);
|
||||
|
@ -279,19 +277,19 @@ private
|
|||
Size : Natural;
|
||||
-- Size of the pattern zone
|
||||
|
||||
Pattern : Word_32;
|
||||
Pattern : Interfaces.Unsigned_32;
|
||||
-- Pattern used to recognize untouched memory
|
||||
|
||||
Inner_Pattern_Mark : Stack_Address;
|
||||
-- Innermost bound of the pattern area on the stack
|
||||
Bottom_Pattern_Mark : Stack_Address;
|
||||
-- Bound of the pattern area on the stack clostest to the bottom
|
||||
|
||||
Outer_Pattern_Mark : Stack_Address;
|
||||
-- Outermost bound of the pattern area on the stack
|
||||
Top_Pattern_Mark : Stack_Address;
|
||||
-- Topmost bound of the pattern area on the stack
|
||||
|
||||
Outermost_Touched_Mark : Stack_Address;
|
||||
-- Outermost address of the pattern area whose value it is pointing
|
||||
Topmost_Touched_Mark : Stack_Address;
|
||||
-- Topmost address of the pattern area whose value it is pointing
|
||||
-- at has been modified during execution. If the systematic error are
|
||||
-- compensated, it is the outermost value of the stack pointer during
|
||||
-- compensated, it is the topmost value of the stack pointer during
|
||||
-- the execution.
|
||||
|
||||
Bottom_Of_Stack : Stack_Address;
|
||||
|
@ -299,16 +297,20 @@ private
|
|||
-- Initialize_Analyzer.
|
||||
|
||||
Array_Address : System.Address;
|
||||
-- Address of the array of Word_32 that represents the pattern zone
|
||||
-- Address of the array of Unsigned_32 that represents the pattern zone
|
||||
|
||||
First_Is_Outermost : Boolean;
|
||||
-- Set to true if the first element of the array of Word_32 that
|
||||
-- represents the pattern zone is at the outermost address of the
|
||||
-- pattern zone; false if it is the innermost address.
|
||||
First_Is_Topmost : Boolean;
|
||||
-- Set to true if the first element of the array of Unsigned_32 that
|
||||
-- represents the pattern zone is at the topmost address of the
|
||||
-- pattern zone; false if it is the bottommost address.
|
||||
|
||||
Result_Id : Positive;
|
||||
-- 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
|
||||
end record;
|
||||
|
||||
Environment_Task_Analyzer : Stack_Analyzer;
|
||||
|
@ -316,9 +318,10 @@ private
|
|||
Compute_Environment_Task : Boolean;
|
||||
|
||||
type Task_Result is record
|
||||
Task_Name : String (1 .. Task_Name_Length);
|
||||
Measure : Natural;
|
||||
Max_Size : Natural;
|
||||
Task_Name : String (1 .. Task_Name_Length);
|
||||
Measure : Natural;
|
||||
Max_Size : Natural;
|
||||
Overflow_Guard : Natural;
|
||||
end record;
|
||||
|
||||
type Result_Array_Type is array (Positive range <>) of Task_Result;
|
||||
|
|
Loading…
Add table
Reference in a new issue