diff options
| -rw-r--r-- | gcc/ada/s-stausa.adb | 272 |
1 files changed, 253 insertions, 19 deletions
diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index 3823ebe..5f7de09 100644 --- a/gcc/ada/s-stausa.adb +++ b/gcc/ada/s-stausa.adb @@ -30,28 +30,146 @@ -- Extensive contributions were provided by Ada Core Technologies, Inc. -- -- -- ------------------------------------------------------------------------------ --- Dummy implementation. + +with System.Parameters; +with System.CRTL; +with System.IO; package body System.Stack_Usage is + use System.Storage_Elements; + use System; + use System.IO; - -------------------- - -- Compute_Result -- - -------------------- + procedure Output_Result (Result_Id : Natural; Result : Task_Result); - procedure Compute_Result (Analyzer : in out Stack_Analyzer) is - pragma Unreferenced (Analyzer); + function Report_Result (Analyzer : Stack_Analyzer) return Natural; + + function Inner_Than + (A1 : Stack_Address; + A2 : Stack_Address) return Boolean; + pragma Inline (Inner_Than); + -- Return True if, according to the direction of the stack growth, A1 is + -- inner than A2. Inlined to reduce the size of the stack used by the + -- instrumentation code. + + ---------------- + -- Inner_Than -- + ---------------- + + function Inner_Than + (A1 : Stack_Address; + A2 : Stack_Address) return Boolean + is begin - null; - end Compute_Result; + if System.Parameters.Stack_Grows_Down then + return A1 > A2; + else + return A2 > A1; + end if; + end Inner_Than; + + ---------------- + -- Initialize -- + ---------------- + + -- Add comments to this procedure ??? + -- Other subprograms also need more comment in code??? + + procedure Initialize (Buffer_Size : Natural) is + Bottom_Of_Stack : aliased Integer; + + Stack_Size_Chars : System.Address; + begin + Result_Array := new Result_Array_Type (1 .. Buffer_Size); + Result_Array.all := + (others => + (Task_Name => + (others => ASCII.NUL), + Measure => 0, + Max_Size => 0)); + + 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 doens'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, + 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 - pragma Unreferenced (Analyzer); + + -- 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. + + type Word_32_Arr is + array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32; + pragma Pack (Word_32_Arr); + + package Arr_Addr is + new System.Address_To_Access_Conversions (Word_32_Arr); + + Arr : aliased Word_32_Arr; + begin - null; + for J in Word_32_Arr'Range loop + Arr (J) := Analyzer.Pattern; + end loop; + Analyzer.Array_Address := Arr_Addr.To_Address (Arr'Access); + Analyzer.Inner_Pattern_Mark := To_Stack_Address (Arr (1)'Address); + Analyzer.Outer_Pattern_Mark := + To_Stack_Address (Arr (Word_32_Arr'Last)'Address); + + if Inner_Than (Analyzer.Outer_Pattern_Mark, + Analyzer.Inner_Pattern_Mark) then + Analyzer.Inner_Pattern_Mark := Analyzer.Outer_Pattern_Mark; + Analyzer.Outer_Pattern_Mark := To_Stack_Address (Arr (1)'Address); + Analyzer.First_Is_Outermost := True; + else + Analyzer.First_Is_Outermost := False; + 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.Size = + Stack_Size + (Analyzer.Outer_Pattern_Mark, Analyzer.Inner_Pattern_Mark) + + Word_32_Size / Byte_Size); end Fill_Stack; ------------------------- @@ -65,22 +183,119 @@ package body System.Stack_Usage is Bottom : Stack_Address; Pattern : Word_32 := 16#DEAD_BEEF#) is - pragma Unreferenced (Analyzer); - pragma Unreferenced (Task_Name); - pragma Unreferenced (Size); - pragma Unreferenced (Pattern); - pragma Unreferenced (Bottom); begin - null; + Analyzer.Bottom_Of_Stack := Bottom; + Analyzer.Size := Size; + Analyzer.Pattern := Pattern; + Analyzer.Result_Id := Next_Id; + + Analyzer.Task_Name := (others => ' '); + + 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; + + if Next_Id in Result_Array'Range then + Result_Array (Analyzer.Result_Id).Task_Name := Analyzer.Task_Name; + end if; + + Result_Array (Analyzer.Result_Id).Max_Size := Size; + 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. + + type Word_32_Arr is + array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32; + pragma Pack (Word_32_Arr); + + package Arr_Addr is + new System.Address_To_Access_Conversions (Word_32_Arr); + + Arr_Access : Arr_Addr.Object_Pointer; + + begin + Arr_Access := Arr_Addr.To_Pointer (Analyzer.Array_Address); + Analyzer.Outermost_Touched_Mark := Analyzer.Inner_Pattern_Mark; + + for J in Word_32_Arr'Range loop + if Arr_Access (J) /= Analyzer.Pattern then + Analyzer.Outermost_Touched_Mark := + To_Stack_Address (Arr_Access (J)'Address); + + if Analyzer.First_Is_Outermost then + exit; + end if; + end if; + end loop; + end Compute_Result; + + --------------------- + -- Output_Result -- + --------------------- + + procedure Output_Result (Result_Id : Natural; Result : Task_Result) is + begin + Set_Output (Standard_Error); + Put (Natural'Image (Result_Id)); + Put (" | "); + Put (Result.Task_Name); + Put (" | "); + Put (Natural'Image (Result.Max_Size)); + Put (" | "); + Put (Natural'Image (Result.Measure)); + New_Line; + end Output_Result; + --------------------- -- Output_Results -- --------------------- procedure Output_Results is begin - null; + if Compute_Environment_Task then + Compute_Result (Environment_Task_Analyzer); + Report_Result (Environment_Task_Analyzer); + end if; + + Set_Output (Standard_Error); + Put ("INDEX | TASK NAME | STACK SIZE | MAX USAGE"); + New_Line; + + for J in Result_Array'Range loop + exit when J >= Next_Id; + + Output_Result (J, Result_Array (J)); + end loop; end Output_Results; ------------------- @@ -88,9 +303,28 @@ package body System.Stack_Usage is ------------------- procedure Report_Result (Analyzer : Stack_Analyzer) is - pragma Unreferenced (Analyzer); begin - null; + if Analyzer.Result_Id in Result_Array'Range then + Result_Array (Analyzer.Result_Id).Measure := Report_Result (Analyzer); + else + Output_Result + (Analyzer.Result_Id, + (Task_Name => Analyzer.Task_Name, + Max_Size => Analyzer.Size, + Measure => Report_Result (Analyzer))); + end if; + end Report_Result; + + function Report_Result (Analyzer : Stack_Analyzer) return Natural is + begin + if Analyzer.Outermost_Touched_Mark = Analyzer.Inner_Pattern_Mark then + return Stack_Size (Analyzer.Inner_Pattern_Mark, + Analyzer.Bottom_Of_Stack); + + else + return Stack_Size (Analyzer.Outermost_Touched_Mark, + Analyzer.Bottom_Of_Stack); + end if; end Report_Result; end System.Stack_Usage; |