Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------
--                                                                          --
--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
--                                                                          --
--            S Y S T E M . S T A C K _ U S A G E . T A S K I N G           --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--             Copyright (C) 2009, Free Software Foundation, Inc.           --
--                                                                          --
-- GNARL is free software; you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNARL; see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNARL was developed by the GNARL team at Florida State University.       --
-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
--                                                                          --
------------------------------------------------------------------------------
 
with System.Stack_Usage;
 
--  This is why this package is part of GNARL:
 
with System.Tasking.Debug;
with System.Task_Primitives.Operations;
 
with System.IO;
 
package body System.Stack_Usage.Tasking is
   use System.IO;
 
   procedure Report_For_Task (Id : System.Tasking.Task_Id);
   --  A generic procedure calculating stack usage for a given task
 
   procedure Compute_All_Tasks;
   --  Compute the stack usage for all tasks and saves it in
   --  System.Stack_Usage.Result_Array
 
   procedure Compute_Current_Task;
   --  Compute the stack usage for a given task and saves it in the a precise
   --  slot in System.Stack_Usage.Result_Array;
 
   procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean);
   --  Report the stack usage of either all tasks (All_Tasks = True) or of the
   --  current task (All_Task = False). If Print is True, then results are
   --  printed on stderr
 
   procedure Convert
     (TS  : System.Stack_Usage.Task_Result;
      Res : out Stack_Usage_Result);
   --  Convert an object of type System.Stack_Usage in a Stack_Usage_Result
 
   --------------
   --  Convert --
   --------------
 
   procedure Convert
     (TS  : System.Stack_Usage.Task_Result;
      Res : out Stack_Usage_Result) is
   begin
      Res := TS;
   end Convert;
 
   ----------------------
   --  Report_For_Task --
   ----------------------
 
   procedure Report_For_Task (Id : System.Tasking.Task_Id) is
   begin
      System.Stack_Usage.Compute_Result (Id.Common.Analyzer);
      System.Stack_Usage.Report_Result (Id.Common.Analyzer);
   end Report_For_Task;
 
   ------------------------
   --  Compute_All_Tasks --
   ------------------------
 
   procedure Compute_All_Tasks is
      Id : System.Tasking.Task_Id;
      use type System.Tasking.Task_Id;
   begin
      if not System.Stack_Usage.Is_Enabled then
         Put ("Stack Usage not enabled: bind with -uNNN switch");
      else
 
         --  Loop over all tasks
 
         for J in System.Tasking.Debug.Known_Tasks'First + 1
           .. System.Tasking.Debug.Known_Tasks'Last
         loop
            Id := System.Tasking.Debug.Known_Tasks (J);
            exit when Id = null;
 
            --  Calculate the task usage for a given task
 
            Report_For_Task (Id);
         end loop;
 
      end if;
   end Compute_All_Tasks;
 
   ---------------------------
   --  Compute_Current_Task --
   ---------------------------
 
   procedure Compute_Current_Task is
   begin
      if not System.Stack_Usage.Is_Enabled then
         Put ("Stack Usage not enabled: bind with -uNNN switch");
      else
 
         --  The current task
 
         Report_For_Task (System.Tasking.Self);
 
      end if;
   end Compute_Current_Task;
 
   ------------------
   --  Report_Impl --
   ------------------
 
   procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean) is
   begin
 
      --  Lock the runtime
 
      System.Task_Primitives.Operations.Lock_RTS;
 
      --  Calculate results
 
      if All_Tasks then
         Compute_All_Tasks;
      else
         Compute_Current_Task;
      end if;
 
      --  Output results
      if Do_Print then
         System.Stack_Usage.Output_Results;
      end if;
 
      --  Unlock the runtime
 
      System.Task_Primitives.Operations.Unlock_RTS;
 
   end Report_Impl;
 
   ----------------------
   --  Report_All_Task --
   ----------------------
 
   procedure Report_All_Tasks is
   begin
      Report_Impl (True, True);
   end Report_All_Tasks;
 
   --------------------------
   --  Report_Current_Task --
   --------------------------
 
   procedure Report_Current_Task is
      Res : Stack_Usage_Result;
   begin
      Res := Get_Current_Task_Usage;
      Print (Res);
   end Report_Current_Task;
 
   --------------------------
   --  Get_All_Tasks_Usage --
   --------------------------
 
   function Get_All_Tasks_Usage return Stack_Usage_Result_Array is
      Res : Stack_Usage_Result_Array
        (1 .. System.Stack_Usage.Result_Array'Length);
   begin
      Report_Impl (True, False);
 
      for J in Res'Range loop
         Convert (System.Stack_Usage.Result_Array (J), Res (J));
      end loop;
 
      return Res;
   end Get_All_Tasks_Usage;
 
   -----------------------------
   --  Get_Current_Task_Usage --
   -----------------------------
 
   function Get_Current_Task_Usage return Stack_Usage_Result is
      Res : Stack_Usage_Result;
      Original : System.Stack_Usage.Task_Result;
      Found : Boolean := False;
   begin
 
      Report_Impl (False, False);
 
      --  Look for the task info in System.Stack_Usage.Result_Array;
      --  the search is based on task name
 
      for T in System.Stack_Usage.Result_Array'Range loop
         if System.Stack_Usage.Result_Array (T).Task_Name =
           System.Tasking.Self.Common.Analyzer.Task_Name
         then
            Original := System.Stack_Usage.Result_Array (T);
            Found := True;
            exit;
         end if;
      end loop;
 
      --  Be sure a task has been found
 
      pragma Assert (Found);
 
      Convert (Original, Res);
      return Res;
   end Get_Current_Task_Usage;
 
   ------------
   --  Print --
   ------------
 
   procedure Print (Obj : Stack_Usage_Result) is
      Pos : Positive;
   begin
 
      --  Simply trim the string containing the task name
 
      for S in Obj.Task_Name'Range loop
         if Obj.Task_Name (S) = ' ' then
            Pos := S;
            exit;
         end if;
      end loop;
 
      declare
         T_Name : constant String := Obj.Task_Name
           (Obj.Task_Name'First .. Pos);
      begin
         Put_Line
           ("| " & T_Name & " | " & Natural'Image (Obj.Max_Size) &
            Natural'Image (Obj.Value) & " +/- " &
            Natural'Image (Obj.Variation));
      end;
   end Print;
 
end System.Stack_Usage.Tasking;