gnat_arm_elf_13.2.1_db1e9283/arm-eabi/lib/gnat/embedded-stm32f4/gnarl/s-bbcppr.adb

------------------------------------------------------------------------------
--                                                                          --
--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
--                                                                          --
--               S Y S T E M . B B . C P U _ P R I M I T I V E S            --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--        Copyright (C) 1999-2002 Universidad Politecnica de Madrid         --
--             Copyright (C) 2003-2005 The European Space Agency            --
--                     Copyright (C) 2003-2021, AdaCore                     --
--                                                                          --
-- GNARL 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. GNARL 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/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

--  This version is for ARM bareboard targets using the ARMv7-M targets,
--  which only use Thumb2 instructions.

with Ada.Unchecked_Conversion; use Ada;

with System.Multiprocessors;
with System.BB.Board_Support;
with System.BB.CPU_Specific;
with System.BB.Threads;
with System.BB.Threads.Queues;
with System.Machine_Code; use System.Machine_Code;
with System.BB.CPU_Primitives.Context_Switch_Trigger;

package body System.BB.CPU_Primitives is
   use Board_Support;
   use Board_Support.Time;
   use System.BB.CPU_Primitives.Context_Switch_Trigger;
   use Parameters;
   use Threads.Queues;

   NL : constant String := ASCII.LF & ASCII.HT;
   --  New line separator in Asm templates

   Has_VTOR : constant Boolean := System.BB.Parameters.Has_VTOR;
   --  Set True iff the Vector Table Offset Register (VTOR) can be used
   --  (armv7-m architecture or Cortex-M0+).

   Has_OS_Extensions : constant Boolean :=
     System.BB.Parameters.Has_OS_Extensions;
   --  Set True iff the core implements the armv6-m OS extensions

   Is_ARMv6m : constant Boolean := System.BB.Parameters.Is_ARMv6m;
   --  Set True iff the core implements the armv6-m architecture

   -----------
   -- Traps --
   -----------

   Reset_Vector             : constant Vector_Id :=  1;
   NMI_Vector               : constant Vector_Id :=  2;
   Hard_Fault_Vector        : constant Vector_Id :=  3;
   --  Mem_Manage_Vector    : constant Vector_Id :=  4; --  Never referenced
   Bus_Fault_Vector         : constant Vector_Id :=  5;
   Usage_Fault_Vector       : constant Vector_Id :=  6;
   SV_Call_Vector           : constant Vector_Id := 11;
   --  Debug_Mon_Vector     : constant Vector_Id := 12; --  Never referenced
   Pend_SV_Vector           : constant Vector_Id := 14;
   Sys_Tick_Vector          : constant Vector_Id := 15;
   Interrupt_Request_Vector : constant Vector_Id := 16;

   pragma Assert (Interrupt_Request_Vector = Vector_Id'Last);

   type Trap_Handler_Ptr is access procedure (Id : Vector_Id);
   function To_Pointer is new Unchecked_Conversion (Address, Trap_Handler_Ptr);

   type Trap_Handler_Table is array (Vector_Id) of Trap_Handler_Ptr;
   pragma Suppress_Initialization (Trap_Handler_Table);

   Trap_Handlers : Trap_Handler_Table;
   pragma Export (C, Trap_Handlers, "__gnat_bb_exception_handlers");

   System_Vectors : constant System.Address;
   pragma Import (Asm, System_Vectors, "__vectors");

   --  As ARMv7M does not directly provide a single-shot alarm timer, and
   --  we have to use Sys_Tick for that, we need to have this clock generate
   --  interrupts at a relatively high rate. To avoid unnecessary overhead
   --  when no alarms are requested, we'll only call the alarm handler if
   --  the current time exceeds the Alarm_Time by at most half the modulus
   --  of Timer_Interval.

   Alarm_Time : Board_Support.Time.Timer_Interval;
   pragma Volatile (Alarm_Time);
   pragma Import (C, Alarm_Time, "__gnat_alarm_time");

   procedure SV_Call_Handler;
   pragma Export (Asm, SV_Call_Handler, "__gnat_sv_call_trap");

   procedure Sys_Tick_Handler;
   pragma Export (Asm, Sys_Tick_Handler, "__gnat_sys_tick_trap");

   procedure Interrupt_Request_Handler;
   pragma Export (Asm, Interrupt_Request_Handler, "__gnat_irq_trap");

   procedure GNAT_Error_Handler (Trap : Vector_Id);
   pragma No_Return (GNAT_Error_Handler);

   procedure Set_Selected_Priority_Group;
   --  assign the priority group specified by BB.Parameters

   -----------------------
   -- Context Switching --
   -----------------------

   --  This port uses the ARMv6/7-M hardware for saving volatile context for
   --  interrupts, see the Hardware_Context type below for details. Any
   --  non-volatile registers will be preserved by the interrupt handler in
   --  the same way as it happens for ordinary procedure calls.

   --  The non-volatile registers, as well as the value of the stack pointer
   --  (SP_process) are saved in the Context buffer of the Thread_Descriptor.
   --  Any non-volatile floating-point registers are saved on the stack.

   --  R4 .. R11 are at offset 0 .. 7

   SP_process : constant Context_Id := 8;

   type Hardware_Context is record
      R0, R1, R2, R3   : Word;
      R12, LR, PC, PSR : Word;
   end record;

   ----------------
   -- Interrupts --
   ----------------

   subtype Cortex_Priority_Group is Integer range 0 .. 7;
   --  The eight bits in a hardware priority value are subdivided into a "group
   --  priority" and a "sub-priority" level. The group priority level controls
   --  whether an interrupt can take place when the processor is already
   --  executing another interrupt handler, i.e., the preemption levels. The
   --  sub-priority level is only used when two interrupts with the same group
   --  priority occur at the same time. If two interrupts occur at the same
   --  time with the same group priority and sub-priority, the interrupt
   --  number determines which will execute first, so sub-priorities are
   --  not essential.
   --
   --  The group priority occupies the more significant bits (on the "left")
   --  and the sub-priority bits occupy the less significant bits (on the
   --  "right") within the register's least significant byte. The eight
   --  possible Cortex_Priority_Group selection values define the numbers
   --  of bits allocated within the left and right bit subsets.
   --
   --  The possible priority group selection numbers (0 through 7, on the left)
   --  and their two corresponding subsets' bit allocations are as follows. The
   --  group priority column is labeled "Preemption Bits" for clarity.
   --
   ---------------------------------------------
   --    Group  |  Preemption  |  Sub-priority |
   --    Number |     Bits     |     Bits      |
   ---------------------------------------------
   --       0        [7:1]            [0]
   --       1        [7:2]           [1:0]
   --       2        [7:3]           [2:0]
   --       3        [7:4]           [3:0]
   --       4        [7:5]           [4:0]
   --       5        [7:6]           [5:0]
   --       6         [7]            [6:0]
   --       7        none            [7:0]

   Priority_Group : constant Cortex_Priority_Group := 7 - NVIC_Priority_Bits;
   --  The Cortex Priority Group to be configured by the runtime. Set to
   --  maximize the number of hardware priorities available to the runtime
   --  by allocating all implemented hardware priority bits (the quantity
   --  NVIC_Priority_Bits) to the preemption bits. The priority group is
   --  calculated based on the table above.

   type Bit    is mod 2 ** 1;
   type UInt16 is mod 2 ** 16;

   --   App Interrupt and (system) Reset Control

   type AIRCR_Register is record
      SYSRESETREQ    : Bit;
      SYSRESETREQs   : Bit;
      PRIGROUP       : Cortex_Priority_Group;
      BFHFNMINS      : Bit;
      PRIS           : Bit;
      Endianness     : Bit;
      VECTKEY        : UInt16;
   end record with
     Size => 32;

   for AIRCR_Register use record
      SYSRESETREQ    at 0 range 2 .. 2;
      SYSRESETREQs   at 0 range 3 .. 3;
      PRIGROUP       at 0 range 8 .. 10;
      BFHFNMINS      at 0 range 13 .. 13;
      PRIS           at 0 range 14 .. 14;
      Endianness     at 0 range 15 .. 15;
      VECTKEY        at 0 range 16 .. 31;
   end record;

   AIRCR_Write_Key : constant := 16#05FA#;
   AIRCR_Read_Key  : constant := 16#0FA5#;

   AIRCR : AIRCR_Register with Volatile, Import, Address => 16#E000_ED0C#;

   --  Additional control registers

   VTOR : Address with Volatile, Address => 16#E000_ED08#; -- Vec. Table Offset

   CCR   : Word with Volatile, Address => 16#E000_ED14#; -- Config. Control
   SHPR1 : Word with Volatile, Address => 16#E000_ED18#; -- Sys Hand  4- 7 Prio
   SHPR2 : Word with Volatile, Address => 16#E000_ED1C#; -- Sys Hand  8-11 Prio
   SHPR3 : Word with Volatile, Address => 16#E000_ED20#; -- Sys Hand 12-15 Prio
   SHCSR : Word with Volatile, Address => 16#E000_ED24#; -- Sys Hand Ctrl/State

   function PRIMASK return Word with Inline, Export, Convention => C;
   --  Function returning the contents of the PRIMASK register

   -------------
   -- PRIMASK --
   -------------

   function PRIMASK return Word is
      Result : Word;
   begin
      Asm ("mrs %0, PRIMASK",
           Outputs  => Word'Asm_Output ("=r", Result),
           Volatile => True);
      return Result;
   end PRIMASK;

   --------------------
   -- Initialize_CPU --
   --------------------

   procedure Initialize_CPU is
      Interrupt_Stack_Table : array (System.Multiprocessors.CPU)
        of System.Address;
      pragma Import (Asm, Interrupt_Stack_Table, "interrupt_stack_table");
      --  Table containing a pointer to the top of the stack for each processor

      SP : constant System.Address := Interrupt_Stack_Table
        (System.BB.Board_Support.Multiprocessors.Current_CPU);

   begin

      if Has_OS_Extensions then
         --  Switch the stack pointer to SP_process (PSP)

         Asm ("mrs r0, MSP"     & NL &
              "msr PSP, r0"     & NL &
              "mrs r0, CONTROL" & NL &
              "movs r1, #2"     & NL &
              "orr r0,r0,r1"    & NL &
              "msr CONTROL,r0"  & NL &
              "mrs r0, CONTROL",
              Clobber => "r0,r1",
              Volatile => True);

         --  Initialize SP_main (MSP)

         Asm ("msr MSP, %0",
              Inputs => Address'Asm_Input ("r", SP),
              Volatile => True);
      end if;

      if Has_VTOR then
         --  Initialize vector table
         VTOR := System_Vectors'Address;
      end if;

      --  Set configuration: stack is 8 byte aligned, trap on divide by 0,
      --  no trap on unaligned access, can enter thread mode from any level.

      CCR := CCR or 16#211#;

      --  Set priorities of system handlers. The Pend_SV handler runs at the
      --  lowest priority, so context switching does not block higher priority
      --  interrupt handlers. All other system handlers run at the highest
      --  priority (0), so they will not be interrupted. This is also true for
      --  the SysTick interrupt, as this interrupt must be serviced promptly in
      --  order to avoid losing track of time.

      SHPR1 := 0;
      SHPR2 := 0;
      SHPR3 := 16#00_FF_00_00#;

      if not Is_ARMv6m then
         Set_Selected_Priority_Group;
      end if;

      --  Enable usage, bus and memory management fault

      SHCSR := SHCSR or 16#7_0000#;

      --  Call context switch hardware initialization
      Initialize_Context_Switch;

      --  Unmask Fault

      Asm ("cpsie f", Volatile => True);

   end Initialize_CPU;

   ----------------------
   -- Initialize_Stack --
   ----------------------

   procedure Initialize_Stack
     (Base          : Address;
      Size          : Storage_Elements.Storage_Offset;
      Stack_Pointer : out Address)
   is
      use System.Storage_Elements;
   begin
      --  Force alignment
      Stack_Pointer := Base + (Size - (Size mod CPU_Specific.Stack_Alignment));
   end Initialize_Stack;

   --------------------
   -- Context_Switch --
   --------------------

   procedure Context_Switch is
   begin
      --  Interrupts must be disabled at this point

      pragma Assert (PRIMASK = 1);

      Trigger_Context_Switch;

      --  Memory must be clobbered, as task switching causes a task to signal,
      --  which means its memory changes must be visible to all other tasks.
      Asm ("", Volatile => True, Clobber => "memory");
   end Context_Switch;

   -----------------
   -- Get_Context --
   -----------------

   function Get_Context
     (Context : Context_Buffer;
      Index   : Context_Id) return Word
   is
      (Word (Context (Index)));

   ------------------------
   -- GNAT_Error_Handler --
   ------------------------

   procedure GNAT_Error_Handler (Trap : Vector_Id) is
   begin
      case Trap is
         when Reset_Vector =>
            raise Program_Error with "unexpected reset";
         when NMI_Vector =>
            raise Program_Error with "non-maskable interrupt";
         when Hard_Fault_Vector =>
            raise Program_Error with "hard fault";
         when Bus_Fault_Vector  =>
            raise Program_Error with "bus fault";
         when Usage_Fault_Vector =>
            raise Constraint_Error with "usage fault";
         when others =>
            raise Program_Error with "unhandled trap";
      end case;
   end GNAT_Error_Handler;

   ----------------------------------
   -- Interrupt_Request_Handler -- --
   ----------------------------------

   procedure Interrupt_Request_Handler is
   begin
      --  Call the handler (System.BB.Interrupts.Interrupt_Wrapper)

      Trap_Handlers (Interrupt_Request_Vector)(Interrupt_Request_Vector);

      --  The handler has changed the current priority (BASEPRI), although
      --  being useless on ARMv7m. We need to revert it.

      --  The interrupt handler may have scheduled a new task, so we need to
      --  check whether a context switch is needed.

      if Has_OS_Extensions then
         if Context_Switch_Needed then

            --  Perform a context switch because the currently executing thread
            --  is no longer the one with the highest priority.

            --  No need to update execution time. Already done in the wrapper.

            --  Note that the following context switch is not immediate, but
            --  will only take effect after interrupts are enabled.

            Context_Switch;
         end if;
      else
         --  When OS extensions are not available, the context switch will be
         --  handled in the lower level trap handler:
         --  __gnat_irq_trap_without_os_extensions
         null;
      end if;

      --  Restore interrupt masking of interrupted thread

      Enable_Interrupts (Running_Thread.Active_Priority);
   end Interrupt_Request_Handler;

   ---------------------
   -- SV_Call_Handler --
   ---------------------

   procedure SV_Call_Handler is
   begin
      GNAT_Error_Handler (SV_Call_Vector);
   end SV_Call_Handler;

   -----------------
   -- Set_Context --
   -----------------

   procedure Set_Context
     (Context : in out Context_Buffer;
      Index   : Context_Id;
      Value   : Word)
   is
   begin
      Context (Index) := Address (Value);
   end Set_Context;

   ----------------------
   -- Sys_Tick_Handler --
   ----------------------

   procedure Sys_Tick_Handler is
      Max_Alarm_Interval : constant Timer_Interval := Timer_Interval'Last / 2;
      Now : constant Timer_Interval := Timer_Interval (Read_Clock);

   begin
      --  The following allows max. efficiency for "useless" tick interrupts

      if Alarm_Time - Now <= Max_Alarm_Interval then

         --  Alarm is still in the future, nothing to do, so return quickly

         return;
      end if;

      Alarm_Time := Now + Max_Alarm_Interval;

      --  Call the alarm handler

      Trap_Handlers (Sys_Tick_Vector)(Sys_Tick_Vector);

      --  The interrupt handler may have scheduled a new task

      if Context_Switch_Needed then
         Context_Switch;
      end if;

      Enable_Interrupts (Running_Thread.Active_Priority);
   end Sys_Tick_Handler;

   ------------------------
   -- Initialize_Context --
   ------------------------

   procedure Initialize_Context
     (Buffer          : not null access Context_Buffer;
      Program_Counter : System.Address;
      Argument        : System.Address;
      Stack_Pointer   : System.Address)
   is
      HW_Ctx_Bytes : constant System.Address := Hardware_Context'Size / 8;
      New_SP       : constant System.Address :=
                       (Stack_Pointer - HW_Ctx_Bytes) and not 4;

      HW_Ctx : Hardware_Context with Address => New_SP;

   begin
      --  No need to initialize the context of the environment task

      if Program_Counter = Null_Address then
         return;
      end if;

      HW_Ctx := (R0     => Word (Argument),
                 PC     => Word (Program_Counter),
                 PSR    => 2**24, -- Set thumb bit
                 others => 0);

      Buffer.all := (SP_process => New_SP, others => 0);
   end Initialize_Context;

   ----------------------------
   -- Install_Error_Handlers --
   ----------------------------

   procedure Install_Error_Handlers is
      EH : constant Address := GNAT_Error_Handler'Address;
   begin
      Install_Trap_Handler (EH, Reset_Vector);
      Install_Trap_Handler (EH, NMI_Vector);
      Install_Trap_Handler (EH, Hard_Fault_Vector);
      Install_Trap_Handler (EH, Bus_Fault_Vector);
      Install_Trap_Handler (EH, Usage_Fault_Vector);

      if Has_OS_Extensions then
         Install_Trap_Handler (EH, Pend_SV_Vector);
         Install_Trap_Handler (EH, SV_Call_Vector);
      end if;
   end Install_Error_Handlers;

   --------------------------
   -- Install_Trap_Handler --
   --------------------------

   procedure Install_Trap_Handler
     (Service_Routine : System.Address;
      Vector          : Vector_Id;
      Synchronous     : Boolean := False)
   is
      pragma Unreferenced (Synchronous);
   begin
      Trap_Handlers (Vector) := To_Pointer (Service_Routine);
   end Install_Trap_Handler;

   ------------------------
   -- Disable_Interrupts --
   ------------------------

   procedure Disable_Interrupts is
   begin
      Asm ("cpsid i", Volatile => True);
   end Disable_Interrupts;

   -----------------------
   -- Enable_Interrupts --
   -----------------------

   procedure Enable_Interrupts (Level : Integer) is

      procedure Clear_PRIMASK_Register;
      --  Wrapper around the Clear PRIMASK register instruction

      ----------------------------
      -- Clear_PRIMASK_Register --
      ----------------------------

      procedure Clear_PRIMASK_Register is
      begin
         --  Enabling interrupts will cause any pending interrupts to take
         --  effect. The instruction barrier is required by the architecture
         --  to ensure subsequent instructions are executed with interrupts
         --  enabled and at the right hardware priority level.

         Asm ("cpsie i" & NL &
              "isb",
              Clobber => "memory", Volatile => True);
      end Clear_PRIMASK_Register;

   begin
      if Is_ARMv6m then
         --  The absence of the BASEPRI register on the ARMv6-M architecture
         --  means only one interrupt priority can be supported on this
         --  architecture. Consequently, interrupts have to remain
         --  disabled while we are at a priority level of Interrupt_Priority,
         --  otherwise it would allow interrupt handlers to run when a task or
         --  another interrupt handler is running at this level; creating
         --  a scenario where a protected object's mutual exclusion may be
         --  violated.

         if Level /= Interrupt_Priority'Last then
            Clear_PRIMASK_Register;
         end if;
      else
         --  Set BASEPRI to mask interrupts below Level and enable interrupts

         Board_Support.Interrupts.Set_Current_Priority (Level);
         Clear_PRIMASK_Register;
      end if;
   end Enable_Interrupts;

   ---------------------------------
   -- Set_Selected_Priority_Group --
   ---------------------------------

   procedure Set_Selected_Priority_Group is
      Current_AIRCR : AIRCR_Register := AIRCR;
   begin
      Current_AIRCR.PRIGROUP := Priority_Group;
      Current_AIRCR.VECTKEY  := AIRCR_Write_Key;
      AIRCR := Current_AIRCR;

      --  read it to give time for the assignment to take effect

      Current_AIRCR := AIRCR;

      pragma Assert (Current_AIRCR.VECTKEY = AIRCR_Read_Key and then
                     Current_AIRCR.PRIGROUP = Priority_Group);
   end Set_Selected_Priority_Group;

end System.BB.CPU_Primitives;