File : a-taside-raven.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                        GNAT RUN-TIME COMPONENTS                          --
   4 --                                                                          --
   5 --              A D A . T A S K _ I D E N T I F I C A T I O N               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --           Copyright (C) 1992-2015, 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 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  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 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  This is the Ravenscar version of this package
  33 
  34 with System.Task_Primitives.Operations;
  35 --  used for Self
  36 --           Is_Task_Context
  37 
  38 pragma Warnings (Off);
  39 --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
  40 --  package will be categorized as Preelaborate. See AI-362 for details.
  41 --  It is safe in the context of the run-time to violate the rules.
  42 
  43 with System.Tasking.Restricted.Stages;
  44 --  used for Restricted_Terminated
  45 
  46 pragma Warnings (On);
  47 
  48 package body Ada.Task_Identification with
  49   SPARK_Mode => Off
  50 is
  51 
  52    use System.Tasking.Restricted.Stages;
  53 
  54    -----------------------
  55    -- Local Subprograms --
  56    -----------------------
  57 
  58    function Convert_Ids (T : Task_Id) return System.Tasking.Task_Id;
  59    function Convert_Ids (T : System.Tasking.Task_Id) return Task_Id;
  60    pragma Inline (Convert_Ids);
  61    --  Conversion functions between different forms of Task_Id
  62 
  63    ---------
  64    -- "=" --
  65    ---------
  66 
  67    function "=" (Left, Right : Task_Id) return Boolean is
  68    begin
  69       return System.Tasking."=" (Convert_Ids (Left), Convert_Ids (Right));
  70    end "=";
  71 
  72    -----------------
  73    -- Abort_Task --
  74    ----------------
  75 
  76    procedure Abort_Task (T : Task_Id) is
  77    begin
  78       raise Program_Error;
  79    end Abort_Task;
  80 
  81    ----------------------------
  82    -- Activation_Is_Complete --
  83    ----------------------------
  84 
  85    function Activation_Is_Complete (T : Task_Id) return Boolean is
  86       use type System.Tasking.Task_States;
  87    begin
  88       return T.Common.State /= System.Tasking.Unactivated;
  89    end Activation_Is_Complete;
  90 
  91    -----------------
  92    -- Convert_Ids --
  93    -----------------
  94 
  95    function Convert_Ids (T : Task_Id) return System.Tasking.Task_Id is
  96    begin
  97       return System.Tasking.Task_Id (T);
  98    end Convert_Ids;
  99 
 100    function Convert_Ids (T : System.Tasking.Task_Id) return Task_Id is
 101    begin
 102       return Task_Id (T);
 103    end Convert_Ids;
 104 
 105    ------------------
 106    -- Current_Task --
 107    ------------------
 108 
 109    function Current_Task return Task_Id is
 110    begin
 111       --  It is a bounded error to call this function from an interrupt
 112       --  handler (ARM C.7.1, par. 17), so that we raise Program_Error
 113       --  in that case.
 114 
 115       if not System.Task_Primitives.Operations.Is_Task_Context then
 116          raise Program_Error;
 117       end if;
 118 
 119       return Convert_Ids (System.Task_Primitives.Operations.Self);
 120    end Current_Task;
 121 
 122    ----------------------
 123    -- Environment_Task --
 124    ----------------------
 125 
 126    function Environment_Task return Task_Id is
 127    begin
 128       return Convert_Ids (System.Task_Primitives.Operations.Environment_Task);
 129    end Environment_Task;
 130 
 131    -----------
 132    -- Image --
 133    -----------
 134 
 135    function Image (T : Task_Id) return String is
 136       pragma Unreferenced (T);
 137    begin
 138       return "";
 139    end Image;
 140 
 141    -----------------
 142    -- Is_Callable --
 143    -----------------
 144 
 145    function Is_Callable (T : Task_Id) return Boolean is
 146    begin
 147       if T = Null_Task_Id then
 148          raise Program_Error;
 149       else
 150          return False;
 151       end if;
 152    end Is_Callable;
 153 
 154    -------------------
 155    -- Is_Terminated --
 156    -------------------
 157 
 158    function Is_Terminated (T : Task_Id) return Boolean is
 159    begin
 160       if T = Null_Task_Id then
 161          raise Program_Error;
 162       else
 163          return Restricted_Terminated (Convert_Ids (T));
 164       end if;
 165    end Is_Terminated;
 166 
 167 end Ada.Task_Identification;