File : s-tarest-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 . R E S T R I C T E D . S T A G E S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2014, 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. 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 -- 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 a simplified version of the System.Tasking.Stages package, for use
33 -- with the ravenscar/HI-E profile.
34
35 -- This package represents the high level tasking interface used by the
36 -- compiler to expand Ada 95 tasking constructs into simpler run time calls.
37
38 pragma Style_Checks (All_Checks);
39 -- Turn off subprogram alpha order check, since we group soft link bodies and
40 -- also separate off subprograms for restricted GNARLI.
41
42 pragma Polling (Off);
43 -- Turn off polling, we do not want ATC polling to take place during
44 -- tasking operations. It causes infinite loops and other problems.
45
46 with System.Task_Primitives.Operations;
47 -- used for Enter_Task
48 -- Wakeup
49 -- Get_Priority
50 -- Set_Priority
51 -- Sleep
52
53 with System.Secondary_Stack;
54 -- used for SS_Init
55 -- Default_Secondary_Stack_Size
56
57 with System.Storage_Elements;
58 -- used for Storage_Array
59
60 package body System.Tasking.Restricted.Stages is
61
62 use System.Secondary_Stack;
63 use System.Task_Primitives.Operations;
64 use System.Task_Info;
65
66 Tasks_Activation_Chain : Task_Id;
67 -- Chain of all the tasks to activate, when the sequential elaboration
68 -- policy is used
69
70 -----------------------
71 -- Local Subprograms --
72 -----------------------
73
74 procedure Activate_Tasks (Chain : Task_Id);
75 -- Activate the list of tasks started by Chain
76
77 procedure Create_Restricted_Task
78 (Priority : Integer;
79 Stack_Address : System.Address;
80 Size : System.Parameters.Size_Type;
81 Task_Info : System.Task_Info.Task_Info_Type;
82 CPU : Integer;
83 State : Task_Procedure_Access;
84 Discriminants : System.Address;
85 Created_Task : Task_Id);
86 -- Code shared between Create_Restricted_Task (the concurrent version) and
87 -- Create_Restricted_Task_Sequential. See comment of the former in the
88 -- specification of this package.
89
90 procedure Task_Wrapper (Self_ID : Task_Id);
91 -- This is the procedure that is called by the GNULL from the new context
92 -- when a task is created. It waits for activation and then calls the task
93 -- body procedure. When the task body procedure completes, it terminates
94 -- the task.
95
96 ------------------
97 -- Task_Wrapper --
98 ------------------
99
100 -- The task wrapper is a procedure that is called first for each task
101 -- task body, and which in turn calls the compiler-generated task body
102 -- procedure. The wrapper's main job is to do initialization for the task.
103
104 -- The variable ID in the task wrapper is used to implement the Self
105 -- function on targets where there is a fast way to find the stack
106 -- base of the current thread, since it should be at a fixed offset
107 -- from the stack base.
108
109 procedure Task_Wrapper (Self_ID : Task_Id) is
110 use type System.Storage_Elements.Storage_Offset;
111
112 Sec_Stack_Size : constant Storage_Elements.Storage_Offset :=
113 Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size
114 * SSE.Storage_Offset
115 (Parameters.Sec_Stack_Percentage)
116 / 100;
117
118 Secondary_Stack : aliased Storage_Elements.Storage_Array
119 (1 .. Sec_Stack_Size);
120 for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
121 -- This is the secondary stack data. Note that it is critical that this
122 -- have maximum alignment, since any kind of data can be allocated here.
123
124 TH : Termination_Handler := null;
125
126 begin
127 Self_ID.Common.Compiler_Data.Sec_Stack_Addr := Secondary_Stack'Address;
128 SS_Init (Secondary_Stack'Address, Integer (Sec_Stack_Size));
129
130 -- Initialize low-level TCB components, that cannot be initialized by
131 -- the creator.
132
133 Enter_Task (Self_ID);
134
135 -- Call the task body procedure
136
137 Self_ID.Common.Task_Entry_Point (Self_ID.Common.Task_Arg);
138
139 -- Look for a fall-back handler. There is a single task termination
140 -- procedure for all the tasks in the partition.
141
142 -- This package is part of the restricted run time which supports
143 -- neither task hierarchies (No_Task_Hierarchy) nor specific task
144 -- termination handlers (No_Specific_Termination_Handlers).
145
146 -- Raise the priority to prevent race conditions when using
147 -- System.Tasking.Fall_Back_Handler.
148
149 Set_Priority (Self_ID, Any_Priority'Last);
150
151 TH := System.Tasking.Fall_Back_Handler;
152
153 -- Restore original priority after retrieving shared data
154
155 Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
156
157 -- Execute the task termination handler if we found it
158
159 if TH /= null then
160 TH.all (Self_ID);
161 end if;
162
163 -- We used to raise a Program_Error here to signal the task termination
164 -- event in order to avoid silent task death. It has been removed
165 -- because the Ada.Task_Termination functionality serves the same
166 -- purpose in a more flexible (and standard) way. In addition, this
167 -- exception triggered a second execution of the termination handler
168 -- (if any was installed). We simply ensure that the task does not
169 -- execute any more.
170
171 Sleep (Self_ID, Terminated);
172 end Task_Wrapper;
173
174 -----------------------
175 -- Restricted GNARLI --
176 -----------------------
177
178 -----------------------------------
179 -- Activate_All_Tasks_Sequential --
180 -----------------------------------
181
182 procedure Activate_All_Tasks_Sequential is
183 begin
184 pragma Assert (Partition_Elaboration_Policy = 'S');
185 Activate_Tasks (Tasks_Activation_Chain);
186 Tasks_Activation_Chain := Null_Task;
187 end Activate_All_Tasks_Sequential;
188
189 -------------------------------
190 -- Activate_Restricted_Tasks --
191 -------------------------------
192
193 procedure Activate_Restricted_Tasks
194 (Chain_Access : Activation_Chain_Access) is
195 begin
196 if Partition_Elaboration_Policy = 'S' then
197
198 -- In sequential elaboration policy, the chain must be empty. This
199 -- procedure can be called if the unit has been compiled without
200 -- partition elaboration policy, but the partition has a sequential
201 -- elaboration policy.
202
203 pragma Assert (Chain_Access.T_ID = Null_Task);
204 null;
205 else
206 Activate_Tasks (Chain_Access.T_ID);
207 Chain_Access.T_ID := Null_Task;
208 end if;
209 end Activate_Restricted_Tasks;
210
211 --------------------
212 -- Activate_Tasks --
213 --------------------
214
215 procedure Activate_Tasks (Chain : Task_Id) is
216 Self_ID : constant Task_Id := Task_Primitives.Operations.Self;
217 C : Task_Id;
218 Next_C : Task_Id;
219 Success : Boolean;
220
221 begin
222 -- Raise the priority to prevent activated tasks from racing ahead
223 -- before we finish activating the chain.
224
225 Set_Priority (Self_ID, System.Any_Priority'Last);
226
227 -- Activate all the tasks in the chain
228
229 -- Creation of the thread of control was deferred until activation.
230 -- So create it now.
231
232 -- Note that since all created tasks will be blocked trying to get our
233 -- (environment task) lock, there is no need to lock C here.
234
235 C := Chain;
236 while C /= Null_Task loop
237 Next_C := C.Common.Activation_Link;
238
239 C.Common.Activation_Link := null;
240
241 Task_Primitives.Operations.Create_Task
242 (T => C,
243 Wrapper => Task_Wrapper'Address,
244 Stack_Size => Parameters.Size_Type
245 (C.Common.Compiler_Data.Pri_Stack_Info.Size),
246 Priority => C.Common.Base_Priority,
247 Base_CPU => C.Common.Base_CPU,
248 Succeeded => Success);
249
250 if Success then
251 C.Common.State := Runnable;
252 else
253 raise Program_Error;
254 end if;
255
256 C := Next_C;
257 end loop;
258
259 Self_ID.Common.State := Runnable;
260
261 -- Restore the original priority
262
263 Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
264 end Activate_Tasks;
265
266 ------------------------------------
267 -- Complete_Restricted_Activation --
268 ------------------------------------
269
270 procedure Complete_Restricted_Activation is
271 begin
272 -- Nothing to be done
273
274 null;
275 end Complete_Restricted_Activation;
276
277 ------------------------------
278 -- Complete_Restricted_Task --
279 ------------------------------
280
281 procedure Complete_Restricted_Task is
282 begin
283 -- Mark the task as terminated. Do not suspend the task now
284 -- because we need to allow for the task termination procedure
285 -- to execute (if needed) in the Task_Wrapper.
286
287 Task_Primitives.Operations.Self.Common.State := Terminated;
288 end Complete_Restricted_Task;
289
290 ----------------------------
291 -- Create_Restricted_Task --
292 ----------------------------
293
294 procedure Create_Restricted_Task
295 (Priority : Integer;
296 Stack_Address : System.Address;
297 Size : System.Parameters.Size_Type;
298 Task_Info : System.Task_Info.Task_Info_Type;
299 CPU : Integer;
300 State : Task_Procedure_Access;
301 Discriminants : System.Address;
302 Created_Task : Task_Id)
303 is
304 Base_Priority : System.Any_Priority;
305 Base_CPU : System.Multiprocessors.CPU_Range;
306 Success : Boolean;
307
308 begin
309 Base_Priority :=
310 (if Priority = Unspecified_Priority
311 then System.Default_Priority
312 else System.Any_Priority (Priority));
313
314 -- Legal values of CPU are the special Unspecified_CPU value which is
315 -- inserted by the compiler for tasks without CPU aspect, and those in
316 -- the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
317 -- the task is defined to have failed, and it becomes a completed task
318 -- (RM D.16(14/3)).
319
320 if CPU /= Unspecified_CPU
321 and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
322 or else
323 CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
324 then
325 raise Tasking_Error with "CPU not in range";
326
327 -- Normal CPU affinity
328
329 else
330 -- When the application code says nothing about the task affinity
331 -- (task without CPU aspect) then the compiler inserts the
332 -- Unspecified_CPU value which indicates to the run-time library that
333 -- the task will activate and execute on the same processor as its
334 -- activating task if the activating task is assigned a processor
335 -- (RM D.16(14/3)).
336
337 Base_CPU :=
338 (if CPU = Unspecified_CPU
339 then Self.Common.Base_CPU
340 else System.Multiprocessors.CPU_Range (CPU));
341 end if;
342
343 -- No need to lock Self_ID here, since only environment task is running
344
345 Initialize_ATCB
346 (State, Discriminants, Base_Priority, Base_CPU,
347 Task_Info, Stack_Address, Size, Created_Task, Success);
348
349 if not Success then
350 raise Program_Error;
351 end if;
352
353 Created_Task.Entry_Call.Self := Created_Task;
354 end Create_Restricted_Task;
355
356 procedure Create_Restricted_Task
357 (Priority : Integer;
358 Stack_Address : System.Address;
359 Size : System.Parameters.Size_Type;
360 Task_Info : System.Task_Info.Task_Info_Type;
361 CPU : Integer;
362 State : Task_Procedure_Access;
363 Discriminants : System.Address;
364 Elaborated : Access_Boolean;
365 Chain : in out Activation_Chain;
366 Task_Image : String;
367 Created_Task : Task_Id)
368 is
369 begin
370 if Partition_Elaboration_Policy = 'S' then
371
372 -- A unit may have been compiled without partition elaboration
373 -- policy, and in this case the compiler will emit calls for the
374 -- default policy (concurrent). But if the partition policy is
375 -- sequential, activation must be deferred.
376
377 Create_Restricted_Task_Sequential
378 (Priority, Stack_Address, Size, Task_Info, CPU, State,
379 Discriminants, Elaborated, Task_Image, Created_Task);
380
381 else
382 Create_Restricted_Task
383 (Priority, Stack_Address, Size, Task_Info, CPU, State,
384 Discriminants, Created_Task);
385
386 -- Append this task to the activation chain
387
388 Created_Task.Common.Activation_Link := Chain.T_ID;
389 Chain.T_ID := Created_Task;
390 end if;
391 end Create_Restricted_Task;
392
393 ---------------------------------------
394 -- Create_Restricted_Task_Sequential --
395 ---------------------------------------
396
397 procedure Create_Restricted_Task_Sequential
398 (Priority : Integer;
399 Stack_Address : System.Address;
400 Size : System.Parameters.Size_Type;
401 Task_Info : System.Task_Info.Task_Info_Type;
402 CPU : Integer;
403 State : Task_Procedure_Access;
404 Discriminants : System.Address;
405 Elaborated : Access_Boolean;
406 Task_Image : String;
407 Created_Task : Task_Id)
408 is
409 pragma Unreferenced (Task_Image, Elaborated);
410
411 begin
412 Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info,
413 CPU, State, Discriminants, Created_Task);
414
415 -- Append this task to the activation chain
416
417 Created_Task.Common.Activation_Link := Tasks_Activation_Chain;
418 Tasks_Activation_Chain := Created_Task;
419 end Create_Restricted_Task_Sequential;
420
421 ---------------------------
422 -- Finalize_Global_Tasks --
423 ---------------------------
424
425 -- Dummy version since this procedure is not used in true ravenscar mode
426
427 procedure Finalize_Global_Tasks is
428 begin
429 raise Program_Error;
430 end Finalize_Global_Tasks;
431
432 ---------------------------
433 -- Restricted_Terminated --
434 ---------------------------
435
436 function Restricted_Terminated (T : Task_Id) return Boolean is
437 begin
438 return T.Common.State = Terminated;
439 end Restricted_Terminated;
440
441 begin
442 Tasking.Initialize;
443 end System.Tasking.Restricted.Stages;