From 91c2cbdb6847c9c1bbf1c0ce9d7e2f9bd7e3e5ab Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 29 Apr 2009 12:05:44 +0200 Subject: [PATCH] [multiple changes] 2009-04-29 Arnaud Charlet * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove unused assignment. 2009-04-29 Thomas Quinot * make.adb: Minor reformatting. Minor code reorganization throughout. 2009-04-29 Matteo Bordin * 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. From-SVN: r146942 --- gcc/ada/ChangeLog | 27 +++++ gcc/ada/Makefile.rtl | 2 + gcc/ada/g-tastus.ads | 38 ++++++ gcc/ada/gnat_ugn.texi | 12 +- gcc/ada/make.adb | 245 +++++++++++++++++---------------------- gcc/ada/s-stausa.adb | 59 +++++----- gcc/ada/s-stausa.ads | 41 ++++--- gcc/ada/s-stusta.adb | 261 ++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-stusta.ads | 77 +++++++++++++ gcc/ada/s-taskin.adb | 5 +- 10 files changed, 572 insertions(+), 195 deletions(-) create mode 100644 gcc/ada/g-tastus.ads create mode 100644 gcc/ada/s-stusta.adb create mode 100644 gcc/ada/s-stusta.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fd56ece2503..c9bd62054af 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2009-04-29 Arnaud Charlet + + * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove + unused assignment. + +2009-04-29 Thomas Quinot + + * make.adb: Minor reformatting. + Minor code reorganization throughout. + +2009-04-29 Matteo Bordin + + * 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 * initialize.c: Do not expand quoted arguments. diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 66c48e06093..0b2bec599ef 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -41,6 +41,7 @@ GNATRTL_TASKING_OBJS= \ g-boumai$(objext) \ g-semaph$(objext) \ g-signal$(objext) \ + g-tastus$(objext) \ g-thread$(objext) \ s-asthan$(objext) \ s-inmaop$(objext) \ @@ -50,6 +51,7 @@ GNATRTL_TASKING_OBJS= \ s-osinte$(objext) \ s-proinf$(objext) \ s-solita$(objext) \ + s-stusta$(objext) \ s-taenca$(objext) \ s-taprob$(objext) \ s-taprop$(objext) \ diff --git a/gcc/ada/g-tastus.ads b/gcc/ada/g-tastus.ads new file mode 100644 index 00000000000..ccfdf456bdf --- /dev/null +++ b/gcc/ada/g-tastus.ads @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index df66228bb00..521f8a90e88 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -20270,7 +20270,7 @@ output this info at program termination. Results are displayed in four columns: @noindent -Index | Task Name | Stack Size | Actual Use [min - max] +Index | Task Name | Stack Size | Stack Usage [Value +/- Variation] @noindent where: @@ -20285,11 +20285,11 @@ is the name of the task analyzed. @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 diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index f7d7b37a15a..59f0ab145b6 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1267,8 +1267,8 @@ package body Make is 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, @@ -2458,7 +2458,8 @@ package body Make is (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 @@ -2792,9 +2793,8 @@ package body Make is 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 @@ -2852,7 +2852,10 @@ package body Make is 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 @@ -2866,8 +2869,8 @@ package body Make is 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, @@ -2881,8 +2884,7 @@ package body Make is 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); @@ -4403,43 +4405,38 @@ package body Make is 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 @@ -4449,8 +4446,7 @@ package body Make is -- 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, @@ -4464,19 +4460,13 @@ package body Make is 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 := @@ -4490,8 +4480,7 @@ package body Make is -- 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, @@ -4504,8 +4493,7 @@ package body Make is -- 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, @@ -4745,8 +4733,7 @@ package body Make is 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 @@ -5335,14 +5322,10 @@ package body Make is 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; @@ -5387,14 +5370,14 @@ package body Make is 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; @@ -5425,9 +5408,7 @@ package body Make is 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 @@ -5444,8 +5425,7 @@ package body Make is -- 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 @@ -5476,8 +5456,8 @@ package body Make is 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; @@ -5486,11 +5466,12 @@ package body Make is 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; @@ -5498,11 +5479,12 @@ package body Make is 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; @@ -5536,37 +5518,32 @@ package body Make is -- 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 @@ -5593,15 +5570,10 @@ package body Make is 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; @@ -5619,6 +5591,7 @@ package body Make is Executable_Stamp : Time_Stamp_Type; -- Executable is the final executable program + -- ??? comment seems unrelated to declaration Library_Rebuilt : Boolean := False; @@ -5661,6 +5634,7 @@ package body Make is if Total_Compilation_Failures /= 0 then if Keep_Going then goto Next_Main; + else List_Bad_Compilations; Report_Compilation_Failed; @@ -5717,8 +5691,8 @@ package body Make is -- 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 @@ -5867,8 +5841,8 @@ package body Make is -- 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 @@ -5907,8 +5881,8 @@ package body Make is 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 @@ -5955,9 +5929,9 @@ package body Make is 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; @@ -7401,45 +7375,42 @@ package body Make is N : Name_Id; B : Byte; + 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. + + -------------------- + -- Base_Directory -- + -------------------- + + 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; + + Real_Path : constant String := Normalize_Pathname (Dir, Base_Directory); + + -- Start of processing for Mark_Directory + begin - if On_Command_Line then - declare - Real_Path : constant String := Normalize_Pathname (Dir); + Name_Len := 0; - begin - if Real_Path'Length = 0 then - Name_Len := Dir'Length; - Name_Buffer (1 .. Name_Len) := Dir; - - else - Name_Len := Real_Path'Length; - Name_Buffer (1 .. Name_Len) := Real_Path; - end if; - end; + if Real_Path'Length = 0 then + Add_Str_To_Name_Buffer (Dir); else - declare - Real_Path : constant String := - Normalize_Pathname - (Dir, Get_Name_String (Main_Project.Directory.Display_Name)); - - begin - if Real_Path'Length = 0 then - Name_Len := Dir'Length; - Name_Buffer (1 .. Name_Len) := Dir; - - else - Name_Len := Real_Path'Length; - Name_Buffer (1 .. Name_Len) := Real_Path; - end if; - end; + 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 @@ -7468,15 +7439,13 @@ package body Make is 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); @@ -7497,9 +7466,10 @@ package body Make is 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 @@ -8188,8 +8158,8 @@ package body Make is 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, @@ -8197,18 +8167,17 @@ package body Make is 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, diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index 859a9de8564..bf14beb468a 100644 --- a/gcc/ada/s-stausa.adb +++ b/gcc/ada/s-stausa.adb @@ -173,7 +173,7 @@ package body System.Stack_Usage is 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 @@ -204,8 +204,8 @@ package body System.Stack_Usage is 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 @@ -222,16 +222,16 @@ package body System.Stack_Usage is 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); @@ -318,7 +318,7 @@ package body System.Stack_Usage is 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#) @@ -327,7 +327,7 @@ package body System.Stack_Usage is -- 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; @@ -414,11 +414,11 @@ package body System.Stack_Usage is --------------------- 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; --------------------- @@ -431,16 +431,16 @@ package body System.Stack_Usage is 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 @@ -453,7 +453,7 @@ package body System.Stack_Usage is 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; @@ -488,8 +488,8 @@ package body System.Stack_Usage is 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; @@ -559,12 +559,13 @@ package body System.Stack_Usage is 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 @@ -572,15 +573,17 @@ package body System.Stack_Usage is -- 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 diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads index af536560c1c..f42e37452f7 100644 --- a/gcc/ada/s-stausa.ads +++ b/gcc/ada/s-stausa.ads @@ -46,6 +46,27 @@ package System.Stack_Usage is (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. @@ -206,7 +227,7 @@ package System.Stack_Usage is 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#); @@ -256,10 +277,6 @@ 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 Unsigned_32_Addr is new System.Address_To_Access_Conversions (Interfaces.Unsigned_32); @@ -308,20 +325,6 @@ private 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; diff --git a/gcc/ada/s-stusta.adb b/gcc/ada/s-stusta.adb new file mode 100644 index 00000000000..b3fa891fa7d --- /dev/null +++ b/gcc/ada/s-stusta.adb @@ -0,0 +1,261 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/s-stusta.ads b/gcc/ada/s-stusta.ads new file mode 100644 index 00000000000..cc121d5fcf6 --- /dev/null +++ b/gcc/ada/s-stusta.ads @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index ba5ef095345..35fcbdf92a1 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -176,9 +176,7 @@ package body System.Tasking is procedure Initialize is T : Task_Id; Base_Priority : Any_Priority; - - Success : Boolean; - pragma Warnings (Off, Success); + Success : Boolean; begin if Initialized then @@ -195,7 +193,6 @@ package body System.Tasking is 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,