File : s-bbcppr-armv7m.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
   4 --                                                                          --
   5 --               S Y S T E M . B B . C P U _ P R I M I T I V E S            --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --        Copyright (C) 1999-2002 Universidad Politecnica de Madrid         --
  10 --             Copyright (C) 2003-2005 The European Space Agency            --
  11 --                     Copyright (C) 2003-2016, AdaCore                     --
  12 --                                                                          --
  13 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 --                                                                          --
  23 --                                                                          --
  24 -- You should have received a copy of the GNU General Public License and    --
  25 -- a copy of the GCC Runtime Library Exception along with this program;     --
  26 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  27 -- <http://www.gnu.org/licenses/>.                                          --
  28 --                                                                          --
  29 ------------------------------------------------------------------------------
  30 
  31 --  This version is for ARM bareboard targets using the ARMv7-M targets,
  32 --  which only use Thumb2 instructions.
  33 
  34 with Ada.Unchecked_Conversion; use Ada;
  35 
  36 with System.Storage_Elements;
  37 with System.Multiprocessors;
  38 with System.BB.Board_Support;
  39 with System.BB.Threads;
  40 with System.BB.Threads.Queues;
  41 with System.BB.Time;
  42 with System.Machine_Code; use System.Machine_Code;
  43 
  44 package body System.BB.CPU_Primitives is
  45    use Parameters;
  46    use Threads;
  47    use Queues;
  48    use Board_Support;
  49    use Time;
  50    use System.Multiprocessors;
  51 
  52    package SSE renames System.Storage_Elements;
  53    use type SSE.Integer_Address;
  54    use type SSE.Storage_Offset;
  55 
  56    NL : constant String := ASCII.LF & ASCII.HT;
  57    --  New line separator in Asm templates
  58 
  59    No_Floating_Point : constant Boolean := not System.BB.Parameters.Has_FPU;
  60    --  Set True iff the FPU should not be used
  61 
  62    -----------
  63    -- Traps --
  64    -----------
  65 
  66    Reset_Vector             : constant Vector_Id :=  1;
  67    NMI_Vector               : constant Vector_Id :=  2;
  68    Hard_Fault_Vector        : constant Vector_Id :=  3;
  69    --  Mem_Manage_Vector    : constant Vector_Id :=  4; --  Never referenced
  70    Bus_Fault_Vector         : constant Vector_Id :=  5;
  71    Usage_Fault_Vector       : constant Vector_Id :=  6;
  72    SV_Call_Vector           : constant Vector_Id := 11;
  73    --  Debug_Mon_Vector     : constant Vector_Id := 12; --  Never referenced
  74    Pend_SV_Vector           : constant Vector_Id := 14;
  75    Sys_Tick_Vector          : constant Vector_Id := 15;
  76    Interrupt_Request_Vector : constant Vector_Id := 16;
  77 
  78    pragma Assert (Interrupt_Request_Vector = Vector_Id'Last);
  79 
  80    type Trap_Handler_Ptr is access procedure (Id : Vector_Id);
  81    function To_Pointer is new Unchecked_Conversion (Address, Trap_Handler_Ptr);
  82 
  83    type Trap_Handler_Table is array (Vector_Id) of Trap_Handler_Ptr;
  84    pragma Suppress_Initialization (Trap_Handler_Table);
  85 
  86    Trap_Handlers : Trap_Handler_Table;
  87    pragma Export (C, Trap_Handlers, "__gnat_bb_exception_handlers");
  88 
  89    System_Vectors : constant System.Address;
  90    pragma Import (Asm, System_Vectors, "__vectors");
  91 
  92    --  As ARMv7M does not directly provide a single-shot alarm timer, and
  93    --  we have to use Sys_Tick for that, we need to have this clock generate
  94    --  interrupts at a relatively high rate. To avoid unnecessary overhead
  95    --  when no alarms are requested, we'll only call the alarm handler if
  96    --  the current time exceeds the Alarm_Time by at most half the modulus
  97    --  of Timer_Interval.
  98 
  99    Alarm_Time      :  Board_Support.Timer_Interval;
 100    pragma Volatile (Alarm_Time);
 101    pragma Import (C, Alarm_Time, "__gnat_alarm_time");
 102 
 103    procedure SV_Call_Handler;
 104    pragma Export (Asm, SV_Call_Handler, "__gnat_sv_call_trap");
 105 
 106    procedure Pend_SV_Handler;
 107    pragma Machine_Attribute (Pend_SV_Handler, "naked");
 108    pragma Export (Asm, Pend_SV_Handler, "__gnat_pend_sv_trap");
 109    --  This assembly routine needs to save and restore registers without
 110    --  interference. The "naked" machine attribute communicates this to GCC.
 111 
 112    procedure Sys_Tick_Handler;
 113    pragma Export (Asm, Sys_Tick_Handler, "__gnat_sys_tick_trap");
 114 
 115    procedure Interrupt_Request_Handler;
 116    pragma Export (Asm, Interrupt_Request_Handler, "__gnat_irq_trap");
 117 
 118    procedure GNAT_Error_Handler (Trap : Vector_Id);
 119    pragma No_Return (GNAT_Error_Handler);
 120 
 121    -----------------------
 122    -- Context Switching --
 123    -----------------------
 124 
 125    --  This port uses the ARMv7-M hardware for saving volatile context for
 126    --  interrupts, see the Hardware_Context type below for details. Any
 127    --  non-volatile registers will be preserved by the interrupt handler in
 128    --  the same way as it happens for ordinary procedure calls.
 129 
 130    --  The non-volatile registers, as well as the value of the stack pointer
 131    --  (SP_process) are saved in the Context buffer of the Thread_Descriptor.
 132    --  Any non-volatile floating-point registers are saved on the stack.
 133 
 134    --  R4 .. R11 are at offset 0 .. 7
 135 
 136    SP_process : constant Context_Id := 8;
 137 
 138    type Hardware_Context is record
 139       R0, R1, R2, R3   : Word;
 140       R12, LR, PC, PSR : Word;
 141    end record;
 142 
 143    ICSR : Word with Volatile, Address   => 16#E000_ED04#; -- Int. Control/State
 144 
 145    ICSR_Pend_SV_Set : constant Word := 2**28;
 146 
 147    VTOR : Address with Volatile, Address => 16#E000_ED08#; -- Vec. Table Offset
 148 
 149    AIRCR : Word with Volatile, Address => 16#E000_ED0C#; -- App Int/Reset Ctrl
 150    CCR   : Word with Volatile, Address => 16#E000_ED14#; -- Config. Control
 151    SHPR1 : Word with Volatile, Address => 16#E000_ED18#; -- Sys Hand  4- 7 Prio
 152    SHPR2 : Word with Volatile, Address => 16#E000_ED1C#; -- Sys Hand  8-11 Prio
 153    SHPR3 : Word with Volatile, Address => 16#E000_ED20#; -- Sys Hand 12-15 Prio
 154    SHCSR : Word with Volatile, Address => 16#E000_ED24#; -- Sys Hand Ctrl/State
 155 
 156    function PRIMASK return Word with Inline, Export, Convention => C;
 157    --  Function returning the contents of the PRIMASK register
 158 
 159    -------------
 160    -- PRIMASK --
 161    -------------
 162 
 163    function PRIMASK return Word is
 164       R : Word;
 165    begin
 166       Asm ("mrs %0, PRIMASK", Outputs => Word'Asm_Output ("=r", R),
 167            Volatile => True);
 168       return R;
 169    end PRIMASK;
 170 
 171    --------------------
 172    -- Initialize_CPU --
 173    --------------------
 174 
 175    procedure Initialize_CPU is
 176       Interrupt_Stack_Table : array (System.Multiprocessors.CPU)
 177         of System.Address;
 178       pragma Import (Asm, Interrupt_Stack_Table, "interrupt_stack_table");
 179       --  Table containing a pointer to the top of the stack for each processor
 180 
 181    begin
 182       --  Switch the stack pointer to SP_process (PSP)
 183 
 184       Asm ("mrs r0, MSP" & NL &
 185            "msr PSP, r0" & NL &
 186            "mrs r0, CONTROL" & NL &
 187            "orr r0,r0,2" & NL &
 188            "msr CONTROL,r0",
 189            Clobber => "r0",
 190            Volatile => True);
 191 
 192       --  Initialize SP_main (MSP)
 193 
 194       Asm ("msr MSP, %0",
 195            Inputs => Address'Asm_Input ("r", Interrupt_Stack_Table (1)),
 196            Volatile => True);
 197 
 198       --  Initialize vector table
 199 
 200       VTOR := System_Vectors'Address;
 201 
 202       --  Set configuration: stack is 8 byte aligned, trap on divide by 0,
 203       --  no trap on unaligned access, can enter thread mode from any level.
 204 
 205       CCR := CCR or 16#211#;
 206 
 207       --  Set priorities of system handlers. The Pend_SV handler runs at the
 208       --  lowest priority, so context switching does not block higher priority
 209       --  interrupt handlers. All other system handlers run at the highest
 210       --  priority (0), so they will not be interrupted. This is also true for
 211       --  the SysTick interrupt, as this interrupt must be serviced promptly in
 212       --  order to avoid losing track of time.
 213 
 214       SHPR1 := 0;
 215       SHPR2 := 0;
 216       SHPR3 := 16#00_FF_00_00#;
 217 
 218       --  Write the required key (16#05FA#) and desired PRIGROUP value. We
 219       --  configure this to 3, to have 16 group priorities
 220 
 221       AIRCR := 16#05FA_0300#;
 222       pragma Assert (AIRCR = 16#FA05_0300#); --  Key value is swapped
 223 
 224       --  Enable usage, bus and memory management fault
 225 
 226       SHCSR := SHCSR or 16#7_0000#;
 227 
 228       --  Unmask Fault
 229 
 230       Asm ("cpsie f", Volatile => True);
 231    end Initialize_CPU;
 232 
 233    --------------------
 234    -- Context_Switch --
 235    --------------------
 236 
 237    procedure Context_Switch is
 238    begin
 239       --  Interrupts must be disabled at this point
 240 
 241       pragma Assert (PRIMASK = 1);
 242 
 243       --  Make deferred supervisor call pending
 244 
 245       ICSR := ICSR_Pend_SV_Set;
 246 
 247       --  The context switch better be pending, as otherwise it means
 248       --  interrupts were not disabled.
 249 
 250       pragma Assert ((ICSR and ICSR_Pend_SV_Set) /= 0);
 251 
 252       --  Memory must be clobbered, as task switching causes a task to signal,
 253       --  which means its memory changes must be visible to all other tasks.
 254 
 255       Asm ("", Volatile => True, Clobber => "memory");
 256    end Context_Switch;
 257 
 258    -----------------
 259    -- Get_Context --
 260    -----------------
 261 
 262    function Get_Context
 263      (Context : Context_Buffer;
 264       Index   : Context_Id) return Word
 265    is
 266       (Word (Context (Index)));
 267 
 268    ------------------------
 269    -- GNAT_Error_Handler --
 270    ------------------------
 271 
 272    procedure GNAT_Error_Handler (Trap : Vector_Id) is
 273    begin
 274       case Trap is
 275          when Reset_Vector =>
 276             raise Program_Error with "unexpected reset";
 277          when NMI_Vector =>
 278             raise Program_Error with "non-maskable interrupt";
 279          when Hard_Fault_Vector =>
 280             raise Program_Error with "hard fault";
 281          when Bus_Fault_Vector  =>
 282             raise Program_Error with "bus fault";
 283          when Usage_Fault_Vector =>
 284             raise Constraint_Error with "usage fault";
 285          when others =>
 286             raise Program_Error with "unhandled trap";
 287       end case;
 288    end GNAT_Error_Handler;
 289 
 290    ----------------------------------
 291    -- Interrupt_Request_Handler -- --
 292    ----------------------------------
 293 
 294    procedure Interrupt_Request_Handler is
 295    begin
 296       --  Call the handler (System.BB.Interrupts.Interrupt_Wrapper)
 297 
 298       Trap_Handlers (Interrupt_Request_Vector)(Interrupt_Request_Vector);
 299 
 300       --  The handler has changed the current priority (BASEPRI), although
 301       --  being useless on ARMv7m. We need to revert it.
 302 
 303       --  The interrupt handler may have scheduled a new task, so we need to
 304       --  check whether a context switch is needed.
 305 
 306       if Context_Switch_Needed then
 307 
 308          --  Perform a context switch because the currently executing thread is
 309          --  no longer the one with the highest priority.
 310 
 311          --  No need to update execution time. Already done in the wrapper.
 312 
 313          --  Note that the following context switch is not immediate, but
 314          --  will only take effect after interrupts are enabled.
 315 
 316          Context_Switch;
 317       end if;
 318 
 319       --  Restore interrupt masking of interrupted thread
 320 
 321       Enable_Interrupts (Running_Thread.Active_Priority);
 322    end Interrupt_Request_Handler;
 323 
 324    ---------------------
 325    -- Pend_SV_Handler --
 326    ---------------------
 327 
 328    procedure Pend_SV_Handler is
 329    begin
 330       --  At most one instance of this handler can run at a time, and
 331       --  interrupts will preserve all state, so interrupts can be left
 332       --  enabled. Note the invariant that at all times the active context is
 333       --  in the ("__gnat_running_thread_table"). Only this handler may update
 334       --  that variable.
 335 
 336       Asm
 337         (Template =>
 338          "movw r2, #:lower16:__gnat_running_thread_table" & NL &
 339          "movt r2, #:upper16:__gnat_running_thread_table" & NL &
 340          "mrs  r12, PSP "       & NL & -- Retrieve current PSP
 341          "ldr  r3, [r2]"        & NL & -- Load address of running context
 342 
 343          --  If floating point is enabled, we may have to save the non-volatile
 344          --  floating point registers, and save bit 4 of the LR register, as
 345          --  this will indicate whether the floating point context was saved
 346          --  or not.
 347 
 348          (if No_Floating_Point then "" -- No FP context to save
 349           else
 350             "tst  lr, #16"            & NL &  -- if FPCA flag was set,
 351             "itte  eq"                & NL &  -- then
 352             "vstmdbeq r12!,{s16-s31}" & NL &  --   save FP context below PSP
 353             "addeq  r12, #1"          & NL &  --   save flag in bit 0 of PSP
 354             "subne  lr, #16"          & NL) & -- else set FPCA flag in LR
 355 
 356          --  Swap R4-R11 and PSP (stored in R12)
 357 
 358          "stm  r3, {r4-r12}"        & NL & -- Save context
 359          "movw r3, #:lower16:first_thread_table" & NL &
 360          "movt r3, #:upper16:first_thread_table" & NL &
 361          "ldr  r3, [r3]"            & NL & -- Load address of new context
 362          "str  r3, [r2]"            & NL & -- Update value of Pend_SV_Context
 363          "ldm  r3, {r4-r12}"        & NL & -- Load context and new PSP
 364 
 365          --  If floating point is enabled, check bit 0 of PSP to see if we
 366          --  need to restore the floating point context.
 367 
 368          (if No_Floating_Point then ""     -- No FP context to restore
 369           else
 370             "tst  r12, #1"            & NL &  -- if FPCA was set,
 371             "itte  ne"                & NL &  -- then
 372             "subne r12, #1"           & NL &  --   remove flag from PSP
 373             "vldmiane r12!,{s16-s31}" & NL &  --   Restore FP context
 374             "addeq lr, #16"           & NL) & -- else clear FPCA flag in LR
 375 
 376          --  Finally, update PSP and perform the exception return
 377 
 378          "msr  PSP, r12" & NL &        -- Update PSP
 379          "bx   lr",                    -- return to caller
 380          Volatile => True);
 381    end Pend_SV_Handler;
 382 
 383    ---------------------
 384    -- SV_Call_Handler --
 385    ---------------------
 386 
 387    procedure SV_Call_Handler is
 388    begin
 389       GNAT_Error_Handler (SV_Call_Vector);
 390    end SV_Call_Handler;
 391 
 392    -----------------
 393    -- Set_Context --
 394    -----------------
 395 
 396    procedure Set_Context
 397      (Context : in out Context_Buffer;
 398       Index   : Context_Id;
 399       Value   : Word) is
 400    begin
 401       Context (Index) := Address (Value);
 402    end Set_Context;
 403 
 404    ----------------------
 405    -- Sys_Tick_Handler --
 406    ----------------------
 407 
 408    procedure Sys_Tick_Handler is
 409       Max_Alarm_Interval : constant Timer_Interval := Timer_Interval'Last / 2;
 410       Now : constant Timer_Interval := Read_Clock;
 411 
 412    begin
 413       --  The following allows max. efficiency for "useless" tick interrupts
 414 
 415       if Alarm_Time - Now <= Max_Alarm_Interval then
 416 
 417          --  Alarm is still in the future, nothing to do, so return quickly
 418 
 419          return;
 420       end if;
 421 
 422       Alarm_Time := Now + Max_Alarm_Interval;
 423 
 424       --  Call the alarm handler
 425 
 426       Trap_Handlers (Sys_Tick_Vector)(Sys_Tick_Vector);
 427 
 428       --  The interrupt handler may have scheduled a new task
 429 
 430       if Context_Switch_Needed then
 431          Context_Switch;
 432       end if;
 433 
 434       Enable_Interrupts (Running_Thread.Active_Priority);
 435    end Sys_Tick_Handler;
 436 
 437    ------------------------
 438    -- Initialize_Context --
 439    ------------------------
 440 
 441    procedure Initialize_Context
 442      (Buffer          : not null access Context_Buffer;
 443       Program_Counter : System.Address;
 444       Argument        : System.Address;
 445       Stack_Pointer   : System.Address)
 446    is
 447       HW_Ctx_Bytes : constant System.Address := Hardware_Context'Size / 8;
 448       New_SP       : constant System.Address :=
 449                        (Stack_Pointer - HW_Ctx_Bytes) and not 4;
 450 
 451       HW_Ctx : Hardware_Context with Address => New_SP;
 452 
 453    begin
 454       --  No need to initialize the context of the environment task
 455 
 456       if Program_Counter = Null_Address then
 457          return;
 458       end if;
 459 
 460       HW_Ctx := (R0     => Word (Argument),
 461                  PC     => Word (Program_Counter),
 462                  PSR    => 2**24, -- Set thumb bit
 463                  others => 0);
 464 
 465       Buffer.all := (SP_process => New_SP, others => 0);
 466    end Initialize_Context;
 467 
 468    ----------------------------
 469    -- Install_Error_Handlers --
 470    ----------------------------
 471 
 472    procedure Install_Error_Handlers is
 473       EH : constant Address := GNAT_Error_Handler'Address;
 474    begin
 475       Install_Trap_Handler (EH, Reset_Vector);
 476       Install_Trap_Handler (EH, NMI_Vector);
 477       Install_Trap_Handler (EH, Hard_Fault_Vector);
 478       Install_Trap_Handler (EH, Bus_Fault_Vector);
 479       Install_Trap_Handler (EH, Usage_Fault_Vector);
 480       Install_Trap_Handler (EH, Pend_SV_Vector);
 481       Install_Trap_Handler (EH, SV_Call_Vector);
 482    end Install_Error_Handlers;
 483 
 484    --------------------------
 485    -- Install_Trap_Handler --
 486    --------------------------
 487 
 488    procedure Install_Trap_Handler
 489      (Service_Routine : System.Address;
 490       Vector          : Vector_Id;
 491       Synchronous     : Boolean := False)
 492    is
 493       pragma Unreferenced (Synchronous);
 494    begin
 495       Trap_Handlers (Vector) := To_Pointer (Service_Routine);
 496    end Install_Trap_Handler;
 497 
 498    ------------------------
 499    -- Disable_Interrupts --
 500    ------------------------
 501 
 502    procedure Disable_Interrupts is
 503    begin
 504       Asm ("cpsid i", Volatile => True);
 505    end Disable_Interrupts;
 506 
 507    -----------------------
 508    -- Enable_Interrupts --
 509    -----------------------
 510 
 511    procedure Enable_Interrupts (Level : Integer) is
 512    begin
 513       --  Set the BASEPRI according to the specified level. PRIMASK is still
 514       --  set, so the change does not take effect until the next Asm.
 515 
 516       Set_Current_Priority (Level);
 517 
 518       --  The following enables interrupts and will cause any pending
 519       --  interrupts to take effect. The barriers and their placing are
 520       --  essential, otherwise a blocking operation might not cause an
 521       --  immediate context switch, violating mutual exclusion.
 522 
 523       Asm ("cpsie i" & NL
 524          & "dsb"     & NL
 525          & "isb",
 526            Clobber => "memory", Volatile => True);
 527    end Enable_Interrupts;
 528 
 529 end System.BB.CPU_Primitives;