| 1 | 706 | jeremybenn | ------------------------------------------------------------------------------
 | 
      
         | 2 |  |  | --                                                                          --
 | 
      
         | 3 |  |  | --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
 | 
      
         | 4 |  |  | --                                                                          --
 | 
      
         | 5 |  |  | --                 S Y S T E M . T A S K I N G . S T A G E S                --
 | 
      
         | 6 |  |  | --                                                                          --
 | 
      
         | 7 |  |  | --                                  S p e c                                 --
 | 
      
         | 8 |  |  | --                                                                          --
 | 
      
         | 9 |  |  | --          Copyright (C) 1992-2011, 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 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 |  |  | --  This package represents the high level tasking interface used by the
 | 
      
         | 33 |  |  | --  compiler to expand Ada 95 tasking constructs into simpler run time calls
 | 
      
         | 34 |  |  | --  (aka GNARLI, GNU Ada Run-time Library Interface)
 | 
      
         | 35 |  |  |  
 | 
      
         | 36 |  |  | --  Note: Only the compiler is allowed to use this interface, by generating
 | 
      
         | 37 |  |  | --  direct calls to it, via Rtsfind.
 | 
      
         | 38 |  |  |  
 | 
      
         | 39 |  |  | --  Any changes to this interface may require corresponding compiler changes
 | 
      
         | 40 |  |  | --  in exp_ch9.adb and possibly exp_ch7.adb
 | 
      
         | 41 |  |  |  
 | 
      
         | 42 |  |  | with System.Task_Info;
 | 
      
         | 43 |  |  | with System.Parameters;
 | 
      
         | 44 |  |  |  
 | 
      
         | 45 |  |  | with Ada.Real_Time;
 | 
      
         | 46 |  |  |  
 | 
      
         | 47 |  |  | package System.Tasking.Stages is
 | 
      
         | 48 |  |  |    pragma Elaborate_Body;
 | 
      
         | 49 |  |  |  
 | 
      
         | 50 |  |  |    --   The compiler will expand in the GNAT tree the following construct:
 | 
      
         | 51 |  |  |  
 | 
      
         | 52 |  |  |    --   task type T (Discr : Integer);
 | 
      
         | 53 |  |  |  
 | 
      
         | 54 |  |  |    --   task body T is
 | 
      
         | 55 |  |  |    --      ...declarations, possibly some controlled...
 | 
      
         | 56 |  |  |    --   begin
 | 
      
         | 57 |  |  |    --      ...B...;
 | 
      
         | 58 |  |  |    --   end T;
 | 
      
         | 59 |  |  |  
 | 
      
         | 60 |  |  |    --   T1 : T (1);
 | 
      
         | 61 |  |  |  
 | 
      
         | 62 |  |  |    --  as follows:
 | 
      
         | 63 |  |  |  
 | 
      
         | 64 |  |  |    --   enter_master.all;
 | 
      
         | 65 |  |  |  
 | 
      
         | 66 |  |  |    --   _chain : aliased activation_chain;
 | 
      
         | 67 |  |  |    --   activation_chainIP (_chain);
 | 
      
         | 68 |  |  |  
 | 
      
         | 69 |  |  |    --   task type t (discr : integer);
 | 
      
         | 70 |  |  |    --   tE : aliased boolean := false;
 | 
      
         | 71 |  |  |    --   tZ : size_type := unspecified_size;
 | 
      
         | 72 |  |  |    --   type tV (discr : integer) is limited record
 | 
      
         | 73 |  |  |    --      _task_id : task_id;
 | 
      
         | 74 |  |  |    --   end record;
 | 
      
         | 75 |  |  |    --   procedure tB (_task : access tV);
 | 
      
         | 76 |  |  |    --   freeze tV [
 | 
      
         | 77 |  |  |    --      procedure tVIP (_init : in out tV; _master : master_id;
 | 
      
         | 78 |  |  |    --        _chain : in out activation_chain; _task_id : in task_image_type;
 | 
      
         | 79 |  |  |    --        discr : integer) is
 | 
      
         | 80 |  |  |    --      begin
 | 
      
         | 81 |  |  |    --         _init.discr := discr;
 | 
      
         | 82 |  |  |    --         _init._task_id := null;
 | 
      
         | 83 |  |  |    --         create_task (unspecified_priority, tZ,
 | 
      
         | 84 |  |  |    --           unspecified_task_info, unspecified_cpu,
 | 
      
         | 85 |  |  |    --           ada__real_time__time_span_zero, 0, _master,
 | 
      
         | 86 |  |  |    --           task_procedure_access!(tB'address), _init'address,
 | 
      
         | 87 |  |  |    --           tE'unchecked_access, _chain, _task_id, _init._task_id);
 | 
      
         | 88 |  |  |    --         return;
 | 
      
         | 89 |  |  |    --      end tVIP;
 | 
      
         | 90 |  |  |    --   ]
 | 
      
         | 91 |  |  |  
 | 
      
         | 92 |  |  |    --   procedure tB (_task : access tV) is
 | 
      
         | 93 |  |  |    --      discr : integer renames _task.discr;
 | 
      
         | 94 |  |  |  
 | 
      
         | 95 |  |  |    --      procedure _clean is
 | 
      
         | 96 |  |  |    --      begin
 | 
      
         | 97 |  |  |    --         abort_defer.all;
 | 
      
         | 98 |  |  |    --         complete_task;
 | 
      
         | 99 |  |  |    --         finalize_list (F14b);
 | 
      
         | 100 |  |  |    --         abort_undefer.all;
 | 
      
         | 101 |  |  |    --         return;
 | 
      
         | 102 |  |  |    --      end _clean;
 | 
      
         | 103 |  |  |    --   begin
 | 
      
         | 104 |  |  |    --      abort_undefer.all;
 | 
      
         | 105 |  |  |    --      ...declarations...
 | 
      
         | 106 |  |  |    --      complete_activation;
 | 
      
         | 107 |  |  |    --      ...B...;
 | 
      
         | 108 |  |  |    --      return;
 | 
      
         | 109 |  |  |    --   at end
 | 
      
         | 110 |  |  |    --      _clean;
 | 
      
         | 111 |  |  |    --   end tB;
 | 
      
         | 112 |  |  |  
 | 
      
         | 113 |  |  |    --   tE := true;
 | 
      
         | 114 |  |  |    --   t1 : t (1);
 | 
      
         | 115 |  |  |    --   _master : constant master_id := current_master.all;
 | 
      
         | 116 |  |  |    --   t1S : task_image_type := new string'"t1";
 | 
      
         | 117 |  |  |    --   task_image_typeIP (t1, _master, _chain, t1S, 1);
 | 
      
         | 118 |  |  |  
 | 
      
         | 119 |  |  |    --   activate_tasks (_chain'unchecked_access);
 | 
      
         | 120 |  |  |  
 | 
      
         | 121 |  |  |    procedure Abort_Tasks (Tasks : Task_List);
 | 
      
         | 122 |  |  |    --  Compiler interface only. Do not call from within the RTS. Initiate
 | 
      
         | 123 |  |  |    --  abort, however, the actual abort is done by abortee by means of
 | 
      
         | 124 |  |  |    --  Abort_Handler and Abort_Undefer
 | 
      
         | 125 |  |  |    --
 | 
      
         | 126 |  |  |    --  source code:
 | 
      
         | 127 |  |  |    --     Abort T1, T2;
 | 
      
         | 128 |  |  |    --  code expansion:
 | 
      
         | 129 |  |  |    --     abort_tasks (task_list'(t1._task_id, t2._task_id));
 | 
      
         | 130 |  |  |  
 | 
      
         | 131 |  |  |    procedure Activate_Tasks (Chain_Access : Activation_Chain_Access);
 | 
      
         | 132 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 133 |  |  |    --  This must be called by the creator of a chain of one or more new tasks,
 | 
      
         | 134 |  |  |    --  to activate them. The chain is a linked list that up to this point is
 | 
      
         | 135 |  |  |    --  only known to the task that created them, though the individual tasks
 | 
      
         | 136 |  |  |    --  are already in the All_Tasks_List.
 | 
      
         | 137 |  |  |    --
 | 
      
         | 138 |  |  |    --  The compiler builds the chain in LIFO order (as a stack). Another
 | 
      
         | 139 |  |  |    --  version of this procedure had code to reverse the chain, so as to
 | 
      
         | 140 |  |  |    --  activate the tasks in the order of declaration. This might be nice, but
 | 
      
         | 141 |  |  |    --  it is not needed if priority-based scheduling is supported, since all
 | 
      
         | 142 |  |  |    --  the activated tasks synchronize on the activators lock before they
 | 
      
         | 143 |  |  |    --  start activating and so they should start activating in priority order.
 | 
      
         | 144 |  |  |    --  ??? Actually, the body of this package DOES reverse the chain, so I
 | 
      
         | 145 |  |  |    --  don't understand the above comment.
 | 
      
         | 146 |  |  |  
 | 
      
         | 147 |  |  |    procedure Complete_Activation;
 | 
      
         | 148 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 149 |  |  |    --  This should be called from the task body at the end of
 | 
      
         | 150 |  |  |    --  the elaboration code for its declarative part.
 | 
      
         | 151 |  |  |    --  Decrement the count of tasks to be activated by the activator and
 | 
      
         | 152 |  |  |    --  wake it up so it can check to see if all tasks have been activated.
 | 
      
         | 153 |  |  |    --  Except for the environment task, which should never call this procedure,
 | 
      
         | 154 |  |  |    --  T.Activator should only be null iff T has completed activation.
 | 
      
         | 155 |  |  |  
 | 
      
         | 156 |  |  |    procedure Complete_Master;
 | 
      
         | 157 |  |  |    --  Compiler interface only.  Do not call from within the RTS. This must
 | 
      
         | 158 |  |  |    --  be called on exit from any master where Enter_Master was called.
 | 
      
         | 159 |  |  |    --  Assume abort is deferred at this point.
 | 
      
         | 160 |  |  |  
 | 
      
         | 161 |  |  |    procedure Complete_Task;
 | 
      
         | 162 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 163 |  |  |    --  This should be called from an implicit at-end handler
 | 
      
         | 164 |  |  |    --  associated with the task body, when it completes.
 | 
      
         | 165 |  |  |    --  From this point, the current task will become not callable.
 | 
      
         | 166 |  |  |    --  If the current task have not completed activation, this should be done
 | 
      
         | 167 |  |  |    --  now in order to wake up the activator (the environment task).
 | 
      
         | 168 |  |  |  
 | 
      
         | 169 |  |  |    procedure Create_Task
 | 
      
         | 170 |  |  |      (Priority          : Integer;
 | 
      
         | 171 |  |  |       Size              : System.Parameters.Size_Type;
 | 
      
         | 172 |  |  |       Task_Info         : System.Task_Info.Task_Info_Type;
 | 
      
         | 173 |  |  |       CPU               : Integer;
 | 
      
         | 174 |  |  |       Relative_Deadline : Ada.Real_Time.Time_Span;
 | 
      
         | 175 |  |  |       Domain            : Dispatching_Domain_Access;
 | 
      
         | 176 |  |  |       Num_Entries       : Task_Entry_Index;
 | 
      
         | 177 |  |  |       Master            : Master_Level;
 | 
      
         | 178 |  |  |       State             : Task_Procedure_Access;
 | 
      
         | 179 |  |  |       Discriminants     : System.Address;
 | 
      
         | 180 |  |  |       Elaborated        : Access_Boolean;
 | 
      
         | 181 |  |  |       Chain             : in out Activation_Chain;
 | 
      
         | 182 |  |  |       Task_Image        : String;
 | 
      
         | 183 |  |  |       Created_Task      : out Task_Id;
 | 
      
         | 184 |  |  |       Build_Entry_Names : Boolean);
 | 
      
         | 185 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 186 |  |  |    --  This must be called to create a new task.
 | 
      
         | 187 |  |  |    --
 | 
      
         | 188 |  |  |    --  Priority is the task's priority (assumed to be in range of type
 | 
      
         | 189 |  |  |    --   System.Any_Priority)
 | 
      
         | 190 |  |  |    --  Size is the stack size of the task to create
 | 
      
         | 191 |  |  |    --  Task_Info is the task info associated with the created task, or
 | 
      
         | 192 |  |  |    --   Unspecified_Task_Info if none.
 | 
      
         | 193 |  |  |    --  CPU is the task affinity. Passed as an Integer because the undefined
 | 
      
         | 194 |  |  |    --   value is not in the range of CPU_Range. Static range checks are
 | 
      
         | 195 |  |  |    --   performed when analyzing the pragma, and dynamic ones are performed
 | 
      
         | 196 |  |  |    --   before setting the affinity at run time.
 | 
      
         | 197 |  |  |    --  Relative_Deadline is the relative deadline associated with the created
 | 
      
         | 198 |  |  |    --   task by means of a pragma Relative_Deadline, or 0.0 if none.
 | 
      
         | 199 |  |  |    --  Domain is the dispatching domain associated with the created task by
 | 
      
         | 200 |  |  |    --   means of a Dispatching_Domain pragma or aspect, or null if none.
 | 
      
         | 201 |  |  |    --  State is the compiler generated task's procedure body
 | 
      
         | 202 |  |  |    --  Discriminants is a pointer to a limited record whose discriminants
 | 
      
         | 203 |  |  |    --   are those of the task to create. This parameter should be passed as
 | 
      
         | 204 |  |  |    --   the single argument to State.
 | 
      
         | 205 |  |  |    --  Elaborated is a pointer to a Boolean that must be set to true on exit
 | 
      
         | 206 |  |  |    --   if the task could be successfully elaborated.
 | 
      
         | 207 |  |  |    --  Chain is a linked list of task that needs to be created. On exit,
 | 
      
         | 208 |  |  |    --   Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID
 | 
      
         | 209 |  |  |    --   will be Created_Task (e.g the created task will be linked at the front
 | 
      
         | 210 |  |  |    --   of Chain).
 | 
      
         | 211 |  |  |    --  Task_Image is a string created by the compiler that the
 | 
      
         | 212 |  |  |    --   run time can store to ease the debugging and the
 | 
      
         | 213 |  |  |    --   Ada.Task_Identification facility.
 | 
      
         | 214 |  |  |    --  Created_Task is the resulting task.
 | 
      
         | 215 |  |  |    --  Build_Entry_Names is a flag which controls the allocation of the data
 | 
      
         | 216 |  |  |    --   structure which stores all entry names.
 | 
      
         | 217 |  |  |    --
 | 
      
         | 218 |  |  |    --  This procedure can raise Storage_Error if the task creation failed.
 | 
      
         | 219 |  |  |  
 | 
      
         | 220 |  |  |    function Current_Master return Master_Level;
 | 
      
         | 221 |  |  |    --  Compiler interface only.
 | 
      
         | 222 |  |  |    --  This is called to obtain the current master nesting level.
 | 
      
         | 223 |  |  |  
 | 
      
         | 224 |  |  |    procedure Enter_Master;
 | 
      
         | 225 |  |  |    --  Compiler interface only.  Do not call from within the RTS.
 | 
      
         | 226 |  |  |    --  This must be called on entry to any "master" where a task,
 | 
      
         | 227 |  |  |    --  or access type designating objects containing tasks, may be
 | 
      
         | 228 |  |  |    --  declared.
 | 
      
         | 229 |  |  |  
 | 
      
         | 230 |  |  |    procedure Expunge_Unactivated_Tasks (Chain : in out Activation_Chain);
 | 
      
         | 231 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 232 |  |  |    --  This must be called by the compiler-generated code for an allocator if
 | 
      
         | 233 |  |  |    --  the allocated object contains tasks, if the allocator exits without
 | 
      
         | 234 |  |  |    --  calling Activate_Tasks for a given activation chains, as can happen if
 | 
      
         | 235 |  |  |    --  an exception occurs during initialization of the object.
 | 
      
         | 236 |  |  |    --
 | 
      
         | 237 |  |  |    --  This should be called ONLY for tasks created via an allocator. Recovery
 | 
      
         | 238 |  |  |    --  of storage for unactivated local task declarations is done by
 | 
      
         | 239 |  |  |    --  Complete_Master and Complete_Task.
 | 
      
         | 240 |  |  |    --
 | 
      
         | 241 |  |  |    --  We remove each task from Chain and All_Tasks_List before we free the
 | 
      
         | 242 |  |  |    --  storage of its ATCB.
 | 
      
         | 243 |  |  |    --
 | 
      
         | 244 |  |  |    --  In other places where we recover the storage of unactivated tasks, we
 | 
      
         | 245 |  |  |    --  need to clean out the entry queues, but here that should not be
 | 
      
         | 246 |  |  |    --  necessary, since these tasks should not have been visible to any other
 | 
      
         | 247 |  |  |    --  tasks, and so no task should be able to queue a call on their entries.
 | 
      
         | 248 |  |  |    --
 | 
      
         | 249 |  |  |    --  Just in case somebody misuses this subprogram, there is a check to
 | 
      
         | 250 |  |  |    --  verify this condition.
 | 
      
         | 251 |  |  |  
 | 
      
         | 252 |  |  |    procedure Finalize_Global_Tasks;
 | 
      
         | 253 |  |  |    --  This should be called to complete the execution of the environment task
 | 
      
         | 254 |  |  |    --  and shut down the tasking runtime system. It is the equivalent of
 | 
      
         | 255 |  |  |    --  Complete_Task, but for the environment task.
 | 
      
         | 256 |  |  |    --
 | 
      
         | 257 |  |  |    --  The environment task must first call Complete_Master, to wait for user
 | 
      
         | 258 |  |  |    --  tasks that depend on library-level packages to terminate. It then calls
 | 
      
         | 259 |  |  |    --  Abort_Dependents to abort the "independent" library-level server tasks
 | 
      
         | 260 |  |  |    --  that are created implicitly by the RTS packages (signal and timer server
 | 
      
         | 261 |  |  |    --  tasks), and then waits for them to terminate. Then, it calls
 | 
      
         | 262 |  |  |    --  Vulnerable_Complete_Task.
 | 
      
         | 263 |  |  |    --
 | 
      
         | 264 |  |  |    --  It currently also executes the global finalization list, and then resets
 | 
      
         | 265 |  |  |    --  the "soft links".
 | 
      
         | 266 |  |  |  
 | 
      
         | 267 |  |  |    procedure Free_Task (T : Task_Id);
 | 
      
         | 268 |  |  |    --  Recover all runtime system storage associated with the task T, but only
 | 
      
         | 269 |  |  |    --  if T has terminated. Do nothing in the other case. It is called from
 | 
      
         | 270 |  |  |    --  Unchecked_Deallocation, for objects that are or contain tasks.
 | 
      
         | 271 |  |  |  
 | 
      
         | 272 |  |  |    procedure Move_Activation_Chain
 | 
      
         | 273 |  |  |      (From, To   : Activation_Chain_Access;
 | 
      
         | 274 |  |  |       New_Master : Master_ID);
 | 
      
         | 275 |  |  |    --  Compiler interface only. Do not call from within the RTS.
 | 
      
         | 276 |  |  |    --  Move all tasks on From list to To list, and change their Master_of_Task
 | 
      
         | 277 |  |  |    --  to be New_Master. This is used to implement build-in-place function
 | 
      
         | 278 |  |  |    --  returns. Tasks that are part of the return object are initially placed
 | 
      
         | 279 |  |  |    --  on an activation chain local to the return statement, and their master
 | 
      
         | 280 |  |  |    --  is the return statement, in case the return statement is left
 | 
      
         | 281 |  |  |    --  prematurely (due to raising an exception, being aborted, or a goto or
 | 
      
         | 282 |  |  |    --  exit statement). Once the return statement has completed successfully,
 | 
      
         | 283 |  |  |    --  Move_Activation_Chain is called to move them to the caller's activation
 | 
      
         | 284 |  |  |    --  chain, and change their master to the one passed in by the caller. If
 | 
      
         | 285 |  |  |    --  that doesn't happen, they will never be activated, and will become
 | 
      
         | 286 |  |  |    --  terminated on leaving the return statement.
 | 
      
         | 287 |  |  |  
 | 
      
         | 288 |  |  |    procedure Set_Entry_Name
 | 
      
         | 289 |  |  |      (T   : Task_Id;
 | 
      
         | 290 |  |  |       Pos : Task_Entry_Index;
 | 
      
         | 291 |  |  |       Val : String_Access);
 | 
      
         | 292 |  |  |    --  This is called by the compiler to map a string which denotes an entry
 | 
      
         | 293 |  |  |    --  name to a task entry index.
 | 
      
         | 294 |  |  |  
 | 
      
         | 295 |  |  |    function Terminated (T : Task_Id) return Boolean;
 | 
      
         | 296 |  |  |    --  This is called by the compiler to implement the 'Terminated attribute.
 | 
      
         | 297 |  |  |    --  Though is not required to be so by the ARM, we choose to synchronize
 | 
      
         | 298 |  |  |    --  with the task's ATCB, so that this is more useful for polling the state
 | 
      
         | 299 |  |  |    --  of a task, and so that it becomes an abort completion point for the
 | 
      
         | 300 |  |  |    --  calling task (via Undefer_Abort).
 | 
      
         | 301 |  |  |    --
 | 
      
         | 302 |  |  |    --  source code:
 | 
      
         | 303 |  |  |    --     T1'Terminated
 | 
      
         | 304 |  |  |    --
 | 
      
         | 305 |  |  |    --  code expansion:
 | 
      
         | 306 |  |  |    --     terminated (t1._task_id)
 | 
      
         | 307 |  |  |  
 | 
      
         | 308 |  |  |    procedure Terminate_Task (Self_ID : Task_Id);
 | 
      
         | 309 |  |  |    --  Terminate the calling task.
 | 
      
         | 310 |  |  |    --  This should only be called by the Task_Wrapper procedure, and to
 | 
      
         | 311 |  |  |    --  deallocate storage associate with foreign tasks.
 | 
      
         | 312 |  |  |  
 | 
      
         | 313 |  |  | end System.Tasking.Stages;
 |