File : s-bbcppr-arm-xtratum.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-2015, 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 xtratum on tms570A. As Xtratum doesn't provide
  32 --  access to fpexc, it is not possible to do lazy save/restore of the fpu.
  33 
  34 with Ada.Unchecked_Conversion; use Ada;
  35 
  36 with System.Storage_Elements;
  37 with System.Multiprocessors;
  38 with System.BB.Threads;
  39 with System.BB.CPU_Primitives.Multiprocessors;
  40 with System.BB.Threads.Queues;
  41 with System.BB.Board_Support;
  42 with System.BB.Protection;
  43 with System.BB.Interrupts;
  44 with System.Machine_Code; use System.Machine_Code;
  45 
  46 package body System.BB.CPU_Primitives is
  47    use BB.Parameters;
  48    use System.BB.Threads;
  49    use System.BB.CPU_Primitives.Multiprocessors;
  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    -----------
  60    -- Traps --
  61    -----------
  62 
  63    Reset_Vector                  : constant Vector_Id := 0; -- RESET
  64    Undefined_Instruction_Vector  : constant Vector_Id := 1; -- UNDEF
  65    Supervisor_Call_Vector        : constant Vector_Id := 2; -- SVC
  66    Prefetch_Abort_Vector         : constant Vector_Id := 3; -- PABT
  67    Data_Abort_Vector             : constant Vector_Id := 4; -- DABT
  68 --   Interrupt_Request_Vector      : constant Vector_Id := 5; -- IRQ
  69    Fast_Interrupt_Request_Vector : constant Vector_Id := 6; -- FIQ
  70 
  71    type Trap_Handler_Ptr is access procedure (Id : Vector_Id);
  72    function To_Pointer is new Unchecked_Conversion (Address, Trap_Handler_Ptr);
  73 
  74    type Trap_Handler_Table is array (Vector_Id) of Trap_Handler_Ptr;
  75    pragma Suppress_Initialization (Trap_Handler_Table);
  76 
  77    Trap_Handlers  : Trap_Handler_Table;
  78    pragma Export (C, Trap_Handlers, "__gnat_trap_handlers");
  79 
  80    CPSR_I : constant := 2 ** 7;
  81    --  Interrupt disable bit
  82 
  83    procedure GNAT_Error_Handler (Trap : Vector_Id);
  84    pragma No_Return (GNAT_Error_Handler);
  85 
  86    procedure Undef_Handler;
  87    pragma Machine_Attribute (Undef_Handler, "interrupt");
  88    pragma Export (Asm, Undef_Handler, "__gnat_undef_trap");
  89 
  90    procedure Dabt_Handler;
  91    pragma Machine_Attribute (Dabt_Handler, "interrupt");
  92    pragma Export (Asm, Dabt_Handler, "__gnat_dabt_trap");
  93 
  94    procedure Pabt_Handler;
  95    pragma Machine_Attribute (Dabt_Handler, "interrupt");
  96    pragma Export (Asm, Pabt_Handler, "__gnat_pabt_trap");
  97 
  98    procedure SVC_Handler;
  99    pragma Machine_Attribute (SVC_Handler, "interrupt");
 100    pragma Export (Asm, SVC_Handler, "__gnat_svc_trap");
 101 
 102    procedure FIQ_Handler;
 103    pragma Machine_Attribute (FIQ_Handler, "interrupt");
 104    pragma Export (Asm, FIQ_Handler, "__gnat_fiq_trap");
 105 
 106    ---------------------------
 107    -- Context Buffer Layout --
 108    ---------------------------
 109 
 110    --  These are the registers that are initialized: program counter, two
 111    --  argument registers, program counter, processor state register,
 112    --  stack pointer and link register.
 113 
 114    R4 : constant Context_Id := 0;
 115    R5 : constant Context_Id := 1;
 116    SP : constant Context_Id := 8; -- stack pointer, aka R13
 117    LR : constant Context_Id := 9; -- link register, R14
 118 
 119    procedure FPU_Context_Switch (To : Thread_Id) with Inline, Unreferenced;
 120    function Get_CPSR return Word with Inline;
 121    procedure Set_CPSR (CPSR : Word) with Inline;
 122 
 123    --------------
 124    -- Get_CPSR --
 125    --------------
 126 
 127    function Get_CPSR return Word is
 128       procedure Xm_Arm_Get_Cpsr (Addr : Address);
 129       pragma Import (C, Xm_Arm_Get_Cpsr, "XM_arm_get_cpsr");
 130 
 131       CPSR : Word;
 132    begin
 133       Xm_Arm_Get_Cpsr (CPSR'Address);
 134       return CPSR;
 135    end Get_CPSR;
 136 
 137    --------------
 138    -- Set_CPSR --
 139    --------------
 140 
 141    procedure Set_CPSR (CPSR : Word) is
 142       procedure Xm_Arm_Set_Cpsr (CPSR : Word);
 143       pragma Import (C, Xm_Arm_Set_Cpsr, "XM_arm_set_cpsr");
 144    begin
 145       Xm_Arm_Set_Cpsr (CPSR);
 146    end Set_CPSR;
 147 
 148    ------------------
 149    -- Dabt_Handler --
 150    ------------------
 151 
 152    procedure Dabt_Handler is
 153    begin
 154       Trap_Handlers (Data_Abort_Vector) (Data_Abort_Vector);
 155    end Dabt_Handler;
 156 
 157    ------------------
 158    -- Pabt_Handler --
 159    ------------------
 160 
 161    procedure Pabt_Handler is
 162    begin
 163       Trap_Handlers (Prefetch_Abort_Vector) (Prefetch_Abort_Vector);
 164    end Pabt_Handler;
 165 
 166    -------------------
 167    -- Undef_Handler --
 168    -------------------
 169 
 170    procedure Undef_Handler is
 171    begin
 172       Trap_Handlers (Undefined_Instruction_Vector)
 173         (Undefined_Instruction_Vector);
 174    end Undef_Handler;
 175 
 176    -----------------
 177    -- SVC_Handler --
 178    -----------------
 179 
 180    procedure SVC_Handler is
 181    begin
 182       Trap_Handlers (Supervisor_Call_Vector)(Supervisor_Call_Vector);
 183    end SVC_Handler;
 184 
 185    -----------------
 186    -- FIQ_Handler --
 187    -----------------
 188 
 189    procedure FIQ_Handler is
 190    begin
 191       Trap_Handlers (Fast_Interrupt_Request_Vector)
 192         (Fast_Interrupt_Request_Vector);
 193    end FIQ_Handler;
 194 
 195    --------------------
 196    -- Context_Switch --
 197    --------------------
 198 
 199    procedure Context_Switch is
 200       procedure Asm_Context_Switch;
 201       pragma Import (Asm, Asm_Context_Switch, "__gnat_context_switch");
 202    begin
 203       --  When calling this routine from modes other than user or system,
 204       --  the caller is responsible for saving the (banked) SPSR register.
 205       --  This register is only visible in banked modes, so can't be saved
 206       --  here.
 207 
 208       Asm_Context_Switch;
 209    end Context_Switch;
 210 
 211    ------------------------
 212    -- FPU_Context_Switch --
 213    ------------------------
 214 
 215    procedure FPU_Context_Switch (To : Thread_Id) is
 216       C : constant Thread_Id := To;
 217 
 218       Fpscr : Word;
 219 
 220       type Fpu_Context is array (0 .. 31) of Word;
 221       Fpu : Fpu_Context;
 222    begin
 223       if C /= null then
 224          Asm (Template => "vstm %1, {d0-d15}" & NL & "fmrx %0, fpscr",
 225               Outputs  => Word'Asm_Output ("=r", Fpscr),
 226               Inputs   => Address'Asm_Input ("r", Fpu'Address),
 227               Clobber  => "memory",
 228               Volatile => True);
 229       end if;
 230 
 231       if To /= null then
 232          Asm (Template => "vldm %1, {d0-d15}" & NL & "fmxr fpscr, %0",
 233               Inputs   =>
 234                 (Word'Asm_Input ("r", Fpscr),
 235                  Address'Asm_Input ("r", Fpu'Address)),
 236               Clobber  => "memory",
 237               Volatile => True);
 238       end if;
 239    end FPU_Context_Switch;
 240 
 241    -----------------
 242    -- Get_Context --
 243    -----------------
 244 
 245    function Get_Context
 246      (Context : Context_Buffer;
 247       Index   : Context_Id) return Word
 248    is
 249    begin
 250       return Word (Context (Index));
 251    end Get_Context;
 252 
 253    ------------------------
 254    -- GNAT_Error_Handler --
 255    ------------------------
 256 
 257    procedure GNAT_Error_Handler (Trap : Vector_Id) is
 258    begin
 259       case Trap is
 260          when Reset_Vector =>
 261             raise Program_Error with "unexpected reset";
 262          when Undefined_Instruction_Vector =>
 263             raise Program_Error with "illegal instruction";
 264          when Supervisor_Call_Vector =>
 265             raise Program_Error with "unhandled SVC";
 266          when Prefetch_Abort_Vector =>
 267             raise Program_Error with "prefetch abort";
 268          when Data_Abort_Vector =>
 269             raise Constraint_Error with "data abort";
 270          when others =>
 271             raise Program_Error with "unhandled trap";
 272       end case;
 273    end GNAT_Error_Handler;
 274 
 275    -----------------
 276    -- Set_Context --
 277    -----------------
 278 
 279    procedure Set_Context
 280      (Context : in out Context_Buffer;
 281       Index   : Context_Id;
 282       Value   : Word)
 283    is
 284    begin
 285       Context (Index) := Address (Value);
 286    end Set_Context;
 287 
 288    ------------------------
 289    -- Initialize_Context --
 290    ------------------------
 291 
 292    procedure Initialize_Context
 293      (Buffer          : not null access Context_Buffer;
 294       Program_Counter : System.Address;
 295       Argument        : System.Address;
 296       Stack_Pointer   : System.Address)
 297    is
 298       procedure Start_Thread;
 299       pragma Import (Asm, Start_Thread, "__gnat_start_thread");
 300    begin
 301       Buffer.all :=
 302         (R4     => Argument,
 303          R5     => Program_Counter,
 304          SP     => Stack_Pointer,
 305          LR     => Start_Thread'Address,
 306          others => 0);
 307    end Initialize_Context;
 308 
 309    ----------------------------
 310    -- Install_Error_Handlers --
 311    ----------------------------
 312 
 313    procedure Install_Error_Handlers is
 314       EH : constant Address := GNAT_Error_Handler'Address;
 315 
 316    begin
 317       Install_Trap_Handler (EH, Reset_Vector);
 318       Install_Trap_Handler (EH, Undefined_Instruction_Vector, True);
 319       Install_Trap_Handler (EH, Supervisor_Call_Vector, True);
 320       Install_Trap_Handler (EH, Prefetch_Abort_Vector, True);
 321       Install_Trap_Handler (EH, Data_Abort_Vector);
 322 
 323       --  Do not install a handler for the Interrupt_Request_Vector, as
 324       --  the Ravenscar run time will handle that one, and may already
 325       --  have installed its handler before calling Install_Error_Handlers.
 326 
 327       Install_Trap_Handler (EH, Fast_Interrupt_Request_Vector);
 328    end Install_Error_Handlers;
 329 
 330    --------------------------
 331    -- Install_Trap_Handler --
 332    --------------------------
 333 
 334    procedure Install_Trap_Handler
 335      (Service_Routine : System.Address;
 336       Vector          : Vector_Id;
 337       Synchronous     : Boolean := False)
 338    is
 339       pragma Unreferenced (Synchronous);
 340    begin
 341       Trap_Handlers (Vector) := To_Pointer (Service_Routine);
 342    end Install_Trap_Handler;
 343 
 344    ------------------------
 345    -- Disable_Interrupts --
 346    ------------------------
 347 
 348    procedure Disable_Interrupts is
 349    begin
 350       Set_CPSR (Get_CPSR or CPSR_I);
 351    end Disable_Interrupts;
 352 
 353    -----------------------
 354    -- Enable_Interrupts --
 355    -----------------------
 356 
 357    procedure Enable_Interrupts (Level : System.Any_Priority) is
 358    begin
 359       Board_Support.Set_Current_Priority (Level);
 360 
 361       if Level in System.Priority'Range then
 362          Set_CPSR (Get_CPSR and not CPSR_I);
 363       end if;
 364    end Enable_Interrupts;
 365 
 366    --------------------
 367    -- Initialize_CPU --
 368    --------------------
 369 
 370    procedure Initialize_CPU is
 371    begin
 372       null;
 373    end Initialize_CPU;
 374 end System.BB.CPU_Primitives;