File : s-bbthre.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . B B . T H R E A D S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2002 Universidad Politecnica de Madrid --
10 -- Copyright (C) 2003-2005 The European Space Agency --
11 -- Copyright (C) 2003-2016, AdaCore --
12 -- --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 3, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. --
19 -- --
20 -- --
21 -- --
22 -- --
23 -- --
24 -- You should have received a copy of the GNU General Public License and --
25 -- a copy of the GCC Runtime Library Exception along with this program; --
26 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
27 -- <http://www.gnu.org/licenses/>. --
28 -- --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
31 -- --
32 -- The port of GNARL to bare board targets was initially developed by the --
33 -- Real-Time Systems Group at the Technical University of Madrid. --
34 -- --
35 ------------------------------------------------------------------------------
36
37 pragma Restrictions (No_Elaboration_Code);
38
39 with System.Parameters;
40 with System.BB.Parameters;
41 with System.BB.Board_Support;
42 with System.BB.Protection;
43 with System.BB.Threads.Queues;
44
45 with Ada.Unchecked_Conversion;
46
47 package body System.BB.Threads is
48
49 use System.Multiprocessors;
50 use System.BB.CPU_Primitives;
51 use System.BB.CPU_Primitives.Multiprocessors;
52 use System.BB.Time;
53 use System.BB.Parameters;
54 use Board_Support;
55
56 use type System.Address;
57 use type System.Parameters.Size_Type;
58 use type System.Storage_Elements.Storage_Offset;
59
60 procedure Initialize_Thread
61 (Id : Thread_Id;
62 Code : System.Address;
63 Arg : System.Address;
64 Priority : Integer;
65 This_CPU : System.Multiprocessors.CPU_Range;
66 Stack_Top : System.Address;
67 Stack_Bottom : System.Address);
68
69 -----------------------
70 -- Stack information --
71 -----------------------
72
73 -- Boundaries of the stack for the environment task, defined by the linker
74 -- script file.
75
76 Top_Of_Environment_Stack : constant System.Address;
77 pragma Import (Asm, Top_Of_Environment_Stack, "__stack_end");
78 -- Top of the stack to be used by the environment task
79
80 Bottom_Of_Environment_Stack : constant System.Address;
81 pragma Import (Asm, Bottom_Of_Environment_Stack, "__stack_start");
82 -- Bottom of the stack to be used by the environment task
83
84 ------------------
85 -- Get_Affinity --
86 ------------------
87
88 function Get_Affinity (Thread : Thread_Id) return CPU_Range is
89 begin
90 return Thread.Base_CPU;
91 end Get_Affinity;
92
93 -------------
94 -- Get_CPU --
95 -------------
96
97 function Get_CPU (Thread : Thread_Id) return CPU is
98 begin
99 if Thread.Base_CPU = Not_A_Specific_CPU then
100
101 -- Return the implementation specific default CPU
102
103 return CPU'First;
104 else
105 return CPU (Thread.Base_CPU);
106 end if;
107 end Get_CPU;
108
109 --------------
110 -- Get_ATCB --
111 --------------
112
113 function Get_ATCB return System.Address is
114 begin
115 -- This is not a light operation as there is a function call
116
117 return Queues.Running_Thread.ATCB;
118 end Get_ATCB;
119
120 ------------------
121 -- Get_Priority --
122 ------------------
123
124 function Get_Priority (Id : Thread_Id) return Integer is
125 begin
126 -- This function does not need to be protected by Enter_Kernel and
127 -- Leave_Kernel, because the Active_Priority value is only updated by
128 -- Set_Priority (atomically). Moreover, Active_Priority is marked as
129 -- Volatile.
130
131 return Id.Active_Priority;
132 end Get_Priority;
133
134 -----------------------------
135 -- Initialize_Thread --
136 -----------------------------
137
138 procedure Initialize_Thread
139 (Id : Thread_Id;
140 Code : System.Address;
141 Arg : System.Address;
142 Priority : Integer;
143 This_CPU : System.Multiprocessors.CPU_Range;
144 Stack_Top : System.Address;
145 Stack_Bottom : System.Address) is
146 begin
147 -- The environment thread executes the main procedure of the program
148
149 -- CPU of the environment thread is current one (initialization CPU)
150
151 Id.Base_CPU := This_CPU;
152
153 -- The active priority is initially equal to the base priority
154
155 Id.Base_Priority := Priority;
156 Id.Active_Priority := Priority;
157
158 -- Insert in the global list
159 -- ??? Not thread safe.
160
161 Id.Global_List := Queues.Global_List;
162 Queues.Global_List := Id;
163
164 -- Insert task inside the ready list (as last within its priority)
165
166 Queues.Insert (Id);
167
168 -- Store stack information
169
170 Id.Top_Of_Stack := Stack_Top;
171 Id.Bottom_Of_Stack := Stack_Bottom;
172
173 -- The initial state is Runnable
174
175 Id.State := Runnable;
176
177 -- Not currently in an interrupt handler
178
179 Id.In_Interrupt := False;
180
181 -- No wakeup has been yet signaled
182
183 Id.Wakeup_Signaled := False;
184
185 -- Initialize alarm status
186
187 Id.Alarm_Time := System.BB.Time.Time'Last;
188 Id.Next_Alarm := Null_Thread_Id;
189
190 -- Reset execution time
191
192 Id.Execution_Time :=
193 System.BB.Time.Initial_Composite_Execution_Time;
194
195 -- Initialize the saved registers. We can ignore the stack and code to
196 -- execute because the environment task is already executing. We are
197 -- interested in the initialization of the rest of the state, such as
198 -- the interrupt nesting level and the cache state.
199
200 Initialize_Context
201 (Buffer => Id.Context'Access,
202 Program_Counter => Code,
203 Argument => Arg,
204 Stack_Pointer => (if System.Parameters.Stack_Grows_Down
205 then Id.Top_Of_Stack
206 else Id.Bottom_Of_Stack));
207 end Initialize_Thread;
208
209 ----------------
210 -- Initialize --
211 ----------------
212
213 procedure Initialize
214 (Environment_Thread : Thread_Id;
215 Main_Priority : System.Any_Priority)
216 is
217 Main_CPU : constant System.Multiprocessors.CPU := Current_CPU;
218
219 begin
220 -- Perform some basic hardware initialization (clock, timer, and
221 -- interrupt handlers).
222
223 -- First initialize interrupt stacks
224
225 Interrupts.Initialize_Interrupts;
226
227 -- Then the CPU (which set interrupt stack pointer)
228
229 Initialize_CPU;
230
231 -- Then the devices
232
233 Board_Support.Initialize_Board;
234 Time.Initialize_Timers;
235
236 -- Initialize internal queues and the environment task
237
238 Protection.Enter_Kernel;
239
240 -- The environment thread executes the main procedure of the program
241
242 Initialize_Thread
243 (Environment_Thread, Null_Address, Null_Address,
244 Main_Priority, Main_CPU,
245 Top_Of_Environment_Stack'Address,
246 Bottom_Of_Environment_Stack'Address);
247
248 Queues.Running_Thread_Table (Main_CPU) := Environment_Thread;
249
250 -- The tasking executive is initialized
251
252 Initialized := True;
253
254 Protection.Leave_Kernel;
255 end Initialize;
256
257 ----------------------
258 -- Initialize_Slave --
259 ----------------------
260
261 procedure Initialize_Slave
262 (Idle_Thread : Thread_Id;
263 Idle_Priority : Integer;
264 Stack_Address : System.Address;
265 Stack_Size : System.Storage_Elements.Storage_Offset)
266 is
267 CPU_Id : constant System.Multiprocessors.CPU := Current_CPU;
268
269 begin
270 Initialize_Thread
271 (Idle_Thread, Null_Address, Null_Address,
272 Idle_Priority, CPU_Id,
273 Stack_Address + Stack_Size, Stack_Address);
274
275 Queues.Running_Thread_Table (CPU_Id) := Idle_Thread;
276 end Initialize_Slave;
277
278 --------------
279 -- Set_ATCB --
280 --------------
281
282 procedure Set_ATCB (Id : Thread_Id; ATCB : System.Address) is
283 begin
284 -- Set_ATCB is only called in the initialization of the task
285
286 Id.ATCB := ATCB;
287 end Set_ATCB;
288
289 ------------------
290 -- Set_Priority --
291 ------------------
292
293 procedure Set_Priority (Priority : Integer) is
294 begin
295 Protection.Enter_Kernel;
296
297 -- The Ravenscar profile does not allow dynamic priority changes. Tasks
298 -- change their priority only when they inherit the ceiling priority of
299 -- a PO (Ceiling Locking policy). Hence, the task must be running when
300 -- changing the priority. It is not possible to change the priority of
301 -- another thread within the Ravenscar profile, so that is why
302 -- Running_Thread is used.
303
304 -- Priority changes are only possible as a result of inheriting the
305 -- ceiling priority of a protected object. Hence, it can never be set
306 -- a priority which is lower than the base priority of the thread.
307
308 pragma Assert
309 (Queues.Running_Thread /= Null_Thread_Id
310 and then Priority >= Queues.Running_Thread.Base_Priority);
311
312 Queues.Change_Priority (Queues.Running_Thread, Priority);
313
314 Protection.Leave_Kernel;
315 end Set_Priority;
316
317 -----------
318 -- Sleep --
319 -----------
320
321 procedure Sleep is
322 Self_Id : constant Thread_Id := Queues.Running_Thread;
323 begin
324 Protection.Enter_Kernel;
325
326 -- It can only suspend if it is executing
327
328 pragma Assert
329 (Self_Id /= Null_Thread_Id and then Self_Id.State = Runnable);
330
331 if Self_Id.Wakeup_Signaled then
332
333 -- Another thread has already executed a Wakeup on this thread so
334 -- that we just consume the token and continue execution. It means
335 -- that just before this call to Sleep the task has been preempted
336 -- by the task that is awaking it. Hence the Sleep/Wakeup calls do
337 -- not happen in the expected order, and we use the Wakeup_Signaled
338 -- to flag this event so it is not lost.
339
340 -- The situation is the following:
341
342 -- 1) a task A is going to wait in an entry for a barrier
343 -- 2) task A releases the lock associated to the protected object
344 -- 3) task A calls Sleep to suspend itself
345 -- 4) a task B opens the barrier and awakes task A (calls Wakeup)
346
347 -- This is the expected sequence of events, but 4) may happen
348 -- before 3) because task A decreases its priority in step 2) as a
349 -- consequence of releasing the lock (Ceiling_Locking). Hence, task
350 -- A may be preempted by task B in the window between releasing the
351 -- protected object and actually suspending itself, and the Wakeup
352 -- call by task B in 4) can happen before the Sleep call in 3).
353
354 Self_Id.Wakeup_Signaled := False;
355
356 else
357 -- Update status
358
359 Self_Id.State := Suspended;
360
361 -- Extract from the list of ready threads
362
363 Queues.Extract (Self_Id);
364
365 -- The currently executing thread is now blocked, and it will leave
366 -- the CPU when executing the Leave_Kernel procedure.
367
368 end if;
369
370 Protection.Leave_Kernel;
371
372 -- Now the thread has been awaken again and it is executing
373
374 end Sleep;
375
376 -------------------
377 -- Thread_Create --
378 -------------------
379
380 procedure Thread_Create
381 (Id : Thread_Id;
382 Code : System.Address;
383 Arg : System.Address;
384 Priority : Integer;
385 Base_CPU : System.Multiprocessors.CPU_Range;
386 Stack_Address : System.Address;
387 Stack_Size : System.Storage_Elements.Storage_Offset)
388 is
389 begin
390 Protection.Enter_Kernel;
391
392 Initialize_Thread
393 (Id, Code, Arg, Priority, Base_CPU,
394 ((Stack_Address + Stack_Size) /
395 Standard'Maximum_Alignment) * Standard'Maximum_Alignment,
396 Stack_Address);
397
398 Protection.Leave_Kernel;
399 end Thread_Create;
400
401 -----------------
402 -- Thread_Self --
403 -----------------
404
405 function Thread_Self return Thread_Id is
406 begin
407 -- Return the thread that is currently executing
408
409 return Queues.Running_Thread;
410 end Thread_Self;
411
412 ------------
413 -- Wakeup --
414 ------------
415
416 procedure Wakeup (Id : Thread_Id) is
417 begin
418 Protection.Enter_Kernel;
419
420 if Id.State = Suspended then
421
422 -- The thread is already waiting so that we awake it
423
424 -- Update status
425
426 Id.State := Runnable;
427
428 -- Insert the thread at the tail of its active priority so that the
429 -- thread will resume execution.
430
431 Queues.Insert (Id);
432
433 else
434 -- The thread is not yet waiting so that we just signal that the
435 -- Wakeup command has been executed. We are waking up a task that
436 -- is going to wait in an entry for a barrier, but before calling
437 -- Sleep it has been preempted by the task awaking it.
438
439 Id.Wakeup_Signaled := True;
440 end if;
441
442 pragma Assert (Id.State = Runnable);
443
444 Protection.Leave_Kernel;
445 end Wakeup;
446
447 end System.BB.Threads;