rpi-pico: Multicore-safe atomics using hardware spinlocks.

arm/cortexm.py

@@ -64,12 +64,13 @@ def has_double_precision_fpu(self):
     def has_small_memory(self):
         return True
 
-    def __init__(self):
+    def __init__(self, use_armv6m_atomics=True):
         super(ArmV6MTarget, self).__init__()
 
-        self.add_gnat_sources(
-            'src/s-bbarat.ads',
-            'src/s-bbarat.adb')
+        if use_armv6m_atomics:
+            self.add_gnat_sources(
+                'src/s-bbarat.ads',
+                'src/s-bbarat.adb')
 
 
 class ArmV7MTarget(ArmV6MTarget):
@@ -1157,6 +1158,9 @@ def compiler_switches(self):
     def system_ads(self):
         return {'light': 'system-xi-arm.ads'}
 
+    def __init__(self, use_armv6m_atomics=True):
+        super(CortexM0, self).__init__(use_armv6m_atomics)
+
 
 class CortexM0P(CortexM0):
     @property
@@ -1169,6 +1173,9 @@ def compiler_switches(self):
         return ('-mlittle-endian', '-mthumb', '-mfloat-abi=soft',
                 '-mcpu=cortex-m0plus')
 
+    def __init__(self, use_armv6m_atomics=True):
+        super(CortexM0P, self).__init__(use_armv6m_atomics)
+
 
 class CortexM1(ArmV6MTarget):
     @property
@@ -1418,7 +1425,10 @@ def system_ads(self):
     def __init__(self, smp):
         self.smp = smp
 
