1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154 | ------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
-- M U L T I P R O C E S S O R S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010-2023, AdaCore --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
with System.Multiprocessors;
with System.Multiprocessors.Fair_Locks;
with System.Multiprocessors.Spin_Locks;
with System.OS_Interface;
with System.BB.Protection;
with System.BB.CPU_Primitives;
with System.BB.Board_Support;
with System.BB.Threads.Queues;
package body System.Tasking.Protected_Objects.Multiprocessors is
use System.Multiprocessors;
use System.Multiprocessors.Spin_Locks;
use System.Multiprocessors.Fair_Locks;
package STPO renames System.Task_Primitives.Operations;
type Entry_Call_List is limited record
List : Entry_Call_Link;
Lock : Fair_Lock;
end record;
Served_Entry_Call : array (CPU) of Entry_Call_List :=
(others =>
(List => null,
Lock => (Spinning => (others => False),
Lock => (Flag => Unlocked))));
-- List of served Entry_Call for each CPU
------------
-- Served --
------------
procedure Served (Entry_Call : Entry_Call_Link) is
Caller : constant Task_Id := Entry_Call.Self;
Caller_CPU : constant CPU := STPO.Get_CPU (Caller);
begin
-- The entry caller is on a different CPU
-- We have to signal that the caller task is ready to be rescheduled,
-- but we are not allowed modify the ready queue of the other CPU. We
-- use the Served_Entry_Call list and a poke interrupt to signal that
-- the task is ready.
-- Disabled IRQ ensure atomicity of the operation. Atomicity plus Fair
-- locks ensure bounded execution time.
System.BB.CPU_Primitives.Disable_Interrupts;
Lock (Served_Entry_Call (Caller_CPU).Lock);
-- Add the entry call to the served list
Entry_Call.Next := Served_Entry_Call (Caller_CPU).List;
Served_Entry_Call (Caller_CPU).List := Entry_Call;
Unlock (Served_Entry_Call (Caller_CPU).Lock);
-- Enable interrupts (they were just disabled above)
-- We need to set the hardware interrupt masking level equal to
-- the software priority of the task that is executing.
if System.BB.Threads.Queues.Running_Thread.Active_Priority in
Interrupt_Priority'Range
then
-- We need to mask some interrupts because we are executing at a
-- hardware interrupt priority.
System.BB.CPU_Primitives.Enable_Interrupts
(System.BB.Threads.Queues.Running_Thread.Active_Priority);
else
-- We are neither within an interrupt handler nor within task
-- that has a priority in the range of Interrupt_Priority, so
-- that no interrupt should be masked.
System.BB.CPU_Primitives.Enable_Interrupts (0);
end if;
if STPO.Get_Priority (Entry_Call.Self) >
System.OS_Interface.Current_Priority (Caller_CPU)
then
-- Poke the caller's CPU if the task has a higher priority
System.BB.Board_Support.Multiprocessors.Poke_CPU (Caller_CPU);
end if;
end Served;
-------------------------
-- Wakeup_Served_Entry --
-------------------------
procedure Wakeup_Served_Entry is
CPU_Id : constant CPU :=
BB.Board_Support.Multiprocessors.Current_CPU;
Entry_Call : Entry_Call_Link;
begin
-- Interrupts are always disabled when entering here
Lock (Served_Entry_Call (CPU_Id).Lock);
Entry_Call := Served_Entry_Call (CPU_Id).List;
Served_Entry_Call (CPU_Id).List := null;
Unlock (Served_Entry_Call (CPU_Id).Lock);
while Entry_Call /= null loop
STPO.Wakeup (Entry_Call.Self, Entry_Caller_Sleep);
Entry_Call := Entry_Call.Next;
end loop;
end Wakeup_Served_Entry;
begin
System.BB.Protection.Wakeup_Served_Entry_Callback :=
Wakeup_Served_Entry'Access;
end System.Tasking.Protected_Objects.Multiprocessors;
|