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