1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M - S T A C K _ U S A G E --
9 -- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 with System.Parameters;
38 package body System.Stack_Usage is
39 use System.Storage_Elements;
43 procedure Output_Result (Result_Id : Natural; Result : Task_Result);
45 function Report_Result (Analyzer : Stack_Analyzer) return Natural;
49 A2 : Stack_Address) return Boolean;
50 pragma Inline (Inner_Than);
51 -- Return True if, according to the direction of the stack growth, A1 is
52 -- inner than A2. Inlined to reduce the size of the stack used by the
53 -- instrumentation code.
61 A2 : Stack_Address) return Boolean
64 if System.Parameters.Stack_Grows_Down then
75 -- Add comments to this procedure ???
76 -- Other subprograms also need more comment in code???
78 procedure Initialize (Buffer_Size : Natural) is
79 Bottom_Of_Stack : aliased Integer;
81 Stack_Size_Chars : System.Address;
83 Result_Array := new Result_Array_Type (1 .. Buffer_Size);
87 (others => ASCII.NUL),
93 Stack_Size_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
95 -- If variable GNAT_STACK_LIMIT is set, then we will take care of the
96 -- environment task, using GNAT_STASK_LIMIT as the size of the stack.
97 -- It doens't make sens to process the stack when no bound is set (e.g.
98 -- limit is typically up to 4 GB).
100 if Stack_Size_Chars /= Null_Address then
102 Stack_Size : Integer;
105 Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
107 Initialize_Analyzer (Environment_Task_Analyzer,
110 System.Storage_Elements.To_Integer
111 (Bottom_Of_Stack'Address));
113 Fill_Stack (Environment_Task_Analyzer);
115 Compute_Environment_Task := True;
118 -- GNAT_STACK_LIMIT not set
121 Compute_Environment_Task := False;
129 procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
131 -- Change the local variables and parameters of this function with
132 -- super-extra care. The more the stack frame size of this function is
133 -- big, the more an "instrumentation threshold at writing" error is
137 array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32;
138 pragma Pack (Word_32_Arr);
141 new System.Address_To_Access_Conversions (Word_32_Arr);
143 Arr : aliased Word_32_Arr;
146 for J in Word_32_Arr'Range loop
147 Arr (J) := Analyzer.Pattern;
149 Analyzer.Array_Address := Arr_Addr.To_Address (Arr'Access);
150 Analyzer.Inner_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
151 Analyzer.Outer_Pattern_Mark :=
152 To_Stack_Address (Arr (Word_32_Arr'Last)'Address);
154 if Inner_Than (Analyzer.Outer_Pattern_Mark,
155 Analyzer.Inner_Pattern_Mark) then
156 Analyzer.Inner_Pattern_Mark := Analyzer.Outer_Pattern_Mark;
157 Analyzer.Outer_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
158 Analyzer.First_Is_Outermost := True;
160 Analyzer.First_Is_Outermost := False;
163 -- If Arr has been packed, the following assertion must be true (we add
164 -- the size of the element whose address is:
166 -- Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
171 (Analyzer.Outer_Pattern_Mark, Analyzer.Inner_Pattern_Mark) +
172 Word_32_Size / Byte_Size);
175 -------------------------
176 -- Initialize_Analyzer --
177 -------------------------
179 procedure Initialize_Analyzer
180 (Analyzer : in out Stack_Analyzer;
183 Bottom : Stack_Address;
184 Pattern : Word_32 := 16#DEAD_BEEF#)
187 Analyzer.Bottom_Of_Stack := Bottom;
188 Analyzer.Size := Size;
189 Analyzer.Pattern := Pattern;
190 Analyzer.Result_Id := Next_Id;
192 Analyzer.Task_Name := (others => ' ');
194 if Task_Name'Length <= Task_Name_Length then
195 Analyzer.Task_Name (1 .. Task_Name_Length) := Task_Name;
197 Analyzer.Task_Name :=
198 Task_Name (Task_Name'First ..
199 Task_Name'First + Task_Name_Length - 1);
202 if Next_Id in Result_Array'Range then
203 Result_Array (Analyzer.Result_Id).Task_Name := Analyzer.Task_Name;
206 Result_Array (Analyzer.Result_Id).Max_Size := Size;
207 Next_Id := Next_Id + 1;
208 end Initialize_Analyzer;
215 (SP_Low : Stack_Address;
216 SP_High : Stack_Address) return Natural
219 if SP_Low > SP_High then
220 return Natural (SP_Low - SP_High + 4);
222 return Natural (SP_High - SP_Low + 4);
230 procedure Compute_Result (Analyzer : in out Stack_Analyzer) is
232 -- Change the local variables and parameters of this function with
233 -- super-extra care. The larger the stack frame size of this function
234 -- is, the more an "instrumentation threshold at reading" error is
238 array (1 .. Analyzer.Size / (Word_32_Size / Byte_Size)) of Word_32;
239 pragma Pack (Word_32_Arr);
242 new System.Address_To_Access_Conversions (Word_32_Arr);
244 Arr_Access : Arr_Addr.Object_Pointer;
247 Arr_Access := Arr_Addr.To_Pointer (Analyzer.Array_Address);
248 Analyzer.Outermost_Touched_Mark := Analyzer.Inner_Pattern_Mark;
250 for J in Word_32_Arr'Range loop
251 if Arr_Access (J) /= Analyzer.Pattern then
252 Analyzer.Outermost_Touched_Mark :=
253 To_Stack_Address (Arr_Access (J)'Address);
255 if Analyzer.First_Is_Outermost then
262 ---------------------
264 ---------------------
266 procedure Output_Result (Result_Id : Natural; Result : Task_Result) is
268 Set_Output (Standard_Error);
269 Put (Natural'Image (Result_Id));
271 Put (Result.Task_Name);
273 Put (Natural'Image (Result.Max_Size));
275 Put (Natural'Image (Result.Measure));
279 ---------------------
281 ---------------------
283 procedure Output_Results is
285 if Compute_Environment_Task then
286 Compute_Result (Environment_Task_Analyzer);
287 Report_Result (Environment_Task_Analyzer);
290 Set_Output (Standard_Error);
291 Put ("INDEX | TASK NAME | STACK SIZE | MAX USAGE");
294 for J in Result_Array'Range loop
295 exit when J >= Next_Id;
297 Output_Result (J, Result_Array (J));
305 procedure Report_Result (Analyzer : Stack_Analyzer) is
307 if Analyzer.Result_Id in Result_Array'Range then
308 Result_Array (Analyzer.Result_Id).Measure := Report_Result (Analyzer);
312 (Task_Name => Analyzer.Task_Name,
313 Max_Size => Analyzer.Size,
314 Measure => Report_Result (Analyzer)));
318 function Report_Result (Analyzer : Stack_Analyzer) return Natural is
320 if Analyzer.Outermost_Touched_Mark = Analyzer.Inner_Pattern_Mark then
321 return Stack_Size (Analyzer.Inner_Pattern_Mark,
322 Analyzer.Bottom_Of_Stack);
325 return Stack_Size (Analyzer.Outermost_Touched_Mark,
326 Analyzer.Bottom_Of_Stack);
330 end System.Stack_Usage;