File : s-musplo.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 . S P I N _ L O C K S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2010-2016, 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 package body System.Multiprocessors.Spin_Locks is
30
31 ----------
32 -- Lock --
33 ----------
34
35 procedure Lock (Slock : in out Spin_Lock) is
36 Succeeded : Boolean;
37
38 begin
39 -- Loop until we can get the lock
40
41 loop
42 Try_Lock (Slock, Succeeded);
43 exit when Succeeded;
44 end loop;
45 end Lock;
46
47 ------------
48 -- Locked --
49 ------------
50
51 function Locked (Slock : Spin_Lock) return Boolean is
52 begin
53 return Slock.Flag /= Unlocked;
54 end Locked;
55
56 --------------
57 -- Try_Lock --
58 --------------
59
60 procedure Try_Lock (Slock : in out Spin_Lock; Succeeded : out Boolean) is
61
62 function Lock_Test_And_Set
63 (Ptr : access Atomic_Flag;
64 Value : Atomic_Flag)
65 return Atomic_Flag;
66 pragma Import (Intrinsic, Lock_Test_And_Set,
67 "__sync_lock_test_and_set_1");
68 begin
69 Succeeded := (Lock_Test_And_Set (Slock.Flag'Access, 1) = Unlocked);
70 end Try_Lock;
71
72 ------------
73 -- Unlock --
74 ------------
75
76 procedure Unlock (Slock : in out Spin_Lock) is
77
78 procedure Lock_Release (Ptr : access Atomic_Flag);
79 pragma Import (Intrinsic, Lock_Release,
80 "__sync_lock_release_1");
81
82 begin
83 -- Clear Flag. This is a release barrier: all previous memory load
84 -- are satisfied before this write access.
85
86 Lock_Release (Slock.Flag'Access);
87 end Unlock;
88
89 end System.Multiprocessors.Spin_Locks;