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