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-- -- 9-- Copyright (C) 2004-2018, Free Software Foundation, Inc. -- 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 32with System.Parameters; 33with System.CRTL; 34with System.IO; 35 36package 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 565end System.Stack_Usage; 566