File : s-musplo-leon.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-2015, 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.Machine_Code;
  30 with System.BB.Parameters;
  31 
  32 package body System.Multiprocessors.Spin_Locks is
  33 
  34    use System.Machine_Code;
  35 
  36    ----------
  37    -- Lock --
  38    ----------
  39 
  40    procedure Lock (Slock : in out Spin_Lock) is
  41       Succeeded : Boolean;
  42 
  43    begin
  44       --  Loop until we can get the lock
  45 
  46       loop
  47          Try_Lock (Slock, Succeeded);
  48          exit when Succeeded;
  49       end loop;
  50    end Lock;
  51 
  52    ------------
  53    -- Locked --
  54    ------------
  55 
  56    function Locked (Slock : Spin_Lock) return Boolean is
  57       Lock_Value   : Atomic_Flag;
  58       Lock_Address : constant System.Address := Slock.Flag'Address;
  59 
  60    begin
  61 
  62       if System.BB.Parameters.Multiprocessor then
  63 
  64          --  Only for multiprocessor
  65 
  66          --  Read with "Alternate space" number 1 (Leon2/3 only) so we can skip
  67          --  the data cache and work directly in RAM.
  68 
  69          Asm ("lduba [%1] 1, %0" & ASCII.LF & ASCII.HT,
  70               Outputs  => Atomic_Flag'Asm_Output ("=r", Lock_Value),
  71               Inputs   => System.Address'Asm_Input ("r", Lock_Address),
  72               Volatile => True,
  73               Clobber  => "memory");
  74 
  75          return Lock_Value /= Unlocked;
  76       else
  77          return True;
  78       end if;
  79    end Locked;
  80 
  81    --------------
  82    -- Try_Lock --
  83    --------------
  84 
  85    procedure Try_Lock (Slock : in out Spin_Lock; Succeeded : out Boolean) is
  86       Prev_Lock_Value : Atomic_Flag;
  87       Lock_Address : constant System.Address := Slock.Flag'Address;
  88 
  89    begin
  90       if System.BB.Parameters.Multiprocessor then
  91 
  92          --  Only for multiprocessor
  93 
  94          --  Atomic test-and-set with "Alternate space" number 1 (Leon2/3 only)
  95          --  so we can skip the data cache and work directly in RAM.
  96 
  97          Asm ("ldstuba [%1] 1, %0" & ASCII.LF & ASCII.HT,
  98               Outputs  => Atomic_Flag'Asm_Output ("=r", Prev_Lock_Value),
  99               Inputs   => System.Address'Asm_Input ("r", Lock_Address),
 100               Volatile => True,
 101               Clobber  => "memory");
 102          Succeeded := (Prev_Lock_Value = Unlocked);
 103       else
 104          Succeeded := True;
 105       end if;
 106    end Try_Lock;
 107 
 108    ------------
 109    -- Unlock --
 110    ------------
 111 
 112    procedure Unlock (Slock : in out Spin_Lock) is
 113       Lock_Address : constant System.Address := Slock.Flag'Address;
 114 
 115    begin
 116       if System.BB.Parameters.Multiprocessor then
 117 
 118          --  Only for multiprocessor
 119 
 120          --  Set lock value using "Alternate space" number 1 (Leon2/3 only) so
 121          --  we can skip the data cache and directly write into RAM.
 122 
 123          Asm ("stuba %%g0, [%0] 1" & ASCII.LF & ASCII.HT,
 124               Inputs   => System.Address'Asm_Input ("r", Lock_Address),
 125               Volatile => True,
 126               Clobber  => "memory");
 127       end if;
 128    end Unlock;
 129 
 130 end System.Multiprocessors.Spin_Locks;