|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M - S T A C K _ U S A G E --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2004-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNARL was developed by the GNARL team at Florida State University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with System.Parameters;
|
|
|
33 with System.CRTL;
|
|
|
34 with System.IO;
|
|
|
35
|
|
|
36 package body System.Stack_Usage is
|
|
|
37 use System.Storage_Elements;
|
|
|
38 use System.IO;
|
|
|
39 use Interfaces;
|
|
|
40
|
|
|
41 -----------------
|
|
|
42 -- Stack_Slots --
|
|
|
43 -----------------
|
|
|
44
|
|
|
45 -- Stackl_Slots is an internal data type to represent a sequence of real
|
|
|
46 -- stack slots initialized with a provided pattern, with operations to
|
|
|
47 -- abstract away the target call stack growth direction.
|
|
|
48
|
|
|
49 type Stack_Slots is array (Integer range <>) of Pattern_Type;
|
|
|
50 for Stack_Slots'Component_Size use Pattern_Type'Object_Size;
|
|
|
51
|
|
|
52 -- We will carefully handle the initializations ourselves and might want
|
|
|
53 -- to remap an initialized overlay later on with an address clause.
|
|
|
54
|
|
|
55 pragma Suppress_Initialization (Stack_Slots);
|
|
|
56
|
|
|
57 -- The abstract Stack_Slots operations all operate over the simple array
|
|
|
58 -- memory model:
|
|
|
59
|
|
|
60 -- memory addresses increasing ---->
|
|
|
61
|
|
|
62 -- Slots('First) Slots('Last)
|
|
|
63 -- | |
|
|
|
64 -- V V
|
|
|
65 -- +------------------------------------------------------------------+
|
|
|
66 -- |####| |####|
|
|
|
67 -- +------------------------------------------------------------------+
|
|
|
68
|
|
|
69 -- What we call Top or Bottom always denotes call chain leaves or entry
|
|
|
70 -- points respectively, and their relative positions in the stack array
|
|
|
71 -- depends on the target stack growth direction:
|
|
|
72
|
|
|
73 -- Stack_Grows_Down
|
|
|
74
|
|
|
75 -- <----- calls push frames towards decreasing addresses
|
|
|
76
|
|
|
77 -- Top(most) Slot Bottom(most) Slot
|
|
|
78 -- | |
|
|
|
79 -- V V
|
|
|
80 -- +------------------------------------------------------------------+
|
|
|
81 -- |####| | leaf frame | ... | entry frame |
|
|
|
82 -- +------------------------------------------------------------------+
|
|
|
83
|
|
|
84 -- Stack_Grows_Up
|
|
|
85
|
|
|
86 -- calls push frames towards increasing addresses ----->
|
|
|
87
|
|
|
88 -- Bottom(most) Slot Top(most) Slot
|
|
|
89 -- | |
|
|
|
90 -- V V
|
|
|
91 -- +------------------------------------------------------------------+
|
|
|
92 -- | entry frame | ... | leaf frame | |####|
|
|
|
93 -- +------------------------------------------------------------------+
|
|
|
94
|
|
|
95 -------------------
|
|
|
96 -- Unit Services --
|
|
|
97 -------------------
|
|
|
98
|
|
|
99 -- Now the implementation of the services offered by this unit, on top of
|
|
|
100 -- the Stack_Slots abstraction above.
|
|
|
101
|
|
|
102 Index_Str : constant String := "Index";
|
|
|
103 Task_Name_Str : constant String := "Task Name";
|
|
|
104 Stack_Size_Str : constant String := "Stack Size";
|
|
|
105 Actual_Size_Str : constant String := "Stack usage";
|
|
|
106
|
|
|
107 procedure Output_Result
|
|
|
108 (Result_Id : Natural;
|
|
|
109 Result : Task_Result;
|
|
|
110 Max_Stack_Size_Len : Natural;
|
|
|
111 Max_Actual_Use_Len : Natural);
|
|
|
112 -- Prints the result on the standard output. Result Id is the number of
|
|
|
113 -- the result in the array, and Result the contents of the actual result.
|
|
|
114 -- Max_Stack_Size_Len and Max_Actual_Use_Len are used for displaying the
|
|
|
115 -- proper layout. They hold the maximum length of the string representing
|
|
|
116 -- the Stack_Size and Actual_Use values.
|
|
|
117
|
|
|
118 ----------------
|
|
|
119 -- Initialize --
|
|
|
120 ----------------
|
|
|
121
|
|
|
122 procedure Initialize (Buffer_Size : Natural) is
|
|
|
123 Stack_Size_Chars : System.Address;
|
|
|
124
|
|
|
125 begin
|
|
|
126 -- Initialize the buffered result array
|
|
|
127
|
|
|
128 Result_Array := new Result_Array_Type (1 .. Buffer_Size);
|
|
|
129 Result_Array.all :=
|
|
|
130 (others =>
|
|
|
131 (Task_Name => (others => ASCII.NUL),
|
|
|
132 Value => 0,
|
|
|
133 Stack_Size => 0));
|
|
|
134
|
|
|
135 -- Set the Is_Enabled flag to true, so that the task wrapper knows that
|
|
|
136 -- it has to handle dynamic stack analysis
|
|
|
137
|
|
|
138 Is_Enabled := True;
|
|
|
139
|
|
|
140 Stack_Size_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
|
|
|
141
|
|
|
142 -- If variable GNAT_STACK_LIMIT is set, then we will take care of the
|
|
|
143 -- environment task, using GNAT_STASK_LIMIT as the size of the stack.
|
|
|
144 -- It doesn't make sens to process the stack when no bound is set (e.g.
|
|
|
145 -- limit is typically up to 4 GB).
|
|
|
146
|
|
|
147 if Stack_Size_Chars /= Null_Address then
|
|
|
148 declare
|
|
|
149 My_Stack_Size : Integer;
|
|
|
150
|
|
|
151 begin
|
|
|
152 My_Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024;
|
|
|
153
|
|
|
154 Initialize_Analyzer
|
|
|
155 (Environment_Task_Analyzer,
|
|
|
156 "ENVIRONMENT TASK",
|
|
|
157 My_Stack_Size,
|
|
|
158 0,
|
|
|
159 My_Stack_Size);
|
|
|
160
|
|
|
161 Fill_Stack (Environment_Task_Analyzer);
|
|
|
162
|
|
|
163 Compute_Environment_Task := True;
|
|
|
164 end;
|
|
|
165
|
|
|
166 -- GNAT_STACK_LIMIT not set
|
|
|
167
|
|
|
168 else
|
|
|
169 Compute_Environment_Task := False;
|
|
|
170 end if;
|
|
|
171 end Initialize;
|
|
|
172
|
|
|
173 ----------------
|
|
|
174 -- Fill_Stack --
|
|
|
175 ----------------
|
|
|
176
|
|
|
177 procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
|
|
|
178
|
|
|
179 -- Change the local variables and parameters of this function with
|
|
|
180 -- super-extra care. The more the stack frame size of this function is
|
|
|
181 -- big, the more an "instrumentation threshold at writing" error is
|
|
|
182 -- likely to happen.
|
|
|
183
|
|
|
184 Current_Stack_Level : aliased Integer;
|
|
|
185
|
|
|
186 Guard : constant := 256;
|
|
|
187 -- Guard space between the Current_Stack_Level'Address and the last
|
|
|
188 -- allocated byte on the stack.
|
|
|
189 begin
|
|
|
190 if Parameters.Stack_Grows_Down then
|
|
|
191 if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) >
|
|
|
192 To_Stack_Address (Current_Stack_Level'Address) - Guard
|
|
|
193 then
|
|
|
194 -- No room for a pattern
|
|
|
195
|
|
|
196 Analyzer.Pattern_Size := 0;
|
|
|
197 return;
|
|
|
198 end if;
|
|
|
199
|
|
|
200 Analyzer.Pattern_Limit :=
|
|
|
201 Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size);
|
|
|
202
|
|
|
203 if Analyzer.Stack_Base >
|
|
|
204 To_Stack_Address (Current_Stack_Level'Address) - Guard
|
|
|
205 then
|
|
|
206 -- Reduce pattern size to prevent local frame overwrite
|
|
|
207
|
|
|
208 Analyzer.Pattern_Size :=
|
|
|
209 Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard
|
|
|
210 - Analyzer.Pattern_Limit);
|
|
|
211 end if;
|
|
|
212
|
|
|
213 Analyzer.Pattern_Overlay_Address :=
|
|
|
214 To_Address (Analyzer.Pattern_Limit);
|
|
|
215 else
|
|
|
216 if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) <
|
|
|
217 To_Stack_Address (Current_Stack_Level'Address) + Guard
|
|
|
218 then
|
|
|
219 -- No room for a pattern
|
|
|
220
|
|
|
221 Analyzer.Pattern_Size := 0;
|
|
|
222 return;
|
|
|
223 end if;
|
|
|
224
|
|
|
225 Analyzer.Pattern_Limit :=
|
|
|
226 Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size);
|
|
|
227
|
|
|
228 if Analyzer.Stack_Base <
|
|
|
229 To_Stack_Address (Current_Stack_Level'Address) + Guard
|
|
|
230 then
|
|
|
231 -- Reduce pattern size to prevent local frame overwrite
|
|
|
232
|
|
|
233 Analyzer.Pattern_Size :=
|
|
|
234 Integer
|
|
|
235 (Analyzer.Pattern_Limit -
|
|
|
236 (To_Stack_Address (Current_Stack_Level'Address) + Guard));
|
|
|
237 end if;
|
|
|
238
|
|
|
239 Analyzer.Pattern_Overlay_Address :=
|
|
|
240 To_Address (Analyzer.Pattern_Limit -
|
|
|
241 Stack_Address (Analyzer.Pattern_Size));
|
|
|
242 end if;
|
|
|
243
|
|
|
244 -- Declare and fill the pattern buffer
|
|
|
245
|
|
|
246 declare
|
|
|
247 Pattern : aliased Stack_Slots
|
|
|
248 (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
|
|
|
249 for Pattern'Address use Analyzer.Pattern_Overlay_Address;
|
|
|
250
|
|
|
251 begin
|
|
|
252 if System.Parameters.Stack_Grows_Down then
|
|
|
253 for J in reverse Pattern'Range loop
|
|
|
254 Pattern (J) := Analyzer.Pattern;
|
|
|
255 end loop;
|
|
|
256
|
|
|
257 else
|
|
|
258 for J in Pattern'Range loop
|
|
|
259 Pattern (J) := Analyzer.Pattern;
|
|
|
260 end loop;
|
|
|
261 end if;
|
|
|
262 end;
|
|
|
263 end Fill_Stack;
|
|
|
264
|
|
|
265 -------------------------
|
|
|
266 -- Initialize_Analyzer --
|
|
|
267 -------------------------
|
|
|
268
|
|
|
269 procedure Initialize_Analyzer
|
|
|
270 (Analyzer : in out Stack_Analyzer;
|
|
|
271 Task_Name : String;
|
|
|
272 Stack_Size : Natural;
|
|
|
273 Stack_Base : Stack_Address;
|
|
|
274 Pattern_Size : Natural;
|
|
|
275 Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#)
|
|
|
276 is
|
|
|
277 begin
|
|
|
278 -- Initialize the analyzer fields
|
|
|
279
|
|
|
280 Analyzer.Stack_Base := Stack_Base;
|
|
|
281 Analyzer.Stack_Size := Stack_Size;
|
|
|
282 Analyzer.Pattern_Size := Pattern_Size;
|
|
|
283 Analyzer.Pattern := Pattern;
|
|
|
284 Analyzer.Result_Id := Next_Id;
|
|
|
285 Analyzer.Task_Name := (others => ' ');
|
|
|
286
|
|
|
287 -- Compute the task name, and truncate if bigger than Task_Name_Length
|
|
|
288
|
|
|
289 if Task_Name'Length <= Task_Name_Length then
|
|
|
290 Analyzer.Task_Name (1 .. Task_Name'Length) := Task_Name;
|
|
|
291 else
|
|
|
292 Analyzer.Task_Name :=
|
|
|
293 Task_Name (Task_Name'First ..
|
|
|
294 Task_Name'First + Task_Name_Length - 1);
|
|
|
295 end if;
|
|
|
296
|
|
|
297 Next_Id := Next_Id + 1;
|
|
|
298 end Initialize_Analyzer;
|
|
|
299
|
|
|
300 ----------------
|
|
|
301 -- Stack_Size --
|
|
|
302 ----------------
|
|
|
303
|
|
|
304 function Stack_Size
|
|
|
305 (SP_Low : Stack_Address;
|
|
|
306 SP_High : Stack_Address) return Natural
|
|
|
307 is
|
|
|
308 begin
|
|
|
309 if SP_Low > SP_High then
|
|
|
310 return Natural (SP_Low - SP_High);
|
|
|
311 else
|
|
|
312 return Natural (SP_High - SP_Low);
|
|
|
313 end if;
|
|
|
314 end Stack_Size;
|
|
|
315
|
|
|
316 --------------------
|
|
|
317 -- Compute_Result --
|
|
|
318 --------------------
|
|
|
319
|
|
|
320 procedure Compute_Result (Analyzer : in out Stack_Analyzer) is
|
|
|
321
|
|
|
322 -- Change the local variables and parameters of this function with
|
|
|
323 -- super-extra care. The larger the stack frame size of this function
|
|
|
324 -- is, the more an "instrumentation threshold at reading" error is
|
|
|
325 -- likely to happen.
|
|
|
326
|
|
|
327 Stack : Stack_Slots (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
|
|
|
328 for Stack'Address use Analyzer.Pattern_Overlay_Address;
|
|
|
329
|
|
|
330 begin
|
|
|
331 -- Value if the pattern was not modified
|
|
|
332
|
|
|
333 if Parameters.Stack_Grows_Down then
|
|
|
334 Analyzer.Topmost_Touched_Mark :=
|
|
|
335 Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size);
|
|
|
336 else
|
|
|
337 Analyzer.Topmost_Touched_Mark :=
|
|
|
338 Analyzer.Pattern_Limit - Stack_Address (Analyzer.Pattern_Size);
|
|
|
339 end if;
|
|
|
340
|
|
|
341 if Analyzer.Pattern_Size = 0 then
|
|
|
342 return;
|
|
|
343 end if;
|
|
|
344
|
|
|
345 -- Look backward from the topmost possible end of the marked stack to
|
|
|
346 -- the bottom of it. The first index not equals to the patterns marks
|
|
|
347 -- the beginning of the used stack.
|
|
|
348
|
|
|
349 if System.Parameters.Stack_Grows_Down then
|
|
|
350 for J in Stack'Range loop
|
|
|
351 if Stack (J) /= Analyzer.Pattern then
|
|
|
352 Analyzer.Topmost_Touched_Mark :=
|
|
|
353 To_Stack_Address (Stack (J)'Address);
|
|
|
354 exit;
|
|
|
355 end if;
|
|
|
356 end loop;
|
|
|
357
|
|
|
358 else
|
|
|
359 for J in reverse Stack'Range loop
|
|
|
360 if Stack (J) /= Analyzer.Pattern then
|
|
|
361 Analyzer.Topmost_Touched_Mark :=
|
|
|
362 To_Stack_Address (Stack (J)'Address);
|
|
|
363 exit;
|
|
|
364 end if;
|
|
|
365 end loop;
|
|
|
366
|
|
|
367 end if;
|
|
|
368 end Compute_Result;
|
|
|
369
|
|
|
370 ---------------------
|
|
|
371 -- Output_Result --
|
|
|
372 ---------------------
|
|
|
373
|
|
|
374 procedure Output_Result
|
|
|
375 (Result_Id : Natural;
|
|
|
376 Result : Task_Result;
|
|
|
377 Max_Stack_Size_Len : Natural;
|
|
|
378 Max_Actual_Use_Len : Natural)
|
|
|
379 is
|
|
|
380 Result_Id_Str : constant String := Natural'Image (Result_Id);
|
|
|
381 Stack_Size_Str : constant String := Natural'Image (Result.Stack_Size);
|
|
|
382 Actual_Use_Str : constant String := Natural'Image (Result.Value);
|
|
|
383
|
|
|
384 Result_Id_Blanks : constant
|
|
|
385 String (1 .. Index_Str'Length - Result_Id_Str'Length) :=
|
|
|
386 (others => ' ');
|
|
|
387
|
|
|
388 Stack_Size_Blanks : constant
|
|
|
389 String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
|
|
|
390 (others => ' ');
|
|
|
391
|
|
|
392 Actual_Use_Blanks : constant
|
|
|
393 String (1 .. Max_Actual_Use_Len - Actual_Use_Str'Length) :=
|
|
|
394 (others => ' ');
|
|
|
395
|
|
|
396 begin
|
|
|
397 Set_Output (Standard_Error);
|
|
|
398 Put (Result_Id_Blanks & Natural'Image (Result_Id));
|
|
|
399 Put (" | ");
|
|
|
400 Put (Result.Task_Name);
|
|
|
401 Put (" | ");
|
|
|
402 Put (Stack_Size_Blanks & Stack_Size_Str);
|
|
|
403 Put (" | ");
|
|
|
404 Put (Actual_Use_Blanks & Actual_Use_Str);
|
|
|
405 New_Line;
|
|
|
406 end Output_Result;
|
|
|
407
|
|
|
408 ---------------------
|
|
|
409 -- Output_Results --
|
|
|
410 ---------------------
|
|
|
411
|
|
|
412 procedure Output_Results is
|
|
|
413 Max_Stack_Size : Natural := 0;
|
|
|
414 Max_Stack_Usage : Natural := 0;
|
|
|
415 Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0;
|
|
|
416
|
|
|
417 Task_Name_Blanks : constant
|
|
|
418 String
|
|
|
419 (1 .. Task_Name_Length - Task_Name_Str'Length) :=
|
|
|
420 (others => ' ');
|
|
|
421
|
|
|
422 begin
|
|
|
423 Set_Output (Standard_Error);
|
|
|
424
|
|
|
425 if Compute_Environment_Task then
|
|
|
426 Compute_Result (Environment_Task_Analyzer);
|
|
|
427 Report_Result (Environment_Task_Analyzer);
|
|
|
428 end if;
|
|
|
429
|
|
|
430 if Result_Array'Length > 0 then
|
|
|
431
|
|
|
432 -- Computes the size of the largest strings that will get displayed,
|
|
|
433 -- in order to do correct column alignment.
|
|
|
434
|
|
|
435 for J in Result_Array'Range loop
|
|
|
436 exit when J >= Next_Id;
|
|
|
437
|
|
|
438 if Result_Array (J).Value > Max_Stack_Usage then
|
|
|
439 Max_Stack_Usage := Result_Array (J).Value;
|
|
|
440 end if;
|
|
|
441
|
|
|
442 if Result_Array (J).Stack_Size > Max_Stack_Size then
|
|
|
443 Max_Stack_Size := Result_Array (J).Stack_Size;
|
|
|
444 end if;
|
|
|
445 end loop;
|
|
|
446
|
|
|
447 Max_Stack_Size_Len := Natural'Image (Max_Stack_Size)'Length;
|
|
|
448
|
|
|
449 Max_Actual_Use_Len := Natural'Image (Max_Stack_Usage)'Length;
|
|
|
450
|
|
|
451 -- Display the output header. Blanks will be added in front of the
|
|
|
452 -- labels if needed.
|
|
|
453
|
|
|
454 declare
|
|
|
455 Stack_Size_Blanks : constant
|
|
|
456 String (1 .. Max_Stack_Size_Len -
|
|
|
457 Stack_Size_Str'Length) :=
|
|
|
458 (others => ' ');
|
|
|
459
|
|
|
460 Stack_Usage_Blanks : constant
|
|
|
461 String (1 .. Max_Actual_Use_Len -
|
|
|
462 Actual_Size_Str'Length) :=
|
|
|
463 (others => ' ');
|
|
|
464
|
|
|
465 begin
|
|
|
466 if Stack_Size_Str'Length > Max_Stack_Size_Len then
|
|
|
467 Max_Stack_Size_Len := Stack_Size_Str'Length;
|
|
|
468 end if;
|
|
|
469
|
|
|
470 if Actual_Size_Str'Length > Max_Actual_Use_Len then
|
|
|
471 Max_Actual_Use_Len := Actual_Size_Str'Length;
|
|
|
472 end if;
|
|
|
473
|
|
|
474 Put
|
|
|
475 (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
|
|
|
476 & Stack_Size_Str & Stack_Size_Blanks & " | "
|
|
|
477 & Stack_Usage_Blanks & Actual_Size_Str);
|
|
|
478 end;
|
|
|
479
|
|
|
480 New_Line;
|
|
|
481
|
|
|
482 -- Now display the individual results
|
|
|
483
|
|
|
484 for J in Result_Array'Range loop
|
|
|
485 exit when J >= Next_Id;
|
|
|
486 Output_Result
|
|
|
487 (J, Result_Array (J), Max_Stack_Size_Len, Max_Actual_Use_Len);
|
|
|
488 end loop;
|
|
|
489
|
|
|
490 -- Case of no result stored, still display the labels
|
|
|
491
|
|
|
492 else
|
|
|
493 Put
|
|
|
494 (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | "
|
|
|
495 & Stack_Size_Str & " | " & Actual_Size_Str);
|
|
|
496 New_Line;
|
|
|
497 end if;
|
|
|
498 end Output_Results;
|
|
|
499
|
|
|
500 -------------------
|
|
|
501 -- Report_Result --
|
|
|
502 -------------------
|
|
|
503
|
|
|
504 procedure Report_Result (Analyzer : Stack_Analyzer) is
|
|
|
505 Result : Task_Result := (Task_Name => Analyzer.Task_Name,
|
|
|
506 Stack_Size => Analyzer.Stack_Size,
|
|
|
507 Value => 0);
|
|
|
508 begin
|
|
|
509 if Analyzer.Pattern_Size = 0 then
|
|
|
510
|
|
|
511 -- If we have that result, it means that we didn't do any computation
|
|
|
512 -- at all (i.e. we used at least everything (and possibly more).
|
|
|
513
|
|
|
514 Result.Value := Analyzer.Stack_Size;
|
|
|
515
|
|
|
516 else
|
|
|
517 Result.Value := Stack_Size (Analyzer.Topmost_Touched_Mark,
|
|
|
518 Analyzer.Stack_Base);
|
|
|
519 end if;
|
|
|
520
|
|
|
521 if Analyzer.Result_Id in Result_Array'Range then
|
|
|
522
|
|
|
523 -- If the result can be stored, then store it in Result_Array
|
|
|
524
|
|
|
525 Result_Array (Analyzer.Result_Id) := Result;
|
|
|
526
|
|
|
527 else
|
|
|
528 -- If the result cannot be stored, then we display it right away
|
|
|
529
|
|
|
530 declare
|
|
|
531 Result_Str_Len : constant Natural :=
|
|
|
532 Natural'Image (Result.Value)'Length;
|
|
|
533 Size_Str_Len : constant Natural :=
|
|
|
534 Natural'Image (Analyzer.Stack_Size)'Length;
|
|
|
535
|
|
|
536 Max_Stack_Size_Len : Natural;
|
|
|
537 Max_Actual_Use_Len : Natural;
|
|
|
538
|
|
|
539 begin
|
|
|
540 -- Take either the label size or the number image size for the
|
|
|
541 -- size of the column "Stack Size".
|
|
|
542
|
|
|
543 Max_Stack_Size_Len :=
|
|
|
544 (if Size_Str_Len > Stack_Size_Str'Length
|
|
|
545 then Size_Str_Len
|
|
|
546 else Stack_Size_Str'Length);
|
|
|
547
|
|
|
548 -- Take either the label size or the number image size for the
|
|
|
549 -- size of the column "Stack Usage".
|
|
|
550
|
|
|
551 Max_Actual_Use_Len :=
|
|
|
552 (if Result_Str_Len > Actual_Size_Str'Length
|
|
|
553 then Result_Str_Len
|
|
|
554 else Actual_Size_Str'Length);
|
|
|
555
|
|
|
556 Output_Result
|
|
|
557 (Analyzer.Result_Id,
|
|
|
558 Result,
|
|
|
559 Max_Stack_Size_Len,
|
|
|
560 Max_Actual_Use_Len);
|
|
|
561 end;
|
|
|
562 end if;
|
|
|
563 end Report_Result;
|
|
|
564
|
|
|
565 end System.Stack_Usage;
|
