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;