File : s-taprop-xi.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S --
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 ------------------------------------------------------------------------------
28
29 -- This is the generic bare board version of this package
30
31 -- This package contains all the GNULL primitives that interface directly with
32 -- the underlying kernel.
33
34 pragma Restrictions (No_Elaboration_Code);
35
36 with Ada.Unchecked_Conversion;
37
38 with System.Storage_Elements;
39 with System.Tasking.Debug;
40 with System.Task_Info;
41
42 package body System.Task_Primitives.Operations is
43
44 use System.OS_Interface;
45 use System.Parameters;
46 use System.Storage_Elements;
47 use System.Multiprocessors;
48
49 use type System.Tasking.Task_Id;
50
51 ---------------------
52 -- Local Functions --
53 ---------------------
54
55 function To_Address is new
56 Ada.Unchecked_Conversion (ST.Task_Id, System.Address);
57
58 function To_Task_Id is new
59 Ada.Unchecked_Conversion (System.Address, ST.Task_Id);
60
61 procedure Initialize_Idle (CPU_Id : CPU);
62 -- Initialize an Idle task for CPU_ID
63
64 procedure Initialize_Slave (CPU_Id : System.Multiprocessors.CPU);
65 pragma Export (Asm, Initialize_Slave, "__gnat_initialize_slave");
66 -- Initialize a fake environment task for the current CPU. This fake task
67 -- is used to give a context during interrupt handling if the CPU doesn't
68 -- have a regular task.
69
70 procedure Idle (Param : Address);
71 -- Procedure executed by an idle task
72
73 Idle_Stack_Size : constant System.Storage_Elements.Storage_Count :=
74 (2048 / Standard'Maximum_Alignment) * Standard'Maximum_Alignment;
75 -- 2 KB stacks for each of the idle tasks
76
77 type Idle_Stack_Space is
78 new Storage_Elements.Storage_Array (1 .. Idle_Stack_Size);
79 for Idle_Stack_Space'Alignment use Standard'Maximum_Alignment;
80 -- Stack for idle tasks
81
82 Idle_Stacks : array (CPU) of Idle_Stack_Space;
83 -- Array that contains the stack space for idle tasks
84
85 Idle_Stacks_Table : array (CPU) of System.Address;
86 pragma Export (Asm, Idle_Stacks_Table, "__gnat_idle_stack_table");
87 -- Array that contains the stack pointers for idle tasks
88
89 Idle_Tasks : array (Multiprocessors.CPU) of
90 aliased Tasking.Ada_Task_Control_Block (Entry_Num => 0);
91 -- ATCB for the idle tasks. They are used to put the cpu in idle mode,
92 -- and for slave cpus, they are also present to correctly handle interrupts
93 -- (changing the current priority).
94
95 ----------
96 -- Self --
97 ----------
98
99 function Self return ST.Task_Id is
100 begin
101 return To_Task_Id (System.OS_Interface.Get_ATCB);
102 end Self;
103
104 -----------
105 -- Sleep --
106 -----------
107
108 procedure Sleep
109 (Self_ID : ST.Task_Id;
110 Reason : System.Tasking.Task_States)
111 is
112 pragma Unreferenced (Reason);
113 begin
114 -- A task can only suspend itself
115
116 pragma Assert (Self_ID = Self);
117
118 System.OS_Interface.Sleep;
119 end Sleep;
120
121 -----------------
122 -- Delay_Until --
123 -----------------
124
125 procedure Delay_Until (Abs_Time : Time) is
126 Self_ID : constant ST.Task_Id := Self;
127 begin
128 Self_ID.Common.State := ST.Delay_Sleep;
129 System.OS_Interface.Delay_Until (System.OS_Interface.Time (Abs_Time));
130 Self_ID.Common.State := ST.Runnable;
131 end Delay_Until;
132
133 ---------------------
134 -- Monotonic_Clock --
135 ---------------------
136
137 function Monotonic_Clock return Time is
138 begin
139 return Time (System.OS_Interface.Clock);
140 end Monotonic_Clock;
141
142 ------------
143 -- Wakeup --
144 ------------
145
146 procedure Wakeup (T : ST.Task_Id; Reason : System.Tasking.Task_States) is
147 pragma Unreferenced (Reason);
148 begin
149 System.OS_Interface.Wakeup (T.Common.LL.Thread);
150 end Wakeup;
151
152 ------------------
153 -- Set_Priority --
154 ------------------
155
156 procedure Set_Priority (T : ST.Task_Id; Prio : ST.Extended_Priority) is
157 begin
158 -- A task can only change its own priority
159
160 pragma Assert (T = Self);
161
162 -- Change the priority in the underlying executive
163
164 System.OS_Interface.Set_Priority (Prio);
165 end Set_Priority;
166
167 ------------------
168 -- Get_Priority --
169 ------------------
170
171 function Get_Priority (T : ST.Task_Id) return ST.Extended_Priority is
172 begin
173 -- Get current active priority
174
175 return System.OS_Interface.Get_Priority (T.Common.LL.Thread);
176 end Get_Priority;
177
178 ------------------
179 -- Get_Affinity --
180 ------------------
181
182 function Get_Affinity
183 (T : ST.Task_Id) return System.Multiprocessors.CPU_Range
184 is
185 begin
186 return System.OS_Interface.Get_Affinity (T.Common.LL.Thread);
187 end Get_Affinity;
188
189 -------------
190 -- Get_CPU --
191 -------------
192
193 function Get_CPU (T : ST.Task_Id) return System.Multiprocessors.CPU is
194 begin
195
196 return System.OS_Interface.Get_CPU (T.Common.LL.Thread);
197 end Get_CPU;
198
199 -------------------
200 -- Get_Thread_Id --
201 -------------------
202
203 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
204 begin
205 return T.Common.LL.Thread;
206 end Get_Thread_Id;
207
208 ----------------
209 -- Enter_Task --
210 ----------------
211
212 procedure Enter_Task (Self_ID : ST.Task_Id) is
213 begin
214 -- Set lwp (for gdb)
215
216 Self_ID.Common.LL.Lwp := Lwp_Self;
217
218 -- Register the task to System.Tasking.Debug
219
220 System.Tasking.Debug.Add_Task_Id (Self_ID);
221
222 -- Ensure that the task has the right priority priority at the end
223 -- of its initialization (before calling the task's code).
224
225 System.OS_Interface.Set_Priority (Self_ID.Common.Base_Priority);
226 end Enter_Task;
227
228 ----------
229 -- Idle --
230 ----------
231
232 procedure Idle (Param : Address)
233 is
234 pragma Unreferenced (Param);
235 T : constant Tasking.Task_Id := Self;
236 begin
237 Enter_Task (T);
238
239 loop
240 OS_Interface.Power_Down;
241 end loop;
242 end Idle;
243
244 --------------------
245 -- Initialize_TCB --
246 --------------------
247
248 procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean) is
249 pragma Unreferenced (Self_ID);
250 begin
251 -- Nothing to be done as part of the initialization of TCBs
252
253 Succeeded := True;
254 end Initialize_TCB;
255
256 ----------------------
257 -- Initialize_Slave --
258 ----------------------
259
260 procedure Initialize_Slave (CPU_Id : CPU) is
261 Idle_Task : Tasking.Ada_Task_Control_Block renames Idle_Tasks (CPU_Id);
262
263 Success : Boolean;
264 pragma Warnings (Off, Success);
265
266 begin
267 -- Initialize ATCB for the idle task
268
269 Initialize_Idle (CPU_Id);
270
271 -- Initialize the environment thread
272
273 System.OS_Interface.Initialize_Slave
274 (Idle_Task.Common.LL.Thread, Idle_Task.Common.Base_Priority,
275 Idle_Task.Common.Compiler_Data.Pri_Stack_Info.Start_Address,
276 Idle_Task.Common.Compiler_Data.Pri_Stack_Info.Size);
277
278 -- Link the underlying executive thread to the Ada task
279
280 System.OS_Interface.Set_ATCB
281 (Idle_Task.Common.LL.Thread, To_Address (Idle_Task'Access));
282
283 -- Run the idle procedure
284
285 Idle (Null_Address);
286 end Initialize_Slave;
287
288 -----------------
289 -- Create_Task --
290 -----------------
291
292 procedure Create_Task
293 (T : ST.Task_Id;
294 Wrapper : System.Address;
295 Stack_Size : System.Parameters.Size_Type;
296 Priority : ST.Extended_Priority;
297 Base_CPU : System.Multiprocessors.CPU_Range;
298 Succeeded : out Boolean)
299 is
300 begin
301 -- The stack has been preallocated for these targets
302
303 pragma Assert
304 (T.Common.Compiler_Data.Pri_Stack_Info.Start_Address /= Null_Address
305 and then Storage_Offset (Stack_Size) =
306 T.Common.Compiler_Data.Pri_Stack_Info.Size);
307
308 T.Common.LL.Thread := T.Common.LL.Thread_Desc'Access;
309
310 -- Create the underlying task
311
312 System.OS_Interface.Thread_Create
313 (T.Common.LL.Thread,
314 Wrapper,
315 To_Address (T),
316 Priority,
317 Base_CPU,
318 T.Common.Compiler_Data.Pri_Stack_Info.Start_Address,
319 T.Common.Compiler_Data.Pri_Stack_Info.Size);
320
321 -- Link the underlying executive thread to the Ada task
322
323 System.OS_Interface.Set_ATCB (T.Common.LL.Thread, To_Address (T));
324
325 Succeeded := True;
326 end Create_Task;
327
328 ----------------
329 -- Initialize --
330 ----------------
331
332 procedure Initialize (Environment_Task : ST.Task_Id) is
333 T : Thread_Id renames Environment_Task.Common.LL.Thread;
334 begin
335 -- Set the thread
336
337 T := Environment_Task.Common.LL.Thread_Desc'Access;
338
339 -- Clear Activation_Link, as required by Add_Task_Id
340
341 Environment_Task.Common.Activation_Link := null;
342
343 -- First the underlying multitasking executive must be initialized.
344 -- The ATCB is already initialized and task priority is set.
345
346 System.OS_Interface.Initialize
347 (T, Environment_Task.Common.Base_Priority);
348
349 -- Link the underlying executive thread to the Ada task
350
351 System.OS_Interface.Set_ATCB (T, To_Address (Environment_Task));
352
353 -- The environment task must also execute its initialization
354
355 Enter_Task (Environment_Task);
356
357 -- Store the identifier for the environment task
358
359 Operations.Environment_Task := Environment_Task;
360
361 -- Compute the stack pointers of idle tasks
362
363 for CPU_Id in CPU loop
364 Idle_Stacks_Table (CPU_Id) :=
365 (if System.Parameters.Stack_Grows_Down
366 then (Idle_Stacks (CPU_Id)'Address + Idle_Stack_Size)
367 else Idle_Stacks (CPU_Id)'Address);
368 end loop;
369
370 -- Create the idle task for the main cpu
371
372 declare
373 Idle_Task : Tasking.Ada_Task_Control_Block renames
374 Idle_Tasks (CPU'First);
375 Success : Boolean;
376 pragma Unreferenced (Success);
377
378 begin
379 Initialize_Idle (CPU'First);
380
381 Create_Task
382 (Idle_Task'Access, Idle'Address,
383 Parameters.Size_Type
384 (Idle_Task.Common.Compiler_Data.Pri_Stack_Info.Size),
385 Tasking.Idle_Priority, CPU'First, Success);
386 end;
387 end Initialize;
388
389 ---------------------
390 -- Initialize_Idle --
391 ---------------------
392
393 procedure Initialize_Idle (CPU_Id : CPU) is
394 Success : Boolean;
395 pragma Warnings (Off, Success);
396
397 Idle_Task : Tasking.Ada_Task_Control_Block renames Idle_Tasks (CPU_Id);
398 begin
399 -- Initialize a fake environment task for this slave CPU
400
401 Tasking.Initialize_ATCB
402 (Idle'Access, Null_Address, Tasking.Idle_Priority, CPU_Id,
403 Task_Info.Unspecified_Task_Info,
404 Idle_Stacks (CPU_Id)'Address,
405 Parameters.Size_Type (Idle_Stack_Size),
406 Idle_Task'Access, Success);
407
408 Idle_Task.Common.LL.Thread := Idle_Task.Common.LL.Thread_Desc'Access;
409 Idle_Task.Entry_Call.Self := Idle_Task'Access;
410 Idle_Task.Common.State := Tasking.Runnable;
411 end Initialize_Idle;
412
413 ---------------------
414 -- Is_Task_Context --
415 ---------------------
416
417 function Is_Task_Context return Boolean is
418 begin
419 return System.OS_Interface.Current_Interrupt = No_Interrupt;
420 end Is_Task_Context;
421
422 end System.Task_Primitives.Operations;