File : s-bbthqu.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 . Q U E U E 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 package body System.BB.Threads.Queues is
40
41 use System.Multiprocessors;
42 use System.BB.CPU_Primitives.Multiprocessors;
43
44 ----------------
45 -- Local data --
46 ----------------
47
48 Alarms_Table : array (CPU) of Thread_Id := (others => Null_Thread_Id);
49 pragma Volatile_Components (Alarms_Table);
50 -- Identifier of the thread that is in the first place of the alarm queue
51
52 ---------------------
53 -- Change_Priority --
54 ---------------------
55
56 procedure Change_Priority (Thread : Thread_Id; Priority : Integer)
57 is
58 CPU_Id : constant CPU := Current_CPU;
59 Head : Thread_Id;
60 Prev_Pointer : Thread_Id;
61
62 begin
63 -- A CPU can only change the priority of its own tasks
64
65 pragma Assert (CPU_Id = Get_CPU (Thread));
66
67 -- Return now if there is no change. This is a rather common case, as
68 -- it happens if user is not using priorities, or if the priority of
69 -- an interrupt handler is the same as the priority of the interrupt.
70 -- In any case, the check is quick enough.
71
72 if Thread.Active_Priority = Priority then
73 return;
74 end if;
75
76 -- Change the active priority. The base priority does not change
77
78 Thread.Active_Priority := Priority;
79
80 -- Outside of the executive kernel, the running thread is also the first
81 -- thread in the First_Thread_Table list. This is also true in general
82 -- within the kernel, except during transcient period when a task is
83 -- extracted from the list (blocked by a delay until or on an entry),
84 -- when a task is inserted (after a wakeup), after a yield or after
85 -- this procedure. But then a context_switch put things in order.
86
87 -- However, on ARM Cortex-M, context switches can be delayed by
88 -- interrupts. They are performed via a special interrupt (Pend_SV),
89 -- which is at the lowest priority. This has three consequences:
90 -- A) it is not possible to have tasks in the Interrupt_Priority range
91 -- B) the head of First_Thread_Table list may be different from the
92 -- running thread within user interrupt handler
93 -- C) the running thread may not be in the First_Thread_Table list.
94 -- The following scenario shows case B: while a thread is running, an
95 -- interrupt awakes a task at a higher priority; it is put in front of
96 -- the First_Thread_Table queue, and a context switch is requested. But
97 -- before the end of the interrupt, another interrupt triggers. It
98 -- increases the priority of the current thread, which is not the
99 -- first in queue.
100 -- The following scenario shows case C: a task is executing a delay
101 -- until and therefore it is removed from the First_Thread_Table. But
102 -- before the context switch, an interrupt triggers and change the
103 -- priority of the running thread.
104
105 -- First, find THREAD in the queue and remove it temporarly.
106
107 Head := First_Thread_Table (CPU_Id);
108
109 if Head = Thread then
110
111 -- This is the very common case: THREAD is the first in the queue
112
113 if Thread.Next = Null_Thread_Id
114 or else Priority >= Thread.Next.Active_Priority
115 then
116 -- Already at the right place.
117 return;
118 end if;
119
120 -- Remove THREAD from the queue
121
122 Head := Thread.Next;
123 else
124
125 -- Uncommon case: less than 0.1% on a Cortex-M test.
126
127 -- Search the thread before THREAD.
128
129 Prev_Pointer := Head;
130 loop
131 if Prev_Pointer = null then
132 -- THREAD is not in the queue. This corresponds to case B.
133 return;
134 end if;
135
136 exit when Prev_Pointer.Next = Thread;
137
138 Prev_Pointer := Prev_Pointer.Next;
139 end loop;
140
141 -- Remove THREAD from the queue.
142
143 Prev_Pointer.Next := Thread.Next;
144 end if;
145
146 -- Now insert THREAD.
147
148 -- FIFO_Within_Priorities dispatching policy. In ALRM D.2.2 it is
149 -- said that when the active priority is lowered due to the loss of
150 -- inherited priority (the only possible case within the Ravenscar
151 -- profile) the task is added at the head of the ready queue for
152 -- its new active priority.
153
154 if Priority >= Head.Active_Priority then
155
156 -- THREAD is the highest priority thread, so put it in the front of
157 -- the queue.
158
159 Thread.Next := Head;
160 Head := Thread;
161 else
162
163 -- Search the right place in the queue.
164
165 Prev_Pointer := Head;
166 while Prev_Pointer.Next /= Null_Thread_Id
167 and then Priority < Prev_Pointer.Next.Active_Priority
168 loop
169 Prev_Pointer := Prev_Pointer.Next;
170 end loop;
171
172 Thread.Next := Prev_Pointer.Next;
173 Prev_Pointer.Next := Thread;
174 end if;
175
176 First_Thread_Table (CPU_Id) := Head;
177 end Change_Priority;
178
179 ---------------------------
180 -- Context_Switch_Needed --
181 ---------------------------
182
183 function Context_Switch_Needed return Boolean is
184 begin
185 -- A context switch is needed when there is a higher priority task ready
186 -- to execute. It means that First_Thread is not null and it is not
187 -- equal to the task currently executing (Running_Thread).
188
189 return First_Thread /= Running_Thread;
190 end Context_Switch_Needed;
191
192 ----------------------
193 -- Current_Priority --
194 ----------------------
195
196 function Current_Priority
197 (CPU_Id : System.Multiprocessors.CPU) return Integer
198 is
199 Thread : constant Thread_Id := Running_Thread_Table (CPU_Id);
200 begin
201 if Thread = null or else Thread.State /= Threads.Runnable then
202 return System.Any_Priority'First;
203 else
204 return Thread.Active_Priority;
205 end if;
206 end Current_Priority;
207
208 -------------
209 -- Extract --
210 -------------
211
212 procedure Extract (Thread : Thread_Id) is
213 CPU_Id : constant CPU := Get_CPU (Thread);
214
215 begin
216 -- A CPU can only modify its own tasks queues
217
218 pragma Assert (CPU_Id = Current_CPU);
219
220 First_Thread_Table (CPU_Id) := Thread.Next;
221 Thread.Next := Null_Thread_Id;
222 end Extract;
223
224 -------------------------
225 -- Extract_First_Alarm --
226 -------------------------
227
228 function Extract_First_Alarm return Thread_Id is
229 CPU_Id : constant CPU := Current_CPU;
230 Result : constant Thread_Id := Alarms_Table (CPU_Id);
231
232 begin
233 -- A CPU can only modify its own tasks queues
234
235 pragma Assert (CPU_Id = Current_CPU);
236
237 Alarms_Table (CPU_Id) := Result.Next_Alarm;
238 Result.Alarm_Time := System.BB.Time.Time'Last;
239 Result.Next_Alarm := Null_Thread_Id;
240 return Result;
241 end Extract_First_Alarm;
242
243 ------------------
244 -- First_Thread --
245 ------------------
246
247 function First_Thread return Thread_Id is
248 begin
249 return First_Thread_Table (Current_CPU);
250 end First_Thread;
251
252 -------------------------
253 -- Get_Next_Alarm_Time --
254 -------------------------
255
256 function Get_Next_Alarm_Time (CPU_Id : CPU) return System.BB.Time.Time is
257 Thread : Thread_Id;
258
259 begin
260 Thread := Alarms_Table (CPU_Id);
261
262 if Thread = Null_Thread_Id then
263
264 -- If alarm queue is empty then next alarm to raise will be Time'Last
265
266 return System.BB.Time.Time'Last;
267
268 else
269 return Thread.Alarm_Time;
270 end if;
271 end Get_Next_Alarm_Time;
272
273 ------------
274 -- Insert --
275 ------------
276
277 procedure Insert (Thread : Thread_Id) is
278 Aux_Pointer : Thread_Id;
279 CPU_Id : constant CPU := Get_CPU (Thread);
280
281 begin
282 -- ??? This pragma is disabled because the Tasks_Activated only
283 -- represents the end of activation for one package not all the
284 -- packages. We have to find a better milestone for the end of
285 -- tasks activation.
286
287 -- -- A CPU can only insert alarm in its own queue, except during
288 -- -- initialization.
289
290 -- pragma Assert (CPU_Id = Current_CPU or else not Tasks_Activated);
291
292 -- It may be the case that we try to insert a task that is already in
293 -- the queue. This can only happen if the task was not runnable and its
294 -- context was being used for handling an interrupt. Hence, if the task
295 -- is already in the queue and we try to insert it, we need to check
296 -- whether it is in the correct place.
297
298 -- No insertion if the task is already at the head of the queue
299
300 if First_Thread_Table (CPU_Id) = Thread then
301 null;
302
303 -- Insert at the head of queue if there is no other thread with a higher
304 -- priority.
305
306 elsif First_Thread_Table (CPU_Id) = Null_Thread_Id
307 or else
308 Thread.Active_Priority > First_Thread_Table (CPU_Id).Active_Priority
309 then
310 Thread.Next := First_Thread_Table (CPU_Id);
311 First_Thread_Table (CPU_Id) := Thread;
312
313 -- Middle or tail insertion
314
315 else
316 -- Look for the Aux_Pointer to insert the thread just after it
317
318 Aux_Pointer := First_Thread_Table (CPU_Id);
319 while Aux_Pointer.Next /= Null_Thread_Id
320 and then Aux_Pointer.Next /= Thread
321 and then Aux_Pointer.Next.Active_Priority >= Thread.Active_Priority
322 loop
323 Aux_Pointer := Aux_Pointer.Next;
324 end loop;
325
326 -- If we found the thread already in the queue, then we need to move
327 -- it to its right place.
328
329 if Aux_Pointer.Next = Thread then
330
331 -- Extract it from its current location
332
333 Aux_Pointer.Next := Thread.Next;
334
335 -- Look for the Aux_Pointer to insert the thread just after it
336
337 while Aux_Pointer.Next /= Null_Thread_Id
338 and then
339 Aux_Pointer.Next.Active_Priority >= Thread.Active_Priority
340 loop
341 Aux_Pointer := Aux_Pointer.Next;
342 end loop;
343 end if;
344
345 -- Insert the thread after the Aux_Pointer
346
347 Thread.Next := Aux_Pointer.Next;
348 Aux_Pointer.Next := Thread;
349 end if;
350 end Insert;
351
352 ------------------
353 -- Insert_Alarm --
354 ------------------
355
356 procedure Insert_Alarm
357 (T : System.BB.Time.Time;
358 Thread : Thread_Id;
359 Is_First : out Boolean)
360 is
361 CPU_Id : constant CPU := Get_CPU (Thread);
362 Alarm_Id_Aux : Thread_Id;
363
364 begin
365 -- A CPU can only insert alarm in its own queue
366
367 pragma Assert (CPU_Id = Current_CPU);
368
369 -- Set the Alarm_Time within the thread descriptor
370
371 Thread.Alarm_Time := T;
372
373 -- Case of empty queue, or new alarm expires earlier, insert the thread
374 -- as the first thread.
375
376 if Alarms_Table (CPU_Id) = Null_Thread_Id
377 or else T < Alarms_Table (CPU_Id).Alarm_Time
378 then
379 Thread.Next_Alarm := Alarms_Table (CPU_Id);
380 Alarms_Table (CPU_Id) := Thread;
381 Is_First := True;
382
383 -- Otherwise, place in the middle
384
385 else
386 -- Find the minimum greater than T alarm within the alarm queue
387
388 Alarm_Id_Aux := Alarms_Table (CPU_Id);
389 while Alarm_Id_Aux.Next_Alarm /= Null_Thread_Id and then
390 Alarm_Id_Aux.Next_Alarm.Alarm_Time < T
391 loop
392 Alarm_Id_Aux := Alarm_Id_Aux.Next_Alarm;
393 end loop;
394
395 Thread.Next_Alarm := Alarm_Id_Aux.Next_Alarm;
396 Alarm_Id_Aux.Next_Alarm := Thread;
397
398 Is_First := False;
399 end if;
400 end Insert_Alarm;
401
402 --------------------
403 -- Running_Thread --
404 --------------------
405
406 function Running_Thread return Thread_Id is
407 begin
408 return Running_Thread_Table (Current_CPU);
409 end Running_Thread;
410
411 ---------------------------
412 -- Wakeup_Expired_Alarms --
413 ---------------------------
414
415 procedure Wakeup_Expired_Alarms (Now : Time.Time) is
416 use Time;
417
418 CPU_Id : constant CPU := Current_CPU;
419 Next_Alarm : Time.Time;
420 Wakeup_Thread : Thread_Id;
421
422 begin
423 -- Extract all the threads whose delay has expired
424
425 while Get_Next_Alarm_Time (CPU_Id) <= Now loop
426
427 -- Extract the task(s) that was waiting in the alarm queue and insert
428 -- it in the ready queue.
429
430 Wakeup_Thread := Extract_First_Alarm;
431
432 -- We can only awake tasks that are delay statement
433
434 pragma Assert (Wakeup_Thread.State = Delayed);
435
436 Wakeup_Thread.State := Runnable;
437
438 Insert (Wakeup_Thread);
439 end loop;
440
441 -- Set the timer for the next alarm on this CPU
442
443 Next_Alarm := Get_Next_Timeout (CPU_Id);
444 Update_Alarm (Next_Alarm);
445 end Wakeup_Expired_Alarms;
446
447 -----------
448 -- Yield --
449 -----------
450
451 procedure Yield (Thread : Thread_Id) is
452 CPU_Id : constant CPU := Get_CPU (Thread);
453 Prio : constant Integer := Thread.Active_Priority;
454 Aux_Pointer : Thread_Id;
455
456 begin
457 -- A CPU can only modify its own tasks queues
458
459 pragma Assert (CPU_Id = Current_CPU);
460
461 if Thread.Next /= Null_Thread_Id
462 and then Thread.Next.Active_Priority = Prio
463 then
464 First_Thread_Table (CPU_Id) := Thread.Next;
465
466 -- Look for the Aux_Pointer to insert the thread just after it
467
468 Aux_Pointer := First_Thread_Table (CPU_Id);
469 while Aux_Pointer.Next /= Null_Thread_Id
470 and then Prio = Aux_Pointer.Next.Active_Priority
471 loop
472 Aux_Pointer := Aux_Pointer.Next;
473 end loop;
474
475 -- Insert the thread after the Aux_Pointer
476
477 Thread.Next := Aux_Pointer.Next;
478 Aux_Pointer.Next := Thread;
479 end if;
480 end Yield;
481
482 ------------------
483 -- Queue_Length --
484 ------------------
485
486 function Queue_Length return Natural is
487 Res : Natural := 0;
488 T : Thread_Id := First_Thread_Table (Current_CPU);
489
490 begin
491 while T /= null loop
492 Res := Res + 1;
493 T := T.Next;
494 end loop;
495
496 return Res;
497 end Queue_Length;
498
499 -------------------
500 -- Queue_Ordered --
501 -------------------
502
503 function Queue_Ordered return Boolean is
504 T : Thread_Id := First_Thread_Table (Current_CPU);
505 N : Thread_Id;
506
507 begin
508 if T = Null_Thread_Id then
509 -- True if the queue is empty
510 return True;
511 end if;
512
513 loop
514 N := T.Next;
515 if N = Null_Thread_Id then
516 -- True if at end of the queue
517 return True;
518 end if;
519
520 if T.Active_Priority < N.Active_Priority then
521 return False;
522 end if;
523
524 T := N;
525 end loop;
526 end Queue_Ordered;
527
528 end System.BB.Threads.Queues;