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-2007, 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;
44 Index_Str : constant String := "Index";
45 Task_Name_Str : constant String := "Task Name";
46 Stack_Size_Str : constant String := "Stack Size";
47 Actual_Size_Str : constant String := "Stack usage [min - max]";
48 Pattern_Array_Elem_Size : constant Natural :=
49 (Unsigned_32_Size / Byte_Size);
51 function Get_Usage_Range (Result : Task_Result) return String;
52 -- Return string representing the range of possible result of stack usage
54 procedure Output_Result
57 Max_Stack_Size_Len : Natural;
58 Max_Actual_Use_Len : Natural);
59 -- Prints the result on the standard output. Result Id is the number of
60 -- the result in the array, and Result the contents of the actual result.
61 -- Max_Stack_Size_Len and Max_Actual_Use_Len are used for displaying the
62 -- proper layout. They hold the maximum length of the string representing
63 -- the Stack_Size and Actual_Use values.
65 function Closer_To_Bottom
67 A2 : Stack_Address) return Boolean;
68 pragma Inline (Closer_To_Bottom);
69 -- Return True if, according to the direction of the stack growth, A1 is
70 -- closer to the bottom than A2. Inlined to reduce the size of the stack
71 -- used by the instrumentation code.
73 ----------------------
74 -- Closer_To_Bottom --
75 ----------------------
77 function Closer_To_Bottom
79 A2 : Stack_Address) return Boolean
82 if System.Parameters.Stack_Grows_Down then
93 procedure Initialize (Buffer_Size : Natural) is
94 Bottom_Of_Stack : aliased Integer;
95 Stack_Size_Chars : System.Address;
98 -- Initialize the buffered result array
100 Result_Array := new Result_Array_Type (1 .. Buffer_Size);
103 (Task_Name => (others => ASCII.NUL),
106 Overflow_Guard => 0));
108 -- Set the Is_Enabled flag to true, so that the task wrapper knows that
109 -- it has to handle dynamic stack analysis
113 Stack_Size_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
115 -- If variable GNAT_STACK_LIMIT is set, then we will take care of the
116 -- environment task, using GNAT_STASK_LIMIT as the size of the stack.
117 -- It doens't make sens to process the stack when no bound is set (e.g.
118 -- limit is typically up to 4 GB).
120 if Stack_Size_Chars /= Null_Address then
122 Stack_Size : Integer;
125 Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
128 (Environment_Task_Analyzer,
132 System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
134 Fill_Stack (Environment_Task_Analyzer);
136 Compute_Environment_Task := True;
139 -- GNAT_STACK_LIMIT not set
142 Compute_Environment_Task := False;
150 procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
152 -- Change the local variables and parameters of this function with
153 -- super-extra care. The more the stack frame size of this function is
154 -- big, the more an "instrumentation threshold at writing" error is
157 type Unsigned_32_Arr is
158 array (1 .. Analyzer.Size / Pattern_Array_Elem_Size) of Unsigned_32;
159 for Unsigned_32_Arr'Component_Size use 32;
162 new System.Address_To_Access_Conversions (Unsigned_32_Arr);
164 Arr : aliased Unsigned_32_Arr;
167 -- Fill the stack with the pattern
169 for J in Unsigned_32_Arr'Range loop
170 Arr (J) := Analyzer.Pattern;
173 -- Initialize the analyzer value
175 Analyzer.Array_Address := Arr_Addr.To_Address (Arr'Access);
176 Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
177 Analyzer.Top_Pattern_Mark :=
178 To_Stack_Address (Arr (Unsigned_32_Arr'Last)'Address);
182 (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark)
184 Analyzer.Bottom_Pattern_Mark := Analyzer.Top_Pattern_Mark;
185 Analyzer.Top_Pattern_Mark := To_Stack_Address (Arr (1)'Address);
186 Analyzer.First_Is_Topmost := True;
188 Analyzer.First_Is_Topmost := False;
191 -- If Arr has been packed, the following assertion must be true (we add
192 -- the size of the element whose address is:
193 -- Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
198 (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
201 -------------------------
202 -- Initialize_Analyzer --
203 -------------------------
205 procedure Initialize_Analyzer
206 (Analyzer : in out Stack_Analyzer;
209 Overflow_Guard : Natural;
210 Bottom : Stack_Address;
211 Pattern : Unsigned_32 := 16#DEAD_BEEF#)
214 -- Initialize the analyzer fields
216 Analyzer.Bottom_Of_Stack := Bottom;
217 Analyzer.Size := Size;
218 Analyzer.Pattern := Pattern;
219 Analyzer.Result_Id := Next_Id;
221 Analyzer.Task_Name := (others => ' ');
223 -- Compute the task name, and truncate it if it's bigger than
226 if Task_Name'Length <= Task_Name_Length then
227 Analyzer.Task_Name (1 .. Task_Name'Length) := Task_Name;
229 Analyzer.Task_Name :=
230 Task_Name (Task_Name'First ..
231 Task_Name'First + Task_Name_Length - 1);
234 Analyzer.Overflow_Guard := Overflow_Guard;
236 Next_Id := Next_Id + 1;
237 end Initialize_Analyzer;
244 (SP_Low : Stack_Address;
245 SP_High : Stack_Address) return Natural
248 if SP_Low > SP_High then
249 return Natural (SP_Low - SP_High + 4);
251 return Natural (SP_High - SP_Low + 4);
259 procedure Compute_Result (Analyzer : in out Stack_Analyzer) is
261 -- Change the local variables and parameters of this function with
262 -- super-extra care. The larger the stack frame size of this function
263 -- is, the more an "instrumentation threshold at reading" error is
266 type Unsigned_32_Arr is
267 array (1 .. Analyzer.Size / Pattern_Array_Elem_Size) of Unsigned_32;
268 for Unsigned_32_Arr'Component_Size use 32;
271 new System.Address_To_Access_Conversions (Unsigned_32_Arr);
273 Arr_Access : Arr_Addr.Object_Pointer;
276 Arr_Access := Arr_Addr.To_Pointer (Analyzer.Array_Address);
277 Analyzer.Topmost_Touched_Mark := Analyzer.Bottom_Pattern_Mark;
279 -- Look backward from the end of the stack to the beginning. The first
280 -- index not equals to the patterns marks the beginning of the used
283 for J in Unsigned_32_Arr'Range loop
284 if Arr_Access (J) /= Analyzer.Pattern then
285 Analyzer.Topmost_Touched_Mark :=
286 To_Stack_Address (Arr_Access (J)'Address);
288 if Analyzer.First_Is_Topmost then
295 ---------------------
296 -- Get_Usage_Range --
297 ---------------------
299 function Get_Usage_Range (Result : Task_Result) return String is
300 Min_Used_Str : constant String :=
301 Natural'Image (Result.Measure);
302 Max_Used_Str : constant String :=
303 Natural'Image (Result.Measure + Result.Overflow_Guard);
305 return "[" & Min_Used_Str (2 .. Min_Used_Str'Last) & " -"
306 & Max_Used_Str & "]";
309 ---------------------
311 ---------------------
313 procedure Output_Result
314 (Result_Id : Natural;
315 Result : Task_Result;
316 Max_Stack_Size_Len : Natural;
317 Max_Actual_Use_Len : Natural)
319 Result_Id_Str : constant String := Natural'Image (Result_Id);
320 Stack_Size_Str : constant String := Natural'Image (Result.Max_Size);
321 Actual_Use_Str : constant String := Get_Usage_Range (Result);
323 Result_Id_Blanks : constant
324 String (1 .. Index_Str'Length - Result_Id_Str'Length) :=
326 Stack_Size_Blanks : constant
327 String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
329 Actual_Use_Blanks : constant
330 String (1 .. Max_Actual_Use_Len - Actual_Use_Str'Length) :=
333 Set_Output (Standard_Error);
334 Put (Result_Id_Blanks & Natural'Image (Result_Id));
336 Put (Result.Task_Name);
338 Put (Stack_Size_Blanks & Stack_Size_Str);
340 Put (Actual_Use_Blanks & Actual_Use_Str);
344 ---------------------
346 ---------------------
348 procedure Output_Results is
349 Max_Stack_Size : Natural := 0;
350 Max_Actual_Use_Result_Id : Natural := Result_Array'First;
351 Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0;
354 constant String (1 .. Task_Name_Length - Task_Name_Str'Length) :=
357 Set_Output (Standard_Error);
359 if Compute_Environment_Task then
360 Compute_Result (Environment_Task_Analyzer);
361 Report_Result (Environment_Task_Analyzer);
364 if Result_Array'Length > 0 then
365 -- Computes the size of the largest strings that will get displayed,
366 -- in order to do correct column alignment.
368 for J in Result_Array'Range loop
369 exit when J >= Next_Id;
371 if Result_Array (J).Measure
372 > Result_Array (Max_Actual_Use_Result_Id).Measure
374 Max_Actual_Use_Result_Id := J;
377 if Result_Array (J).Max_Size > Max_Stack_Size then
378 Max_Stack_Size := Result_Array (J).Max_Size;
382 Max_Stack_Size_Len := Natural'Image (Max_Stack_Size)'Length;
384 Max_Actual_Use_Len :=
385 Get_Usage_Range (Result_Array (Max_Actual_Use_Result_Id))'Length;
387 -- Display the output header. Blanks will be added in front of the
391 Stack_Size_Blanks : constant
392 String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
394 Stack_Usage_Blanks : constant
395 String (1 .. Max_Actual_Use_Len - Actual_Size_Str'Length) :=
399 if Stack_Size_Str'Length > Max_Stack_Size_Len then
400 Max_Stack_Size_Len := Stack_Size_Str'Length;
403 if Actual_Size_Str'Length > Max_Actual_Use_Len then
404 Max_Actual_Use_Len := Actual_Size_Str'Length;
408 (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
409 & Stack_Size_Str & Stack_Size_Blanks & " | "
410 & Stack_Usage_Blanks & Actual_Size_Str);
415 -- Now display the individual results
417 for J in Result_Array'Range loop
418 exit when J >= Next_Id;
420 (J, Result_Array (J), Max_Stack_Size_Len, Max_Actual_Use_Len);
423 -- If there are no result stored, we'll still display the labels
426 (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
427 & Stack_Size_Str & " | " & Actual_Size_Str);
436 procedure Report_Result (Analyzer : Stack_Analyzer) is
437 Result : constant Task_Result :=
438 (Task_Name => Analyzer.Task_Name,
439 Max_Size => Analyzer.Size + Analyzer.Overflow_Guard,
440 Measure => Stack_Size
441 (Analyzer.Topmost_Touched_Mark,
442 Analyzer.Bottom_Of_Stack),
443 Overflow_Guard => Analyzer.Overflow_Guard -
444 Natural (Analyzer.Bottom_Of_Stack -
445 Analyzer.Bottom_Pattern_Mark));
447 if Analyzer.Result_Id in Result_Array'Range then
449 -- If the result can be stored, then store it in Result_Array
451 Result_Array (Analyzer.Result_Id) := Result;
455 -- If the result cannot be stored, then we display it right away
458 Result_Str_Len : constant Natural :=
459 Get_Usage_Range (Result)'Length;
460 Size_Str_Len : constant Natural :=
461 Natural'Image (Analyzer.Size)'Length;
463 Max_Stack_Size_Len : Natural;
464 Max_Actual_Use_Len : Natural;
467 -- Take either the label size or the number image size for the
468 -- size of the column "Stack Size".
470 if Size_Str_Len > Stack_Size_Str'Length then
471 Max_Stack_Size_Len := Size_Str_Len;
473 Max_Stack_Size_Len := Stack_Size_Str'Length;
476 -- Take either the label size or the number image size for the
477 -- size of the column "Stack Usage"
479 if Result_Str_Len > Actual_Size_Str'Length then
480 Max_Actual_Use_Len := Result_Str_Len;
482 Max_Actual_Use_Len := Actual_Size_Str'Length;
494 end System.Stack_Usage;