| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2021, 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.IO; |
| use Interfaces; |
| |
| ----------------- |
| -- Stack_Slots -- |
| ----------------- |
| |
| -- Stack_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 | |####| |
| -- +------------------------------------------------------------------+ |
| |
| ------------------- |
| -- 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"; |
| |
| 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 |
| 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), |
| Value => 0, |
| Stack_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 |
| My_Stack_Size : Integer; |
| |
| begin |
| My_Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024; |
| |
| Initialize_Analyzer |
| (Environment_Task_Analyzer, |
| "ENVIRONMENT TASK", |
| My_Stack_Size, |
| 0, |
| My_Stack_Size); |
| |
| 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. |
| |
| Current_Stack_Level : aliased Integer; |
| |
| Guard : constant := 256; |
| -- Guard space between the Current_Stack_Level'Address and the last |
| -- allocated byte on the stack. |
| begin |
| if Parameters.Stack_Grows_Down then |
| if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) > |
| To_Stack_Address (Current_Stack_Level'Address) - Guard |
| then |
| -- No room for a pattern |
| |
| Analyzer.Pattern_Size := 0; |
| return; |
| end if; |
| |
| Analyzer.Pattern_Limit := |
| Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size); |
| |
| if Analyzer.Stack_Base > |
| To_Stack_Address (Current_Stack_Level'Address) - Guard |
| then |
| -- Reduce pattern size to prevent local frame overwrite |
| |
| Analyzer.Pattern_Size := |
| Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard |
| - Analyzer.Pattern_Limit); |
| end if; |
| |
| Analyzer.Pattern_Overlay_Address := |
| To_Address (Analyzer.Pattern_Limit); |
| else |
| if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) < |
| To_Stack_Address (Current_Stack_Level'Address) + Guard |
| then |
| -- No room for a pattern |
| |
| Analyzer.Pattern_Size := 0; |
| return; |
| end if; |
| |
| Analyzer.Pattern_Limit := |
| Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size); |
| |
| if Analyzer.Stack_Base < |
| To_Stack_Address (Current_Stack_Level'Address) + Guard |
| then |
| -- Reduce pattern size to prevent local frame overwrite |
| |
| Analyzer.Pattern_Size := |
| Integer |
| (Analyzer.Pattern_Limit - |
| (To_Stack_Address (Current_Stack_Level'Address) + Guard)); |
| end if; |
| |
| Analyzer.Pattern_Overlay_Address := |
| To_Address (Analyzer.Pattern_Limit - |
| Stack_Address (Analyzer.Pattern_Size)); |
| end if; |
| |
| -- Declare and fill the pattern buffer |
| |
| declare |
| Pattern : aliased Stack_Slots |
| (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern); |
| for Pattern'Address use Analyzer.Pattern_Overlay_Address; |
| |
| begin |
| if System.Parameters.Stack_Grows_Down then |
| for J in reverse Pattern'Range loop |
| Pattern (J) := Analyzer.Pattern; |
| end loop; |
| |
| else |
| for J in Pattern'Range loop |
| Pattern (J) := Analyzer.Pattern; |
| end loop; |
| end if; |
| end; |
| end Fill_Stack; |
| |
| ------------------------- |
| -- Initialize_Analyzer -- |
| ------------------------- |
| |
| procedure Initialize_Analyzer |
| (Analyzer : in out Stack_Analyzer; |
| Task_Name : String; |
| Stack_Size : Natural; |
| Stack_Base : Stack_Address; |
| Pattern_Size : Natural; |
| Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#) |
| is |
| begin |
| -- Initialize the analyzer fields |
| |
| Analyzer.Stack_Base := Stack_Base; |
| Analyzer.Stack_Size := Stack_Size; |
| Analyzer.Pattern_Size := 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); |
| else |
| return Natural (SP_High - SP_Low); |
| 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.Pattern_Overlay_Address; |
| |
| begin |
| -- Value if the pattern was not modified |
| |
| if Parameters.Stack_Grows_Down then |
| Analyzer.Topmost_Touched_Mark := |
| Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size); |
| else |
| Analyzer.Topmost_Touched_Mark := |
| Analyzer.Pattern_Limit - Stack_Address (Analyzer.Pattern_Size); |
| end if; |
| |
| 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. |
| |
| if System.Parameters.Stack_Grows_Down then |
| for J in Stack'Range loop |
| if Stack (J) /= Analyzer.Pattern then |
| Analyzer.Topmost_Touched_Mark := |
| To_Stack_Address (Stack (J)'Address); |
| exit; |
| end if; |
| end loop; |
| |
| else |
| for J in reverse Stack'Range loop |
| if Stack (J) /= Analyzer.Pattern then |
| Analyzer.Topmost_Touched_Mark := |
| To_Stack_Address (Stack (J)'Address); |
| exit; |
| end if; |
| end loop; |
| |
| end if; |
| end Compute_Result; |
| |
| --------------------- |
| -- 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.Stack_Size); |
| Actual_Use_Str : constant String := Natural'Image (Result.Value); |
| |
| 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_Stack_Usage : Natural := 0; |
| 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).Value > Max_Stack_Usage then |
| Max_Stack_Usage := Result_Array (J).Value; |
| end if; |
| |
| if Result_Array (J).Stack_Size > Max_Stack_Size then |
| Max_Stack_Size := Result_Array (J).Stack_Size; |
| end if; |
| end loop; |
| |
| Max_Stack_Size_Len := Natural'Image (Max_Stack_Size)'Length; |
| |
| Max_Actual_Use_Len := Natural'Image (Max_Stack_Usage)'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, |
| Stack_Size => Analyzer.Stack_Size, |
| Value => 0); |
| begin |
| if Analyzer.Pattern_Size = 0 then |
| |
| -- If we have that result, it means that we didn't do any computation |
| -- at all (i.e. we used at least everything (and possibly more). |
| |
| Result.Value := Analyzer.Stack_Size; |
| |
| else |
| Result.Value := Stack_Size (Analyzer.Topmost_Touched_Mark, |
| Analyzer.Stack_Base); |
| 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 := |
| Natural'Image (Result.Value)'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". |
| |
| Max_Stack_Size_Len := |
| (if Size_Str_Len > Stack_Size_Str'Length |
| then Size_Str_Len |
| else Stack_Size_Str'Length); |
| |
| -- Take either the label size or the number image size for the |
| -- size of the column "Stack Usage". |
| |
| Max_Actual_Use_Len := |
| (if Result_Str_Len > Actual_Size_Str'Length |
| then Result_Str_Len |
| else Actual_Size_Str'Length); |
| |
| Output_Result |
| (Analyzer.Result_Id, |
| Result, |
| Max_Stack_Size_Len, |
| Max_Actual_Use_Len); |
| end; |
| end if; |
| end Report_Result; |
| |
| end System.Stack_Usage; |
