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