gcc/ada/s-stusta.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --            S Y S T E M . S T A C K _ U S A G E . T A S K I N G           --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --             Copyright (C) 2009, 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 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.                                              --
  21 --                                                                          --
  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.                                      --
  28 --                                                                          --
  29 -- GNARL was developed by the GNARL team at Florida State University.       --
  30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with System.Stack_Usage;
  35
  36 --  This is why this package is part of GNARL:
  37
  38 with System.Tasking.Debug;
  39 with System.Task_Primitives.Operations;
  40
  41 with System.IO;
  42
  43 package body System.Stack_Usage.Tasking is
  44    use System.IO;
  45
  46    procedure Report_For_Task (Id : System.Tasking.Task_Id);
  47    --  A generic procedure calculating stack usage for a given task
  48
  49    procedure Compute_All_Tasks;
  50    --  Compute the stack usage for all tasks and saves it in
  51    --  System.Stack_Usage.Result_Array
  52
  53    procedure Compute_Current_Task;
  54    --  Compute the stack usage for a given task and saves it in the a precise
  55    --  slot in System.Stack_Usage.Result_Array;
  56
  57    procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean);
  58    --  Report the stack usage of either all tasks (All_Tasks = True) or of the
  59    --  current task (All_Task = False). If Print is True, then results are
  60    --  printed on stderr
  61
  62    procedure Convert
  63      (TS  : System.Stack_Usage.Task_Result;
  64       Res : out Stack_Usage_Result);
  65    --  Convert an object of type System.Stack_Usage in a Stack_Usage_Result
  66
  67    --------------
  68    --  Convert --
  69    --------------
  70
  71    procedure Convert
  72      (TS  : System.Stack_Usage.Task_Result;
  73       Res : out Stack_Usage_Result) is
  74    begin
  75       Res := TS;
  76    end Convert;
  77
  78    ----------------------
  79    --  Report_For_Task --
  80    ----------------------
  81
  82    procedure Report_For_Task (Id : System.Tasking.Task_Id) is
  83    begin
  84       System.Stack_Usage.Compute_Result (Id.Common.Analyzer);
  85       System.Stack_Usage.Report_Result (Id.Common.Analyzer);
  86    end Report_For_Task;
  87
  88    ------------------------
  89    --  Compute_All_Tasks --
  90    ------------------------
  91
  92    procedure Compute_All_Tasks is
  93       Id : System.Tasking.Task_Id;
  94       use type System.Tasking.Task_Id;
  95    begin
  96       if not System.Stack_Usage.Is_Enabled then
  97          Put ("Stack Usage not enabled: bind with -uNNN switch");
  98       else
  99
 100          --  Loop over all tasks
 101
 102          for J in System.Tasking.Debug.Known_Tasks'First + 1
 103            .. System.Tasking.Debug.Known_Tasks'Last
 104          loop
 105             Id := System.Tasking.Debug.Known_Tasks (J);
 106             exit when Id = null;
 107
 108             --  Calculate the task usage for a given task
 109
 110             Report_For_Task (Id);
 111          end loop;
 112
 113       end if;
 114    end Compute_All_Tasks;
 115
 116    ---------------------------
 117    --  Compute_Current_Task --
 118    ---------------------------
 119
 120    procedure Compute_Current_Task is
 121    begin
 122       if not System.Stack_Usage.Is_Enabled then
 123          Put ("Stack Usage not enabled: bind with -uNNN switch");
 124       else
 125
 126          --  The current task
 127
 128          Report_For_Task (System.Tasking.Self);
 129
 130       end if;
 131    end Compute_Current_Task;
 132
 133    ------------------
 134    --  Report_Impl --
 135    ------------------
 136
 137    procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean) is
 138    begin
 139
 140       --  Lock the runtime
 141
 142       System.Task_Primitives.Operations.Lock_RTS;
 143
 144       --  Calculate results
 145
 146       if All_Tasks then
 147          Compute_All_Tasks;
 148       else
 149          Compute_Current_Task;
 150       end if;
 151
 152       --  Output results
 153       if Do_Print then
 154          System.Stack_Usage.Output_Results;
 155       end if;
 156
 157       --  Unlock the runtime
 158
 159       System.Task_Primitives.Operations.Unlock_RTS;
 160
 161    end Report_Impl;
 162
 163    ----------------------
 164    --  Report_All_Task --
 165    ----------------------
 166
 167    procedure Report_All_Tasks is
 168    begin
 169       Report_Impl (True, True);
 170    end Report_All_Tasks;
 171
 172    --------------------------
 173    --  Report_Current_Task --
 174    --------------------------
 175
 176    procedure Report_Current_Task is
 177       Res : Stack_Usage_Result;
 178    begin
 179       Res := Get_Current_Task_Usage;
 180       Print (Res);
 181    end Report_Current_Task;
 182
 183    --------------------------
 184    --  Get_All_Tasks_Usage --
 185    --------------------------
 186
 187    function Get_All_Tasks_Usage return Stack_Usage_Result_Array is
 188       Res : Stack_Usage_Result_Array
 189         (1 .. System.Stack_Usage.Result_Array'Length);
 190    begin
 191       Report_Impl (True, False);
 192
 193       for J in Res'Range loop
 194          Convert (System.Stack_Usage.Result_Array (J), Res (J));
 195       end loop;
 196
 197       return Res;
 198    end Get_All_Tasks_Usage;
 199
 200    -----------------------------
 201    --  Get_Current_Task_Usage --
 202    -----------------------------
 203
 204    function Get_Current_Task_Usage return Stack_Usage_Result is
 205       Res : Stack_Usage_Result;
 206       Original : System.Stack_Usage.Task_Result;
 207       Found : Boolean := False;
 208    begin
 209
 210       Report_Impl (False, False);
 211
 212       --  Look for the task info in System.Stack_Usage.Result_Array;
 213       --  the search is based on task name
 214
 215       for T in System.Stack_Usage.Result_Array'Range loop
 216          if System.Stack_Usage.Result_Array (T).Task_Name =
 217            System.Tasking.Self.Common.Analyzer.Task_Name
 218          then
 219             Original := System.Stack_Usage.Result_Array (T);
 220             Found := True;
 221             exit;
 222          end if;
 223       end loop;
 224
 225       --  Be sure a task has been found
 226
 227       pragma Assert (Found);
 228
 229       Convert (Original, Res);
 230       return Res;
 231    end Get_Current_Task_Usage;
 232
 233    ------------
 234    --  Print --
 235    ------------
 236
 237    procedure Print (Obj : Stack_Usage_Result) is
 238       Pos : Positive;
 239    begin
 240
 241       --  Simply trim the string containing the task name
 242
 243       for S in Obj.Task_Name'Range loop
 244          if Obj.Task_Name (S) = ' ' then
 245             Pos := S;
 246             exit;
 247          end if;
 248       end loop;
 249
 250       declare
 251          T_Name : constant String := Obj.Task_Name
 252            (Obj.Task_Name'First .. Pos);
 253       begin
 254          Put_Line
 255            ("| " & T_Name & " | " & Natural'Image (Obj.Max_Size) &
 256             Natural'Image (Obj.Value) & " +/- " &
 257             Natural'Image (Obj.Variation));
 258       end;
 259    end Print;
 260
 261 end System.Stack_Usage.Tasking;