File : s-bbcppr-arm.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-R or ARMv7-A
32 -- instruction set. It is not suitable for ARMv7-M targets, which use
33 -- Thumb2.
34
35 with Ada.Unchecked_Conversion; use Ada;
36
37 with System.Storage_Elements;
38 with System.Multiprocessors;
39 with System.BB.Threads;
40 with System.BB.CPU_Primitives.Multiprocessors;
41 with System.BB.Threads.Queues;
42 with System.BB.Board_Support;
43 with System.BB.Protection;
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
79 procedure GNAT_Error_Handler (Trap : Vector_Id);
80 pragma No_Return (GNAT_Error_Handler);
81
82 procedure Undef_Handler;
83 pragma Machine_Attribute (Undef_Handler, "interrupt");
84 pragma Export (Asm, Undef_Handler, "__gnat_undef_trap");
85
86 procedure Dabt_Handler;
87 pragma Machine_Attribute (Dabt_Handler, "interrupt");
88 pragma Export (Asm, Dabt_Handler, "__gnat_dabt_trap");
89
90 procedure FIQ_Handler;
91 pragma Machine_Attribute (FIQ_Handler, "interrupt");
92 pragma Export (Asm, FIQ_Handler, "__gnat_fiq_trap");
93
94 procedure IRQ_Handler;
95 pragma Machine_Attribute (IRQ_Handler, "interrupt");
96 pragma Export (Asm, IRQ_Handler, "__gnat_irq_trap");
97
98 ---------------------------
99 -- Context Buffer Layout --
100 ---------------------------
101
102 -- These are the registers that are initialized: program counter, two
103 -- argument registers, program counter, processor state register,
104 -- stack pointer and link register.
105
106 R0 : constant Context_Id := 0; -- used for first argument
107 R1 : constant Context_Id := 1; -- saved register
108 PC : constant Context_Id := 2; -- use call-clobbered R2 for PC
109 CPSR : constant Context_Id := 3; -- use R3 for saving user CPSR
110 SP : constant Context_Id := 4; -- stack pointer, aka R13
111 LR : constant Context_Id := 5; -- link register, R14
112 S0 : constant Context_Id := 6; -- S00/S01 aliases to D0
113 S31 : constant Context_Id := 37; -- S30/S31 aliases to D15
114 FPSCR : constant Context_Id := 38; -- Fpt status/control reg
115
116 pragma Assert (S31 - S0 = 31 and R1 = R0 + 1 and LR = SP + 1);
117
118 ----------------------------
119 -- Floating Point Context --
120 ----------------------------
121
122 -- This port uses lazy context switching for the FPU context. Rather than
123 -- saving and restoring floating point registers on a context switch or
124 -- interrupt, the FPU is disabled unless the switch is to a thread that is
125 -- equal the Current_FPU_Context. This is on the expectation that the new
126 -- context will not use floating point during its execution window. If it
127 -- does, then an undefined instruction trap will be executed that performs
128 -- the context switch and retries. We also don't restore the FPU enabled
129 -- state when leaving an interrupt handler that didn't use the FPU as we
130 -- rather incur the trap at the user level than leaving interrupt masked
131 -- longer than absolutely necessary.
132
133 type Thread_Table is array (System.Multiprocessors.CPU) of Thread_Id;
134 pragma Volatile_Components (Thread_Table);
135
136 function Is_FPU_Enabled return Boolean with Inline;
137 procedure Set_FPU_Enabled (Enabled : Boolean) with Inline;
138 procedure FPU_Context_Switch (To : Thread_Id) with Inline;
139 function Get_SPSR return Word with Inline;
140
141 Current_FPU_Context : Thread_Table := (others => Null_Thread_Id);
142 -- This variable contains the last thread that used the floating point unit
143 -- for each CPU. Hence, it points to the place where the floating point
144 -- state must be stored. Null means no task using it.
145
146 --------------
147 -- Get_SPSR --
148 --------------
149
150 function Get_SPSR return Word is
151 SPSR : Word;
152 begin
153 Asm ("mrs %0, SPSR",
154 Outputs => Word'Asm_Output ("=r", SPSR),
155 Volatile => True);
156 return SPSR;
157 end Get_SPSR;
158
159 ------------------
160 -- Dabt_Handler --
161 ------------------
162
163 procedure Dabt_Handler is
164 begin
165 Trap_Handlers (Data_Abort_Vector) (Data_Abort_Vector);
166 end Dabt_Handler;
167
168 -----------------
169 -- FIQ_Handler --
170 -----------------
171
172 procedure FIQ_Handler is
173 begin
174 -- Force trap if handler uses floating point
175
176 Set_FPU_Enabled (False);
177
178 Trap_Handlers (Fast_Interrupt_Request_Vector)
179 (Fast_Interrupt_Request_Vector);
180 end FIQ_Handler;
181
182 -----------------
183 -- IRQ_Handler --
184 -----------------
185
186 procedure IRQ_Handler is
187 SPSR : Word;
188
189 begin
190 -- Force trap if handler uses floating point
191
192 Set_FPU_Enabled (False);
193
194 -- If we are going to do context switches or otherwise allow IRQ's
195 -- from within the interrupt handler, the SPSR register needs to
196 -- be saved too.
197
198 SPSR := Get_SPSR;
199
200 Trap_Handlers (Interrupt_Request_Vector) (Interrupt_Request_Vector);
201
202 -- As the System.BB.Interrupts.Interrupt_Wrapper returns to the low
203 -- level interrupt handler without checking for required context
204 -- switches, we need to do that here.
205
206 if Threads.Queues.Context_Switch_Needed then
207
208 -- The interrupt handler caused pre-emption of the thread that
209 -- was executing. This means we need to switch context. We do not
210 -- explicitly enable IRQ's at this point, as that will done by the
211 -- CPSR update as part of the context switch.
212
213 -- Note that the part of the thread state is still on the interrupt
214 -- stack, and will be restored when the pre-empted thread continues.
215
216 Context_Switch;
217
218 -- The pre-empted thread can now resume
219 end if;
220
221 Asm ("msr SPSR_cxsf, %0",
222 Inputs => (Word'Asm_Input ("r", SPSR)),
223 Volatile => True);
224 end IRQ_Handler;
225
226 -------------------
227 -- Undef_Handler --
228 -------------------
229
230 procedure Undef_Handler is
231 SPSR : constant Word := Get_SPSR;
232 In_IRQ_Or_FIQ : Boolean;
233
234 begin
235 In_IRQ_Or_FIQ := (SPSR mod 32) in 17 | 18;
236
237 if not Is_FPU_Enabled then
238 Set_FPU_Enabled (True);
239 FPU_Context_Switch
240 (if In_IRQ_Or_FIQ then null else Queues.Running_Thread_Table (1));
241 else
242 Trap_Handlers (Undefined_Instruction_Vector)
243 (Undefined_Instruction_Vector);
244 end if;
245 end Undef_Handler;
246
247 --------------------
248 -- Context_Switch --
249 --------------------
250
251 procedure Context_Switch is
252 begin
253 -- Whenever switching to a new context, disable the FPU, so we don't
254 -- have to worry about its state. It is much more efficient to lazily
255 -- switch the FPU when it is actually used.
256
257 -- When calling this routine from modes other than user or system,
258 -- the caller is responsible for saving the (banked) SPSR register.
259 -- This register is only visible in banked modes, so can't be saved
260 -- here.
261
262 Set_FPU_Enabled (False);
263
264 -- Some notes about the Asm insert:
265
266 -- * While we only need to save callee-save registers in principle,
267 -- GCC may use caller-save variables, so if we don't save them
268 -- they must be marked clobbered.
269
270 -- * Changing SPSR is far cheaper than changing CPSR, so switching
271 -- to supervisor mode is beneficial.
272
273 -- * Mark LR as clobbered, so the compiler won't use this register
274 -- for any input arguments, as it is banked in supervisor mode
275
276 -- * The user-mode LR register must also be preserved in the context,
277 -- as the shadowing of LR will not help in case of pre-emption.
278
279 -- * Memory must be clobbered, as task switching causes a task to
280 -- signal, which means its memory changes must be visible to all
281 -- other tasks.
282
283 -- * We need three registers with fixed (known) offsets for the
284 -- Program_Counter, Program_Status and Stack_Pointer, and we need
285 -- to leave at least some registers for GCC to pass us arguments
286 -- and for its own use, so we save 6 registers and mark the rest
287 -- clobbered.
288
289 -- * While we could mark R0 and R1 as clobbered, and not save them
290 -- across the context switch, this does not help. The registers are
291 -- used and must be saved somehow. Also, this would mean we need an
292 -- extra routine for starting a thread, so we can pass in the
293 -- argument.
294
295 -- * Note that the first register to save should be even for most
296 -- efficient save/restore.
297
298 -- * This routine may be inlined, therefore it is very important
299 -- that the Asm constraints are correct.
300
301 Asm
302 (Template =>
303 "mrs r3, CPSR" & NL -- Save CPSR
304 & "ldr r4, [%0]" & NL -- Load Running_Thread
305 & "cps #19" & NL -- Switch to supervisor mode
306 & "adr r2, 0f" & NL -- Adjust R0 to point past ctx switch
307 & "stm r4, {r0-r3,sp,lr}^" & NL -- Save user registers
308 & "str %1, [%0]" & NL -- Set Running_Thread := First_Thread
309 & "ldm %1, {r0-r3,sp,lr}^" & NL -- Restore user registers
310 & "msr SPSR_cxsf, r3" & NL -- Move user CPSR to our SPSR
311 & "movs pc, r2" & NL -- Switch back to current thread mode
312 & "0:", -- Label indicating where to continue
313 Inputs =>
314 (Address'Asm_Input ("r", Queues.Running_Thread_Table (1)'Address),
315 Thread_Id'Asm_Input ("r", Queues.First_Thread_Table (1))),
316 Volatile => True,
317 Clobber => ("memory,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,lr"));
318 end Context_Switch;
319
320 ------------------------
321 -- FPU_Context_Switch --
322 ------------------------
323
324 procedure FPU_Context_Switch (To : Thread_Id) is
325 C : constant Thread_Id := Current_FPU_Context (1);
326
327 begin
328 if C /= To then
329 if C /= null then
330 Asm (Template => "vstm %1, {d0-d15}" & NL & "fmrx %0, fpscr",
331 Outputs => (Address'Asm_Output ("=r", C.Context (FPSCR))),
332 Inputs => (Address'Asm_Input ("r", C.Context (S0)'Address)),
333 Clobber => "memory",
334 Volatile => True);
335 end if;
336
337 if To /= null then
338 Asm (Template => "vldm %1, {d0-d15}" & NL & "fmxr fpscr, %0",
339 Inputs =>
340 (Address'Asm_Input ("r", To.Context (FPSCR)),
341 Address'Asm_Input ("r", To.Context (S0)'Address)),
342 Clobber => "memory",
343 Volatile => True);
344 end if;
345
346 Current_FPU_Context (1) := To;
347 end if;
348 end FPU_Context_Switch;
349
350 -----------------
351 -- Get_Context --
352 -----------------
353
354 function Get_Context
355 (Context : Context_Buffer;
356 Index : Context_Id) return Word
357 is
358 begin
359 return Word (Context (Index));
360 end Get_Context;
361
362 ------------------------
363 -- GNAT_Error_Handler --
364 ------------------------
365
366 procedure GNAT_Error_Handler (Trap : Vector_Id) is
367 begin
368 case Trap is
369 when Reset_Vector =>
370 raise Program_Error with "unexpected reset";
371 when Undefined_Instruction_Vector =>
372 raise Program_Error with "illegal instruction";
373 when Supervisor_Call_Vector =>
374 raise Program_Error with "unhandled SVC";
375 when Prefetch_Abort_Vector =>
376 raise Program_Error with "prefetch abort";
377 when Data_Abort_Vector =>
378 raise Constraint_Error with "data abort";
379 when others =>
380 raise Program_Error with "unhandled trap";
381 end case;
382 end GNAT_Error_Handler;
383
384 -----------------
385 -- Set_Context --
386 -----------------
387
388 procedure Set_Context
389 (Context : in out Context_Buffer;
390 Index : Context_Id;
391 Value : Word)
392 is
393 begin
394 Context (Index) := Address (Value);
395 end Set_Context;
396
397 ------------------------
398 -- Initialize_Context --
399 ------------------------
400
401 procedure Initialize_Context
402 (Buffer : not null access Context_Buffer;
403 Program_Counter : System.Address;
404 Argument : System.Address;
405 Stack_Pointer : System.Address)
406 is
407 User_CPSR : Word;
408 Mask_CPSR : constant Word := 16#07f0_ffe0#;
409 System_Mode : constant Word := 2#11111#; -- #31
410
411 begin
412 -- Use a read-modify-write strategy for computing the CPSR for the new
413 -- task: we clear any freely user-accessible bits, as well as the mode
414 -- bits, then add in the new mode.
415
416 Asm ("mrs %0, CPSR",
417 Outputs => Word'Asm_Output ("=r", User_CPSR),
418 Volatile => True);
419 User_CPSR := (User_CPSR and Mask_CPSR) + System_Mode;
420
421 Buffer.all :=
422 (R0 => Argument,
423 PC => Program_Counter,
424 CPSR => Address (User_CPSR),
425 SP => Stack_Pointer,
426 others => 0);
427 end Initialize_Context;
428
429 ----------------------------
430 -- Install_Error_Handlers --
431 ----------------------------
432
433 procedure Install_Error_Handlers is
434 EH : constant Address := GNAT_Error_Handler'Address;
435
436 begin
437 Install_Trap_Handler (EH, Reset_Vector);
438 Install_Trap_Handler (EH, Undefined_Instruction_Vector, True);
439 Install_Trap_Handler (EH, Supervisor_Call_Vector, True);
440 Install_Trap_Handler (EH, Prefetch_Abort_Vector, True);
441 Install_Trap_Handler (EH, Data_Abort_Vector);
442
443 -- Do not install a handler for the Interrupt_Request_Vector, as
444 -- the Ravenscar run time will handle that one, and may already
445 -- have installed its handler before calling Install_Error_Handlers.
446
447 Install_Trap_Handler (EH, Fast_Interrupt_Request_Vector);
448 end Install_Error_Handlers;
449
450 --------------------------
451 -- Install_Trap_Handler --
452 --------------------------
453
454 procedure Install_Trap_Handler
455 (Service_Routine : System.Address;
456 Vector : Vector_Id;
457 Synchronous : Boolean := False)
458 is
459 begin
460 pragma Assert
461 (Synchronous =
462 (Vector in Undefined_Instruction_Vector .. Prefetch_Abort_Vector));
463 Trap_Handlers (Vector) := To_Pointer (Service_Routine);
464 end Install_Trap_Handler;
465
466 --------------------
467 -- Is_FPU_Enabled --
468 --------------------
469
470 function Is_FPU_Enabled return Boolean is
471 R : Word;
472 begin
473 Asm ("fmrx %0, fpexc",
474 Outputs => Word'Asm_Output ("=r", R),
475 Volatile => True);
476 return (R and 16#4000_0000#) /= 0;
477 end Is_FPU_Enabled;
478
479 ------------------------
480 -- Disable_Interrupts --
481 ------------------------
482
483 procedure Disable_Interrupts is
484 begin
485 Asm ("cpsid i", Volatile => True);
486 end Disable_Interrupts;
487
488 -----------------------
489 -- Enable_Interrupts --
490 -----------------------
491
492 procedure Enable_Interrupts (Level : Integer) is
493 begin
494 Board_Support.Set_Current_Priority (Level);
495
496 if Level < System.Interrupt_Priority'First then
497 Asm ("cpsie i", Volatile => True);
498 end if;
499 end Enable_Interrupts;
500
501 --------------------
502 -- Initialize_CPU --
503 --------------------
504
505 procedure Initialize_CPU is
506 begin
507 -- We start with not allowing floating point. This way there never will
508 -- be overhead saving unused floating point registers, We'll also be
509 -- able to tell if floating point instructions were ever used.
510
511 Set_FPU_Enabled (False);
512 end Initialize_CPU;
513
514 ---------------------
515 -- Set_FPU_Enabled --
516 ---------------------
517
518 procedure Set_FPU_Enabled (Enabled : Boolean) is
519 begin
520 Asm ("fmxr fpexc, %0",
521 Inputs => Word'Asm_Input
522 ("r", (if Enabled then 16#4000_0000# else 0)),
523 Volatile => True);
524 pragma Assert (Is_FPU_Enabled = Enabled);
525 end Set_FPU_Enabled;
526 end System.BB.CPU_Primitives;