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-2010, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Parameters
;
36 package body System
.Stack_Usage
is
37 use System
.Storage_Elements
;
46 -- Stackl_Slots is an internal data type to represent a sequence of real
47 -- stack slots initialized with a provided pattern, with operations to
48 -- abstract away the target call stack growth direction.
50 type Stack_Slots
is array (Integer range <>) of Pattern_Type
;
51 for Stack_Slots
'Component_Size use Pattern_Type
'Object_Size;
53 -- We will carefully handle the initializations ourselves and might want
54 -- to remap an initialized overlay later on with an address clause.
56 pragma Suppress_Initialization
(Stack_Slots
);
58 -- The abstract Stack_Slots operations all operate over the simple array
61 -- memory addresses increasing ---->
63 -- Slots('First) Slots('Last)
66 -- +------------------------------------------------------------------+
68 -- +------------------------------------------------------------------+
70 -- What we call Top or Bottom always denotes call chain leaves or entry
71 -- points respectively, and their relative positions in the stack array
72 -- depends on the target stack growth direction:
76 -- <----- calls push frames towards decreasing addresses
78 -- Top(most) Slot Bottom(most) Slot
81 -- +------------------------------------------------------------------+
82 -- |####| | leaf frame | ... | entry frame |
83 -- +------------------------------------------------------------------+
87 -- calls push frames towards increasing addresses ----->
89 -- Bottom(most) Slot Top(most) Slot
92 -- +------------------------------------------------------------------+
93 -- | entry frame | ... | leaf frame | |####|
94 -- +------------------------------------------------------------------+
96 function Top_Slot_Index_In
(Stack
: Stack_Slots
) return Integer;
97 -- Index of the stack Top slot in the Slots array, denoting the latest
98 -- possible slot available to call chain leaves.
100 function Bottom_Slot_Index_In
(Stack
: Stack_Slots
) return Integer;
101 -- Index of the stack Bottom slot in the Slots array, denoting the first
102 -- possible slot available to call chain entry points.
104 function Push_Index_Step_For
(Stack
: Stack_Slots
) return Integer;
105 -- By how much do we need to update a Slots index to Push a single slot on
108 function Pop_Index_Step_For
(Stack
: Stack_Slots
) return Integer;
109 -- By how much do we need to update a Slots index to Pop a single slot off
112 pragma Inline_Always
(Top_Slot_Index_In
);
113 pragma Inline_Always
(Bottom_Slot_Index_In
);
114 pragma Inline_Always
(Push_Index_Step_For
);
115 pragma Inline_Always
(Pop_Index_Step_For
);
117 -----------------------
118 -- Top_Slot_Index_In --
119 -----------------------
121 function Top_Slot_Index_In
(Stack
: Stack_Slots
) return Integer is
123 if System
.Parameters
.Stack_Grows_Down
then
128 end Top_Slot_Index_In
;
130 ----------------------------
131 -- Bottom_Slot_Index_In --
132 ----------------------------
134 function Bottom_Slot_Index_In
(Stack
: Stack_Slots
) return Integer is
136 if System
.Parameters
.Stack_Grows_Down
then
141 end Bottom_Slot_Index_In
;
143 -------------------------
144 -- Push_Index_Step_For --
145 -------------------------
147 function Push_Index_Step_For
(Stack
: Stack_Slots
) return Integer is
148 pragma Unreferenced
(Stack
);
150 if System
.Parameters
.Stack_Grows_Down
then
155 end Push_Index_Step_For
;
157 ------------------------
158 -- Pop_Index_Step_For --
159 ------------------------
161 function Pop_Index_Step_For
(Stack
: Stack_Slots
) return Integer is
163 return -Push_Index_Step_For
(Stack
);
164 end Pop_Index_Step_For
;
170 -- Now the implementation of the services offered by this unit, on top of
171 -- the Stack_Slots abstraction above.
173 Index_Str
: constant String := "Index";
174 Task_Name_Str
: constant String := "Task Name";
175 Stack_Size_Str
: constant String := "Stack Size";
176 Actual_Size_Str
: constant String := "Stack usage";
178 function Get_Usage_Range
(Result
: Task_Result
) return String;
179 -- Return string representing the range of possible result of stack usage
181 procedure Output_Result
182 (Result_Id
: Natural;
183 Result
: Task_Result
;
184 Max_Stack_Size_Len
: Natural;
185 Max_Actual_Use_Len
: Natural);
186 -- Prints the result on the standard output. Result Id is the number of
187 -- the result in the array, and Result the contents of the actual result.
188 -- Max_Stack_Size_Len and Max_Actual_Use_Len are used for displaying the
189 -- proper layout. They hold the maximum length of the string representing
190 -- the Stack_Size and Actual_Use values.
196 procedure Initialize
(Buffer_Size
: Natural) is
197 Bottom_Of_Stack
: aliased Integer;
198 Stack_Size_Chars
: System
.Address
;
201 -- Initialize the buffered result array
203 Result_Array
:= new Result_Array_Type
(1 .. Buffer_Size
);
206 (Task_Name
=> (others => ASCII
.NUL
),
211 -- Set the Is_Enabled flag to true, so that the task wrapper knows that
212 -- it has to handle dynamic stack analysis
216 Stack_Size_Chars
:= System
.CRTL
.getenv
("GNAT_STACK_LIMIT" & ASCII
.NUL
);
218 -- If variable GNAT_STACK_LIMIT is set, then we will take care of the
219 -- environment task, using GNAT_STASK_LIMIT as the size of the stack.
220 -- It doesn't make sens to process the stack when no bound is set (e.g.
221 -- limit is typically up to 4 GB).
223 if Stack_Size_Chars
/= Null_Address
then
225 My_Stack_Size
: Integer;
228 My_Stack_Size
:= System
.CRTL
.atoi
(Stack_Size_Chars
) * 1024;
231 (Environment_Task_Analyzer
,
235 System
.Storage_Elements
.To_Integer
(Bottom_Of_Stack
'Address),
238 Fill_Stack
(Environment_Task_Analyzer
);
240 Compute_Environment_Task
:= True;
243 -- GNAT_STACK_LIMIT not set
246 Compute_Environment_Task
:= False;
254 procedure Fill_Stack
(Analyzer
: in out Stack_Analyzer
) is
255 -- Change the local variables and parameters of this function with
256 -- super-extra care. The more the stack frame size of this function is
257 -- big, the more an "instrumentation threshold at writing" error is
260 Stack_Used_When_Filling
: Integer;
261 Current_Stack_Level
: aliased Integer;
263 Guard
: constant Integer := 256;
264 -- Guard space between the Current_Stack_Level'Address and the last
265 -- allocated byte on the stack.
268 -- Easiest and most accurate method: the top of the stack is known.
270 if Analyzer
.Top_Pattern_Mark
/= 0 then
271 Analyzer
.Pattern_Size
:=
272 Stack_Size
(Analyzer
.Top_Pattern_Mark
,
273 To_Stack_Address
(Current_Stack_Level
'Address))
276 if System
.Parameters
.Stack_Grows_Down
then
277 Analyzer
.Stack_Overlay_Address
:=
278 To_Address
(Analyzer
.Top_Pattern_Mark
);
280 Analyzer
.Stack_Overlay_Address
:=
281 To_Address
(Analyzer
.Top_Pattern_Mark
282 - Stack_Address
(Analyzer
.Pattern_Size
));
286 Pattern
: aliased Stack_Slots
287 (1 .. Analyzer
.Pattern_Size
/ Bytes_Per_Pattern
);
288 for Pattern
'Address use Analyzer
.Stack_Overlay_Address
;
291 if System
.Parameters
.Stack_Grows_Down
then
292 for J
in reverse Pattern
'Range loop
293 Pattern
(J
) := Analyzer
.Pattern
;
296 Analyzer
.Bottom_Pattern_Mark
:=
297 To_Stack_Address
(Pattern
(Pattern
'Last)'Address);
300 for J
in Pattern
'Range loop
301 Pattern
(J
) := Analyzer
.Pattern
;
304 Analyzer
.Bottom_Pattern_Mark
:=
305 To_Stack_Address
(Pattern
(Pattern
'First)'Address);
310 -- Readjust the pattern size. When we arrive in this function, there
311 -- is already a given amount of stack used, that we won't analyze.
313 Stack_Used_When_Filling
:=
314 Stack_Size
(Analyzer
.Bottom_Of_Stack
,
315 To_Stack_Address
(Current_Stack_Level
'Address));
317 if Stack_Used_When_Filling
> Analyzer
.Pattern_Size
then
319 -- In this case, the known size of the stack is too small, we've
320 -- already taken more than expected, so there's no possible
323 Analyzer
.Pattern_Size
:= 0;
325 Analyzer
.Pattern_Size
:=
326 Analyzer
.Pattern_Size
- Stack_Used_When_Filling
;
330 Stack
: aliased Stack_Slots
331 (1 .. Analyzer
.Pattern_Size
/ Bytes_Per_Pattern
);
334 Stack
:= (others => Analyzer
.Pattern
);
336 Analyzer
.Stack_Overlay_Address
:= Stack
'Address;
338 if Analyzer
.Pattern_Size
/= 0 then
339 Analyzer
.Bottom_Pattern_Mark
:=
341 (Stack
(Bottom_Slot_Index_In
(Stack
))'Address);
342 Analyzer
.Top_Pattern_Mark
:=
344 (Stack
(Top_Slot_Index_In
(Stack
))'Address);
346 Analyzer
.Bottom_Pattern_Mark
:=
347 To_Stack_Address
(Stack
'Address);
348 Analyzer
.Top_Pattern_Mark
:=
349 To_Stack_Address
(Stack
'Address);
355 -------------------------
356 -- Initialize_Analyzer --
357 -------------------------
359 procedure Initialize_Analyzer
360 (Analyzer
: in out Stack_Analyzer
;
362 My_Stack_Size
: Natural;
363 Max_Pattern_Size
: Natural;
364 Bottom
: Stack_Address
;
366 Pattern
: Unsigned_32
:= 16#DEAD_BEEF#
)
369 -- Initialize the analyzer fields
371 Analyzer
.Bottom_Of_Stack
:= Bottom
;
372 Analyzer
.Stack_Size
:= My_Stack_Size
;
373 Analyzer
.Pattern_Size
:= Max_Pattern_Size
;
374 Analyzer
.Pattern
:= Pattern
;
375 Analyzer
.Result_Id
:= Next_Id
;
376 Analyzer
.Task_Name
:= (others => ' ');
377 Analyzer
.Top_Pattern_Mark
:= Top
;
379 -- Compute the task name, and truncate if bigger than Task_Name_Length
381 if Task_Name
'Length <= Task_Name_Length
then
382 Analyzer
.Task_Name
(1 .. Task_Name
'Length) := Task_Name
;
384 Analyzer
.Task_Name
:=
385 Task_Name
(Task_Name
'First ..
386 Task_Name
'First + Task_Name_Length
- 1);
389 Next_Id
:= Next_Id
+ 1;
390 end Initialize_Analyzer
;
397 (SP_Low
: Stack_Address
;
398 SP_High
: Stack_Address
) return Natural
401 if SP_Low
> SP_High
then
402 return Natural (SP_Low
- SP_High
+ 4);
404 return Natural (SP_High
- SP_Low
+ 4);
412 procedure Compute_Result
(Analyzer
: in out Stack_Analyzer
) is
414 -- Change the local variables and parameters of this function with
415 -- super-extra care. The larger the stack frame size of this function
416 -- is, the more an "instrumentation threshold at reading" error is
419 Stack
: Stack_Slots
(1 .. Analyzer
.Pattern_Size
/ Bytes_Per_Pattern
);
420 for Stack
'Address use Analyzer
.Stack_Overlay_Address
;
423 Analyzer
.Topmost_Touched_Mark
:= Analyzer
.Bottom_Pattern_Mark
;
425 if Analyzer
.Pattern_Size
= 0 then
429 -- Look backward from the topmost possible end of the marked stack to
430 -- the bottom of it. The first index not equals to the patterns marks
431 -- the beginning of the used stack.
434 Top_Index
: constant Integer := Top_Slot_Index_In
(Stack
);
435 Bottom_Index
: constant Integer := Bottom_Slot_Index_In
(Stack
);
436 Step
: constant Integer := Pop_Index_Step_For
(Stack
);
442 if Stack
(J
) /= Analyzer
.Pattern
then
443 Analyzer
.Topmost_Touched_Mark
444 := To_Stack_Address
(Stack
(J
)'Address);
448 exit when J
= Bottom_Index
;
454 ---------------------
455 -- Get_Usage_Range --
456 ---------------------
458 function Get_Usage_Range
(Result
: Task_Result
) return String is
459 Variation_Used_Str
: constant String :=
460 Natural'Image (Result
.Variation
);
461 Value_Used_Str
: constant String :=
462 Natural'Image (Result
.Value
);
464 return Value_Used_Str
& " +/- " & Variation_Used_Str
;
467 ---------------------
469 ---------------------
471 procedure Output_Result
472 (Result_Id
: Natural;
473 Result
: Task_Result
;
474 Max_Stack_Size_Len
: Natural;
475 Max_Actual_Use_Len
: Natural)
477 Result_Id_Str
: constant String := Natural'Image (Result_Id
);
478 My_Stack_Size_Str
: constant String := Natural'Image (Result
.Max_Size
);
479 Actual_Use_Str
: constant String := Get_Usage_Range
(Result
);
481 Result_Id_Blanks
: constant
482 String (1 .. Index_Str
'Length - Result_Id_Str
'Length) :=
485 Stack_Size_Blanks
: constant
486 String (1 .. Max_Stack_Size_Len
- My_Stack_Size_Str
'Length) :=
489 Actual_Use_Blanks
: constant
490 String (1 .. Max_Actual_Use_Len
- Actual_Use_Str
'Length) :=
494 Set_Output
(Standard_Error
);
495 Put
(Result_Id_Blanks
& Natural'Image (Result_Id
));
497 Put
(Result
.Task_Name
);
499 Put
(Stack_Size_Blanks
& My_Stack_Size_Str
);
501 Put
(Actual_Use_Blanks
& Actual_Use_Str
);
505 ---------------------
507 ---------------------
509 procedure Output_Results
is
510 Max_Stack_Size
: Natural := 0;
511 Max_Actual_Use_Result_Id
: Natural := Result_Array
'First;
512 Max_Stack_Size_Len
, Max_Actual_Use_Len
: Natural := 0;
514 Task_Name_Blanks
: constant
515 String (1 .. Task_Name_Length
- Task_Name_Str
'Length) :=
519 Set_Output
(Standard_Error
);
521 if Compute_Environment_Task
then
522 Compute_Result
(Environment_Task_Analyzer
);
523 Report_Result
(Environment_Task_Analyzer
);
526 if Result_Array
'Length > 0 then
528 -- Computes the size of the largest strings that will get displayed,
529 -- in order to do correct column alignment.
531 for J
in Result_Array
'Range loop
532 exit when J
>= Next_Id
;
534 if Result_Array
(J
).Value
>
535 Result_Array
(Max_Actual_Use_Result_Id
).Value
537 Max_Actual_Use_Result_Id
:= J
;
540 if Result_Array
(J
).Max_Size
> Max_Stack_Size
then
541 Max_Stack_Size
:= Result_Array
(J
).Max_Size
;
545 Max_Stack_Size_Len
:= Natural'Image (Max_Stack_Size
)'Length;
547 Max_Actual_Use_Len
:=
548 Get_Usage_Range
(Result_Array
(Max_Actual_Use_Result_Id
))'Length;
550 -- Display the output header. Blanks will be added in front of the
554 Stack_Size_Blanks
: constant
555 String (1 .. Max_Stack_Size_Len
- Stack_Size_Str
'Length) :=
558 Stack_Usage_Blanks
: constant
559 String (1 .. Max_Actual_Use_Len
- Actual_Size_Str
'Length) :=
563 if Stack_Size_Str
'Length > Max_Stack_Size_Len
then
564 Max_Stack_Size_Len
:= Stack_Size_Str
'Length;
567 if Actual_Size_Str
'Length > Max_Actual_Use_Len
then
568 Max_Actual_Use_Len
:= Actual_Size_Str
'Length;
572 (Index_Str
& " | " & Task_Name_Str
& Task_Name_Blanks
& " | "
573 & Stack_Size_Str
& Stack_Size_Blanks
& " | "
574 & Stack_Usage_Blanks
& Actual_Size_Str
);
579 -- Now display the individual results
581 for J
in Result_Array
'Range loop
582 exit when J
>= Next_Id
;
584 (J
, Result_Array
(J
), Max_Stack_Size_Len
, Max_Actual_Use_Len
);
587 -- Case of no result stored, still display the labels
591 (Index_Str
& " | " & Task_Name_Str
& Task_Name_Blanks
& " | "
592 & Stack_Size_Str
& " | " & Actual_Size_Str
);
601 procedure Report_Result
(Analyzer
: Stack_Analyzer
) is
602 Result
: Task_Result
:=
603 (Task_Name
=> Analyzer
.Task_Name
,
604 Max_Size
=> Analyzer
.Stack_Size
,
608 Overflow_Guard
: constant Integer :=
610 - Stack_Size
(Analyzer
.Top_Pattern_Mark
, Analyzer
.Bottom_Of_Stack
);
614 if Analyzer
.Pattern_Size
= 0 then
616 -- If we have that result, it means that we didn't do any computation
617 -- at all. In other words, we used at least everything (and possibly
620 Min
:= Analyzer
.Stack_Size
- Overflow_Guard
;
621 Max
:= Analyzer
.Stack_Size
;
626 (Analyzer
.Topmost_Touched_Mark
, Analyzer
.Bottom_Of_Stack
);
627 Max
:= Min
+ Overflow_Guard
;
630 Result
.Value
:= (Max
+ Min
) / 2;
631 Result
.Variation
:= (Max
- Min
) / 2;
633 if Analyzer
.Result_Id
in Result_Array
'Range then
635 -- If the result can be stored, then store it in Result_Array
637 Result_Array
(Analyzer
.Result_Id
) := Result
;
640 -- If the result cannot be stored, then we display it right away
643 Result_Str_Len
: constant Natural :=
644 Get_Usage_Range
(Result
)'Length;
645 Size_Str_Len
: constant Natural :=
646 Natural'Image (Analyzer
.Stack_Size
)'Length;
648 Max_Stack_Size_Len
: Natural;
649 Max_Actual_Use_Len
: Natural;
652 -- Take either the label size or the number image size for the
653 -- size of the column "Stack Size".
655 Max_Stack_Size_Len
:=
656 (if Size_Str_Len
> Stack_Size_Str
'Length
658 else Stack_Size_Str
'Length);
660 -- Take either the label size or the number image size for the
661 -- size of the column "Stack Usage".
663 Max_Actual_Use_Len
:=
664 (if Result_Str_Len
> Actual_Size_Str
'Length
666 else Actual_Size_Str
'Length);
677 end System
.Stack_Usage
;