From fff877f61eb26eaa725093f8df9b21343ea40137 Mon Sep 17 00:00:00 2001 From: Daniel King Date: Tue, 16 Aug 2022 21:56:11 +0100 Subject: [PATCH 1/3] rpi-pico: Multicore-safe atomics using hardware spinlocks. The default System.BB.Armv6m_Atomic package is not safe for use with the rpi-pico-smp runtimes since it does not ensure atomic accesses between cores. This implements an alternative implementation which uses SPINLOCK31 to ensure mutual exclusion for atomic operations between both cores. Additional GCC atomic built-in functions are also implemented using the same spinlock to ensure atomicity between all atomic operations. These are intended to be used by applications that make use of atomics, for example via the "atomic" crate in Alire. --- arm/cortexm.py | 22 +- arm/rpi/rp2040/README | 13 +- arm/rpi/rp2040/s-bbrpat.adb | 404 +++++++++++++++++++++++++++++++ arm/rpi/rp2040/s-bbrpat.ads | 470 ++++++++++++++++++++++++++++++++++++ src/s-bbbosu__rp2040.adb | 8 + 5 files changed, 907 insertions(+), 10 deletions(-) create mode 100644 arm/rpi/rp2040/s-bbrpat.adb create mode 100644 arm/rpi/rp2040/s-bbrpat.ads diff --git a/arm/cortexm.py b/arm/cortexm.py index 5a709e9d..73288952 100644 --- a/arm/cortexm.py +++ b/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', diff --git a/arm/rpi/rp2040/README b/arm/rpi/rp2040/README index dbf39d12..cc9bcfb7 100644 --- a/arm/rpi/rp2040/README +++ b/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,7 +98,7 @@ 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 @@ -107,10 +106,14 @@ 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 diff --git a/arm/rpi/rp2040/s-bbrpat.adb b/arm/rpi/rp2040/s-bbrpat.adb new file mode 100644 index 00000000..9a25ce18 --- /dev/null +++ b/arm/rpi/rp2040/s-bbrpat.adb @@ -0,0 +1,404 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; + + ----------------- + -- Atomic_Load -- + ----------------- + + function Atomic_Load (Addr : System.Address; + Order : Mem_Order) return T + is + Data : T with Address => Addr; + Ret : T; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Ret := Data; + end Inner; + + procedure Fallback is new Atomic_Wrapper (Inner); + + begin + + -- Byte, halfword, and word accesses are always atomic on armv6m. + -- doubleword accesses are not atomic, so we need to fallback to + -- doing the load with interrupts disabled. + + if T'Size <= 32 then + if Order = Relaxed then + Ret := Data; + else + Fallback; + end if; + else + Fallback; + end if; + + return Ret; + end Atomic_Load; + + ------------------ + -- Atomic_Store -- + ------------------ + + procedure Atomic_Store (Addr : System.Address; + Value : T; + Order : Mem_Order) + is + Data : T with Address => Addr; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Data := Value; + end Inner; + + procedure Fallback is new Atomic_Wrapper (Inner); + + begin + -- Byte, halfword, and word accesses are always atomic on armv6m. + -- doubleword accesses are not atomic, so we need to fallback to + -- doing the load with interrupts disabled. + + if T'Size <= 32 then + if Order = Relaxed then + Data := Value; + else + Fallback; + end if; + else + Fallback; + end if; + end Atomic_Store; + + --------------------- + -- Atomic_Exchange -- + --------------------- + + function Atomic_Exchange (Addr : System.Address; + Value : T; + Order : Mem_Order) return T + is + pragma Unreferenced (Order); + + Data : T with Address => Addr; + Ret : T; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Ret := Data; + Data := Value; + end Inner; + + procedure Do_Atomic_Exchange is new Atomic_Wrapper (Inner); + + begin + Do_Atomic_Exchange; + return Ret; + end Atomic_Exchange; + + ----------------------------- + -- Atomic_Compare_Exchange -- + ----------------------------- + + function Atomic_Compare_Exchange + (Addr : System.Address; + Expected_Addr : System.Address; + Desired : T; + Weak : Interfaces.C.C_bool; + Success_Order : Mem_Order; + Failure_Order : Mem_Order) return Interfaces.C.C_bool + is + pragma Unreferenced (Weak); + pragma Unreferenced (Success_Order); + pragma Unreferenced (Failure_Order); + + Data : T with Address => Addr; + Expected : T with Address => Expected_Addr; + Ret : Interfaces.C.C_bool; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Ret := Interfaces.C.C_bool (Data = Expected); + if Ret then + Data := Desired; + end if; + end Inner; + + procedure Do_Atomic_Compare_Exchange is new Atomic_Wrapper (Inner); + + begin + Do_Atomic_Compare_Exchange; + return Ret; + end Atomic_Compare_Exchange; + + --------------------- + -- Atomic_Op_Fetch -- + --------------------- + + function Atomic_Op_Fetch (Addr : System.Address; + Value : T; + Order : Mem_Order) return T + is + pragma Unreferenced (Order); + + Data : T with Address => Addr; + Ret : T; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Ret := Operation (Data, Value); + Data := Ret; + end Inner; + + procedure Do_Atomic_Op_Fetch is new Atomic_Wrapper (Inner); + + begin + Do_Atomic_Op_Fetch; + return Ret; + end Atomic_Op_Fetch; + + --------------------- + -- Atomic_Fetch_Op -- + --------------------- + + function Atomic_Fetch_Op (Addr : System.Address; + Value : T; + Order : Mem_Order) return T + is + pragma Unreferenced (Order); + + Data : T with Address => Addr; + Ret : T; + + procedure Inner + with Inline_Always; + + procedure Inner + is + begin + Ret := Data; + Data := Operation (Data, Value); + end Inner; + + procedure Do_Atomic_Fetch_Op is new Atomic_Wrapper (Inner); + + begin + Do_Atomic_Fetch_Op; + return Ret; + end Atomic_Fetch_Op; + +end System.BB.RP2040_Atomic; diff --git a/arm/rpi/rp2040/s-bbrpat.ads b/arm/rpi/rp2040/s-bbrpat.ads new file mode 100644 index 00000000..e16cdc62 --- /dev/null +++ b/arm/rpi/rp2040/s-bbrpat.ads @@ -0,0 +1,470 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package implements some intrinsics not provided by GCC for the armv6m +-- architecture. An RP2040 hardware spinlock is used to ensure atomicity +-- across all processors. + +with Interfaces.C; + +package System.BB.RP2040_Atomic is + + ------------------------------ + -- __sync_lock_test_and_set -- + ------------------------------ + + generic + type T is mod <>; + function Sync_Lock_Test_And_Set (Addr : System.Address; + Value : T) + return T; + + function Sync_Lock_Test_And_Set_1 is + new Sync_Lock_Test_And_Set (Interfaces.Unsigned_8); + pragma Export (C, Sync_Lock_Test_And_Set_1, + "__sync_lock_test_and_set_1"); + + ---------------------------------- + -- __sync_bool_compare_and_swap -- + ---------------------------------- + + generic + type T is mod <>; + function Sync_Bool_Compare_And_Swap (Addr : System.Address; + Old_Value : T; + New_Value : T) + return Interfaces.C.char; + + function Sync_Bool_Compare_And_Swap_4 is + new Sync_Bool_Compare_And_Swap (Interfaces.Unsigned_32); + pragma Export (C, Sync_Bool_Compare_And_Swap_4, + "__sync_bool_compare_and_swap_4"); + + ------------------- + -- Memory Orders -- + ------------------- + + type Mem_Order is new Interfaces.C.int; + + Relaxed : constant Mem_Order := 0; + -- Implies no inter-thread ordering constraints + + Consume : constant Mem_Order := 1; + -- This is currently implemented using the stronger __ATOMIC_ACQUIRE + -- memory order because of a deficiency in C++11's semantics for + -- memory_order_consume. + + Acquire : constant Mem_Order := 2; + -- Creates an inter-thread happens-before constraint from the release + -- (or stronger) semantic store to this acquire load. Can prevent + -- hoisting of code to before the operation. + + Release : constant Mem_Order := 3; + -- Creates an inter-thread happens-before constraint to acquire (or + -- stronger) semantic loads that read from this release store. Can + -- prevent sinking of code to after the operation. + + Acq_Rel : constant Mem_Order := 4; + -- Combines the effects of both Acquire and Release + + Seq_Cst : constant Mem_Order := 5; + -- Enforces total ordering with all other Seq_Cst operations + + --------------------- + -- __atomic_load_n -- + --------------------- + + generic + type T is mod <>; + function Atomic_Load (Addr : System.Address; + Order : Mem_Order) return T; + + function Atomic_Load_1 is new Atomic_Load (Interfaces.Unsigned_8); + pragma Export (C, Atomic_Load_1, "__atomic_load_1"); + function Atomic_Load_2 is new Atomic_Load (Interfaces.Unsigned_16); + pragma Export (C, Atomic_Load_2, "__atomic_load_2"); + function Atomic_Load_4 is new Atomic_Load (Interfaces.Unsigned_32); + pragma Export (C, Atomic_Load_4, "__atomic_load_4"); + function Atomic_Load_8 is new Atomic_Load (Interfaces.Unsigned_64); + pragma Export (C, Atomic_Load_8, "__atomic_load_8"); + + ---------------------- + -- __atomic_store_n -- + ---------------------- + + generic + type T is mod <>; + procedure Atomic_Store (Addr : System.Address; + Value : T; + Order : Mem_Order); + + procedure Atomic_Store_1 is new Atomic_Store (Interfaces.Unsigned_8); + pragma Export (C, Atomic_Store_1, "__atomic_store_1"); + procedure Atomic_Store_2 is new Atomic_Store (Interfaces.Unsigned_16); + pragma Export (C, Atomic_Store_2, "__atomic_store_2"); + procedure Atomic_Store_4 is new Atomic_Store (Interfaces.Unsigned_32); + pragma Export (C, Atomic_Store_4, "__atomic_store_4"); + procedure Atomic_Store_8 is new Atomic_Store (Interfaces.Unsigned_64); + pragma Export (C, Atomic_Store_8, "__atomic_store_8"); + + ------------------------- + -- __atomic_exchange_n -- + ------------------------- + + generic + type T is mod <>; + function Atomic_Exchange (Addr : System.Address; + Value : T; + Order : Mem_Order) return T; + + function Atomic_Exchange_1 is new Atomic_Exchange (Interfaces.Unsigned_8); + pragma Export (C, Atomic_Exchange_1, "__atomic_exchange_1"); + function Atomic_Exchange_2 is new Atomic_Exchange (Interfaces.Unsigned_16); + pragma Export (C, Atomic_Exchange_2, "__atomic_exchange_2"); + function Atomic_Exchange_4 is new Atomic_Exchange (Interfaces.Unsigned_32); + pragma Export (C, Atomic_Exchange_4, "__atomic_exchange_4"); + function Atomic_Exchange_8 is new Atomic_Exchange (Interfaces.Unsigned_64); + pragma Export (C, Atomic_Exchange_8, "__atomic_exchange_8"); + + --------------------------------- + -- __atomic_compare_exchange_n -- + --------------------------------- + + generic + type T is mod <>; + function Atomic_Compare_Exchange + (Addr : System.Address; + Expected_Addr : System.Address; + Desired : T; + Weak : Interfaces.C.C_bool; + Success_Order : Mem_Order; + Failure_Order : Mem_Order) return Interfaces.C.C_bool; + + function Atomic_Compare_Exchange_1 is + new Atomic_Compare_Exchange (Interfaces.Unsigned_8); + pragma Export (C, Atomic_Compare_Exchange_1, + "__atomic_compare_exchange_1"); + + function Atomic_Compare_Exchange_2 is + new Atomic_Compare_Exchange (Interfaces.Unsigned_16); + pragma Export (C, Atomic_Compare_Exchange_2, + "__atomic_compare_exchange_2"); + + function Atomic_Compare_Exchange_4 is + new Atomic_Compare_Exchange (Interfaces.Unsigned_32); + pragma Export (C, Atomic_Compare_Exchange_4, + "__atomic_compare_exchange_4"); + + function Atomic_Compare_Exchange_8 is + new Atomic_Compare_Exchange (Interfaces.Unsigned_64); + pragma Export (C, Atomic_Compare_Exchange_8, + "__atomic_compare_exchange_8"); + + ------------------------ + -- __atomic__fetch -- + ------------------------ + + generic + type T is mod <>; + with function Operation (Left, Right : T) return T; + function Atomic_Op_Fetch (Addr : System.Address; + Value : T; + Order : Mem_Order) return T; + + -- __atomic_add_fetch + + function Atomic_Add_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."+"); + pragma Export (C, Atomic_Add_Fetch_1, "__atomic_add_fetch_1"); + + function Atomic_Add_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."+"); + pragma Export (C, Atomic_Add_Fetch_2, "__atomic_add_fetch_2"); + + function Atomic_Add_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."+"); + pragma Export (C, Atomic_Add_Fetch_4, "__atomic_add_fetch_4"); + + function Atomic_Add_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."+"); + pragma Export (C, Atomic_Add_Fetch_8, "__atomic_add_fetch_8"); + + -- __atomic_sub_fetch + + function Atomic_Sub_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."-"); + pragma Export (C, Atomic_Sub_Fetch_1, "__atomic_sub_fetch_1"); + + function Atomic_Sub_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."-"); + pragma Export (C, Atomic_Sub_Fetch_2, "__atomic_sub_fetch_2"); + + function Atomic_Sub_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."-"); + pragma Export (C, Atomic_Sub_Fetch_4, "__atomic_sub_fetch_4"); + + function Atomic_Sub_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."-"); + pragma Export (C, Atomic_Sub_Fetch_8, "__atomic_sub_fetch_8"); + + -- __atomic_and_fetch + + function Atomic_And_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."and"); + pragma Export (C, Atomic_And_Fetch_1, "__atomic_and_fetch_1"); + + function Atomic_And_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."and"); + pragma Export (C, Atomic_And_Fetch_2, "__atomic_and_fetch_2"); + + function Atomic_And_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."and"); + pragma Export (C, Atomic_And_Fetch_4, "__atomic_and_fetch_4"); + + function Atomic_And_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."and"); + pragma Export (C, Atomic_And_Fetch_8, "__atomic_and_fetch_8"); + + -- __atomic_xor_fetch + + function Atomic_Xor_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."xor"); + pragma Export (C, Atomic_Xor_Fetch_1, "__atomic_xor_fetch_1"); + + function Atomic_Xor_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."xor"); + pragma Export (C, Atomic_Xor_Fetch_2, "__atomic_xor_fetch_2"); + + function Atomic_Xor_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."xor"); + pragma Export (C, Atomic_Xor_Fetch_4, "__atomic_xor_fetch_4"); + + function Atomic_Xor_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."xor"); + pragma Export (C, Atomic_Xor_Fetch_8, "__atomic_xor_fetch_8"); + + -- __atomic_or_fetch + + function Atomic_Or_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."or"); + pragma Export (C, Atomic_Or_Fetch_1, "__atomic_or_fetch_1"); + + function Atomic_Or_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."or"); + pragma Export (C, Atomic_Or_Fetch_2, "__atomic_or_fetch_2"); + + function Atomic_Or_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."or"); + pragma Export (C, Atomic_Or_Fetch_4, "__atomic_or_fetch_4"); + + function Atomic_Or_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."or"); + pragma Export (C, Atomic_Or_Fetch_8, "__atomic_or_fetch_8"); + + -- __atomic_nand_fetch + + generic + type T is mod <>; + function Generic_Nand (Left, Right : T) return T; + + function Generic_Nand (Left, Right : T) return T is (not (Left and Right)); + + function Nand_8 is new Generic_Nand (Interfaces.Unsigned_8); + function Nand_16 is new Generic_Nand (Interfaces.Unsigned_16); + function Nand_32 is new Generic_Nand (Interfaces.Unsigned_32); + function Nand_64 is new Generic_Nand (Interfaces.Unsigned_64); + + function Atomic_Nand_Fetch_1 is new + Atomic_Op_Fetch (Interfaces.Unsigned_8, Nand_8); + pragma Export (C, Atomic_Nand_Fetch_1, "__atomic_nand_fetch_1"); + + function Atomic_Nand_Fetch_2 is new + Atomic_Op_Fetch (Interfaces.Unsigned_16, Nand_16); + pragma Export (C, Atomic_Nand_Fetch_2, "__atomic_nand_fetch_2"); + + function Atomic_Nand_Fetch_4 is new + Atomic_Op_Fetch (Interfaces.Unsigned_32, Nand_32); + pragma Export (C, Atomic_Nand_Fetch_4, "__atomic_nand_fetch_4"); + + function Atomic_Nand_Fetch_8 is new + Atomic_Op_Fetch (Interfaces.Unsigned_64, Nand_64); + pragma Export (C, Atomic_Nand_Fetch_8, "__atomic_nand_fetch_8"); + + ------------------------ + -- __atomic_fetch_ -- + ------------------------ + + generic + type T is mod <>; + with function Operation (Left, Right : T) return T; + function Atomic_Fetch_Op (Addr : System.Address; + Value : T; + Order : Mem_Order) return T; + + -- __atomic_fetch_add + + function Atomic_Fetch_Add_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."+"); + pragma Export (C, Atomic_Fetch_Add_1, "__atomic_fetch_add_1"); + + function Atomic_Fetch_Add_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."+"); + pragma Export (C, Atomic_Fetch_Add_2, "__atomic_fetch_add_2"); + + function Atomic_Fetch_Add_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."+"); + pragma Export (C, Atomic_Fetch_Add_4, "__atomic_fetch_add_4"); + + function Atomic_Fetch_Add_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."+"); + pragma Export (C, Atomic_Fetch_Add_8, "__atomic_fetch_add_8"); + + -- __atomic_fetch_sub + + function Atomic_Fetch_Sub_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."-"); + pragma Export (C, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1"); + + function Atomic_Fetch_Sub_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."-"); + pragma Export (C, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2"); + + function Atomic_Fetch_Sub_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."-"); + pragma Export (C, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4"); + + function Atomic_Fetch_Sub_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."-"); + pragma Export (C, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8"); + + -- __atomic_fetch_and + + function Atomic_Fetch_And_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."and"); + pragma Export (C, Atomic_Fetch_And_1, "__atomic_fetch_and_1"); + + function Atomic_Fetch_And_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."and"); + pragma Export (C, Atomic_Fetch_And_2, "__atomic_fetch_and_2"); + + function Atomic_Fetch_And_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."and"); + pragma Export (C, Atomic_Fetch_And_4, "__atomic_fetch_and_4"); + + function Atomic_Fetch_And_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."and"); + pragma Export (C, Atomic_Fetch_And_8, "__atomic_fetch_and_8"); + + -- __atomic_fetch_xor + + function Atomic_Fetch_Xor_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."xor"); + pragma Export (C, Atomic_Fetch_Xor_1, "__atomic_fetch_xor_1"); + + function Atomic_Fetch_Xor_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."xor"); + pragma Export (C, Atomic_Fetch_Xor_2, "__atomic_fetch_xor_2"); + + function Atomic_Fetch_Xor_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."xor"); + pragma Export (C, Atomic_Fetch_Xor_4, "__atomic_fetch_xor_4"); + + function Atomic_Fetch_Xor_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."xor"); + pragma Export (C, Atomic_Fetch_Xor_8, "__atomic_fetch_xor_8"); + + -- __atomic_fetch_or + + function Atomic_Fetch_Or_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."or"); + pragma Export (C, Atomic_Fetch_Or_1, "__atomic_fetch_or_1"); + + function Atomic_Fetch_Or_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."or"); + pragma Export (C, Atomic_Fetch_Or_2, "__atomic_fetch_or_2"); + + function Atomic_Fetch_Or_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."or"); + pragma Export (C, Atomic_Fetch_Or_4, "__atomic_fetch_or_4"); + + function Atomic_Fetch_Or_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."or"); + pragma Export (C, Atomic_Fetch_Or_8, "__atomic_fetch_or_8"); + + -- __atomic_fetch_nand + + function Atomic_Fetch_Nand_1 is new + Atomic_Fetch_Op (Interfaces.Unsigned_8, Nand_8); + pragma Export (C, Atomic_Fetch_Nand_1, "__atomic_fetch_nand_1"); + + function Atomic_Fetch_Nand_2 is new + Atomic_Fetch_Op (Interfaces.Unsigned_16, Nand_16); + pragma Export (C, Atomic_Fetch_Nand_2, "__atomic_fetch_nand_2"); + + function Atomic_Fetch_Nand_4 is new + Atomic_Fetch_Op (Interfaces.Unsigned_32, Nand_32); + pragma Export (C, Atomic_Fetch_Nand_4, "__atomic_fetch_nand_4"); + + function Atomic_Fetch_Nand_8 is new + Atomic_Fetch_Op (Interfaces.Unsigned_64, Nand_64); + pragma Export (C, Atomic_Fetch_Nand_8, "__atomic_fetch_nand_8"); + +private + + function PRIMASK return Interfaces.Unsigned_32 + with Inline_Always; + + function Interrupt_Disabled return Boolean + with Inline_Always; + + procedure Disable_Interrupts + with Inline_Always; + + procedure Enable_Interrupts + with Inline_Always; + + procedure Spinlock_Lock + with Inline_Always, + Pre => Interrupt_Disabled; + -- Obtain the hardware spinlock. + -- + -- This must be called with interrupts disabled to avoid deadlocks when + -- an interrupt occurs and tries to do an atomic operation immediately + -- after the spinlock was obtained by a lower priority task/interrupt. + + procedure Spinlock_Unlock + with Inline_Always; + + generic + with procedure Wrapped_Proc; + procedure Atomic_Wrapper + with Inline_Always; + -- Calls Wrapped_Proc with interrupts disabled + -- and the hardware spinlock obtained (locked). + +end System.BB.RP2040_Atomic; \ No newline at end of file diff --git a/src/s-bbbosu__rp2040.adb b/src/s-bbbosu__rp2040.adb index bac8c419..94ae85ff 100644 --- a/src/s-bbbosu__rp2040.adb +++ b/src/s-bbbosu__rp2040.adb @@ -79,10 +79,17 @@ package body System.BB.Board_Support is NVIC_ISPR0 : constant Address := NVIC_Base + 16#200#; + NVIC_ICPR0 : constant Address := NVIC_Base + 16#280#; + -- Writing a bit mask to this register clears the interrupt pending bit + NVIC_ISER : Word with Volatile, Address => NVIC_ISER0; -- NVIC Interrupt Set-Enable Register (ISER) + NVIC_ICPR : Word + with Volatile, Address => NVIC_ICPR0; + -- NVIC Interrupt Clear Pending Register (ISER) + NVIC_ISPR : Word with Volatile, Address => NVIC_ISPR0; -- NVIC Interrupt Set Pending Register (ISPR) @@ -234,6 +241,7 @@ package body System.BB.Board_Support is -- Clear pending timer interrupt if any Time.Clear_Alarm_Interrupt; + NVIC_ICPR := NVIC_ISER or 2**Alarm_Interrupt_ID; -- Enable interrupt NVIC_ISER := NVIC_ISER or 2**Alarm_Interrupt_ID; From ceed75b9686a59a8d947da472cead81a77393dbc Mon Sep 17 00:00:00 2001 From: Daniel King Date: Mon, 17 Oct 2022 19:15:05 +0100 Subject: [PATCH 2/3] rpi-pico: Remove GCC __atomic intrinsics --- arm/rpi/rp2040/s-bbrpat.adb | 206 -------------------- arm/rpi/rp2040/s-bbrpat.ads | 369 ------------------------------------ 2 files changed, 575 deletions(-) diff --git a/arm/rpi/rp2040/s-bbrpat.adb b/arm/rpi/rp2040/s-bbrpat.adb index 9a25ce18..574583a2 100644 --- a/arm/rpi/rp2040/s-bbrpat.adb +++ b/arm/rpi/rp2040/s-bbrpat.adb @@ -195,210 +195,4 @@ package body System.BB.RP2040_Atomic is return Ret; end Sync_Bool_Compare_And_Swap; - ----------------- - -- Atomic_Load -- - ----------------- - - function Atomic_Load (Addr : System.Address; - Order : Mem_Order) return T - is - Data : T with Address => Addr; - Ret : T; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Ret := Data; - end Inner; - - procedure Fallback is new Atomic_Wrapper (Inner); - - begin - - -- Byte, halfword, and word accesses are always atomic on armv6m. - -- doubleword accesses are not atomic, so we need to fallback to - -- doing the load with interrupts disabled. - - if T'Size <= 32 then - if Order = Relaxed then - Ret := Data; - else - Fallback; - end if; - else - Fallback; - end if; - - return Ret; - end Atomic_Load; - - ------------------ - -- Atomic_Store -- - ------------------ - - procedure Atomic_Store (Addr : System.Address; - Value : T; - Order : Mem_Order) - is - Data : T with Address => Addr; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Data := Value; - end Inner; - - procedure Fallback is new Atomic_Wrapper (Inner); - - begin - -- Byte, halfword, and word accesses are always atomic on armv6m. - -- doubleword accesses are not atomic, so we need to fallback to - -- doing the load with interrupts disabled. - - if T'Size <= 32 then - if Order = Relaxed then - Data := Value; - else - Fallback; - end if; - else - Fallback; - end if; - end Atomic_Store; - - --------------------- - -- Atomic_Exchange -- - --------------------- - - function Atomic_Exchange (Addr : System.Address; - Value : T; - Order : Mem_Order) return T - is - pragma Unreferenced (Order); - - Data : T with Address => Addr; - Ret : T; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Ret := Data; - Data := Value; - end Inner; - - procedure Do_Atomic_Exchange is new Atomic_Wrapper (Inner); - - begin - Do_Atomic_Exchange; - return Ret; - end Atomic_Exchange; - - ----------------------------- - -- Atomic_Compare_Exchange -- - ----------------------------- - - function Atomic_Compare_Exchange - (Addr : System.Address; - Expected_Addr : System.Address; - Desired : T; - Weak : Interfaces.C.C_bool; - Success_Order : Mem_Order; - Failure_Order : Mem_Order) return Interfaces.C.C_bool - is - pragma Unreferenced (Weak); - pragma Unreferenced (Success_Order); - pragma Unreferenced (Failure_Order); - - Data : T with Address => Addr; - Expected : T with Address => Expected_Addr; - Ret : Interfaces.C.C_bool; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Ret := Interfaces.C.C_bool (Data = Expected); - if Ret then - Data := Desired; - end if; - end Inner; - - procedure Do_Atomic_Compare_Exchange is new Atomic_Wrapper (Inner); - - begin - Do_Atomic_Compare_Exchange; - return Ret; - end Atomic_Compare_Exchange; - - --------------------- - -- Atomic_Op_Fetch -- - --------------------- - - function Atomic_Op_Fetch (Addr : System.Address; - Value : T; - Order : Mem_Order) return T - is - pragma Unreferenced (Order); - - Data : T with Address => Addr; - Ret : T; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Ret := Operation (Data, Value); - Data := Ret; - end Inner; - - procedure Do_Atomic_Op_Fetch is new Atomic_Wrapper (Inner); - - begin - Do_Atomic_Op_Fetch; - return Ret; - end Atomic_Op_Fetch; - - --------------------- - -- Atomic_Fetch_Op -- - --------------------- - - function Atomic_Fetch_Op (Addr : System.Address; - Value : T; - Order : Mem_Order) return T - is - pragma Unreferenced (Order); - - Data : T with Address => Addr; - Ret : T; - - procedure Inner - with Inline_Always; - - procedure Inner - is - begin - Ret := Data; - Data := Operation (Data, Value); - end Inner; - - procedure Do_Atomic_Fetch_Op is new Atomic_Wrapper (Inner); - - begin - Do_Atomic_Fetch_Op; - return Ret; - end Atomic_Fetch_Op; - end System.BB.RP2040_Atomic; diff --git a/arm/rpi/rp2040/s-bbrpat.ads b/arm/rpi/rp2040/s-bbrpat.ads index e16cdc62..4d30a893 100644 --- a/arm/rpi/rp2040/s-bbrpat.ads +++ b/arm/rpi/rp2040/s-bbrpat.ads @@ -65,375 +65,6 @@ package System.BB.RP2040_Atomic is pragma Export (C, Sync_Bool_Compare_And_Swap_4, "__sync_bool_compare_and_swap_4"); - ------------------- - -- Memory Orders -- - ------------------- - - type Mem_Order is new Interfaces.C.int; - - Relaxed : constant Mem_Order := 0; - -- Implies no inter-thread ordering constraints - - Consume : constant Mem_Order := 1; - -- This is currently implemented using the stronger __ATOMIC_ACQUIRE - -- memory order because of a deficiency in C++11's semantics for - -- memory_order_consume. - - Acquire : constant Mem_Order := 2; - -- Creates an inter-thread happens-before constraint from the release - -- (or stronger) semantic store to this acquire load. Can prevent - -- hoisting of code to before the operation. - - Release : constant Mem_Order := 3; - -- Creates an inter-thread happens-before constraint to acquire (or - -- stronger) semantic loads that read from this release store. Can - -- prevent sinking of code to after the operation. - - Acq_Rel : constant Mem_Order := 4; - -- Combines the effects of both Acquire and Release - - Seq_Cst : constant Mem_Order := 5; - -- Enforces total ordering with all other Seq_Cst operations - - --------------------- - -- __atomic_load_n -- - --------------------- - - generic - type T is mod <>; - function Atomic_Load (Addr : System.Address; - Order : Mem_Order) return T; - - function Atomic_Load_1 is new Atomic_Load (Interfaces.Unsigned_8); - pragma Export (C, Atomic_Load_1, "__atomic_load_1"); - function Atomic_Load_2 is new Atomic_Load (Interfaces.Unsigned_16); - pragma Export (C, Atomic_Load_2, "__atomic_load_2"); - function Atomic_Load_4 is new Atomic_Load (Interfaces.Unsigned_32); - pragma Export (C, Atomic_Load_4, "__atomic_load_4"); - function Atomic_Load_8 is new Atomic_Load (Interfaces.Unsigned_64); - pragma Export (C, Atomic_Load_8, "__atomic_load_8"); - - ---------------------- - -- __atomic_store_n -- - ---------------------- - - generic - type T is mod <>; - procedure Atomic_Store (Addr : System.Address; - Value : T; - Order : Mem_Order); - - procedure Atomic_Store_1 is new Atomic_Store (Interfaces.Unsigned_8); - pragma Export (C, Atomic_Store_1, "__atomic_store_1"); - procedure Atomic_Store_2 is new Atomic_Store (Interfaces.Unsigned_16); - pragma Export (C, Atomic_Store_2, "__atomic_store_2"); - procedure Atomic_Store_4 is new Atomic_Store (Interfaces.Unsigned_32); - pragma Export (C, Atomic_Store_4, "__atomic_store_4"); - procedure Atomic_Store_8 is new Atomic_Store (Interfaces.Unsigned_64); - pragma Export (C, Atomic_Store_8, "__atomic_store_8"); - - ------------------------- - -- __atomic_exchange_n -- - ------------------------- - - generic - type T is mod <>; - function Atomic_Exchange (Addr : System.Address; - Value : T; - Order : Mem_Order) return T; - - function Atomic_Exchange_1 is new Atomic_Exchange (Interfaces.Unsigned_8); - pragma Export (C, Atomic_Exchange_1, "__atomic_exchange_1"); - function Atomic_Exchange_2 is new Atomic_Exchange (Interfaces.Unsigned_16); - pragma Export (C, Atomic_Exchange_2, "__atomic_exchange_2"); - function Atomic_Exchange_4 is new Atomic_Exchange (Interfaces.Unsigned_32); - pragma Export (C, Atomic_Exchange_4, "__atomic_exchange_4"); - function Atomic_Exchange_8 is new Atomic_Exchange (Interfaces.Unsigned_64); - pragma Export (C, Atomic_Exchange_8, "__atomic_exchange_8"); - - --------------------------------- - -- __atomic_compare_exchange_n -- - --------------------------------- - - generic - type T is mod <>; - function Atomic_Compare_Exchange - (Addr : System.Address; - Expected_Addr : System.Address; - Desired : T; - Weak : Interfaces.C.C_bool; - Success_Order : Mem_Order; - Failure_Order : Mem_Order) return Interfaces.C.C_bool; - - function Atomic_Compare_Exchange_1 is - new Atomic_Compare_Exchange (Interfaces.Unsigned_8); - pragma Export (C, Atomic_Compare_Exchange_1, - "__atomic_compare_exchange_1"); - - function Atomic_Compare_Exchange_2 is - new Atomic_Compare_Exchange (Interfaces.Unsigned_16); - pragma Export (C, Atomic_Compare_Exchange_2, - "__atomic_compare_exchange_2"); - - function Atomic_Compare_Exchange_4 is - new Atomic_Compare_Exchange (Interfaces.Unsigned_32); - pragma Export (C, Atomic_Compare_Exchange_4, - "__atomic_compare_exchange_4"); - - function Atomic_Compare_Exchange_8 is - new Atomic_Compare_Exchange (Interfaces.Unsigned_64); - pragma Export (C, Atomic_Compare_Exchange_8, - "__atomic_compare_exchange_8"); - - ------------------------ - -- __atomic__fetch -- - ------------------------ - - generic - type T is mod <>; - with function Operation (Left, Right : T) return T; - function Atomic_Op_Fetch (Addr : System.Address; - Value : T; - Order : Mem_Order) return T; - - -- __atomic_add_fetch - - function Atomic_Add_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."+"); - pragma Export (C, Atomic_Add_Fetch_1, "__atomic_add_fetch_1"); - - function Atomic_Add_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."+"); - pragma Export (C, Atomic_Add_Fetch_2, "__atomic_add_fetch_2"); - - function Atomic_Add_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."+"); - pragma Export (C, Atomic_Add_Fetch_4, "__atomic_add_fetch_4"); - - function Atomic_Add_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."+"); - pragma Export (C, Atomic_Add_Fetch_8, "__atomic_add_fetch_8"); - - -- __atomic_sub_fetch - - function Atomic_Sub_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."-"); - pragma Export (C, Atomic_Sub_Fetch_1, "__atomic_sub_fetch_1"); - - function Atomic_Sub_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."-"); - pragma Export (C, Atomic_Sub_Fetch_2, "__atomic_sub_fetch_2"); - - function Atomic_Sub_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."-"); - pragma Export (C, Atomic_Sub_Fetch_4, "__atomic_sub_fetch_4"); - - function Atomic_Sub_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."-"); - pragma Export (C, Atomic_Sub_Fetch_8, "__atomic_sub_fetch_8"); - - -- __atomic_and_fetch - - function Atomic_And_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."and"); - pragma Export (C, Atomic_And_Fetch_1, "__atomic_and_fetch_1"); - - function Atomic_And_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."and"); - pragma Export (C, Atomic_And_Fetch_2, "__atomic_and_fetch_2"); - - function Atomic_And_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."and"); - pragma Export (C, Atomic_And_Fetch_4, "__atomic_and_fetch_4"); - - function Atomic_And_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."and"); - pragma Export (C, Atomic_And_Fetch_8, "__atomic_and_fetch_8"); - - -- __atomic_xor_fetch - - function Atomic_Xor_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."xor"); - pragma Export (C, Atomic_Xor_Fetch_1, "__atomic_xor_fetch_1"); - - function Atomic_Xor_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."xor"); - pragma Export (C, Atomic_Xor_Fetch_2, "__atomic_xor_fetch_2"); - - function Atomic_Xor_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."xor"); - pragma Export (C, Atomic_Xor_Fetch_4, "__atomic_xor_fetch_4"); - - function Atomic_Xor_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."xor"); - pragma Export (C, Atomic_Xor_Fetch_8, "__atomic_xor_fetch_8"); - - -- __atomic_or_fetch - - function Atomic_Or_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Interfaces."or"); - pragma Export (C, Atomic_Or_Fetch_1, "__atomic_or_fetch_1"); - - function Atomic_Or_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Interfaces."or"); - pragma Export (C, Atomic_Or_Fetch_2, "__atomic_or_fetch_2"); - - function Atomic_Or_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Interfaces."or"); - pragma Export (C, Atomic_Or_Fetch_4, "__atomic_or_fetch_4"); - - function Atomic_Or_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Interfaces."or"); - pragma Export (C, Atomic_Or_Fetch_8, "__atomic_or_fetch_8"); - - -- __atomic_nand_fetch - - generic - type T is mod <>; - function Generic_Nand (Left, Right : T) return T; - - function Generic_Nand (Left, Right : T) return T is (not (Left and Right)); - - function Nand_8 is new Generic_Nand (Interfaces.Unsigned_8); - function Nand_16 is new Generic_Nand (Interfaces.Unsigned_16); - function Nand_32 is new Generic_Nand (Interfaces.Unsigned_32); - function Nand_64 is new Generic_Nand (Interfaces.Unsigned_64); - - function Atomic_Nand_Fetch_1 is new - Atomic_Op_Fetch (Interfaces.Unsigned_8, Nand_8); - pragma Export (C, Atomic_Nand_Fetch_1, "__atomic_nand_fetch_1"); - - function Atomic_Nand_Fetch_2 is new - Atomic_Op_Fetch (Interfaces.Unsigned_16, Nand_16); - pragma Export (C, Atomic_Nand_Fetch_2, "__atomic_nand_fetch_2"); - - function Atomic_Nand_Fetch_4 is new - Atomic_Op_Fetch (Interfaces.Unsigned_32, Nand_32); - pragma Export (C, Atomic_Nand_Fetch_4, "__atomic_nand_fetch_4"); - - function Atomic_Nand_Fetch_8 is new - Atomic_Op_Fetch (Interfaces.Unsigned_64, Nand_64); - pragma Export (C, Atomic_Nand_Fetch_8, "__atomic_nand_fetch_8"); - - ------------------------ - -- __atomic_fetch_ -- - ------------------------ - - generic - type T is mod <>; - with function Operation (Left, Right : T) return T; - function Atomic_Fetch_Op (Addr : System.Address; - Value : T; - Order : Mem_Order) return T; - - -- __atomic_fetch_add - - function Atomic_Fetch_Add_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."+"); - pragma Export (C, Atomic_Fetch_Add_1, "__atomic_fetch_add_1"); - - function Atomic_Fetch_Add_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."+"); - pragma Export (C, Atomic_Fetch_Add_2, "__atomic_fetch_add_2"); - - function Atomic_Fetch_Add_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."+"); - pragma Export (C, Atomic_Fetch_Add_4, "__atomic_fetch_add_4"); - - function Atomic_Fetch_Add_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."+"); - pragma Export (C, Atomic_Fetch_Add_8, "__atomic_fetch_add_8"); - - -- __atomic_fetch_sub - - function Atomic_Fetch_Sub_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."-"); - pragma Export (C, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1"); - - function Atomic_Fetch_Sub_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."-"); - pragma Export (C, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2"); - - function Atomic_Fetch_Sub_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."-"); - pragma Export (C, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4"); - - function Atomic_Fetch_Sub_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."-"); - pragma Export (C, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8"); - - -- __atomic_fetch_and - - function Atomic_Fetch_And_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."and"); - pragma Export (C, Atomic_Fetch_And_1, "__atomic_fetch_and_1"); - - function Atomic_Fetch_And_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."and"); - pragma Export (C, Atomic_Fetch_And_2, "__atomic_fetch_and_2"); - - function Atomic_Fetch_And_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."and"); - pragma Export (C, Atomic_Fetch_And_4, "__atomic_fetch_and_4"); - - function Atomic_Fetch_And_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."and"); - pragma Export (C, Atomic_Fetch_And_8, "__atomic_fetch_and_8"); - - -- __atomic_fetch_xor - - function Atomic_Fetch_Xor_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."xor"); - pragma Export (C, Atomic_Fetch_Xor_1, "__atomic_fetch_xor_1"); - - function Atomic_Fetch_Xor_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."xor"); - pragma Export (C, Atomic_Fetch_Xor_2, "__atomic_fetch_xor_2"); - - function Atomic_Fetch_Xor_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."xor"); - pragma Export (C, Atomic_Fetch_Xor_4, "__atomic_fetch_xor_4"); - - function Atomic_Fetch_Xor_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."xor"); - pragma Export (C, Atomic_Fetch_Xor_8, "__atomic_fetch_xor_8"); - - -- __atomic_fetch_or - - function Atomic_Fetch_Or_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Interfaces."or"); - pragma Export (C, Atomic_Fetch_Or_1, "__atomic_fetch_or_1"); - - function Atomic_Fetch_Or_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Interfaces."or"); - pragma Export (C, Atomic_Fetch_Or_2, "__atomic_fetch_or_2"); - - function Atomic_Fetch_Or_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Interfaces."or"); - pragma Export (C, Atomic_Fetch_Or_4, "__atomic_fetch_or_4"); - - function Atomic_Fetch_Or_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Interfaces."or"); - pragma Export (C, Atomic_Fetch_Or_8, "__atomic_fetch_or_8"); - - -- __atomic_fetch_nand - - function Atomic_Fetch_Nand_1 is new - Atomic_Fetch_Op (Interfaces.Unsigned_8, Nand_8); - pragma Export (C, Atomic_Fetch_Nand_1, "__atomic_fetch_nand_1"); - - function Atomic_Fetch_Nand_2 is new - Atomic_Fetch_Op (Interfaces.Unsigned_16, Nand_16); - pragma Export (C, Atomic_Fetch_Nand_2, "__atomic_fetch_nand_2"); - - function Atomic_Fetch_Nand_4 is new - Atomic_Fetch_Op (Interfaces.Unsigned_32, Nand_32); - pragma Export (C, Atomic_Fetch_Nand_4, "__atomic_fetch_nand_4"); - - function Atomic_Fetch_Nand_8 is new - Atomic_Fetch_Op (Interfaces.Unsigned_64, Nand_64); - pragma Export (C, Atomic_Fetch_Nand_8, "__atomic_fetch_nand_8"); - private function PRIMASK return Interfaces.Unsigned_32 From 29e4890ba2d444d3942fae3dc6afa1d366ff708a Mon Sep 17 00:00:00 2001 From: Daniel King Date: Wed, 19 Oct 2022 20:32:07 +0100 Subject: [PATCH 3/3] rpi-pico: Update copyright headers --- arm/rpi/rp2040/s-bbrpat.adb | 5 +++-- arm/rpi/rp2040/s-bbrpat.ads | 5 +++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/arm/rpi/rp2040/s-bbrpat.adb b/arm/rpi/rp2040/s-bbrpat.adb index 574583a2..48865b97 100644 --- a/arm/rpi/rp2040/s-bbrpat.adb +++ b/arm/rpi/rp2040/s-bbrpat.adb @@ -2,8 +2,9 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- Copyright (C) 2022, Daniel King -- --- Copyright (C) 2022, AdaCore -- +-- Copyright (C) AdaCore and other contributors, 2022 -- +-- See https://github.com/AdaCore/bb-runtimes/graphs/contributors -- +-- for more information -- -- -- -- 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- -- diff --git a/arm/rpi/rp2040/s-bbrpat.ads b/arm/rpi/rp2040/s-bbrpat.ads index 4d30a893..6a89b767 100644 --- a/arm/rpi/rp2040/s-bbrpat.ads +++ b/arm/rpi/rp2040/s-bbrpat.ads @@ -2,8 +2,9 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- Copyright (C) 2022, Daniel King -- --- Copyright (C) 2022, AdaCore -- +-- Copyright (C) AdaCore and other contributors, 2022 -- +-- See https://github.com/AdaCore/bb-runtimes/graphs/contributors -- +-- for more information -- -- -- -- 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- --