diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/s-stausa.adb')
-rw-r--r-- | gcc-4.4.3/gcc/ada/s-stausa.adb | 630 |
1 files changed, 0 insertions, 630 deletions
diff --git a/gcc-4.4.3/gcc/ada/s-stausa.adb b/gcc-4.4.3/gcc/ada/s-stausa.adb deleted file mode 100644 index 859a9de85..000000000 --- a/gcc-4.4.3/gcc/ada/s-stausa.adb +++ /dev/null @@ -1,630 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M - S T A C K _ U S A G E -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-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 3, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - -with System.Parameters; -with System.CRTL; -with System.IO; - -package body System.Stack_Usage is - use System.Storage_Elements; - use System; - use System.IO; - use Interfaces; - - ----------------- - -- Stack_Slots -- - ----------------- - - -- Stackl_Slots is an internal data type to represent a sequence of real - -- stack slots initialized with a provided pattern, with operations to - -- abstract away the target call stack growth direction. - - type Stack_Slots is array (Integer range <>) of Pattern_Type; - for Stack_Slots'Component_Size use Pattern_Type'Object_Size; - - -- We will carefully handle the initializations ourselves and might want - -- to remap an initialized overlay later on with an address clause. - - pragma Suppress_Initialization (Stack_Slots); - - -- The abstract Stack_Slots operations all operate over the simple array - -- memory model: - - -- memory addresses increasing ----> - - -- Slots('First) Slots('Last) - -- | | - -- V V - -- +------------------------------------------------------------------+ - -- |####| |####| - -- +------------------------------------------------------------------+ - - -- What we call Top or Bottom always denotes call chain leaves or entry - -- points respectively, and their relative positions in the stack array - -- depends on the target stack growth direction: - - -- Stack_Grows_Down - - -- <----- calls push frames towards decreasing addresses - - -- Top(most) Slot Bottom(most) Slot - -- | | - -- V V - -- +------------------------------------------------------------------+ - -- |####| | leaf frame | ... | entry frame | - -- +------------------------------------------------------------------+ - - -- Stack_Grows_Up - - -- calls push frames towards increasing addresses -----> - - -- Bottom(most) Slot Top(most) Slot - -- | | - -- V V - -- +------------------------------------------------------------------+ - -- | entry frame | ... | leaf frame | |####| - -- +------------------------------------------------------------------+ - - function Top_Slot_Index_In (Stack : Stack_Slots) return Integer; - -- Index of the stack Top slot in the Slots array, denoting the latest - -- possible slot available to call chain leaves. - - function Bottom_Slot_Index_In (Stack : Stack_Slots) return Integer; - -- Index of the stack Bottom slot in the Slots array, denoting the first - -- possible slot available to call chain entry points. - - function Push_Index_Step_For (Stack : Stack_Slots) return Integer; - -- By how much do we need to update a Slots index to Push a single slot on - -- the stack. - - function Pop_Index_Step_For (Stack : Stack_Slots) return Integer; - -- By how much do we need to update a Slots index to Pop a single slot off - -- the stack. - - pragma Inline_Always (Top_Slot_Index_In); - pragma Inline_Always (Bottom_Slot_Index_In); - pragma Inline_Always (Push_Index_Step_For); - pragma Inline_Always (Pop_Index_Step_For); - - ----------------------- - -- Top_Slot_Index_In -- - ----------------------- - - function Top_Slot_Index_In (Stack : Stack_Slots) return Integer is - begin - if System.Parameters.Stack_Grows_Down then - return Stack'First; - else - return Stack'Last; - end if; - end Top_Slot_Index_In; - - ---------------------------- - -- Bottom_Slot_Index_In -- - ---------------------------- - - function Bottom_Slot_Index_In (Stack : Stack_Slots) return Integer is - begin - if System.Parameters.Stack_Grows_Down then - return Stack'Last; - else - return Stack'First; - end if; - end Bottom_Slot_Index_In; - - ------------------------- - -- Push_Index_Step_For -- - ------------------------- - - function Push_Index_Step_For (Stack : Stack_Slots) return Integer is - pragma Unreferenced (Stack); - begin - if System.Parameters.Stack_Grows_Down then - return -1; - else - return +1; - end if; - end Push_Index_Step_For; - - ------------------------ - -- Pop_Index_Step_For -- - ------------------------ - - function Pop_Index_Step_For (Stack : Stack_Slots) return Integer is - begin - return -Push_Index_Step_For (Stack); - end Pop_Index_Step_For; - - ------------------- - -- Unit Services -- - ------------------- - - -- Now the implementation of the services offered by this unit, on top of - -- the Stack_Slots abstraction above. - - 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]"; - - function Get_Usage_Range (Result : Task_Result) return String; - -- Return string representing the range of possible result of stack usage - - 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. - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize (Buffer_Size : Natural) is - 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), - Min_Measure => 0, - Max_Measure => 0, - Max_Size => 0)); - - -- Set the Is_Enabled flag to true, so that the task wrapper knows that - -- it has to handle dynamic stack analysis - - Is_Enabled := True; - - Stack_Size_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL); - - -- If variable GNAT_STACK_LIMIT is set, then we will take care of the - -- environment task, using GNAT_STASK_LIMIT as the size of the stack. - -- It doesn't make sens to process the stack when no bound is set (e.g. - -- limit is typically up to 4 GB). - - if Stack_Size_Chars /= Null_Address then - declare - Stack_Size : Integer; - - begin - Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024; - - Initialize_Analyzer - (Environment_Task_Analyzer, - "ENVIRONMENT TASK", - Stack_Size, - Stack_Size, - System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address)); - - Fill_Stack (Environment_Task_Analyzer); - - Compute_Environment_Task := True; - end; - - -- GNAT_STACK_LIMIT not set - - else - Compute_Environment_Task := False; - end if; - end Initialize; - - ---------------- - -- Fill_Stack -- - ---------------- - - procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is - -- Change the local variables and parameters of this function with - -- super-extra care. The more the stack frame size of this function is - -- big, the more an "instrumentation threshold at writing" error is - -- likely to happen. - - Stack_Used_When_Filling : Integer; - Current_Stack_Level : aliased Integer; - - begin - -- Readjust the pattern size. When we arrive in this function, there is - -- already a given amount of stack used, that we won't analyze. - - Stack_Used_When_Filling := - Stack_Size - (Analyzer.Bottom_Of_Stack, - To_Stack_Address (Current_Stack_Level'Address)) - + Natural (Current_Stack_Level'Size); - - if Stack_Used_When_Filling > Analyzer.Pattern_Size then - -- In this case, the known size of the stack is too small, we've - -- already taken more than expected, so there's no possible - -- computation - - Analyzer.Pattern_Size := 0; - else - Analyzer.Pattern_Size := - Analyzer.Pattern_Size - Stack_Used_When_Filling; - end if; - - declare - Stack : aliased Stack_Slots - (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern); - - begin - Stack := (others => Analyzer.Pattern); - - Analyzer.Stack_Overlay_Address := Stack'Address; - - if Analyzer.Pattern_Size /= 0 then - Analyzer.Bottom_Pattern_Mark := - To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address); - Analyzer.Top_Pattern_Mark := - To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address); - else - Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address); - Analyzer.Top_Pattern_Mark := To_Stack_Address (Stack'Address); - 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.Pattern_Size = 0 or else - Analyzer.Pattern_Size = - Stack_Size - (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark)); - end; - end Fill_Stack; - - ------------------------- - -- Initialize_Analyzer -- - ------------------------- - - procedure Initialize_Analyzer - (Analyzer : in out Stack_Analyzer; - Task_Name : String; - Stack_Size : Natural; - Max_Pattern_Size : Natural; - Bottom : Stack_Address; - Pattern : Unsigned_32 := 16#DEAD_BEEF#) - is - begin - -- Initialize the analyzer fields - - Analyzer.Bottom_Of_Stack := Bottom; - Analyzer.Stack_Size := Stack_Size; - Analyzer.Pattern_Size := Max_Pattern_Size; - Analyzer.Pattern := Pattern; - Analyzer.Result_Id := Next_Id; - - Analyzer.Task_Name := (others => ' '); - - -- Compute the task name, and truncate if bigger than Task_Name_Length - - if Task_Name'Length <= Task_Name_Length then - Analyzer.Task_Name (1 .. Task_Name'Length) := Task_Name; - else - Analyzer.Task_Name := - Task_Name (Task_Name'First .. - Task_Name'First + Task_Name_Length - 1); - end if; - - Next_Id := Next_Id + 1; - end Initialize_Analyzer; - - ---------------- - -- Stack_Size -- - ---------------- - - function Stack_Size - (SP_Low : Stack_Address; - SP_High : Stack_Address) return Natural - is - begin - if SP_Low > SP_High then - return Natural (SP_Low - SP_High + 4); - else - return Natural (SP_High - SP_Low + 4); - end if; - end Stack_Size; - - -------------------- - -- Compute_Result -- - -------------------- - - procedure Compute_Result (Analyzer : in out Stack_Analyzer) is - - -- Change the local variables and parameters of this function with - -- super-extra care. The larger the stack frame size of this function - -- is, the more an "instrumentation threshold at reading" error is - -- likely to happen. - - Stack : Stack_Slots (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern); - for Stack'Address use Analyzer.Stack_Overlay_Address; - - begin - Analyzer.Topmost_Touched_Mark := Analyzer.Bottom_Pattern_Mark; - - if Analyzer.Pattern_Size = 0 then - return; - end if; - - -- Look backward from the topmost possible end of the marked stack to - -- the bottom of it. The first index not equals to the patterns marks - -- the beginning of the used stack. - - declare - Top_Index : constant Integer := Top_Slot_Index_In (Stack); - Bottom_Index : constant Integer := Bottom_Slot_Index_In (Stack); - Step : constant Integer := Pop_Index_Step_For (Stack); - J : Integer; - - begin - J := Top_Index; - loop - if Stack (J) /= Analyzer.Pattern then - Analyzer.Topmost_Touched_Mark - := To_Stack_Address (Stack (J)'Address); - exit; - end if; - - exit when J = Bottom_Index; - J := J + Step; - end loop; - end; - end Compute_Result; - - --------------------- - -- Get_Usage_Range -- - --------------------- - - 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); - 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; - 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 (Result_Id_Blanks & Natural'Image (Result_Id)); - Put (" | "); - Put (Result.Task_Name); - Put (" | "); - Put (Stack_Size_Blanks & Stack_Size_Str); - Put (" | "); - Put (Actual_Use_Blanks & Actual_Use_Str); - New_Line; - end Output_Result; - - --------------------- - -- Output_Results -- - --------------------- - - 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; - - 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; - - if Result_Array (J).Max_Measure - > Result_Array (Max_Actual_Use_Result_Id).Max_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; - - -- Case of no result stored, still display the labels - - else - Put - (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | " - & Stack_Size_Str & " | " & Actual_Size_Str); - New_Line; - end if; - end Output_Results; - - ------------------- - -- Report_Result -- - ------------------- - - procedure Report_Result (Analyzer : Stack_Analyzer) is - Result : Task_Result := - (Task_Name => Analyzer.Task_Name, - Max_Size => Analyzer.Stack_Size, - Min_Measure => 0, - Max_Measure => 0); - - Overflow_Guard : constant Integer := - Analyzer.Stack_Size - - Stack_Size (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Of_Stack); - - begin - if Analyzer.Pattern_Size = 0 then - -- If we have that result, it means that we didn't do any computation - -- 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; - else - Result.Min_Measure := Stack_Size - (Analyzer.Topmost_Touched_Mark, - Analyzer.Bottom_Of_Stack); - Result.Max_Measure := Result.Min_Measure + Overflow_Guard; - end if; - - if Analyzer.Result_Id in Result_Array'Range then - - -- If the result can be stored, then store it in Result_Array - - Result_Array (Analyzer.Result_Id) := Result; - - else - -- 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.Stack_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; - -end System.Stack_Usage; |