File : s-taskin-raven.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --                        S Y S T E M . T A S K I N G                       --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2016, AdaCore                     --
  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. 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.                                     --
  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 -- 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 --  This is the Ravenscar/HI-E and Ravenscar/full version of this package
  33 
  34 pragma Restrictions (No_Elaboration_Code);
  35 --  For Ravenscar/HI-E, this restriction is simply an optimization.
  36 --  For Ravenscar/full, this restriction is required because the Initialize
  37 --  procedure is called by s-init before the elaboration.
  38 
  39 pragma Polling (Off);
  40 --  Turn off polling, we do not want ATC polling to take place during tasking
  41 --  operations. It causes infinite loops and other problems.
  42 
  43 with System.Task_Primitives.Operations;
  44 --  used for Self
  45 
  46 with System.Secondary_Stack;
  47 --  used for SS_Init
  48 --           Default_Secondary_Stack_Size
  49 
  50 package body System.Tasking is
  51 
  52    use System.Secondary_Stack;
  53    use System.Multiprocessors;
  54 
  55    ------------------------
  56    -- Local Declarations --
  57    ------------------------
  58 
  59    Main_Priority : Integer := Unspecified_Priority;
  60    pragma Export (C, Main_Priority, "__gl_main_priority");
  61    --  Priority associated with the environment task. By default, its value is
  62    --  undefined, and can be set by using pragma Priority in the main program.
  63 
  64    Main_CPU : Integer := Unspecified_CPU;
  65    pragma Export (C, Main_CPU, "__gl_main_cpu");
  66    --  Affinity associated with the environment task. By default, its value is
  67    --  undefined, and can be set by using pragma CPU in the main program.
  68    --  Switching the environment task to the right CPU is left to the user.
  69 
  70    Environment_Task : aliased Ada_Task_Control_Block (Entry_Num => 0);
  71    --  ATCB for the environment task. The name of this array is
  72    --  'Environment_Task', so that there is a nice display of the environment
  73    --  task in GDB (which uses the suffix of the symbol).
  74 
  75    -------------------
  76    -- Get_Sec_Stack --
  77    -------------------
  78 
  79    function Get_Sec_Stack return Address is
  80    begin
  81       return Self.Common.Compiler_Data.Sec_Stack_Addr;
  82    end Get_Sec_Stack;
  83 
  84    ---------------------
  85    -- Initialize_ATCB --
  86    ---------------------
  87 
  88    procedure Initialize_ATCB
  89      (Task_Entry_Point : Task_Procedure_Access;
  90       Task_Arg         : System.Address;
  91       Base_Priority    : Extended_Priority;
  92       Base_CPU         : System.Multiprocessors.CPU_Range;
  93       Task_Info        : System.Task_Info.Task_Info_Type;
  94       Stack_Address    : System.Address;
  95       Stack_Size       : System.Parameters.Size_Type;
  96       T                : Task_Id;
  97       Success          : out Boolean)
  98    is
  99    begin
 100       T.Common.State := Unactivated;
 101 
 102       --  Initialize T.Common.LL
 103 
 104       Task_Primitives.Operations.Initialize_TCB (T, Success);
 105 
 106       if not Success then
 107          return;
 108       end if;
 109 
 110       T.Common.Base_Priority            := Base_Priority;
 111       T.Common.Base_CPU                 := Base_CPU;
 112       T.Common.Protected_Action_Nesting := 0;
 113       T.Common.Task_Arg                 := Task_Arg;
 114       T.Common.Task_Entry_Point         := Task_Entry_Point;
 115       T.Common.Task_Info                := Task_Info;
 116 
 117       T.Common.Compiler_Data.Pri_Stack_Info.Start_Address :=
 118         Stack_Address;
 119 
 120       T.Common.Compiler_Data.Pri_Stack_Info.Size :=
 121         Storage_Elements.Storage_Offset
 122           (Parameters.Adjust_Storage_Size (Stack_Size));
 123    end Initialize_ATCB;
 124 
 125    ----------------
 126    -- Initialize --
 127    ----------------
 128 
 129    Secondary_Stack : aliased Storage_Elements.Storage_Array
 130                        (1 .. Storage_Elements.Storage_Offset
 131                                (Default_Secondary_Stack_Size));
 132    for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
 133    pragma Warnings (Off, Secondary_Stack);
 134    --  Secondary stack of the environmental task
 135 
 136    Initialized : Boolean := False;
 137    --  Used to prevent multiple calls to Initialize
 138 
 139    procedure Initialize is
 140       Base_Priority : Any_Priority;
 141 
 142       Success : Boolean;
 143       pragma Warnings (Off, Success);
 144 
 145    begin
 146       if Initialized then
 147          return;
 148       end if;
 149 
 150       Initialized := True;
 151 
 152       --  Compute priority
 153 
 154       if Main_Priority = Unspecified_Priority then
 155          Base_Priority := Default_Priority;
 156       else
 157          Base_Priority := Main_Priority;
 158       end if;
 159 
 160       Initialize_ATCB
 161         (null, Null_Address, Base_Priority, CPU'First,
 162          Task_Info.Unspecified_Task_Info, Null_Address, 0,
 163          Environment_Task'Access, Success);
 164 
 165       Task_Primitives.Operations.Initialize
 166         (Environment_Task'Access);
 167 
 168       --  Note: we used to set the priority at this point, but it is already
 169       --  done in Enter_Task via s-taprop.Initialize.
 170 
 171       Environment_Task.Common.State := Runnable;
 172       Environment_Task.Entry_Call.Self := Environment_Task'Access;
 173 
 174       --  Initialize the secondary stack
 175 
 176       Environment_Task.Common.Compiler_Data.Sec_Stack_Addr :=
 177         Secondary_Stack'Address;
 178       SS_Init (Secondary_Stack'Address, Default_Secondary_Stack_Size);
 179 
 180       --  No fall back handler by default
 181 
 182       Fall_Back_Handler := null;
 183 
 184       --  Legal values of CPU are the special Unspecified_CPU value, which is
 185       --  inserted by the compiler for tasks without CPU aspect, and those in
 186       --  the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
 187       --  the task is defined to have failed, and it becomes a completed task
 188       --  (RM D.16(14/3)).
 189 
 190       --  Only accept CPU'First for CPU value, starting on a slave CPU is not
 191       --  supported.
 192 
 193       if Main_CPU /= Unspecified_CPU and then Main_CPU /= Integer (CPU'First)
 194       then
 195          --  Invalid CPU, will raise Tasking_Error after the environment task
 196          --  is initialized (as exception propagation is supported in the full
 197          --  Ravenscar profile).
 198 
 199          raise Tasking_Error with "Main CPU is not the master one";
 200       end if;
 201    end Initialize;
 202 
 203    ----------
 204    -- Self --
 205    ----------
 206 
 207    function Self return Task_Id renames System.Task_Primitives.Operations.Self;
 208 
 209    -------------------
 210    -- Set_Sec_Stack --
 211    -------------------
 212 
 213    procedure Set_Sec_Stack (Stk : Address) is
 214    begin
 215       Self.Common.Compiler_Data.Sec_Stack_Addr := Stk;
 216    end Set_Sec_Stack;
 217 
 218    ------------------
 219    -- Storage_Size --
 220    ------------------
 221 
 222    function Storage_Size (T : Task_Id) return System.Parameters.Size_Type is
 223    begin
 224       return
 225         System.Parameters.Size_Type
 226           (T.Common.Compiler_Data.Pri_Stack_Info.Size);
 227    end Storage_Size;
 228 
 229 end System.Tasking;