------------------------------------------------------------------------------ -- -- -- 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 -- -- . -- -- -- -- 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;