aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.3/gcc/ada/s-stausa.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.3/gcc/ada/s-stausa.adb')
-rw-r--r--gcc-4.4.3/gcc/ada/s-stausa.adb630
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;