-        super(RP2040, self).__init__()
+        # Don't use the default System.BB.Armv6m_Atomic package as it's not
+        # safe for the SMP runtime. We use a alternative implementation
+        # that uses the RP2040 hardware spinlocks.
+        super(RP2040, self).__init__(use_armv6m_atomics=False)
 
         smp_template_values = {
             # The SMP runtime uses the TIMER for task delays, which runs from
@@ -1479,6 +1489,8 @@ def __init__(self, smp):
             'arm/rpi/rp2040/svd/i-rp2040-watchdog.ads',
             'arm/rpi/rp2040/svd/i-rp2040-xosc.ads',
             'arm/rpi/rp2040/s-bbmcpa.ads.tmpl',
+            'arm/rpi/rp2040/s-bbrpat.ads',
+            'arm/rpi/rp2040/s-bbrpat.adb',
             'arm/rpi/rp2040/start-rom.S.tmpl',
             'arm/rpi/rp2040/s-bootro.ads',
             'arm/rpi/rp2040/s-bootro.adb',

arm/rpi/rp2040/README

@@ -1,8 +1,8 @@
 ARM RP2040 Runtimes
 ===================
 
-* Ravenscar-SFP
-* Ravenscar-Full
+* light-tasking
+* embedded
 
 Targets Supported
 -----------------
@@ -86,7 +86,6 @@ in the multiprocessor runtime:
 
    end Example;
 
-
 Resources Used
 --------------
 
@@ -99,18 +98,22 @@ trigger a HardFault on the processor that uses it.
 Multiprocessor Runtimes
 ,,,,,,,,,,,,,,,,,,,,,,,
 
-The Ravenscar runtime libraries on the multiprocessor runtime configuration
+The tasking runtime libraries on the multiprocessor runtime configuration
 use the TIMER ALARM_3 interrupt to implement Ada semantics for time, i.e.
 delay statements and package Ada.Real_Time. The ALARM_3 interrupt handler
 runs at the highest priority. This implementation uses a tick-less approach
 to configure the alarm interrupt to trigger exactly at the alarm time,
 thereby avoiding most "useless" tick interrupts. See procedure Set_Alarm in
 package body System.BB.Board_Support (gnarl/s-bbbosu.adb).
 
+The runtime additionally uses SPINLOCK31 to implement the GCC atomic built-in
+functions in a way that ensures atomicity between both cores. See the package
+System.BB.RP2040_Atomics (gnat/s-bbrpat.adb).
+
 Single-processor Runtimes
 ,,,,,,,,,,,,,,,,,,,,,,,,,
 
-The Ravenscar runtime libraries on the single processor runtime configuration
+The tasking runtime libraries on the single processor runtime configuration
 use the SysTick interrupt to implement Ada semantics for time, i.e., delay
 statements and package Ada.Real_Time. The SysTick interrupt handler runs at
 highest priority. See procedure Sys_Tick_Handler in package body

arm/rpi/rp2040/s-bbrpat.adb

@@ -0,0 +1,198 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                    Copyright (C) 2022, Daniel King                       --
+--                      Copyright (C) 2022, AdaCore                         --
+--                                                                          --
+-- GNAT 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.  GNAT 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/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Machine_Code;   use System.Machine_Code;
+with System.BB.Parameters;
+with Interfaces;            use Interfaces;
+with Interfaces.RP2040.SIO; use Interfaces.RP2040.SIO;
+
+package body System.BB.RP2040_Atomic is
+
+   -------------
+   -- PRIMASK --
+   -------------
+
+   function PRIMASK return Unsigned_32 is
+      R : Unsigned_32;
+   begin
+      Asm ("mrs %0, PRIMASK", Outputs => Unsigned_32'Asm_Output ("=r", R),
+           Volatile => True);
+      return R;
+   end PRIMASK;
+
+   ------------------------
+   -- Interrupt_Disabled --
+   ------------------------
+
+   function Interrupt_Disabled return Boolean
+   is ((PRIMASK and 1) /= 0);
+
+   ------------------------
+   -- Disable_Interrupts --
+   ------------------------
+
+   procedure Disable_Interrupts is
+   begin
+      Asm ("cpsid i" & ASCII.CR & ASCII.LF
+             & "dsb" & ASCII.CR & ASCII.LF
+             & "isb",
+           Clobber => "memory",
+           Volatile => True);
+   end Disable_Interrupts;
+
+   -----------------------
+   -- Enable_Interrupts --
+   -----------------------
+
+   procedure Enable_Interrupts is
+   begin
+      Asm ("cpsie i" & ASCII.CR & ASCII.LF
+             & "dsb" & ASCII.CR & ASCII.LF
+             & "isb",
+           Clobber => "memory",
+           Volatile => True);
+   end Enable_Interrupts;
+
+   -------------------
+   -- Spinlock_Lock --
+   -------------------
+
+   procedure Spinlock_Lock is
+      use type Interfaces.RP2040.UInt32;
+   begin
+      --  Reads attempt to claim the lock.
+      --  Read value is nonzero if the lock was successfully claimed,
+      --  or zero if the lock had already been claimed by a previous read.
+      loop
+         exit when SIO_Periph.SPINLOCK31 /= 0;
+      end loop;
+   end Spinlock_Lock;
+
+   ---------------------
+   -- Spinlock_Unlock --
+   ---------------------
+
+   procedure Spinlock_Unlock is
+   begin
+      --  Write any value to release the lock
+      SIO_Periph.SPINLOCK31 := 0;
+   end Spinlock_Unlock;
+
+   --------------------
+   -- Atomic_Wrapper --
+   --------------------
+
+   procedure Atomic_Wrapper is
+      Already_Disabled : constant Boolean := Interrupt_Disabled;
+      --  Make sure not to change the status of interrupt control by checking
+      --  if they are enabled when entering the function.
+   begin
+
+      if not Already_Disabled then
+         Disable_Interrupts;
+      end if;
+
+      if System.BB.Parameters.Multiprocessor then
+         Spinlock_Lock;
+      end if;
+
+      Wrapped_Proc;
+
+      if System.BB.Parameters.Multiprocessor then
+         Spinlock_Unlock;
+      end if;
+
+      --  If the interrupts were disabled when entering this function, we do
+      --  not want enable them.
+      if not Already_Disabled then
+         Enable_Interrupts;
+      end if;
+   end Atomic_Wrapper;
+
+   ----------------------------
+   -- Sync_Lock_Test_And_Set --
+   ----------------------------
+
+   function Sync_Lock_Test_And_Set (Addr  : System.Address;
+                                    Value : T)
+                                   return T
+   is
+      Data : T with Address => Addr;
+      Ret  : T;
+
+      procedure Inner
+        with Inline_Always;
+
+      procedure Inner
+      is
+      begin
+         Ret  := Data;
+         Data := Value;
+      end Inner;
+
+      procedure Atomic_Action is new Atomic_Wrapper (Inner);
+
+   begin
+      Atomic_Action;
+      return Ret;
+   end Sync_Lock_Test_And_Set;
+
+   --------------------------------
+   -- Sync_Bool_Compare_And_Swap --
+   --------------------------------
+
+   function Sync_Bool_Compare_And_Swap (Addr      : System.Address;
+                                        Old_Value : T;
+                                        New_Value : T)
+                                       return Interfaces.C.char
+   is
+      Data : T with Address => Addr;
+      Ret  : Interfaces.C.char;
+
+      procedure Inner
+        with Inline_Always;
+
+      procedure Inner
+      is
+      begin
+         if Data = Old_Value then
+            Data := New_Value;
+            Ret := Interfaces.C.char'Succ (Interfaces.C.nul); -- True
+         else
+            Ret := Interfaces.C.nul; -- False
+         end if;
+      end Inner;
+
+      procedure Atomic_Action is new Atomic_Wrapper (Inner);
+
+   begin
+      Atomic_Action;
+      return Ret;
+   end Sync_Bool_Compare_And_Swap;
+
+end System.BB.RP2040_Atomic;