File : s-mufalo.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . M U L T I P R O C E S S O R S . F A I R _ L O C K S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2010, 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 with System.OS_Interface;
30
31 package body System.Multiprocessors.Fair_Locks is
32
33 use System.Multiprocessors.Spin_Locks;
34
35 Multiprocessor : constant Boolean := CPU'Range_Length /= 1;
36 -- Set true if on multiprocessor (more than one CPU)
37
38 function Next_Spinning (Flock : Fair_Lock) return CPU;
39 pragma Inline (Next_Spinning);
40 -- Search for the next spinning CPU. If no one is spinning return the
41 -- current CPU.
42
43 ----------------
44 -- Initialize --
45 ----------------
46
47 procedure Initialize (Flock : in out Fair_Lock) is
48 begin
49 Unlock (Flock.Lock);
50 Flock.Spinning := (others => False);
51 end Initialize;
52
53 ----------
54 -- Lock --
55 ----------
56
57 procedure Lock (Flock : in out Fair_Lock) is
58 CPU_Id : constant CPU := System.OS_Interface.Current_CPU;
59 Succeeded : Boolean;
60
61 begin
62 -- Notify we are waiting for the lock
63
64 Flock.Spinning (CPU_Id) := True;
65
66 loop
67 Try_Lock (Flock.Lock, Succeeded);
68 if Succeeded then
69
70 -- We have the lock
71
72 Flock.Spinning (CPU_Id) := False;
73 return;
74
75 else
76 loop
77 if not Flock.Spinning (CPU_Id) then
78
79 -- Lock's owner gives us the lock
80
81 return;
82 end if;
83
84 -- Lock's owner left but didn't wake us up, retry to get lock
85
86 exit when not Locked (Flock.Lock);
87 end loop;
88 end if;
89 end loop;
90 end Lock;
91
92 ------------
93 -- Locked --
94 ------------
95
96 function Locked (Flock : Fair_Lock) return Boolean is
97 begin
98 return Locked (Flock.Lock);
99 end Locked;
100
101 -------------------
102 -- Next_Spinning --
103 -------------------
104
105 function Next_Spinning (Flock : Fair_Lock) return CPU is
106 Current : constant CPU := System.OS_Interface.Current_CPU;
107 CPU_Id : CPU := Current;
108
109 begin
110
111 if Multiprocessor then
112
113 -- Only for multiprocessor
114
115 loop
116 if CPU_Id = CPU'Last then
117 CPU_Id := CPU'First;
118 else
119 CPU_Id := CPU_Id + 1;
120 end if;
121
122 exit when Flock.Spinning (CPU_Id) or else CPU_Id = Current;
123 end loop;
124 end if;
125
126 return CPU_Id;
127 end Next_Spinning;
128
129 --------------
130 -- Try_Lock --
131 --------------
132
133 procedure Try_Lock (Flock : in out Fair_Lock; Succeeded : out Boolean) is
134 begin
135 Try_Lock (Flock.Lock, Succeeded);
136 end Try_Lock;
137
138 ------------
139 -- Unlock --
140 ------------
141
142 procedure Unlock (Flock : in out Fair_Lock) is
143 CPU_Id : constant CPU := Next_Spinning (Flock);
144
145 begin
146 if CPU_Id /= System.OS_Interface.Current_CPU then
147
148 -- Wake up the next spinning CPU
149
150 Flock.Spinning (CPU_Id) := False;
151
152 else
153 -- Nobody is waiting for the Lock
154
155 Unlock (Flock.Lock);
156 end if;
157 end Unlock;
158
159 end System.Multiprocessors.Fair_Locks;