+2009-04-29 Arnaud Charlet <charlet@adacore.com>
+
+ * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove
+ unused assignment.
+
+2009-04-29 Thomas Quinot <quinot@adacore.com>
+
+ * make.adb: Minor reformatting.
+ Minor code reorganization throughout.
+
+2009-04-29 Matteo Bordin <bordin@adacore.com>
+
+ * s-stausa.ads: Changed visibility of type Task_Result: moved to
+ public part to give application visibility over it.
+ This is for future improvement and to build a public API on top of it.
+ Changed record components name of type Task_Result to reflect the new
+ way of reporting.
+
+ * s-stausa.adb: Actual_Size_Str changed to reflect the new way of
+ reporting Stack usage.
+
+ * gnat_ugn.texi: Update doc of stack usage report.
+
+ * g-tastus.ads, s-stusta.ads, s-stusta.adb: New files.
+
+ * Makefile.rtl: Add new run-time files.
+
2009-04-29 Pascal Obry <obry@adacore.com>
* initialize.c: Do not expand quoted arguments.
g-boumai$(objext) \
g-semaph$(objext) \
g-signal$(objext) \
+ g-tastus$(objext) \
g-thread$(objext) \
s-asthan$(objext) \
s-inmaop$(objext) \
s-osinte$(objext) \
s-proinf$(objext) \
s-solita$(objext) \
+ s-stusta$(objext) \
s-taenca$(objext) \
s-taprob$(objext) \
s-taprop$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . T A S K _ S T A C K _ U S A G E --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides an API to query for tasks stack usage at runtime
+-- and during debug.
+
+-- See file s-stusta.ads for full documentation of the interface
+
+with System.Stack_Usage.Tasking;
+
+package GNAT.Task_Stack_Usage renames System.Stack_Usage.Tasking;
columns:
@noindent
-Index | Task Name | Stack Size | Actual Use [min - max]
+Index | Task Name | Stack Size | Stack Usage [Value +/- Variation]
@noindent
where:
@item Stack Size
is the maximum size for the stack.
-@item Actual Use
-is the measure done by the stack analyzer. In order to prevent overflow,
-the stack is not entirely analyzed, and it's not possible to know exactly how
-much has actually been used. The real amount of stack used is between the min
-and max values.
+@item Stack Usage
+is the measure done by the stack analyzer. In order to prevent overflow, the stack
+is not entirely analyzed, and it's not possible to know exactly how
+much has actually been used. The report thus contains the theoretical stack usage
+(Value) and the possible variation (Variation) around this value.
@end table
Unknown_Switches_To_The_Compiler;
if File_Name'Length > 0 then
- Name_Len := File_Name'Length;
- Name_Buffer (1 .. Name_Len) := File_Name;
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (File_Name);
Switches :=
Switches_Of
(Source_File => Name_Find,
(1 => new String'
(Name_Buffer (1 .. Name_Len)));
Dir_Path : constant String :=
- Get_Name_String (Arguments_Project.Directory.Name);
+ Get_Name_String
+ (Arguments_Project.Directory.Name);
begin
Test_If_Relative_Path
Add_It : Boolean := True;
begin
- Name_Len := Standard_Library_Package_Body_Name'Length;
- Name_Buffer (1 .. Name_Len) :=
- Standard_Library_Package_Body_Name;
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Standard_Library_Package_Body_Name);
Sfile := Name_Enter;
-- If we have a special runtime, we add the standard
if Arguments_Project /= No_Project then
if not Arguments_Project.Externally_Built then
- Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True);
+ Prj.Env.Set_Ada_Paths
+ (Arguments_Project,
+ Project_Tree,
+ Including_Libraries => True);
if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= Prj.None
and then not Prj.Externally_Built
and then not Prj.Need_To_Build_Lib
then
- -- Add to the Q all sources of the project that
- -- have not been marked.
+ -- Add to the Q all sources of the project that have
+ -- not been marked.
Insert_Project_Sources
(The_Project => Prj,
end;
end if;
- -- Change to the object directory of the project file,
- -- if necessary.
+ -- Change to object directory of the project file, if necessary
Change_To_Object_Directory (Arguments_Project);
No_Project
then
Get_Name_String (Unit.Name);
- Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b";
- Name_Len := Name_Len + 2;
+ Add_Str_To_Name_Buffer ("%b");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Body_Part).Display_Name);
- ALI_Project :=
- Unit.File_Names (Body_Part).Project;
+ ALI_Project := Unit.File_Names (Body_Part).Project;
- -- Otherwise, if there is a spec, put it
- -- in the mapping.
+ -- Otherwise, if there is a spec, put it in the
+ -- mapping.
elsif Unit.File_Names (Specification).Name /= No_File
and then Unit.File_Names (Specification).Project /=
No_Project
then
Get_Name_String (Unit.Name);
- Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s";
- Name_Len := Name_Len + 2;
+ Add_Str_To_Name_Buffer ("%s");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Specification).Display_Name);
- ALI_Project :=
- Unit.File_Names (Specification).Project;
+ ALI_Project := Unit.File_Names (Specification).Project;
else
ALI_Name := No_File;
end if;
- -- If we have something to put in the mapping
- -- then we do it now. However, if the project
- -- is extended, we don't put anything in the
- -- mapping file, because we do not know where
- -- the ALI file is: it might be in the ext-
- -- ended project obj dir as well as in the
- -- extending project obj dir.
+ -- If we have something to put in the mapping then do it
+ -- now. However, if the project is extended, we don't put
+ -- anything in the mapping file, because we do not know
+ -- where the ALI file is: it might be in the extended
+ -- project obj dir as well as in the extending project
+ -- obj dir.
if ALI_Name /= No_File
and then ALI_Project.Extended_By = No_Project
-- do not put the unit in the mapping file.
declare
- ALI : constant String :=
- Get_Name_String (ALI_Name);
+ ALI : constant String := Get_Name_String (ALI_Name);
begin
-- For library projects, use the library directory,
end if;
if Name_Buffer (Name_Len) /=
- Directory_Separator
+ Directory_Separator
then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) :=
- Directory_Separator;
+ Add_Char_To_Name_Buffer (Directory_Separator);
end if;
- Name_Buffer
- (Name_Len + 1 ..
- Name_Len + ALI'Length) := ALI;
- Name_Len :=
- Name_Len + ALI'Length + 1;
- Name_Buffer (Name_Len) := ASCII.LF;
+ Add_Str_To_Name_Buffer (ALI);
+ Add_Char_To_Name_Buffer (ASCII.LF);
declare
ALI_Path_Name : constant String :=
-- First line is the unit name
Get_Name_String (ALI_Unit);
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := ASCII.LF;
+ Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
-- Second line it the ALI file name
Get_Name_String (ALI_Name);
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := ASCII.LF;
+ Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
while Value /= Prj.Nil_String loop
Get_Name_String
- (Project_Tree.String_Elements.Table
- (Value).Value);
+ (Project_Tree.String_Elements.Table (Value).Value);
-- To know if a main is an Ada main, get its project.
-- It should be the project specified on the command
Get_Name_String (Main_Project.Exec_Directory.Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
+ Add_Char_To_Name_Buffer (Directory_Separator);
end if;
- Name_Buffer (Name_Len + 1 ..
- Name_Len + Exec_File_Name'Length) :=
- Exec_File_Name;
- Name_Len := Name_Len + Exec_File_Name'Length;
+ Add_Str_To_Name_Buffer (Exec_File_Name);
Saved_Linker_Switches.Table (J + 1) :=
new String'(Name_Buffer (1 .. Name_Len));
end if;
for J in 1 .. Gcc_Switches.Last loop
Test_If_Relative_Path
(Gcc_Switches.Table (J),
- Parent => Dir_Path,
+ Parent => Dir_Path,
Including_Non_Switch => False);
end loop;
for J in 1 .. Saved_Gcc_Switches.Last loop
Test_If_Relative_Path
(Saved_Gcc_Switches.Table (J),
- Parent => Current_Work_Dir.all,
+ Parent => Current_Work_Dir.all,
Including_Non_Switch => False);
end loop;
end;
if Main_Project = No_Project then
for J in 1 .. Saved_Gcc_Switches.Last loop
Add_Switch
- (Saved_Gcc_Switches.Table (J),
- Compiler,
- And_Save => False);
+ (Saved_Gcc_Switches.Table (J), Compiler, And_Save => False);
end loop;
else
-- We never use gnat.adc when a project file is used
- The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
- No_gnat_adc;
+ The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) := No_gnat_adc;
end if;
-- If there was a --GCC, --GNATBIND or --GNATLINK switch on
Saved_Maximum_Processes := Maximum_Processes;
end if;
- -- Allocate as many temporary mapping file names as the maximum
- -- number of compilation processed, for each possible project.
+ -- Allocate as many temporary mapping file names as the maximum number
+ -- of compilations processed, for each possible project.
declare
Data : Project_Compilation_Access;
while Proj /= null loop
Data := new Project_Compilation_Data'
(Mapping_File_Names => new Temp_Path_Names
- (1 .. Saved_Maximum_Processes),
+ (1 .. Saved_Maximum_Processes),
Last_Mapping_File_Names => 0,
Free_Mapping_File_Indices => new Free_File_Indices
- (1 .. Saved_Maximum_Processes),
+ (1 .. Saved_Maximum_Processes),
Last_Free_Indices => 0);
+
Project_Compilation_Htable.Set
(Project_Compilation, Proj.Project, Data);
Proj := Proj.Next;
Data := new Project_Compilation_Data'
(Mapping_File_Names => new Temp_Path_Names
- (1 .. Saved_Maximum_Processes),
+ (1 .. Saved_Maximum_Processes),
Last_Mapping_File_Names => 0,
Free_Mapping_File_Indices => new Free_File_Indices
- (1 .. Saved_Maximum_Processes),
+ (1 .. Saved_Maximum_Processes),
Last_Free_Indices => 0);
+
Project_Compilation_Htable.Set
(Project_Compilation, No_Project, Data);
end;
-- Look inside the linker switches to see if the name of the final
-- executable program was specified.
- for
- J in reverse Linker_Switches.First .. Linker_Switches.Last
- loop
+ for J in reverse Linker_Switches.First .. Linker_Switches.Last loop
if Linker_Switches.Table (J).all = Output_Flag.all then
pragma Assert (J < Linker_Switches.Last);
- -- We cannot specify a single executable for several
- -- main subprograms!
+ -- We cannot specify a single executable for several main
+ -- subprograms
if Osint.Number_Of_Files > 1 then
Fail
- ("cannot specify a single executable " &
- "for several mains");
+ ("cannot specify a single executable for several mains");
end if;
- Name_Len := Linker_Switches.Table (J + 1)'Length;
- Name_Buffer (1 .. Name_Len) :=
- Linker_Switches.Table (J + 1).all;
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Linker_Switches.Table (J + 1).all);
Executable := Name_Enter;
Verbose_Msg (Executable, "final executable");
end if;
end loop;
- -- If the name of the final executable program was not specified
- -- then construct it from the main input file.
+ -- If the name of the final executable program was not specified then
+ -- construct it from the main input file.
if Executable = No_File then
if Main_Project = No_Project then
- Executable :=
- Executable_Name (Strip_Suffix (Main_Source_File));
+ Executable := Executable_Name (Strip_Suffix (Main_Source_File));
else
-- If we are using a project file, we attempt to remove the
Get_Name_String (Main_Project.Exec_Directory.Display_Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
+ Add_Char_To_Name_Buffer (Directory_Separator);
end if;
- Name_Buffer (Name_Len + 1 ..
- Name_Len + Exec_File_Name'Length) :=
- Exec_File_Name;
-
- Name_Len := Name_Len + Exec_File_Name'Length;
+ Add_Str_To_Name_Buffer (Exec_File_Name);
Executable := Name_Find;
end if;
Executable_Stamp : Time_Stamp_Type;
-- Executable is the final executable program
+ -- ??? comment seems unrelated to declaration
Library_Rebuilt : Boolean := False;
if Total_Compilation_Failures /= 0 then
if Keep_Going then
goto Next_Main;
+
else
List_Bad_Compilations;
Report_Compilation_Failed;
-- or probably better, break this out as a nested proc).
begin
- -- Put in Library_Projs table all library project
- -- file ids when the library need to be rebuilt.
+ -- Put in Library_Projs table all library project file
+ -- ids when the library need to be rebuilt.
Proj1 := Project_Tree.Projects;
while Proj1 /= null loop
-- If the objects were up-to-date check if the executable file
-- is also up-to-date. For now always bind and link on the JVM
- -- since there is currently no simple way to check the
- -- up-to-date status of objects
+ -- since there is currently no simple way to check whether
+ -- objects are up-to-date.
if Targparm.VM_Target /= JVM_Target
and then First_Compiled_File = No_File
Executable_Obsolete := Youngest_Obj_File /= No_File;
end if;
- -- Return if the executable is up to date
- -- and otherwise motivate the relink/rebind.
+ -- Return if the executable is up to date and otherwise
+ -- motivate the relink/rebind.
if not Executable_Obsolete then
if not Quiet_Output then
Change_To_Object_Directory (Main_Project);
end if;
- -- If we are here, it means that we need to rebuilt the current
- -- main. So we set Executable_Obsolete to True to make sure that
- -- the subsequent mains will be rebuilt.
+ -- If we are here, it means that we need to rebuilt the current main,
+ -- so we set Executable_Obsolete to True to make sure that subsequent
+ -- mains will be rebuilt.
Main_ALI_In_Place_Mode_Step : declare
ALI_File : File_Name_Type;
N : Name_Id;
B : Byte;
- begin
- if On_Command_Line then
- declare
- Real_Path : constant String := Normalize_Pathname (Dir);
+ function Base_Directory return String;
+ -- If Dir comes from the command line, empty string (relative paths
+ -- are resolved with respect to the current directory), else return
+ -- the main project's directory.
- begin
- if Real_Path'Length = 0 then
- Name_Len := Dir'Length;
- Name_Buffer (1 .. Name_Len) := Dir;
+ --------------------
+ -- Base_Directory --
+ --------------------
- else
- Name_Len := Real_Path'Length;
- Name_Buffer (1 .. Name_Len) := Real_Path;
- end if;
- end;
+ function Base_Directory return String is
+ begin
+ if On_Command_Line then
+ return "";
+ else
+ return Get_Name_String (Main_Project.Directory.Display_Name);
+ end if;
+ end Base_Directory;
- else
- declare
- Real_Path : constant String :=
- Normalize_Pathname
- (Dir, Get_Name_String (Main_Project.Directory.Display_Name));
+ Real_Path : constant String := Normalize_Pathname (Dir, Base_Directory);
- begin
- if Real_Path'Length = 0 then
- Name_Len := Dir'Length;
- Name_Buffer (1 .. Name_Len) := Dir;
+ -- Start of processing for Mark_Directory
- else
- Name_Len := Real_Path'Length;
- Name_Buffer (1 .. Name_Len) := Real_Path;
- end if;
- end;
+ begin
+ Name_Len := 0;
+
+ if Real_Path'Length = 0 then
+ Add_Str_To_Name_Buffer (Dir);
+
+ else
+ Add_Str_To_Name_Buffer (Real_Path);
end if;
-- Last character is supposed to be a directory separator
if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
+ Add_Char_To_Name_Buffer (Directory_Separator);
end if;
-- Add flags to the already existing flags
Proj : Project_Id;
begin
- if Prj.Depth >= Depth
- or else Get (Seen, Prj)
- then
+ if Prj.Depth >= Depth or else Get (Seen, Prj) then
return;
end if;
-- We need a test to avoid infinite recursions with limited withs:
-- If we have A -> B -> A, then when set level of A to n, we try and
- -- set level of B to n+1, and then level of A to n + 2,...
+ -- set level of B to n+1, and then level of A to n + 2, ...
Set (Seen, Prj, True);
Set (Seen, Prj, False);
end Recurse;
+ Proj : Project_List;
+
-- Start of processing for Recursive_Compute_Depth
- Proj : Project_List;
begin
Proj := Project_Tree.Projects;
while Proj /= null loop
end if;
if Truncated then
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name (1 .. Last));
Switches :=
Prj.Util.Value_Of
(Index => Name_Find,
In_Array => Switches_Array,
In_Tree => Project_Tree);
- if Switches = Nil_Variable_Value
- and then Allow_ALI
- then
+ if Switches = Nil_Variable_Value and then Allow_ALI then
Last := Source_File_Name'Length;
while Name (Last) /= '.' loop
Last := Last - 1;
end loop;
- Name (Last + 1 .. Last + 3) := "ali";
- Name_Len := Last + 3;
- Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len);
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name (1 .. Last));
+ Add_Str_To_Name_Buffer ("ali");
+
Switches :=
Prj.Util.Value_Of
(Index => Name_Find,
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]";
+ Actual_Size_Str : constant String := "Stack usage [Value +/- Variation]";
function Get_Usage_Range (Result : Task_Result) return String;
-- Return string representing the range of possible result of stack usage
Result_Array.all :=
(others =>
(Task_Name => (others => ASCII.NUL),
- Min_Measure => 0,
- Max_Measure => 0,
+ Variation => 0,
+ Value => 0,
Max_Size => 0));
-- Set the Is_Enabled flag to true, so that the task wrapper knows that
if Stack_Size_Chars /= Null_Address then
declare
- Stack_Size : Integer;
+ My_Stack_Size : Integer;
begin
- Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
+ My_Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
Initialize_Analyzer
(Environment_Task_Analyzer,
"ENVIRONMENT TASK",
- Stack_Size,
- Stack_Size,
+ My_Stack_Size,
+ My_Stack_Size,
System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
Fill_Stack (Environment_Task_Analyzer);
procedure Initialize_Analyzer
(Analyzer : in out Stack_Analyzer;
Task_Name : String;
- Stack_Size : Natural;
+ My_Stack_Size : Natural;
Max_Pattern_Size : Natural;
Bottom : Stack_Address;
Pattern : Unsigned_32 := 16#DEAD_BEEF#)
-- Initialize the analyzer fields
Analyzer.Bottom_Of_Stack := Bottom;
- Analyzer.Stack_Size := Stack_Size;
+ Analyzer.Stack_Size := My_Stack_Size;
Analyzer.Pattern_Size := Max_Pattern_Size;
Analyzer.Pattern := Pattern;
Analyzer.Result_Id := Next_Id;
---------------------
function Get_Usage_Range (Result : Task_Result) return String is
- Min_Used_Str : constant String := Natural'Image (Result.Min_Measure);
- Max_Used_Str : constant String := Natural'Image (Result.Max_Measure);
+ Variation_Used_Str : constant String :=
+ Natural'Image (Result.Variation);
+ Value_Used_Str : constant String := Natural'Image (Result.Value);
begin
- return "[" & Min_Used_Str (2 .. Min_Used_Str'Last) & " -"
- & Max_Used_Str & "]";
+ return "[" & Value_Used_Str & " +/- " & Variation_Used_Str & "]";
end Get_Usage_Range;
---------------------
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_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_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) :=
+ String (1 .. Max_Stack_Size_Len - My_Stack_Size_Str'Length) :=
(others => ' ');
Actual_Use_Blanks : constant
Put (" | ");
Put (Result.Task_Name);
Put (" | ");
- Put (Stack_Size_Blanks & Stack_Size_Str);
+ Put (Stack_Size_Blanks & My_Stack_Size_Str);
Put (" | ");
Put (Actual_Use_Blanks & Actual_Use_Str);
New_Line;
for J in Result_Array'Range loop
exit when J >= Next_Id;
- if Result_Array (J).Max_Measure
- > Result_Array (Max_Actual_Use_Result_Id).Max_Measure
+ if Result_Array (J).Value
+ > Result_Array (Max_Actual_Use_Result_Id).Value
then
Max_Actual_Use_Result_Id := J;
end if;
Result : Task_Result :=
(Task_Name => Analyzer.Task_Name,
Max_Size => Analyzer.Stack_Size,
- Min_Measure => 0,
- Max_Measure => 0);
+ Variation => 0,
+ Value => 0);
Overflow_Guard : constant Integer :=
Analyzer.Stack_Size
- Stack_Size (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Of_Stack);
+ Max, Min : Positive;
begin
if Analyzer.Pattern_Size = 0 then
-- at all. In other words, we used at least everything (and possibly
-- more).
- Result.Min_Measure := Analyzer.Stack_Size - Overflow_Guard;
- Result.Max_Measure := Analyzer.Stack_Size;
+ Min := Analyzer.Stack_Size - Overflow_Guard;
+ Max := Analyzer.Stack_Size;
else
- Result.Min_Measure := Stack_Size
- (Analyzer.Topmost_Touched_Mark,
- Analyzer.Bottom_Of_Stack);
- Result.Max_Measure := Result.Min_Measure + Overflow_Guard;
+ Min := Stack_Size
+ (Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack);
+ Max := Min + Overflow_Guard;
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
(Value : System.Address) return Stack_Address
renames System.Storage_Elements.To_Integer;
+ Task_Name_Length : constant := 32;
+ -- The maximum length of task name displayed.
+ -- ??? Consider merging this variable with Max_Task_Image_Length.
+
+ type Task_Result is record
+ Task_Name : String (1 .. Task_Name_Length);
+
+ Value : Natural;
+ -- Amount of the stack used; the value is calculated on the basis of
+ -- the mechanism used by GNAT to allocate it, and it is NOT a precise
+ -- value.
+
+ Variation : Natural;
+ -- Possible variation in the amount of used stack. The real stack usage
+ -- may vary in the range Value +/- Variation
+
+ Max_Size : Natural;
+ end record;
+
+ type Result_Array_Type is array (Positive range <>) of Task_Result;
+
type Stack_Analyzer is private;
-- Type of the stack analyzer tool. It is used to fill a portion of the
-- stack with Pattern, and to compute the stack used after some execution.
procedure Initialize_Analyzer
(Analyzer : in out Stack_Analyzer;
Task_Name : String;
- Stack_Size : Natural;
+ My_Stack_Size : Natural;
Max_Pattern_Size : Natural;
Bottom : Stack_Address;
Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
private
- Task_Name_Length : constant := 32;
- -- The maximum length of task name displayed.
- -- ??? Consider merging this variable with Max_Task_Image_Length.
-
package Unsigned_32_Addr is
new System.Address_To_Access_Conversions (Interfaces.Unsigned_32);
Compute_Environment_Task : Boolean;
- type Task_Result is record
- Task_Name : String (1 .. Task_Name_Length);
-
- Min_Measure : Natural;
- -- Minimum value for the measure
-
- Max_Measure : Natural;
- -- Maximum value for the measure, taking into account the actual size
- -- of the pattern filled.
-
- Max_Size : Natural;
- end record;
-
- type Result_Array_Type is array (Positive range <>) of Task_Result;
type Result_Array_Ptr is access all Result_Array_Type;
Result_Array : Result_Array_Ptr;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . S T A C K _ U S A G E . T AS K I N G --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Stack_Usage;
+
+-- This is why this package is part of GNARL:
+
+with System.Tasking.Debug;
+with System.Task_Primitives.Operations;
+
+with System.IO;
+
+package body System.Stack_Usage.Tasking is
+ use System.IO;
+
+ procedure Report_For_Task (Id : System.Tasking.Task_Id);
+ -- A generic procedure calculating stack usage for a given task
+
+ procedure Compute_All_Tasks;
+ -- Compute the stack usage for all tasks and saves it in
+ -- System.Stack_Usage.Result_Array
+
+ procedure Compute_Current_Task;
+ -- Compute the stack usage for a given task and saves it in the a precise
+ -- slot in System.Stack_Usage.Result_Array;
+
+ procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean);
+ -- Report the stack usage of either all tasks (All_Tasks = True) or of the
+ -- current task (All_Task = False). If Print is True, then results are
+ -- printed on stderr
+
+ procedure Convert
+ (TS : System.Stack_Usage.Task_Result;
+ Res : out Stack_Usage_Result);
+ -- Convert an object of type System.Stack_Usage in a Stack_Usage_Result
+
+ --------------
+ -- Convert --
+ --------------
+
+ procedure Convert
+ (TS : System.Stack_Usage.Task_Result;
+ Res : out Stack_Usage_Result) is
+ begin
+ Res := TS;
+ end Convert;
+
+ ----------------------
+ -- Report_For_Task --
+ ----------------------
+
+ procedure Report_For_Task (Id : System.Tasking.Task_Id) is
+ begin
+ System.Stack_Usage.Compute_Result (Id.Common.Analyzer);
+ System.Stack_Usage.Report_Result (Id.Common.Analyzer);
+ end Report_For_Task;
+
+ ------------------------
+ -- Compute_All_Tasks --
+ ------------------------
+
+ procedure Compute_All_Tasks is
+ Id : System.Tasking.Task_Id;
+ use type System.Tasking.Task_Id;
+ begin
+ if not System.Stack_Usage.Is_Enabled then
+ Put ("Stack Usage not enabled: bind with -uNNN switch");
+ else
+
+ -- Loop over all tasks
+
+ for J in System.Tasking.Debug.Known_Tasks'First + 1
+ .. System.Tasking.Debug.Known_Tasks'Last
+ loop
+ Id := System.Tasking.Debug.Known_Tasks (J);
+ exit when Id = null;
+
+ -- Calculate the task usage for a given task
+
+ Report_For_Task (Id);
+ end loop;
+
+ end if;
+ end Compute_All_Tasks;
+
+ ---------------------------
+ -- Compute_Current_Task --
+ ---------------------------
+
+ procedure Compute_Current_Task is
+ begin
+ if not System.Stack_Usage.Is_Enabled then
+ Put ("Stack Usage not enabled: bind with -uNNN switch");
+ else
+
+ -- The current task
+
+ Report_For_Task (System.Tasking.Self);
+
+ end if;
+ end Compute_Current_Task;
+
+ ------------------
+ -- Report_Impl --
+ ------------------
+
+ procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean) is
+ begin
+
+ -- Lock the runtime
+
+ System.Task_Primitives.Operations.Lock_RTS;
+
+ -- Calculate results
+
+ if All_Tasks then
+ Compute_All_Tasks;
+ else
+ Compute_Current_Task;
+ end if;
+
+ -- Output results
+ if Do_Print then
+ System.Stack_Usage.Output_Results;
+ end if;
+
+ -- Unlock the runtime
+
+ System.Task_Primitives.Operations.Unlock_RTS;
+
+ end Report_Impl;
+
+ ----------------------
+ -- Report_All_Task --
+ ----------------------
+
+ procedure Report_All_Tasks is
+ begin
+ Report_Impl (True, True);
+ end Report_All_Tasks;
+
+ --------------------------
+ -- Report_Current_Task --
+ --------------------------
+
+ procedure Report_Current_Task is
+ Res : Stack_Usage_Result;
+ begin
+ Res := Get_Current_Task_Usage;
+ Print (Res);
+ end Report_Current_Task;
+
+ --------------------------
+ -- Get_All_Tasks_Usage --
+ --------------------------
+
+ function Get_All_Tasks_Usage return Stack_Usage_Result_Array is
+ Res : Stack_Usage_Result_Array
+ (1 .. System.Stack_Usage.Result_Array'Length);
+ begin
+ Report_Impl (True, False);
+
+ for J in Res'Range loop
+ Convert (System.Stack_Usage.Result_Array (J), Res (J));
+ end loop;
+
+ return Res;
+ end Get_All_Tasks_Usage;
+
+ -----------------------------
+ -- Get_Current_Task_Usage --
+ -----------------------------
+
+ function Get_Current_Task_Usage return Stack_Usage_Result is
+ Res : Stack_Usage_Result;
+ Original : System.Stack_Usage.Task_Result;
+ Found : Boolean := False;
+ begin
+
+ Report_Impl (False, False);
+
+ -- Look for the task info in System.Stack_Usage.Result_Array;
+ -- the search is based on task name
+
+ for T in System.Stack_Usage.Result_Array'Range loop
+ if System.Stack_Usage.Result_Array (T).Task_Name =
+ System.Tasking.Self.Common.Analyzer.Task_Name
+ then
+ Original := System.Stack_Usage.Result_Array (T);
+ Found := True;
+ exit;
+ end if;
+ end loop;
+
+ -- Be sure a task has been found
+
+ pragma Assert (Found);
+
+ Convert (Original, Res);
+ return Res;
+ end Get_Current_Task_Usage;
+
+ ------------
+ -- Print --
+ ------------
+
+ procedure Print (Obj : Stack_Usage_Result) is
+ Pos : Positive;
+ begin
+
+ -- Simply trim the string containing the task name
+
+ for S in Obj.Task_Name'Range loop
+ if Obj.Task_Name (S) = ' ' then
+ Pos := S;
+ exit;
+ end if;
+ end loop;
+
+ declare
+ T_Name : constant String := Obj.Task_Name
+ (Obj.Task_Name'First .. Pos);
+ begin
+ Put_Line
+ ("| " & T_Name & " | " & Natural'Image (Obj.Max_Size) & " [" &
+ Natural'Image (Obj.Value) & " +/- " &
+ Natural'Image (Obj.Variation) & "]");
+ end;
+ end Print;
+
+end System.Stack_Usage.Tasking;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . S T A C K _ U S A G E . T AS K I N G --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides exported subprograms to be called at debug time to
+-- measure stack usage at run-time.
+
+-- Note: this package must be a child package of System.Stack_Usage to have
+-- visibility over its private part; it is however part of GNARL because it
+-- needs to access tasking features via System.Tasking.Debug and
+-- System.Task_Primitives.Operations;
+
+package System.Stack_Usage.Tasking is
+
+ procedure Report_All_Tasks;
+ -- Print the current stack usage of all tasks on stderr. Exported to be
+ -- called also in debug mode.
+
+ pragma Export
+ (C,
+ Report_All_Tasks,
+ "__gnat_tasks_stack_usage_report_all_tasks");
+
+ procedure Report_Current_Task;
+ -- Print the stack usage of current task on stderr. Exported to be called
+ -- also in debug mode.
+
+ pragma Export
+ (C,
+ Report_Current_Task,
+ "__gnat_tasks_stack_usage_report_current_task");
+
+ subtype Stack_Usage_Result is System.Stack_Usage.Task_Result;
+ -- This type is a descriptor for task stack usage result.
+
+ type Stack_Usage_Result_Array is
+ array (Positive range <>) of Stack_Usage_Result;
+
+ function Get_Current_Task_Usage return Stack_Usage_Result;
+ -- Return the current stack usage for the invoking task
+
+ function Get_All_Tasks_Usage return Stack_Usage_Result_Array;
+ -- Return an array containing the stack usage results for all tasks
+
+ procedure Print (Obj : Stack_Usage_Result);
+ -- Print Obj on stderr
+
+end System.Stack_Usage.Tasking;
procedure Initialize is
T : Task_Id;
Base_Priority : Any_Priority;
-
- Success : Boolean;
- pragma Warnings (Off, Success);
+ Success : Boolean;
begin
if Initialized then
Base_Priority := Priority (Main_Priority);
end if;
- Success := True;
T := STPO.New_ATCB (0);
Initialize_ATCB
(null, null, Null_Address, Null_Task, null, Base_Priority,
projects / thirdparty / gcc.git / commitdiff
